From 3ffed564bc9ab34d6bf539d7b7b2d9e5dadd90b5 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 27 Nov 2006 05:30:57 +0000 Subject: [PATCH] Live search command handling improved --- TODO.FACTOR.txt | 2 - library/generic/tuple.factor | 2 +- library/generic/tuple.facts | 2 +- library/ui/tools/operations.factor | 25 ------------ library/ui/tools/search.factor | 64 +++++++++++------------------- 5 files changed, 26 insertions(+), 69 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index b49e5877e6..9f374db6b7 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,5 @@ + 0.87: -- module operations on module-links, etc -- empty search list, handle - variable width word wrap - graphical crossref tool - http://paste.lisp.org/display/30426 diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 9ffbb201e9..545f6facb6 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -92,7 +92,7 @@ M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ; : (delegates) ( obj -- ) - [ dup delegate (delegates) , ] when* ; + [ dup , delegate (delegates) ] when* ; : delegates ( obj -- seq ) [ (delegates) ] { } make ; diff --git a/library/generic/tuple.facts b/library/generic/tuple.facts index 39729b6e32..680582ee51 100644 --- a/library/generic/tuple.facts +++ b/library/generic/tuple.facts @@ -62,7 +62,7 @@ HELP: define-tuple HELP: delegates { $values { "obj" "an object" } { "seq" "a sequence" } } -{ $description "Outputs the delegation chain of an object. The last element of " { $snippet "seq" } " is " { $snippet "obj" } " itself. If " { $snippet "obj" } " is " { $link f } ", an empty sequence is output." } ; +{ $description "Outputs the delegation chain of an object. The first element of " { $snippet "seq" } " is " { $snippet "obj" } " itself. If " { $snippet "obj" } " is " { $link f } ", an empty sequence is output." } ; HELP: is? { $values { "obj" "an object" } { "quot" "a quotation with stack effect " { $snippet "( obj -- ? )" } } { "?" "a boolean" } } diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor index c42c7845ae..20304698f2 100644 --- a/library/ui/tools/operations.factor +++ b/library/ui/tools/operations.factor @@ -318,28 +318,3 @@ link class-operations [ help-action ] modify-commands [ command-name "Follow" = not ] subset append define-commands - -\ word-search "operations" -{ word compound } [ class-operations ] map concat -[ search-action ] modify-commands -define-commands - -\ vocab-search "operations" -\ vocab-link class-operations -[ search-action ] modify-commands -define-commands - -\ module-search "operations" -\ module class-operations -[ search-action ] modify-commands -define-commands - -\ source-file-search "operations" -\ pathname class-operations -[ search-action ] modify-commands -define-commands - -\ help-search "operations" -\ link class-operations -[ search-action ] modify-commands -define-commands diff --git a/library/ui/tools/search.factor b/library/ui/tools/search.factor index 4788893ffc..3a754b29d4 100644 --- a/library/ui/tools/search.factor +++ b/library/ui/tools/search.factor @@ -10,6 +10,18 @@ modules prettyprint ; TUPLE: live-search field list ; +: search-gesture ( gesture live-search -- command/f ) + live-search-list list-value object-operations + [ command-gesture = ] find-with nip ; + +M: live-search handle-gesture* ( gadget gesture delegate -- ? ) + drop over search-gesture dup [ + over find-workspace hide-popup + >r live-search-list list-value r> invoke-command f + ] [ + 2drop t + ] if ; + : find-live-search [ [ live-search? ] is? ] find-parent ; : find-search-list find-live-search live-search-list ; @@ -61,73 +73,45 @@ M: live-search focusable-child* live-search-field ; : delegate>live-search ( string seq producer presenter gadget -- ) >r r> set-gadget-delegate ; -TUPLE: word-search ; - -C: word-search ( string words -- gadget ) - >r +: ( string words -- gadget ) [ word-completions ] [ summary ] - r> - [ delegate>live-search ] keep ; + ; : help-completions ( str pairs -- seq ) >r >lower r> [ second >lower ] swap completions [ first ] map ; -TUPLE: help-search ; - -C: help-search ( string -- gadget ) - >r +: ( string -- gadget ) all-articles [ dup article-title 2array ] map [ [ second ] 2apply <=> ] sort [ help-completions ] [ article-title ] - r> - [ delegate>live-search ] keep ; + ; -TUPLE: source-file-search ; - -C: source-file-search ( string files -- gadget ) - >r +: ( string files -- gadget ) [ string-completions [ ] map ] [ pathname-string ] - r> - [ delegate>live-search ] keep ; + ; : module-completions ( str modules -- seq ) [ module-name ] swap completions ; -TUPLE: module-search ; - -C: module-search ( string -- gadget ) - >r +: ( string -- gadget ) available-modules [ module-completions ] [ module-string ] - r> - [ delegate>live-search ] keep ; + ; -TUPLE: vocab-search ; - -C: vocab-search ( string -- gadget ) - >r +: ( string -- gadget ) vocabs [ string-completions [ ] map ] [ vocab-link-name ] - r> - [ delegate>live-search ] keep ; + ; -TUPLE: history-search ; - -C: history-search ( string seq -- gadget ) - >r +: ( string seq -- gadget ) [ string-completions [ ] map ] [ input-string ] - r> - [ delegate>live-search ] keep ; - -: search-action ( search -- obj ) - dup find-workspace hide-popup - live-search-list list-value ; + ; : show-titled-popup ( workspace gadget title -- ) [ find-workspace hide-popup ]