From 027c53b5b73e82e4a604aee7cdf2f548681aba9a Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 19 Jul 2006 22:46:33 +0000 Subject: [PATCH] Removing old single-line editor and updating code --- library/bootstrap/boot-stage1.factor | 3 +- library/ui/cocoa/callback.factor | 4 +- library/ui/gadgets/editors.factor | 124 --------------------- library/ui/gadgets/line-editor.factor | 152 -------------------------- library/ui/gadgets/panes.factor | 64 ++--------- library/ui/gestures.factor | 3 +- library/ui/text/document.factor | 2 +- library/ui/text/editor.factor | 2 +- library/ui/text/field.factor | 7 +- library/ui/text/interactor.factor | 45 ++++++++ library/ui/tools/listener.factor | 32 ++++-- library/ui/tools/search.factor | 27 ++--- 12 files changed, 93 insertions(+), 372 deletions(-) delete mode 100644 library/ui/gadgets/editors.factor delete mode 100644 library/ui/gadgets/line-editor.factor create mode 100644 library/ui/text/interactor.factor diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index cd24a011c1..ea183a85a2 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -189,11 +189,9 @@ sequences vectors words ; "/library/ui/gadgets/borders.factor" "/library/ui/gadgets/buttons.factor" "/library/ui/gadgets/tiles.factor" - "/library/ui/gadgets/line-editor.factor" "/library/ui/gadgets/sliders.factor" "/library/ui/gadgets/viewports.factor" "/library/ui/gadgets/scrolling.factor" - "/library/ui/gadgets/editors.factor" "/library/ui/gadgets/tracks.factor" "/library/ui/gadgets/incremental.factor" "/library/ui/gadgets/paragraphs.factor" @@ -204,6 +202,7 @@ sequences vectors words ; "/library/ui/text/editor.factor" "/library/ui/text/commands.factor" "/library/ui/text/field.factor" + "/library/ui/text/interactor.factor" "/library/ui/ui.factor" "/library/ui/gadgets/presentations.factor" "/library/ui/tools/listener.factor" diff --git a/library/ui/cocoa/callback.factor b/library/ui/cocoa/callback.factor index ef6f21c18b..eaf14e8d66 100644 --- a/library/ui/cocoa/callback.factor +++ b/library/ui/cocoa/callback.factor @@ -4,7 +4,7 @@ IN: objc-classes DEFER: FactorCallback IN: cocoa -USING: hashtables kernel namespaces objc ; +USING: gadgets hashtables kernel namespaces objc ; SYMBOL: callbacks @@ -15,7 +15,7 @@ reset-callbacks "NSObject" "FactorCallback" { { "perform:" "void" { "id" "SEL" "id" } - [ 2drop callbacks get hash call ] + [ 2drop callbacks get hash ui-try ] } { "dealloc" "void" { "id" "SEL" } diff --git a/library/ui/gadgets/editors.factor b/library/ui/gadgets/editors.factor deleted file mode 100644 index 6fcf5fecf0..0000000000 --- a/library/ui/gadgets/editors.factor +++ /dev/null @@ -1,124 +0,0 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: gadgets-editors -USING: arrays freetype gadgets gadgets-labels gadgets-scrolling -gadgets-theme generic kernel math namespaces sequences strings -styles threads ; - -! A caret -TUPLE: caret ; - -C: caret ( -- caret ) - dup delegate>gadget - dup caret-theme - f over set-gadget-visible? ; - -USE: line-editor - -! An editor gadget wraps a line editor object and passes -! gestures to the line editor. - -TUPLE: editor line caret font color ; - -: with-editor ( editor quot -- ) - #! Execute a quotation in the line editor scope, then - #! update the display. - swap [ editor-line swap bind ] keep - dup relayout editor-caret scroll>gadget ; inline - -: editor-text ( editor -- text ) - editor-line [ line-text get ] bind ; - -: set-editor-text ( text editor -- ) - [ set-line-text ] with-editor ; - -: commit-editor-text ( editor -- line ) - #! Add current line to the history, and clear the editor. - [ commit-history line-text get line-clear ] with-editor ; - -: run-char-widths ( font str -- wlist ) - #! List of x co-ordinates of each character. - >array [ char-width ] map-with - dup 0 [ + ] accumulate swap 2 v/n v+ ; - -: x>offset ( x font str -- offset ) - dup >r run-char-widths [ <= ] find-with drop dup -1 = - [ drop r> length ] [ r> drop ] if ; - -: set-caret-x ( x editor -- ) - #! Move the caret to a clicked location. - dup [ - label-font lookup-font line-text get - x>offset set-caret-pos - ] with-editor ; - -: click-editor ( editor -- ) - dup hand-click-rel first over set-caret-x request-focus ; - -editor H{ - { T{ button-down } [ click-editor ] } - { T{ gain-focus } [ editor-caret show-gadget ] } - { T{ lose-focus } [ editor-caret hide-gadget ] } - { T{ key-down f f "BACKSPACE" } [ [ T{ char-elt } delete-prev-elt ] with-editor ] } - { T{ key-down f f "DELETE" } [ [ T{ char-elt } delete-next-elt ] with-editor ] } - { T{ key-down f { C+ } "BACKSPACE" } [ [ T{ word-elt } delete-prev-elt ] with-editor ] } - { T{ key-down f { C+ } "DELETE" } [ [ T{ word-elt } delete-next-elt ] with-editor ] } - { T{ key-down f { A+ } "BACKSPACE" } [ [ T{ document-elt } delete-prev-elt ] with-editor ] } - { T{ key-down f { A+ } "DELETE" } [ [ T{ document-elt } delete-next-elt ] with-editor ] } - { T{ key-down f f "LEFT" } [ [ T{ char-elt } prev-elt ] with-editor ] } - { T{ key-down f f "RIGHT" } [ [ T{ char-elt } next-elt ] with-editor ] } - { T{ key-down f { C+ } "LEFT" } [ [ T{ word-elt } prev-elt ] with-editor ] } - { T{ key-down f { C+ } "RIGHT" } [ [ T{ word-elt } next-elt ] with-editor ] } - { T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] } - { T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] } - { T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] } - { T{ button-up f 2 } [ dup click-editor selection get paste-clipboard ] } - { T{ paste-action } [ clipboard get paste-clipboard ] } -} set-gestures - -: add-editor-caret 2dup set-editor-caret add-gadget ; - -C: editor ( text -- ) - dup delegate>gadget - dup editor-theme - over set-editor-line - over add-editor-caret - [ set-editor-text ] keep ; - -: offset>x ( gadget offset str -- x ) - head-slice >r label-font lookup-font r> string-width ; - -: caret-loc ( editor -- x y ) - dup editor-line [ caret-pos line-text get ] bind offset>x - 0 2array ; - -: caret-dim ( editor -- w h ) - rect-dim { 0 1 } v* { 1 0 } v+ ; - -M: editor user-input* ( str editor -- ? ) - [ insert-string ] with-editor f ; - -M: editor pref-dim* ( editor -- dim ) - label-size { 1 0 } v+ ; - -M: editor layout* ( editor -- ) - dup editor-caret over caret-dim swap set-layout-dim - dup editor-caret swap caret-loc swap set-rect-loc ; - -M: editor label-text editor-text ; - -M: editor label-color editor-color ; - -M: editor label-font editor-font ; - -M: editor set-label-text set-editor-text ; - -M: editor set-label-color set-editor-color ; - -M: editor set-label-font set-editor-font ; - -M: editor draw-gadget* ( editor -- ) draw-label ; - -: set-possibilities ( possibilities editor -- ) - #! Set completion possibilities. - [ possibilities set ] with-editor ; diff --git a/library/ui/gadgets/line-editor.factor b/library/ui/gadgets/line-editor.factor deleted file mode 100644 index 560356eedc..0000000000 --- a/library/ui/gadgets/line-editor.factor +++ /dev/null @@ -1,152 +0,0 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: line-editor -USING: kernel math namespaces sequences strings vectors words ; - -SYMBOL: history -SYMBOL: history-index - -SYMBOL: line-text -SYMBOL: caret - -! Completion -SYMBOL: possibilities - -: history-length ( -- n ) - #! Call this in the line editor scope. - history get length ; - -: reset-history ( -- ) - #! Call this in the line editor scope. After user input, - #! resets the history index. - history-length history-index set ; - -! A point is a mutable object holding an index in the line -! editor. Changing text in the points registered with the -! line editor will move the point if it is after the changed -! text. -TUPLE: point index ; - -: (point-update) ( len from to index -- index ) - pick over > [ - >r 3drop r> - ] [ - 3dup -rot between? [ 2drop ] [ >r - + r> ] if + - ] if ; - -: point-update ( len from to point -- ) - #! Call this in the line editor scope. - [ point-index (point-update) ] keep set-point-index ; - -: line-replace ( str from to -- ) - #! Call this in the line editor scope. - reset-history - pick length pick pick caret get point-update - line-text [ replace-slice ] change ; - -: line-remove ( from to -- ) - #! Call this in the line editor scope. - "" -rot line-replace ; - -: line-length line-text get length ; - -: set-line-text ( text -- ) - #! Call this in the line editor scope. - 0 line-length line-replace ; - -: line-clear ( -- ) - #! Call this in the line editor scope. - "" set-line-text ; - -! An element is a unit of text; character, word, etc. -GENERIC: next-elt* ( i str element -- i ) -GENERIC: prev-elt* ( i str element -- i ) - -TUPLE: char-elt ; - -M: char-elt next-elt* 2drop 1+ ; -M: char-elt prev-elt* 2drop 1- ; - -TUPLE: word-elt ; - -M: word-elt next-elt* ( i str element -- i ) - drop dup length >r [ blank? ] find* drop dup -1 = - [ drop r> ] [ r> drop 1+ ] if ; - -M: word-elt prev-elt* ( i str element -- i ) - drop >r 1- r> [ blank? ] find-last* drop 1+ ; - -TUPLE: document-elt ; - -M: document-elt next-elt* rot 2drop length ; -M: document-elt prev-elt* 3drop 0 ; - -: caret-pos caret get point-index ; - -: set-caret-pos caret get set-point-index ; - -: next-elt@ ( element -- from to ) - >r caret-pos dup line-text get r> next-elt* line-length min ; - -: next-elt ( element -- ) - next-elt@ set-caret-pos drop ; - -: prev-elt@ ( element -- from to ) - >r caret-pos dup line-text get r> prev-elt* 0 max swap ; - -: prev-elt ( element -- ) - prev-elt@ drop set-caret-pos ; - -: delete-next-elt ( element -- ) - next-elt@ line-remove ; - -: delete-prev-elt ( element -- ) - prev-elt@ line-remove ; - -: insert-string ( str -- ) - #! Call this in the line editor scope. - caret-pos dup line-replace ; - -: commit-history ( -- ) - #! Call this in the line editor scope. Adds the currently - #! entered text to the history. - line-text get dup empty? - [ drop ] [ history get push reset-history ] if ; - -: ( -- editor ) - [ - "" line-text set - 0 caret set - V{ } clone history set - 0 history-index set - possibilities off - ] make-hash ; - -: goto-history ( n -- ) - #! Call this in the line editor scope. - dup history get nth set-line-text history-index set ; - -: history-prev ( -- ) - #! Call this in the line editor scope. - history-index get dup zero? [ - drop - ] [ - dup history-length = [ commit-history ] when - 1- goto-history - ] if ; - -: history-next ( -- ) - #! Call this in the line editor scope. - history-index get dup 1+ history-length >= - [ drop ] [ 1+ goto-history ] if ; - -: line-completions ( -- seq ) - T{ word-elt } prev-elt@ 2dup = [ - 2drop f - ] [ - line-text get subseq possibilities get completions - [ word-name ] map - ] if ; - -: complete ( completion -- ) - T{ word-elt } prev-elt@ line-replace ; diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor index 0b60a5c119..e8c35ef4e9 100644 --- a/library/ui/gadgets/panes.factor +++ b/library/ui/gadgets/panes.factor @@ -2,56 +2,22 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-panes USING: arrays gadgets gadgets-buttons gadgets-controls -gadgets-editors gadgets-frames gadgets-grids gadgets-labels -gadgets-scrolling gadgets-theme generic hashtables io kernel -line-editor math namespaces prettyprint sequences strings styles -threads ; +gadgets-frames gadgets-grids gadgets-labels gadgets-scrolling +gadgets-theme generic hashtables io kernel math namespaces +sequences strings ; -TUPLE: pane output active current input prototype continuation ; +TUPLE: pane output active current prototype ; : add-output 2dup set-pane-output add-gadget ; -: ( current input -- line ) - 2array [ ] subset make-shelf ; - : init-line ( pane -- ) dup pane-prototype clone swap set-pane-current ; : prepare-line ( pane -- ) dup init-line dup pane-active unparent - [ dup pane-current swap pane-input ] keep + [ pane-current 1array make-shelf ] keep 2dup set-pane-active add-gadget ; -: pop-continuation ( pane -- quot ) - dup pane-continuation f rot set-pane-continuation ; - -: pane-eval ( string pane -- ) - pop-continuation dup [ - [ continue-with ] in-thread - ] when 2drop ; - -SYMBOL: structured-input - -: pane-call ( quot pane -- ) - dup [ "Command: " write over short. ] with-stream* - >r structured-input set-global - "\"structured-input\" \"gadgets-panes\" lookup get-global call" - r> pane-eval ; - -: replace-input ( string pane -- ) pane-input set-editor-text ; - -: print-input ( string pane -- ) - [ - dup [ - presented set - bold font-style set - ] make-hash format terpri - ] with-stream* ; - -: pane-commit ( pane -- ) - dup pane-input commit-editor-text - swap 2dup print-input pane-eval ; - : pane-clear ( pane -- ) dup pane-output clear-incremental pane-current clear-gadget ; @@ -61,20 +27,6 @@ C: pane ( -- pane ) over add-output dup prepare-line ; -pane H{ - { T{ button-down } [ pane-input click-editor ] } - { T{ key-down f f "RETURN" } [ pane-commit ] } - { T{ key-down f f "UP" } [ pane-input [ history-prev ] with-editor ] } - { T{ key-down f f "DOWN" } [ pane-input [ history-next ] with-editor ] } - { T{ key-down f { C+ } "l" } [ pane-clear ] } -} set-gestures - -: ( -- pane ) - "" over set-pane-input ; - -M: pane focusable-child* ( pane -- editor ) - pane-input [ t ] unless* ; - : prepare-print ( current -- gadget ) #! Optimization: if line has 1 child, add the child. dup gadget-children { @@ -105,12 +57,10 @@ M: pane focusable-child* ( pane -- editor ) ! Panes are streams. M: pane stream-flush ( pane -- ) drop ; -M: pane stream-readln ( pane -- line ) - [ over set-pane-continuation stop ] callcc1 nip ; - : scroll-pane ( pane -- ) #! Only input panes scroll. - dup pane-input [ dup pane-active scroll>gadget ] when drop ; + drop ; + ! dup pane-input [ dup pane-active scroll>gadget ] when drop ; M: pane stream-terpri ( pane -- ) dup pane-current prepare-print diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index 4ae0c0f7f7..fb6776c878 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -6,7 +6,8 @@ sequences words ; : (gestures) ( gadget -- ) [ - dup "gestures" word-prop [ , ] when* delegate (gestures) + dup class "gestures" word-prop [ , ] when* + delegate (gestures) ] when* ; : gestures ( gadget -- seq ) [ (gestures) ] { } make ; diff --git a/library/ui/text/document.factor b/library/ui/text/document.factor index 0c794e0140..b50d08040f 100644 --- a/library/ui/text/document.factor +++ b/library/ui/text/document.factor @@ -17,7 +17,7 @@ test ; TUPLE: document locs ; C: document ( -- document ) - { "" } over set-delegate + V{ "" } clone over set-delegate V{ } clone over set-document-locs ; : add-loc document-locs push ; diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor index 917783e9e6..6ae86b89a6 100644 --- a/library/ui/text/editor.factor +++ b/library/ui/text/editor.factor @@ -3,7 +3,7 @@ IN: gadgets-text USING: arrays errors freetype gadgets gadgets-borders gadgets-buttons gadgets-frames gadgets-labels gadgets-scrolling -gadgets-theme io kernel math models namespaces opengl sequences +io kernel math models namespaces opengl sequences strings styles ; TUPLE: editor diff --git a/library/ui/text/field.factor b/library/ui/text/field.factor index aaffad0229..077bb9d5cc 100644 --- a/library/ui/text/field.factor +++ b/library/ui/text/field.factor @@ -13,12 +13,13 @@ C: field ( model -- field ) : field-next editor-document go-forward ; -: field-commit ( field -- ) - dup field-model [ >r editor-text r> set-model ] when* +: field-commit ( field -- string ) + [ editor-text ] keep + dup field-model [ dupd set-model ] when* editor-document dup add-history clear-doc ; field H{ { T{ key-down f { C+ } "p" } [ field-prev ] } { T{ key-down f { C+ } "n" } [ field-next ] } - { T{ key-down f f "ENTER" } [ field-commit ] } + { T{ key-down f f "RETURN" } [ field-commit drop ] } } set-gestures diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor new file mode 100644 index 0000000000..8c3ab77e5b --- /dev/null +++ b/library/ui/text/interactor.factor @@ -0,0 +1,45 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: gadgets-text +USING: gadgets gadgets-panes io kernel namespaces prettyprint +styles threads ; + +TUPLE: interactor output continuation ; + +C: interactor ( output -- gadget ) + [ set-interactor-output ] keep + f over set-gadget-delegate ; + +: interactor-eval ( string gadget -- ) + interactor-continuation dup + [ [ continue-with ] in-thread ] [ 2drop ] if ; + +SYMBOL: structured-input + +: interactor-call ( quot gadget -- ) + dup interactor-output [ + "Command: " write over short. + ] with-stream* + >r structured-input set-global + "\"structured-input\" \"gadgets-text\" lookup get-global call" + r> interactor-eval ; + +: print-input ( string interactor -- ) + interactor-output [ + dup [ + presented set + bold font-style set + ] make-hash format terpri + ] with-stream* ; + +: interactor-commit ( gadget -- ) + dup field-commit + swap 2dup print-input interactor-eval ; + +interactor H{ + { T{ key-down f f "RETURN" } [ interactor-commit ] } + { T{ key-down f { C+ } "l" } [ interactor-output pane-clear ] } +} set-gestures + +M: interactor stream-readln ( pane -- line ) + [ over set-interactor-continuation stop ] callcc1 nip ; diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index 492eca4419..a33800f355 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -1,21 +1,25 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-listener -USING: arrays gadgets gadgets-editors gadgets-frames -gadgets-labels gadgets-panes gadgets-presentations -gadgets-scrolling gadgets-theme gadgets-tiles gadgets-tracks -generic hashtables inspector io jedit kernel listener math -models namespaces parser prettyprint sequences shells styles -threads words ; +USING: arrays gadgets gadgets-frames gadgets-labels +gadgets-panes gadgets-presentations gadgets-scrolling +gadgets-text gadgets-theme gadgets-tiles gadgets-tracks generic +hashtables inspector io jedit kernel listener math models +namespaces parser prettyprint sequences shells styles threads +words ; -TUPLE: listener-gadget pane stack ; +TUPLE: listener-gadget input output stack ; : ui-listener-hook ( listener -- ) >r datastack-hook get call r> listener-gadget-stack set-model ; +: listener-stream ( listener -- stream ) + dup listener-gadget-input swap listener-gadget-output + ; + : listener-thread ( listener -- ) - dup listener-gadget-pane [ + dup listener-stream [ [ ui-listener-hook ] curry listener-hook set tty ] with-stream* ; @@ -23,6 +27,9 @@ TUPLE: listener-gadget pane stack ; [ >r clear r> init-namespaces listener-thread ] in-thread drop ; +: ( -- gadget ) + gadget get listener-gadget-output ; + : ( model quot title -- gadget ) >r r> f ; @@ -34,7 +41,8 @@ TUPLE: listener-gadget pane stack ; C: listener-gadget ( -- gadget ) f over set-listener-gadget-stack { - { [ ] set-listener-gadget-pane [ ] 5/6 } + { [ ] set-listener-gadget-output [ ] 4/6 } + { [ ] set-listener-gadget-input [ ] 1/6 } { [ ] f f 1/6 } } { 0 1 } make-track* dup start-listener ; @@ -42,15 +50,15 @@ M: listener-gadget pref-dim* delegate pref-dim* { 600 600 } vmax ; M: listener-gadget focusable-child* ( listener -- gadget ) - listener-gadget-pane ; + listener-gadget-input ; M: listener-gadget gadget-title drop "Listener" ; : listener-window ( -- ) open-window ; : call-listener ( quot/string listener -- ) - listener-gadget-pane over quotation? - [ pane-call ] [ replace-input ] if ; + listener-gadget-input over quotation? + [ interactor-call ] [ set-editor-text ] if ; : listener-tool [ listener-gadget? ] diff --git a/library/ui/tools/search.factor b/library/ui/tools/search.factor index 1dc6793055..55e983c5b0 100644 --- a/library/ui/tools/search.factor +++ b/library/ui/tools/search.factor @@ -1,27 +1,20 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-search -USING: gadgets gadgets-editors gadgets-frames gadgets-labels -gadgets-panes gadgets-scrolling gadgets-theme generic help -inspector kernel sequences words ; +USING: gadgets gadgets-frames gadgets-labels gadgets-panes +gadgets-scrolling gadgets-text gadgets-theme generic help +inspector kernel models sequences words ; -TUPLE: search-gadget pane input quot ; +TUPLE: search-gadget input ; -: do-search ( apropos -- ) - dup search-gadget-input commit-editor-text dup empty? [ - 2drop - ] [ - over search-gadget-pane - rot search-gadget-quot with-pane - ] if ; - -search-gadget H{ { T{ key-down f f "RETURN" } [ do-search ] } } -set-gestures +: ( model quot -- ) + [ over empty? [ 2drop ] [ call ] if ] curry + ; C: search-gadget ( quot -- ) - [ set-search-gadget-quot ] keep { - { [ ] set-search-gadget-pane [ ] @center } - { [ "" ] set-search-gadget-input f @top } + >r f dup r> { + { [ ] set-search-gadget-input f @top } + { [ swap ] f f @center } } make-frame* ; M: search-gadget focusable-child* search-gadget-input ;