From 74e132c6a6e62e615f1235797dfafc3ec801ecd2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 17 Dec 2005 03:28:14 +0000 Subject: [PATCH] split presentations into two files --- library/bootstrap/boot-stage1.factor | 1 + library/ui/commands.factor | 55 ++++++++++++++++++++++++++ library/ui/presentations.factor | 59 ++-------------------------- 3 files changed, 59 insertions(+), 56 deletions(-) create mode 100644 library/ui/commands.factor diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 0d63de9b1a..98d4d6eabe 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -186,6 +186,7 @@ vectors words ; "/library/ui/panes.factor" "/library/ui/books.factor" "/library/ui/outliner.factor" + "/library/ui/commands.factor" "/library/ui/presentations.factor" "/library/ui/listener.factor" "/library/ui/ui.factor" diff --git a/library/ui/commands.factor b/library/ui/commands.factor new file mode 100644 index 0000000000..8966700271 --- /dev/null +++ b/library/ui/commands.factor @@ -0,0 +1,55 @@ +IN: gadgets-presentations +USING: compiler gadgets gadgets-buttons gadgets-menus +gadgets-panes generic hashtables inference inspector jedit +kernel lists namespaces parser prettyprint sequences words ; + +SYMBOL: commands + +V{ } clone commands global set-hash + +: forget-command ( name -- ) + commands [ [ second = not ] subset-with ] change ; + +: define-command ( class name quot -- ) + over forget-command 3array commands get push ; + +: applicable ( object -- seq ) + commands get [ first call ] subset-with ; + +: command-quot ( presented quot -- quot ) + [ \ drop , curry , [ pane get pane-call ] % ] [ ] make ; + +TUPLE: command-button object ; + +: command-menu ( command-button -- ) + command-button-object dup applicable + [ [ third command-quot ] keep second swons ] map-with + show-hand-menu ; + +C: command-button ( gadget object -- button ) + [ + set-command-button-object + [ command-menu ] + ] keep + [ set-gadget-delegate ] keep + dup menu-button-actions ; + +M: command-button gadget-help ( button -- string ) + command-button-object dup word? [ synopsis ] [ summary ] if ; + +[ drop t ] "Prettyprint" [ . ] define-command +[ drop t ] "Describe" [ describe ] define-command +[ drop t ] "Push on data stack" [ ] define-command + +[ word? ] "See word" [ see ] define-command +[ word? ] "Word call hierarchy" [ uses. ] define-command +[ word? ] "Word caller hierarchy" [ usage. ] define-command +[ word? ] "Open in jEdit" [ jedit ] define-command +[ word? ] "Reload original source" [ reload ] define-command +[ compound? ] "Annotate with watchpoint" [ watch ] define-command +[ compound? ] "Annotate with breakpoint" [ break ] define-command +[ compound? ] "Annotate with profiling" [ profile ] define-command +[ word? ] "Compile" [ recompile ] define-command +[ word? ] "Infer stack effect" [ unit infer . ] define-command + +[ [ gadget? ] is? ] "Display gadget" [ gadget. ] define-command diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor index 55d28da6b7..6aa2fbca9b 100644 --- a/library/ui/presentations.factor +++ b/library/ui/presentations.factor @@ -1,45 +1,9 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets-presentations -USING: arrays compiler gadgets gadgets-borders gadgets-buttons -gadgets-labels gadgets-layouts gadgets-menus gadgets-outliner -gadgets-panes gadgets-theme generic hashtables inference -inspector io jedit kernel lists memory namespaces parser -prettyprint sequences strings styles words ; - -SYMBOL: commands - -V{ } clone commands global set-hash - -: forget-command ( name -- ) - commands [ [ second = not ] subset-with ] change ; - -: define-command ( class name quot -- ) - over forget-command 3array commands get push ; - -: applicable ( object -- seq ) - commands get [ first call ] subset-with ; - -: command-quot ( presented quot -- quot ) - [ \ drop , curry , [ pane get pane-call ] % ] [ ] make ; - -TUPLE: command-button object ; - -: command-menu ( command-button -- ) - command-button-object dup applicable - [ [ third command-quot ] keep second swons ] map-with - show-hand-menu ; - -C: command-button ( gadget object -- button ) - [ - set-command-button-object - [ command-menu ] - ] keep - [ set-gadget-delegate ] keep - dup menu-button-actions ; - -M: command-button gadget-help ( button -- string ) - command-button-object dup word? [ synopsis ] [ summary ] if ; +USING: arrays gadgets gadgets-labels gadgets-layouts +gadgets-outliner gadgets-panes hashtables io kernel sequences +strings styles ; : init-commands ( style gadget -- gadget ) presented rot hash [ ] when* ; @@ -91,20 +55,3 @@ M: gadget-stream stream-close ( stream -- ) drop ; M: pane with-nested-stream ( quot style stream -- ) >r >r make-pane r> paragraph-style r> pane-current add-gadget ; - -[ drop t ] "Prettyprint" [ . ] define-command -[ drop t ] "Describe" [ describe ] define-command -[ drop t ] "Push on data stack" [ ] define-command - -[ word? ] "See word" [ see ] define-command -[ word? ] "Word call hierarchy" [ uses. ] define-command -[ word? ] "Word caller hierarchy" [ usage. ] define-command -[ word? ] "Open in jEdit" [ jedit ] define-command -[ word? ] "Reload original source" [ reload ] define-command -[ compound? ] "Annotate with watchpoint" [ watch ] define-command -[ compound? ] "Annotate with breakpoint" [ break ] define-command -[ compound? ] "Annotate with profiling" [ profile ] define-command -[ word? ] "Compile" [ recompile ] define-command -[ word? ] "Infer stack effect" [ unit infer . ] define-command - -[ [ gadget? ] is? ] "Display gadget" [ gadget. ] define-command