From d5c1eba09a4fd7d5698fa4ee7f58e47bd98fca3f Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 28 Aug 2006 19:54:40 +0000 Subject: [PATCH] Commands/operations cleanup --- TODO.FACTOR.txt | 8 ----- library/collections/arrays.factor | 6 ++++ library/ui/commands.factor | 6 ++-- library/ui/text/interactor.factor | 53 ++++++++++++++++++++----------- library/ui/tools/listener.factor | 13 ++++---- library/ui/tools/workspace.factor | 31 +++++++++++------- 6 files changed, 68 insertions(+), 49 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index de498ed38f..f4a3954e54 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -14,8 +14,6 @@ - signal 4 on datastack underflow on mac intel?? - new section in cookbook: philosophy - help gadget should not re-render every time it is grafted -- clean up interactor and listener commands -- there is a lot of - duplication - keyboard help persists after clicking on a link - apropos and help search @@ -49,12 +47,6 @@ - fonts/ should go inside the .app -- we need multi-tier resource-path - should be possible to drop an image file on the .app to run it - add-gadget, model-changed, set-model should compile -- shortcuts: - - find a listener - - find a browser - - find a help window - - they'll either focus such a window, or if the current window is of - that type, cycle - support x11's large selections, if needed - own-selection violates ICCCM - cocoa: windows are not updated while resizing diff --git a/library/collections/arrays.factor b/library/collections/arrays.factor index 15730cd59f..264c158fe0 100644 --- a/library/collections/arrays.factor +++ b/library/collections/arrays.factor @@ -30,3 +30,9 @@ M: byte-array resize resize-array ; 3 swap [ 1 swap set-array-nth ] keep [ 0 swap set-array-nth ] keep ; + +: 4array ( x y z t -- array ) + 4 swap + [ 2 swap set-array-nth ] keep + [ 1 swap set-array-nth ] keep + [ 0 swap set-array-nth ] keep ; diff --git a/library/ui/commands.factor b/library/ui/commands.factor index eeff64dd52..72e8b7abef 100644 --- a/library/ui/commands.factor +++ b/library/ui/commands.factor @@ -71,9 +71,6 @@ world H{ SYMBOL: operations -: define-operation ( pred button# name quot -- ) - >r >r f r> f r> 3array operations get push-new ; - : object-operation ( obj button# -- command ) swap operations get [ >r class r> first class< ] subset-with @@ -82,3 +79,6 @@ SYMBOL: operations : object-operations ( object -- seq ) 3 [ 1+ object-operation ] map-with ; + +: ( name quot -- command ) + >r >r f r> f r> ; diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 87996d8d60..0cc6a9fae2 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-text -USING: definitions gadgets gadgets-controls gadgets-panes +USING: arrays definitions gadgets gadgets-controls gadgets-panes generic hashtables help io kernel namespaces prettyprint styles threads sequences vectors definitions parser words ; @@ -60,33 +60,48 @@ SYMBOL: structured-input swap interactor-eval ] if ; -: interactor-history. ( interactor -- ) - dup interactor-output [ - interactor-history [ dup print-input ] each +: interactor-history. ( -- ) + stdio get dup duplex-stream-out [ + duplex-stream-in interactor-history + [ dup print-input ] each ] with-stream* ; -: word-action ( interactor word -- ) +: token-action ( interactor quot -- ) over gadget-selection? [ over T{ word-elt } select-elt ] unless over gadget-selection add* swap interactor-call ; +: word-action ( interactor quot -- ) + search token-action ; + : usable-words ( -- seq ) use get [ hash-values natural-sort ] map concat prune ; -interactor { - { f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] } - { f "History" T{ key-down f { C+ } "h" } [ dup [ interactor-history. ] curry swap interactor-call ] } - { f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } - { f "Stack effect" T{ key-down f { C+ A+ } "i" } [ "infer ." quot-action ] } - { f "Single step" T{ key-down f { C+ A+ } "w" } [ "walk" quot-action ] } - { f "See" T{ key-down f { A+ } "s" } [ [ search see ] word-action ] } - { f "Help" T{ key-down f { A+ } "h" } [ [ search help ] word-action ] } - { f "Callers" T{ key-down f { A+ } "u" } [ [ search usage. ] word-action ] } - { f "Edit" T{ key-down f { A+ } "e" } [ [ search edit ] word-action ] } - { f "Reload" T{ key-down f { A+ } "r" } [ [ search reload ] word-action ] } - { f "Apropos (all)" T{ key-down f { A+ } "a" } [ [ apropos ] word-action ] } - { f "Apropos (used)" T{ key-down f f "TAB" } [ [ usable-words (apropos) ] word-action ] } -} define-commands +interactor [ + { f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] } , + { f "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] } , + { f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } , + + { + { f "Stack effect" T{ key-down f { C+ A+ } "i" } "infer ." } + { f "Single step" T{ key-down f { C+ A+ } "w" } "walk" } + { f "Single step" T{ key-down f { C+ A+ } "t" } "time" } + } [ first4 [ quot-action ] curry 4array ] map % + + { + { f "See" T{ key-down f { A+ } "s" } [ see ] } + { f "Help" T{ key-down f { A+ } "h" } [ help ] } + { f "Callers" T{ key-down f { A+ } "u" } [ usage. ] } + { f "Edit" T{ key-down f { A+ } "e" } [ edit ] } + { f "Reload" T{ key-down f { A+ } "r" } [ reload ] } + { f "Reload" T{ key-down f { A+ } "w" } [ watch ] } + } [ first4 [ word-action ] curry 4array ] map % + + { + { f "Apropos (all)" T{ key-down f { A+ } "a" } [ apropos ] } + { f "Apropos (used)" T{ key-down f f "TAB" } [ usable-words (apropos) ] } + } [ first4 [ token-action ] curry 4array ] map % +] { } make define-commands M: interactor stream-readln dup interactor-queue empty? [ diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index 357fefc5c1..1caa920384 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -2,11 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-listener USING: arrays gadgets gadgets-frames gadgets-labels -gadgets-panes gadgets-scrolling -gadgets-text gadgets-theme gadgets-tiles gadgets-tracks generic -hashtables inspector io kernel listener math models -namespaces parser prettyprint sequences shells styles threads -words memory ; +gadgets-panes gadgets-scrolling gadgets-text gadgets-theme +gadgets-tiles gadgets-tracks generic hashtables inspector io +kernel listener math models namespaces parser prettyprint +sequences shells styles threads words memory ; TUPLE: listener-gadget input output stack ; @@ -60,5 +59,5 @@ M: listener-gadget gadget-title drop "Listener" ; drop f ] if ; -: clear-listener ( listener -- ) - listener-gadget-output pane-clear ; +: clear-listener ( -- ) + stdio get duplex-stream-out pane-clear ; diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index 7351da837b..e009151b89 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -82,12 +82,17 @@ workspace { { f "Walker" T{ key-down f f "F3" } [ walker-gadget select-tool ] } { f "Dictionary" T{ key-down f f "F4" } [ browser select-tool ] } { f "Documentation" T{ key-down f f "F5" } [ help-gadget select-tool ] } + { f "New workspace" T{ key-down f { C+ } "n" } [ workspace-window drop ] } } define-commands V{ } clone operations set-global -\ word 2 "Edit" [ edit ] define-operation -link 2 "Edit" [ edit ] define-operation +: define-operation ( pred button# name tool quot -- ) + [ % , \ call-tool , ] [ ] make 3array + operations get push-new ; + +\ word 2 "Edit" [ [ edit ] curry ] listener-gadget define-operation +link 2 "Edit" [ [ edit ] curry ] listener-gadget define-operation ! Listener tool M: listener-gadget call-tool* ( quot/string listener -- ) @@ -102,14 +107,16 @@ M: listener-gadget call-tool* ( quot/string listener -- ) ] if ; listener-gadget { - { f "Clear" T{ key-down f f "CLEAR" } [ dup [ clear-listener ] curry listener-gadget call-tool ] } - { f "Globals" f [ [ global inspect ] listener-gadget call-tool ] } - { f "Memory" f [ [ heap-stats. room. ] listener-gadget call-tool ] } -} define-commands + { f "Clear" T{ key-down f f "CLEAR" } [ clear-listener ] } + { f "Globals" f [ global inspect ] } + { f "Memory" f [ heap-stats. room. ] } +} +[ first4 [ listener-gadget call-tool ] curry 4array ] map +define-commands -object 1 "Inspect" [ [ inspect ] curry listener-gadget call-tool ] define-operation -object 3 "Inspect" [ [ inspect ] curry listener-gadget call-tool ] define-operation -input 1 "Input" [ input-string listener-gadget call-tool ] define-operation +object 1 "Inspect" [ [ inspect ] curry ] listener-gadget define-operation +object 3 "Inspect" [ [ inspect ] curry ] listener-gadget define-operation +input 1 "Input" [ input-string ] listener-gadget define-operation ! Browser tool M: browser call-tool* @@ -119,13 +126,13 @@ M: browser call-tool* show-word ] if ; -\ word 1 "Browse" [ browser call-tool ] define-operation -vocab-link 1 "Browse" [ browser call-tool ] define-operation +\ word 1 "Browse" [ ] browser define-operation +vocab-link 1 "Browse" [ ] browser define-operation ! Help tool M: help-gadget call-tool* show-help ; -link 1 "Follow link" [ help-gadget call-tool ] define-operation +link 1 "Follow link" [ ] help-gadget define-operation ! Walker tool M: walker-gadget call-tool* ( arg tool -- )