From 97c59a3cf81ec56392894bd7b3b9f9b8e314777f Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 17 Nov 2006 09:34:22 +0000 Subject: [PATCH] Completion overhaul in UI --- TODO.FACTOR.txt | 13 ++--- doc/handbook/ui/tools.facts | 2 +- library/tools/completion.factor | 6 +- library/ui/commands.factor | 17 ++++-- library/ui/gadgets/lists.factor | 22 +++++--- library/ui/gadgets/presentations.factor | 2 +- library/ui/tools/browser.factor | 14 ++--- library/ui/tools/help.factor | 14 +---- library/ui/tools/listener.factor | 75 ++++++++++++------------- library/ui/tools/operations.factor | 16 +++--- 10 files changed, 86 insertions(+), 95 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 8530faefb4..eb4a99a9e9 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,14 +1,13 @@ + 0.87: +- vocab links don't work +- browse modules and vocabs by showing a new list +- get rid of the navigator in the browser tool +- list gadget mouse over help - tabs across the bottom: [History] [Words] [Vocabs] [Sources] [Modules] [Help] to show various search gadgets -- list: primary/secondary action -- search gadget: actions should -- fix top level window positioning when opening new windows - - cocoa: [center] - - x11: let the wm take care of it - - windows: ? +- top level window positioning on ms windows - scroll>rect broken if there are gadgets in between - completion is not ideal: eg, C+e "buttons" - crashes: @@ -17,7 +16,7 @@ - callback scheduling issue - httpd crash - fep when closing window - - got a random sig11 while reloading/recompiling + - : foo \ each reload foo ; foo eventually crashes - these things are "Too Slow": - all-words - make-image diff --git a/doc/handbook/ui/tools.facts b/doc/handbook/ui/tools.facts index c69ad0d148..239e73dc3e 100644 --- a/doc/handbook/ui/tools.facts +++ b/doc/handbook/ui/tools.facts @@ -27,7 +27,7 @@ ARTICLE: "ui-listener" "UI listener" { $commands interactor "interactor" } { $heading "Completion" } "Completion commands display a gadget at the bottom of the listener, known as the mini-buffer. Typing more text narrows down the list of available items. The " { $snippet "UP" } " and " { $snippet "DOWN" } " arrow keys shift the selection between listed items, and the " { $snippet "RETURN" } " key invokes a default operation for the selected item." -{ $commands listener-gadget "completion" } +{ $commands listener-gadget "popups" } { $heading "Word commands" } "These commands operate on the token at the caret position in the input area." { $commands interactor "words" } diff --git a/library/tools/completion.factor b/library/tools/completion.factor index 0b55bb42c3..2f5def00f7 100644 --- a/library/tools/completion.factor +++ b/library/tools/completion.factor @@ -61,11 +61,7 @@ USING: kernel arrays sequences math namespaces strings io ; : completions ( str quot candidates -- seq ) pick empty? [ - dup length 100 > [ - 3drop f - ] [ - 2nip - ] if + 2nip ] [ [ >r 2dup r> completion ] map 2nip rank-completions ] if ; inline diff --git a/library/ui/commands.factor b/library/ui/commands.factor index 8c7d485fd6..ad5dbf53f0 100644 --- a/library/ui/commands.factor +++ b/library/ui/commands.factor @@ -10,6 +10,8 @@ M: command equal? eq? ; GENERIC: invoke-command ( target command -- ) +M: f invoke-command ( target command -- ) 2drop ; + M: command invoke-command ( target command -- ) command-quot call ; @@ -58,9 +60,10 @@ SYMBOL: +name+ SYMBOL: +quot+ SYMBOL: +listener+ SYMBOL: +keyboard+ -SYMBOL: +default+ +SYMBOL: +primary+ +SYMBOL: +secondary+ -TUPLE: operation predicate listener? default? ; +TUPLE: operation predicate listener? primary? secondary? ; : (command) ( -- command ) +name+ get +keyboard+ get +quot+ get ; @@ -68,7 +71,8 @@ TUPLE: operation predicate listener? default? ; C: operation ( predicate hash -- operation ) swap [ (command) over set-delegate - +default+ get over set-operation-default? + +primary+ get over set-operation-primary? + +secondary+ get over set-operation-secondary? +listener+ get over set-operation-listener? ] bind [ set-operation-predicate ] keep ; @@ -82,8 +86,11 @@ SYMBOL: operations "predicate" word-prop operations get [ operation-predicate = ] subset-with ; -: default-operation ( obj -- command ) - object-operations [ operation-default? ] find-last nip ; +: primary-operation ( obj -- command ) + object-operations [ operation-primary? ] find-last nip ; + +: secondary-operation ( obj -- command ) + object-operations [ operation-secondary? ] find-last nip ; : modify-operation ( quot operation -- operation ) clone diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor index 95c8f1b176..5bc74fad05 100644 --- a/library/ui/gadgets/lists.factor +++ b/library/ui/gadgets/lists.factor @@ -4,15 +4,15 @@ IN: gadgets-lists USING: gadgets gadgets-labels gadgets-scrolling kernel sequences models opengl math namespaces gadgets-theme ; -TUPLE: list index presenter action color ; +TUPLE: list index hook presenter color ; : list-theme ( list -- ) { 0.8 0.8 1.0 1.0 } swap set-list-color ; -C: list ( action presenter model -- gadget ) +C: list ( hook presenter model -- gadget ) [ swap delegate>control ] keep [ set-list-presenter ] keep - [ set-list-action ] keep + [ set-list-hook ] keep 0 over set-list-index 1 over set-pack-fill dup list-theme ; @@ -67,11 +67,6 @@ M: list focusable-child* drop t ; : select-next ( list -- ) dup list-index 1+ swap select-index ; -: call-action ( list -- ) - dup list-empty? [ - dup list-value over list-action call - ] unless drop ; - : click-list ( list -- ) hand-gadget get [ gadget-parent list? ] find-parent dup [ @@ -81,10 +76,19 @@ M: list focusable-child* drop t ; 2drop ] if ; +: list-action ( list -- ) + dup list-empty? [ + drop + ] [ + [ + list-value dup secondary-operation invoke-command + ] keep list-hook call + ] if ; inline + list H{ { T{ button-down } [ dup request-focus click-list ] } { T{ drag } [ click-list ] } { T{ key-down f f "UP" } [ select-prev ] } { T{ key-down f f "DOWN" } [ select-next ] } - { T{ key-down f f "RETURN" } [ call-action ] } + { T{ key-down f f "RETURN" } [ list-action ] } } set-gestures diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor index fd7f93c753..55ed810dae 100644 --- a/library/ui/gadgets/presentations.factor +++ b/library/ui/gadgets/presentations.factor @@ -14,7 +14,7 @@ styles words help math models namespaces ; TUPLE: presentation object ; : invoke-presentation ( presentation -- ) - presentation-object dup default-operation invoke-command ; + presentation-object dup primary-operation invoke-command ; : show-mouse-help ( presentation -- ) dup find-world [ world-status set-model* ] [ drop ] if* ; diff --git a/library/ui/tools/browser.factor b/library/ui/tools/browser.factor index c9f474ee36..50ed9177cc 100644 --- a/library/ui/tools/browser.factor +++ b/library/ui/tools/browser.factor @@ -8,7 +8,7 @@ gadgets-workspace help gadgets-buttons gadgets-search tools ; IN: gadgets-browser -TUPLE: browser navigator definitions search ; +TUPLE: browser navigator definitions ; TUPLE: definitions showing ; @@ -49,6 +49,8 @@ C: tile ( definition -- gadget ) over set-gadget-delegate [ set-tile-definition ] keep ; +tile "toolbar" { { "Close" f [ close-tile ] } } define-commands + : show-definition ( definition definitions -- ) 2dup definition-index dup 0 >= [ over nth-gadget swap scroll>rect drop @@ -93,18 +95,10 @@ C: browser ( -- gadget ) [ ] set-browser-definitions [ ] - 3/5 - } - { - [ "" [ browser call-tool ] ] - set-browser-search - [ "Word search" ] - 1/5 + 4/5 } } { 0 1 } make-track* ; -M: browser focusable-child* browser-search ; - : show-vocab ( vocab browser -- ) browser-navigator navigator-vocab set-model* ; diff --git a/library/ui/tools/help.factor b/library/ui/tools/help.factor index 62f0ca44de..9005767ad5 100644 --- a/library/ui/tools/help.factor +++ b/library/ui/tools/help.factor @@ -5,7 +5,7 @@ USING: gadgets gadgets-borders gadgets-buttons gadgets-panes gadgets-search gadgets-scrolling help kernel models namespaces sequences gadgets-tracks gadgets-workspace ; -TUPLE: help-gadget pane history search ; +TUPLE: help-gadget pane history ; : show-help ( link help -- ) dup help-gadget-history add-history @@ -26,17 +26,9 @@ C: help-gadget ( -- gadget ) [ ] set-help-gadget-pane [ ] - 4/5 + @center } - { - [ "" [ help-gadget call-tool ] ] - set-help-gadget-search - [ "Help search" ] - 1/5 - } - } { 0 1 } make-track* ; - -M: help-gadget focusable-child* help-gadget-search ; + } make-frame* ; M: help-gadget call-tool* show-help ; diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index c58d55dfea..92518ee9a6 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -127,27 +127,28 @@ M: listener-gadget tool-help : show-titled-minibuffer ( listener gadget title -- ) swap show-minibuffer ; -: minibuffer-action ( quot -- quot ) - [ find-listener hide-minibuffer ] swap append ; - -: show-word-search ( listener action -- ) - minibuffer-action +: show-word-search ( listener words -- ) + >r [ find-listener hide-minibuffer ] >r dup listener-gadget-input selected-word r> - "Word search" show-titled-minibuffer ; + r> "Word search" show-titled-minibuffer ; -: show-source-files-search ( listener action -- ) - minibuffer-action - "" swap +: show-help-search ( listener -- ) + [ find-listener hide-minibuffer ] + "" swap "Help search" show-titled-minibuffer ; + +: show-source-file-search ( listener action -- ) + [ find-listener hide-minibuffer ] + "" swap "Source file search" show-titled-minibuffer ; -: show-vocabs-search ( listener action -- ) - minibuffer-action +: show-vocab-search ( listener action -- ) + [ find-listener hide-minibuffer ] >r dup listener-gadget-input selected-word r> - "Vocabulary search" show-titled-minibuffer ; + "Vocabulary search" show-titled-minibuffer ; -: show-modules-search ( listener action -- ) - minibuffer-action - "" swap +: show-module-search ( listener action -- ) + [ find-listener hide-minibuffer ] + "" swap "Module search" show-titled-minibuffer ; : listener-history ( listener -- seq ) @@ -158,26 +159,12 @@ M: listener-gadget tool-help : show-history ( listener -- ) dup listener-gadget-input editor-text - [ input-string history-action ] minibuffer-action + [ find-listener hide-minibuffer ] pick listener-history "History search" show-titled-minibuffer ; -: completion-string ( word listener -- string ) - >r dup word-name swap word-vocabulary dup vocab r> - listener-gadget-use memq? - [ drop ] [ [ "USE: " % % " " % % ] "" make ] if ; - -: insert-completion ( completion -- ) - find-listener [ completion-string ] keep - listener-gadget-input user-input ; - listener-gadget "toolbar" { { "Restart" f [ start-listener ] } - { - "History" - T{ key-down f { C+ } "h" } - [ show-history ] - } { "Clear output" T{ key-down f f "CLEAR" } @@ -191,26 +178,36 @@ listener-gadget "toolbar" { { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] } } define-commands -listener-gadget "completion" { +listener-gadget "popups" { { "Complete word" T{ key-down f f "TAB" } - [ [ insert-completion ] show-word-search ] - } - { - "Edit file" - T{ key-down f { C+ } "e" } - [ [ pathname-string edit-file ] show-source-files-search ] + [ all-words show-word-search ] } { "Use vocabulary" T{ key-down f { C+ } "u" } - [ [ [ vocab-link-name use+ ] curry call-listener ] show-vocabs-search ] + [ show-vocab-search ] + } + { + "History" + T{ key-down f { C+ } "p" } + [ show-history ] + } + { + "Help search" + T{ key-down f { C+ } "h" } + [ show-help-search ] } { "Run module" T{ key-down f { C+ } "m" } - [ [ [ module-name run-module ] curry call-listener ] show-modules-search ] + [ show-module-search ] + } + { + "Edit file" + T{ key-down f { C+ } "e" } + [ show-source-file-search ] } { "Hide minibuffer" diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor index cef6c05310..d16763ebdc 100644 --- a/library/ui/tools/operations.factor +++ b/library/ui/tools/operations.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-workspace USING: definitions gadgets gadgets-browser gadgets-dataflow -gadgets-help gadgets-listener gadgets-text gadgets-workspace -hashtables help inference kernel namespaces parser prettyprint -scratchpad sequences strings styles syntax test tools words -generic models io modules ; +gadgets-help gadgets-listener gadgets-search gadgets-text +gadgets-workspace hashtables help inference kernel namespaces +parser prettyprint scratchpad sequences strings styles syntax +test tools words generic models io modules ; V{ } clone operations set-global @@ -25,7 +25,7 @@ M: operation invoke-command ( target operation -- ) ! Objects [ drop t ] H{ - { +default+ t } + { +primary+ t } { +name+ "Inspect" } { +quot+ [ inspect ] } { +listener+ t } @@ -45,15 +45,17 @@ M: operation invoke-command ( target operation -- ) ! Input [ input? ] H{ - { +default+ t } + { +primary+ t } + { +secondary+ t } { +name+ "Input" } { +quot+ [ listener-gadget call-tool ] } } define-operation ! Pathnames [ pathname? ] H{ - { +default+ t } + { +primary+ t } { +name+ "Edit" } + { +keyboard+ T{ key-down f { A+ } "e" } } { +quot+ [ pathname-string edit-file ] } } define-operation