diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 41ff57a492..b0a7fac8fd 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,13 +1,7 @@ + 0.87: - live search operations need to hide the minibuffer -- 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 - top level window positioning on ms windows - scroll>rect broken if there are gadgets in between - completion is not ideal: eg, C+e "buttons" diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor index 5bc74fad05..636f69e7c2 100644 --- a/library/ui/gadgets/lists.factor +++ b/library/ui/gadgets/lists.factor @@ -82,7 +82,7 @@ M: list focusable-child* drop t ; ] [ [ list-value dup secondary-operation invoke-command - ] keep list-hook call + ] keep dup list-hook call ] if ; inline list H{ diff --git a/library/ui/gadgets/theme.factor b/library/ui/gadgets/theme.factor index f45ea5ef09..89ec7191d7 100644 --- a/library/ui/gadgets/theme.factor +++ b/library/ui/gadgets/theme.factor @@ -103,3 +103,7 @@ USING: arrays gadgets kernel sequences styles ; { 1.0 0.0 0.0 1.0 } over set-editor-caret-color { 0.8 0.8 1.0 1.0 } over set-editor-selection-color { "monospace" plain 12 } swap set-editor-font ; + +: popup-theme ( gadget -- ) + T{ solid f { 0.95 0.95 0.95 0.95 } } + swap set-gadget-interior ; diff --git a/library/ui/load.factor b/library/ui/load.factor index d347d78d8f..b5f4e0072a 100644 --- a/library/ui/load.factor +++ b/library/ui/load.factor @@ -39,7 +39,6 @@ PROVIDE: library/ui "gadgets/presentations.factor" "ui.factor" "tools/tools.factor" - "tools/search.factor" "tools/messages.factor" "tools/listener.factor" "tools/walker.factor" @@ -47,6 +46,7 @@ PROVIDE: library/ui "tools/help.factor" "tools/dataflow.factor" "tools/workspace.factor" + "tools/search.factor" "tools/operations.factor" "text/editor.facts" } } diff --git a/library/ui/tools/browser.factor b/library/ui/tools/browser.factor index 50ed9177cc..1ebf55895d 100644 --- a/library/ui/tools/browser.factor +++ b/library/ui/tools/browser.factor @@ -4,11 +4,10 @@ USING: arrays sequences kernel gadgets-panes definitions prettyprint gadgets-theme gadgets-borders gadgets generic gadgets-scrolling math io words models styles namespaces gadgets-tracks gadgets-presentations -gadgets-workspace help gadgets-buttons -gadgets-search tools ; +gadgets-workspace help gadgets-buttons tools ; IN: gadgets-browser -TUPLE: browser navigator definitions ; +TUPLE: browser definitions ; TUPLE: definitions showing ; @@ -60,51 +59,15 @@ tile "toolbar" { { "Close" f [ close-tile ] } } define-commands scroll>bottom ] if ; -: ( model quot -- gadget ) - [ map [ first2 write-object terpri ] each ] curry - ; - -TUPLE: navigator vocab ; - -: ( -- gadget ) - vocabs [ dup 2array ] - ; - -: ( model -- gadget ) - gadget get navigator-vocab - [ words natural-sort ] - [ dup word-name swap 2array ] - ; - -C: navigator ( -- gadget ) - f over set-navigator-vocab - { - { [ ] f [ ] 1/2 } - { [ ] f [ ] 1/2 } - } { 1 0 } make-track* ; - C: browser ( -- gadget ) { - { - [ ] - set-browser-navigator - f - 1/5 - } { [ ] set-browser-definitions [ ] - 4/5 + @center } - } { 0 1 } make-track* ; - -: show-vocab ( vocab browser -- ) - browser-navigator navigator-vocab set-model* ; - -: show-word ( word browser -- ) - over word-vocabulary over show-vocab - browser-definitions show-definition ; + } make-frame* ; : clear-browser ( browser -- ) browser-definitions close-definitions ; @@ -114,11 +77,7 @@ browser "toolbar" { } define-commands M: browser call-tool* - over vocab-link? [ - >r vocab-link-name r> show-vocab - ] [ - show-word - ] if ; + browser-definitions show-definition ; M: browser tool-scroller browser-definitions find-scroller ; diff --git a/library/ui/tools/help.factor b/library/ui/tools/help.factor index 9005767ad5..b209e86ef0 100644 --- a/library/ui/tools/help.factor +++ b/library/ui/tools/help.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-help USING: gadgets gadgets-borders gadgets-buttons -gadgets-panes gadgets-search gadgets-scrolling help kernel +gadgets-panes gadgets-scrolling help kernel models namespaces sequences gadgets-tracks gadgets-workspace ; TUPLE: help-gadget pane history ; diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index 92518ee9a6..24d7b2f939 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-listener -USING: compiler arrays gadgets gadgets-labels -gadgets-panes gadgets-scrolling gadgets-text gadgets-lists -gadgets-search gadgets-theme gadgets-tracks gadgets-workspace +USING: arrays compiler gadgets gadgets-labels +gadgets-panes gadgets-scrolling gadgets-text +gadgets-theme gadgets-tracks gadgets-workspace generic hashtables tools io kernel listener math models namespaces parser prettyprint sequences shells strings styles -threads words definitions help modules ; +threads words definitions help ; -TUPLE: listener-gadget input output stack use minibuffer ; +TUPLE: listener-gadget input output stack use ; : ui-listener-hook ( listener -- ) use get over set-listener-gadget-use @@ -113,56 +113,6 @@ M: listener-gadget tool-help : clear-listener-stack ( listener -- ) [ clear ] swap (call-listener) ; -: hide-minibuffer ( listener -- ) - dup listener-gadget-minibuffer dup - [ over track-remove ] [ drop ] if - dup listener-gadget-input request-focus - f swap set-listener-gadget-minibuffer ; - -: show-minibuffer ( gadget listener -- ) - [ hide-minibuffer ] keep - [ set-listener-gadget-minibuffer ] 2keep - dupd track-add request-focus ; - -: show-titled-minibuffer ( listener gadget title -- ) - swap show-minibuffer ; - -: show-word-search ( listener words -- ) - >r [ find-listener hide-minibuffer ] - >r dup listener-gadget-input selected-word r> - r> "Word search" show-titled-minibuffer ; - -: 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-vocab-search ( listener action -- ) - [ find-listener hide-minibuffer ] - >r dup listener-gadget-input selected-word r> - "Vocabulary search" show-titled-minibuffer ; - -: show-module-search ( listener action -- ) - [ find-listener hide-minibuffer ] - "" swap - "Module search" show-titled-minibuffer ; - -: listener-history ( listener -- seq ) - listener-gadget-input interactor-history ; - -: history-action ( string -- ) - find-listener listener-gadget-input set-editor-text ; - -: show-history ( listener -- ) - dup listener-gadget-input editor-text - [ find-listener hide-minibuffer ] - pick listener-history - "History search" show-titled-minibuffer ; - listener-gadget "toolbar" { { "Restart" f [ start-listener ] } { @@ -177,41 +127,3 @@ listener-gadget "toolbar" { } { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] } } define-commands - -listener-gadget "popups" { - { - "Complete word" - T{ key-down f f "TAB" } - [ all-words show-word-search ] - } - { - "Use vocabulary" - T{ key-down f { C+ } "u" } - [ 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" } - [ show-module-search ] - } - { - "Edit file" - T{ key-down f { C+ } "e" } - [ show-source-file-search ] - } - { - "Hide minibuffer" - T{ key-down f f "ESCAPE" } - [ hide-minibuffer ] - } -} define-commands diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor index 00faf44f29..0b054eac05 100644 --- a/library/ui/tools/operations.factor +++ b/library/ui/tools/operations.factor @@ -54,8 +54,8 @@ M: operation invoke-command ( target operation -- ) ! Pathnames [ pathname? ] H{ { +primary+ t } + { +secondary+ t } { +name+ "Edit" } - { +keyboard+ T{ key-down f { A+ } "e" } } { +quot+ [ pathname-string edit-file ] } } define-operation @@ -148,19 +148,21 @@ M: operation invoke-command ( target operation -- ) { +primary+ t } { +name+ "Browse" } { +keyboard+ T{ key-down f { A+ } "b" } } - { +quot+ [ browser call-tool ] } + { +quot+ [ vocab-link-name find-workspace swap show-vocab-words ] } } define-operation [ vocab-link? ] H{ { +name+ "Enter in" } { +keyboard+ T{ key-down f { A+ } "i" } } - { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] } + { +quot+ [ vocab-link-name set-in ] } + { +listener+ t } } define-operation [ vocab-link? ] H{ { +secondary+ t } { +name+ "Use" } - { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] } + { +quot+ [ vocab-link-name use+ ] } + { +listener+ t } } define-operation [ vocab-link? ] H{ @@ -171,12 +173,25 @@ M: operation invoke-command ( target operation -- ) ! Modules [ module? ] H{ - { +primary+ t } + { +secondary+ t } { +name+ "Run" } { +quot+ [ module-name run-module ] } { +listener+ t } } define-operation +[ module? ] H{ + { +name+ "Load" } + { +quot+ [ module-name require ] } + { +listener+ t } +} define-operation + +[ module? ] H{ + { +name+ "Reload" } + { +keyboard+ T{ key-down f { A+ } "r" } } + { +quot+ [ reload-module ] } + { +listener+ t } +} define-operation + [ module? ] H{ { +name+ "Documentation" } { +keyboard+ T{ key-down f { A+ } "h" } } @@ -190,16 +205,37 @@ M: operation invoke-command ( target operation -- ) } define-operation [ module? ] H{ - { +name+ "Reload" } - { +keyboard+ T{ key-down f { A+ } "r" } } - { +quot+ [ reload-module ] } + { +primary+ t } + { +name+ "Browse" } + { +keyboard+ T{ key-down f { A+ } "b" } } + { +quot+ [ find-workspace swap show-module-files ] } { +listener+ t } } define-operation [ module? ] H{ { +name+ "See" } - { +keyboard+ T{ key-down f { A+ } "b" } } - { +quot+ [ see ] } + { +quot+ [ browser call-tool ] } + { +listener+ t } +} define-operation + +[ module? ] H{ + { +name+ "Test" } + { +quot+ [ module-name test-module ] } + { +listener+ t } +} define-operation + +! Module links +[ module-link? ] H{ + { +primary+ t } + { +secondary+ t } + { +name+ "Run" } + { +quot+ [ module-name run-module ] } + { +listener+ t } +} define-operation + +[ module-link? ] H{ + { +name+ "Load" } + { +quot+ [ module-name require ] } { +listener+ t } } define-operation diff --git a/library/ui/tools/search.factor b/library/ui/tools/search.factor index 75ce1c5812..9effe17c60 100644 --- a/library/ui/tools/search.factor +++ b/library/ui/tools/search.factor @@ -4,8 +4,9 @@ IN: gadgets-search USING: arrays gadgets gadgets-labels gadgets-panes gadgets-scrolling gadgets-text gadgets-theme generic help tools kernel models sequences words -gadgets-borders gadgets-lists namespaces parser hashtables io -completion styles strings modules ; +gadgets-borders gadgets-lists gadgets-workspace gadgets-listener +namespaces parser hashtables io completion styles strings +modules ; TUPLE: live-search field list ; @@ -31,10 +32,12 @@ search-field H{ [ "\n" join ] swap ; -: ( hook seq producer presenter -- gadget ) - -rot curry ; +: ( seq producer presenter -- gadget ) + -rot curry + [ [ workspace? ] find-parent hide-popup ] -rot + ; -C: live-search ( string hook seq producer presenter -- gadget ) +C: live-search ( string seq producer presenter -- gadget ) { { [ ] @@ -49,16 +52,18 @@ C: live-search ( string hook seq producer presenter -- gadget ) @center } } make-frame* - [ live-search-field set-editor-text ] keep ; + [ live-search-field set-editor-text ] keep + [ live-search-field select-all ] keep + dup popup-theme ; M: live-search focusable-child* live-search-field ; -: delegate>live-search ( string hook seq producer presenter gadget -- ) +: delegate>live-search ( string seq producer presenter gadget -- ) >r r> set-gadget-delegate ; TUPLE: word-search ; -C: word-search ( string action words -- gadget ) +C: word-search ( string words -- gadget ) >r [ word-completions ] [ word-name ] @@ -72,7 +77,7 @@ C: word-search ( string action words -- gadget ) TUPLE: help-search ; -C: help-search ( string action -- gadget ) +C: help-search ( string -- gadget ) >r all-articles [ dup article-title 2array ] map [ [ second ] 2apply <=> ] sort @@ -83,9 +88,8 @@ C: help-search ( string action -- gadget ) TUPLE: source-file-search ; -C: source-file-search ( string action -- gadget ) +C: source-file-search ( string files -- gadget ) >r - source-files get hash-keys natural-sort [ string-completions [ ] map ] [ pathname-string ] r> @@ -96,7 +100,7 @@ C: source-file-search ( string action -- gadget ) TUPLE: module-search ; -: module-search ( string action -- gadget ) +C: module-search ( string -- gadget ) >r available-modules [ module-completions ] [ module-name ] @@ -105,7 +109,7 @@ TUPLE: module-search ; TUPLE: vocab-search ; -C: vocab-search ( string action -- gadget ) +C: vocab-search ( string -- gadget ) >r vocabs [ string-completions [ ] map ] [ vocab-link-name ] @@ -114,7 +118,7 @@ C: vocab-search ( string action -- gadget ) TUPLE: history-search ; -C: history-search ( string action seq -- gadget ) +C: history-search ( string seq -- gadget ) >r [ string-completions [ ] map ] [ input-string ] @@ -123,3 +127,86 @@ C: history-search ( string action seq -- gadget ) : search-action ( search -- obj ) live-search-list list-value ; + +: show-titled-popup ( workspace gadget title -- ) + swap show-popup ; + +: workspace-listener ( workspace -- listener ) + listener-gadget swap find-tool tool-gadget nip ; + +: current-word ( workspace -- string ) + workspace-listener listener-gadget-input selected-word ; + +: show-word-search ( workspace words -- ) + >r dup current-word r> + "Word search" show-titled-popup ; + +: show-vocab-words ( workspace vocab -- ) + "" over words + "Words in " rot append show-titled-popup ; + +: show-help-search ( workspace -- ) + "" "Help search" show-titled-popup ; + +: all-source-files ( -- seq ) + source-files get hash-keys natural-sort ; + +: show-source-file-search ( workspace -- ) + "" all-source-files + "Source file search" show-titled-popup ; + +: show-module-files ( workspace module -- ) + "" over module-files + "Source files in " rot module-name append show-titled-popup ; + +: show-vocab-search ( workspace -- ) + dup current-word + "Vocabulary search" show-titled-popup ; + +: show-module-search ( workspace -- ) + "" "Module search" show-titled-popup ; + +: listener-history ( listener -- seq ) + listener-gadget-input interactor-history ; + +: history-action ( string -- ) + find-listener listener-gadget-input set-editor-text ; + +: show-history ( workspace -- ) + dup workspace-listener + [ listener-gadget-input editor-text ] keep listener-history + + "History search" show-titled-popup ; + +workspace "toolbar" { + { + "History" + T{ key-down f { C+ } "p" } + [ show-history ] + } + { + "Words" + T{ key-down f f "TAB" } + [ all-words show-word-search ] + } + { + "Vocabularies" + T{ key-down f { C+ } "u" } + [ show-vocab-search ] + } + { + "Modules" + T{ key-down f { C+ } "m" } + [ show-module-search ] + } + { + "Sources" + T{ key-down f { C+ } "e" } + [ show-source-file-search ] + } + { + "Search help" + T{ key-down f { C+ } "h" } + [ show-help-search ] + } +} define-commands diff --git a/library/ui/tools/tools.factor b/library/ui/tools/tools.factor index 477ed3f3f5..3b509f30b2 100644 --- a/library/ui/tools/tools.factor +++ b/library/ui/tools/tools.factor @@ -20,15 +20,17 @@ GENERIC: tool-help ( tool -- topic ) M: gadget tool-help drop f ; -TUPLE: workspace ; +TUPLE: workspace book popup ; TUPLE: tool gadget ; : find-tool ( class workspace -- index tool ) - gadget-children [ tool-gadget class eq? ] find-with ; + workspace-book gadget-children + [ tool-gadget class eq? ] find-with ; : show-tool ( class workspace -- tool ) - [ find-tool swap ] keep control-model set-model* ; + [ find-tool swap ] keep workspace-book control-model + set-model* ; : select-tool ( workspace class -- ) swap show-tool drop ; diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index c0d2019f2f..41e85a30cd 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -53,14 +53,19 @@ tool "toolbar" { { "Dataflow" } } ; +: ( -- gadget ) + workspace-tabs 1 [ execute ] map ; + C: workspace ( -- workspace ) - workspace-tabs 1 [ execute ] map - over set-gadget-delegate dup dup set-control-self ; + { + { [ ] set-workspace-book f @center } + { [ gadget get { workspace } ] f f @bottom } + } make-frame* ; M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; -: ( book -- tabs ) - control-model +: ( workspace -- tabs ) + workspace-book control-model workspace-tabs dup length [ swap first 2array ] 2map ; @@ -70,6 +75,33 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; : init-tabs ( world -- ) [ world-gadget ] keep @top grid-add ; +: hide-popup ( workspace -- ) + dup workspace-popup unparent + f over set-workspace-popup + request-focus ; + +: show-popup ( gadget workspace -- ) + dup hide-popup 2dup set-workspace-popup dupd add-gadget + request-focus ; + +: popup-dim ( workspace -- dim ) + rect-dim first2 3 /i 2array ; + +: popup-loc ( workspace -- loc ) + dup rect-dim swap popup-dim v- ; + +: layout-popup ( workspace gadget -- ) + over popup-dim over set-gadget-dim + swap popup-loc swap set-rect-loc ; + +M: workspace layout* + dup delegate layout* + dup workspace-popup dup [ layout-popup ] [ 2drop ] if ; + +M: workspace children-on nip gadget-children ; + +M: workspace focusable-child* workspace-book ; + : workspace-window ( -- workspace ) dup [ init-status ] keep @@ -91,6 +123,7 @@ workspace "scrolling" { } define-commands workspace "tool-switch" { + { "Hide popup" T{ key-down f f "ESCAPE" } [ hide-popup ] } { "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] } { "Messages" T{ key-down f f "F3" } [ messages select-tool ] } { "Definitions" T{ key-down f f "F4" } [ browser select-tool ] }