diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 7755e81592..77486288b6 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -2,8 +2,6 @@ - fix alien-callback/SEH bug on win32 - x11: scroll up/down wiggles caret - tab completion: add a USE: if necessary -- cocoa: horizontal wheel scrolling -- rollover is not updated on window focus changes - cocoa: windows are not updated while resizing + ui: diff --git a/doc/handbook/ui/tools.facts b/doc/handbook/ui/tools.facts index e055225e13..52ce942427 100644 --- a/doc/handbook/ui/tools.facts +++ b/doc/handbook/ui/tools.facts @@ -1,7 +1,7 @@ USING: gadgets gadgets-listener gadgets-browser gadgets-help gadgets-presentations gadgets-walker gadgets-dataflow gadgets-workspace help gadgets-panes gadgets-text listener -definitions prettyprint io parser ; +definitions prettyprint io parser modules compiler ; ARTICLE: "ui-presentations" "Presentations in the UI" "A " { $emphasis "presentation" } " is a graphical view of an object which is directly linked to the object in some way. The help article links you see in the documentation browser are presentations; and if you " { $link see } " a word in the UI listener, all words in the definition will themselves be presentations." @@ -21,26 +21,38 @@ ARTICLE: "ui-listener" "UI listener" "Completion" { "Clickable presentations (see " { $link "ui-presentations" } ")" } } -"The below 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 } -"The below word commands operate on the token at the caret position in the input area. The quotation commands operate on the entire contents of the input area." -{ $commands interactor } +{ $heading "Listener commands" } +{ $commands listener-gadget "toolbar" } +{ $heading "Interactor commands" } +{ $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" } +{ $heading "Word commands" } +"These commands operate on the token at the caret position in the input area." +{ $commands interactor "words" } +{ $heading "Quotation commands" } +"These commands operate on the entire contents of the input area." +{ $commands interactor "quotations" } +{ $heading "Editing commands" } +"The text editing commands are standard and are documented in the " { $link editor } " class." +{ $heading "Implementation" } "Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } "), an input area (instance of " { $link interactor } "), and a stack display kept up to date using a " { $link listener-hook } "." ; ARTICLE: "ui-browser" "UI definition browser" -{ $commands browser } +{ $commands browser "toolbar" } "Definition browsers are instances of " { $link browser } "." ; ARTICLE: "ui-help" "UI documentation browser" "The documentation browser is used to display Factor documentation, which is rooted at the " { $link "handbook" } " page." -{ $commands help-gadget } +{ $commands help-gadget "toolbar" } "Documentation browsers are instances of " { $link help-gadget } "." ; ARTICLE: "ui-walker" "UI walker" "The walker single-steps through quotations. To use the walker, enter a piece of code in the listener's input area and press " { $snippet "C+A+w" } "." $terpri "The walker can travel backwards through time, and restore stacks. This does not undo side effects and therefore can only be used reliably on referentially transparent code." -{ $commands walker-gadget } +{ $commands walker-gadget "toolbar" } "Walkers are instances of " { $link walker-gadget } "." ; ARTICLE: "ui-dataflow" "UI dataflow tool" @@ -49,7 +61,7 @@ $terpri "Only quotations and words for which a stack effect can be inferred can be viewed. See " { $link "inference" } "." $terpri "The dataflow viewer displays the dataflow intermediate representation output by the compiler's optimizer. Therefore inlining and various other optimizations will have already been performed, and the visual representation may not resemble your original code in many ways. An upside of this arrangement is that the dataflow viewer can be used to predict how fast the code will run, because you will see which layers of generic dispatch have been optimized out at compile time." -{ $commands dataflow-gadget } +{ $commands dataflow-gadget "toolbar" } "Dataflow viewers are instances of " { $link dataflow-gadget } "." ; ARTICLE: "ui-cocoa" "Functionality specific to Mac OS X" @@ -77,9 +89,21 @@ $terpri { "Single stepping through the code makes the problem obvious, so you right-click on a presentation of the broken word in the stepper, and choose " { $strong "Edit" } " from the resulting popup menu." } { "After fixing the problem in the source editor, you right click on the word in the stepper and invoke " { $strong "Reload" } "." } } -"All development tools are integrated into a single-window " { $emphasis "workspace" } ". Multiple workspaces can be open at once, and keyboard commands are provided for switching between tools." -{ $commands workspace } +{ $heading "Switching tools" } +"All development tools are integrated into a single-window " { $emphasis "workspace" } "." +{ $commands workspace "tool-switch" } +{ $heading "Opening new windows" } +"Multiple workspace windows can be open at once." +{ $commands workspace "tool-window" } +{ $heading "Scrolling" } +"The current tool's scroll pane can be scrolled from the keyboard." +{ $commands workspace "scrolling" } +{ $heading "Workflow" } +"A pair of commands for invoking " { $link reload-modules } " and " { $link recompile } "." +{ $commands workspace "workflow" } +{ $heading "Implementation" } "Workspaces are instances of " { $link workspace-window } "." +{ $heading "Tools" } { $subsection "ui-presentations" } { $subsection "ui-listener" } { $subsection "ui-browser" } diff --git a/library/tools/listener.factor b/library/tools/listener.factor index deb1e91c63..3c8e46be4e 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -12,12 +12,12 @@ SYMBOL: listener-hook : (read-multiline) ( quot depth -- newquot ? ) >r readln dup [ (parse) depth r> dup >r <= [ - ( we're done ) r> drop t + r> drop t ] [ - ( more input needed ) r> (read-multiline) + r> (read-multiline) ] if ] [ - ( EOF ) r> 2drop f + r> 2drop f ] if ; : read-multiline ( -- quot ? ) diff --git a/library/ui/cocoa/view-utils.factor b/library/ui/cocoa/view-utils.factor index 3d895f53c9..50ed465501 100644 --- a/library/ui/cocoa/view-utils.factor +++ b/library/ui/cocoa/view-utils.factor @@ -246,6 +246,7 @@ opengl sequences ; [ [ 2drop dup view-dim swap window set-gadget-dim + ui-step ] ui-try ] } diff --git a/library/ui/cocoa/window-utils.factor b/library/ui/cocoa/window-utils.factor index 88cd43b276..8752b579cd 100644 --- a/library/ui/cocoa/window-utils.factor +++ b/library/ui/cocoa/window-utils.factor @@ -73,6 +73,7 @@ USING: arrays gadgets kernel math objc sequences ; { "windowDidResignKey:" "void" { "id" "SEL" "id" } [ + forget-rollover 2nip -> object -> contentView window unfocus-world ] } diff --git a/library/ui/gadgets/menus.factor b/library/ui/gadgets/menus.factor index d8860abe0c..267cb18fea 100644 --- a/library/ui/gadgets/menus.factor +++ b/library/ui/gadgets/menus.factor @@ -23,11 +23,8 @@ M: menu-glass layout* gadget-child prefer ; hand-loc get-global swap find-world move-hand ] if ; -: hide-menu ( -- ) - find-world hide-glass f menu-mode? set-global ; - \ menu-glass H{ - { T{ button-up } [ hide-menu ] } + { T{ button-up } [ find-world hide-glass ] } { T{ drag } [ retarget-drag ] } } set-gestures diff --git a/library/ui/load.factor b/library/ui/load.factor index 1bc8573397..821613e549 100644 --- a/library/ui/load.factor +++ b/library/ui/load.factor @@ -47,6 +47,7 @@ PROVIDE: library/ui { "tools/dataflow.factor" "tools/workspace.factor" "tools/operations.factor" + "text/editor.facts" } { "test/gadgets.factor" "test/models.factor" diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor index b5409d342e..0f4e3f1093 100644 --- a/library/ui/text/commands.factor +++ b/library/ui/text/commands.factor @@ -70,7 +70,7 @@ USING: gadgets kernel models namespaces sequences ; [ dup T{ word-elt } select-elt ] unless gadget-selection ; -editor "Editing commands" { +editor "editing" { { "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] } { "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] } { "Insert newline" T{ key-down f f "ENTER" } [ "\n" swap user-input ] } @@ -82,7 +82,7 @@ editor "Editing commands" { { "Delete to end of line" T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] } } define-commands -editor "Clipboard commands" { +editor "clipboard" { { "Paste" T{ paste-action } [ clipboard get paste-clipboard ] } { "Paste selection" T{ button-up f f 2 } [ selection get paste-clipboard ] } { "Copy" T{ copy-action } [ clipboard get editor-copy ] } @@ -90,7 +90,7 @@ editor "Clipboard commands" { { "Cut" T{ cut-action } [ clipboard get editor-cut ] } } define-commands -editor "Caret motion commands" { +editor "caret" { { "Position caret" T{ button-down } [ editor-mouse-down ] } { "Previous character" T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] } { "Next character" T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] } @@ -104,7 +104,7 @@ editor "Caret motion commands" { { "End of document" T{ key-down f { C+ } "END" } [ editor-doc-end ] } } define-commands -editor "Text selection commands" { +editor "selection" { { "Extend selection" T{ button-down f { S+ } } [ editor-extend-selection ] } { "Start selection" T{ drag } [ editor-mouse-drag ] } { "Focus editor" T{ gain-focus } [ focus-editor ] } diff --git a/library/ui/text/editor.facts b/library/ui/text/editor.facts new file mode 100644 index 0000000000..5e0e12d851 --- /dev/null +++ b/library/ui/text/editor.facts @@ -0,0 +1,13 @@ +IN: gadgets-text +USING: help gadgets ; + +HELP: editor +{ $class-description "Instances of this class are multi-line text editors which edit an underlying " { $link document } " model." +$terpri +"The " { $link interactor } " gadget is built off the " { $link editor } " gadget and is used by the " { $link "ui-listener" } "." } +{ $heading "General commands" } +{ $commands editor "editing" } +{ $heading "Caret motion commands" } +{ $commands editor "caret" } +{ $heading "Selection commands" } +{ $commands editor "selection" } ; diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 7545f0b361..7a52067465 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -58,7 +58,7 @@ M: interactor stream-readln [ over set-interactor-continuation stop ] callcc0 ] when interactor-queue pop ; -interactor "Interactor commands" { +interactor "interactor" { { "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] } { "Clear input" T{ key-down f { C+ } "k" } [ control-model clear-doc ] } } define-commands diff --git a/library/ui/tools/browser.factor b/library/ui/tools/browser.factor index 5568b9be45..259488764f 100644 --- a/library/ui/tools/browser.factor +++ b/library/ui/tools/browser.factor @@ -115,7 +115,7 @@ M: browser focusable-child* browser-search ; : clear-browser ( browser -- ) browser-definitions close-definitions ; -browser "Toolbar" { +browser "toolbar" { { "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] } } define-commands diff --git a/library/ui/tools/dataflow.factor b/library/ui/tools/dataflow.factor index 1d0258052e..5965b08450 100644 --- a/library/ui/tools/dataflow.factor +++ b/library/ui/tools/dataflow.factor @@ -188,7 +188,7 @@ DEFER: (compute-heights) ! The UI tool TUPLE: dataflow-gadget history ; -dataflow-gadget "Toolbar" { +dataflow-gadget "toolbar" { { "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] } { "Forward" T{ key-down f { C+ } "f" } [ dataflow-gadget-history go-forward ] } } define-commands diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index 1f89214f3b..23aa5e4856 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -8,9 +8,10 @@ generic hashtables tools io kernel listener math models namespaces parser prettyprint sequences shells strings styles threads words definitions help ; -TUPLE: listener-gadget input output stack minibuffer ; +TUPLE: listener-gadget input output stack use minibuffer ; : ui-listener-hook ( listener -- ) + use get over set-listener-gadget-use >r datastack r> listener-gadget-stack set-model ; : listener-stream ( listener -- stream ) @@ -151,7 +152,7 @@ M: listener-gadget tool-help : insert-completion ( completion -- ) word-name find-listener listener-gadget-input user-input ; -listener-gadget "Toolbar" { +listener-gadget "toolbar" { { "Restart" T{ key-down f { C+ } "r" } [ start-listener ] } { "History" @@ -171,7 +172,7 @@ listener-gadget "Toolbar" { { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] } } define-commands -listener-gadget "Completion commands" { +listener-gadget "completion" { { "Complete word" T{ key-down f f "TAB" } diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor index 65b1c6fd70..ea7935e1bc 100644 --- a/library/ui/tools/operations.factor +++ b/library/ui/tools/operations.factor @@ -187,7 +187,7 @@ M: operation invoke-command ( target operation -- ) ! Define commands in terms of operations ! Tile commands -tile "Toolbar" +tile "toolbar" \ word class-operations [ tile-definition ] modify-operations [ command-name "Browse" = not ] subset { "Close" f [ close-tile ] } add* @@ -200,17 +200,17 @@ define-commands : quot-action ( interactor -- quot ) dup editor-text swap select-all parse ; -interactor "Word commands" +interactor "words" \ word class-operations [ word-action ] modify-listener-operations define-commands -interactor "Quotation commands" +interactor "quotations" quotation class-operations [ quot-action ] modify-listener-operations define-commands -help-gadget "Toolbar" { +help-gadget "toolbar" { { "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] } { "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] } { "Home" T{ key-down f { C+ } "h" } [ go-home ] } diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor index 05ec4b6701..5c79f2b55e 100644 --- a/library/ui/tools/walker.factor +++ b/library/ui/tools/walker.factor @@ -77,7 +77,7 @@ M: walker-gadget tool-help drop "ui-walker" ; dup [ step-all ] walker-command reset-walker find-workspace listener-gadget select-tool ; -walker-gadget "Toolbar" { +walker-gadget "toolbar" { { "Step" T{ key-down f f "s" } [ walker-step ] } { "Step in" T{ key-down f f "i" } [ walker-step-in ] } { "Step out" T{ key-down f f "o" } [ walker-step-out ] } diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index 8ea6ed68e5..40aa5cac97 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -40,7 +40,7 @@ M: tool tool-help tool-gadget tool-help ; : tool-help-window ( tool -- ) tool-help [ help-window ] when* ; -tool "Tool commands" { +tool "toolbar" { { "Tool help" T{ key-down f f "F1" } [ tool-help-window ] } } define-commands @@ -86,12 +86,12 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; : tool-scroll-down ( workspace -- ) current-page tool-scroller [ scroll-down-page ] when* ; -workspace "Scrolling primary pane" { +workspace "scrolling" { { "Scroll up" T{ key-down f { C+ } "PAGE_UP" } [ tool-scroll-up ] } { "Scroll down" T{ key-down f { C+ } "PAGE_DOWN" } [ tool-scroll-down ] } } define-commands -workspace "Tool switching commands" { +workspace "tool-switch" { { "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 ] } @@ -100,13 +100,13 @@ workspace "Tool switching commands" { { "Dataflow" T{ key-down f f "F7" } [ dataflow-gadget select-tool ] } } define-commands -workspace "Tool window commands" { +workspace "tool-window" { { "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] } { "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] } { "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] } } define-commands -workspace "Workflow commands" { +workspace "workflow" { { "Reload changed sources" T{ key-down f f "F8" } [ drop [ reload-modules ] call-listener ] } { "Recompile changed words" T{ key-down f { S+ } "F8" } [ drop [ recompile ] call-listener ] } } define-commands diff --git a/library/ui/ui.factor b/library/ui/ui.factor index 77bcb3ea24..7867beffff 100644 --- a/library/ui/ui.factor +++ b/library/ui/ui.factor @@ -120,7 +120,7 @@ C: titled-gadget ( gadget title -- ) windows get [ empty? not ] [ f ] if* ; : ( target classes -- toolbar ) - [ commands "Toolbar" swap hash ] map concat + [ commands "toolbar" swap hash ] map concat [ ] map-with make-shelf ; @@ -128,19 +128,14 @@ C: titled-gadget ( gadget title -- ) dup command-name swap command-gesture gesture>string 2array ; -: command-table. ( commands group -- ) - $heading +: commands. ( commands -- ) [ command-gesture key-down? ] subset [ command-description ] map - { "Command" "Shortcut" } add* $table ; - -: commands. ( hash -- ) - hash>alist - [ [ first ] 2apply <=> ] sort - [ first2 swap command-table. ] each ; + { { $strong "Command" } { $strong "Shortcut" } } add* + $table ; : $commands ( elt -- ) - dup array? [ first ] when commands commands. ; + first2 swap commands hash commands. ; TUPLE: labelled-gadget content ; diff --git a/library/ui/world.factor b/library/ui/world.factor index e1af1a43b3..2846ac5874 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -74,6 +74,7 @@ M: world layout* ] when* drop ; : hide-glass ( world -- ) + f menu-mode? set-global dup world-glass [ unparent ] when* f swap set-world-glass ;