Documentation updates, menus fix

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:

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."
+{ $heading "Listener commands" }
-{ $commands listener-gadget }
+{ $commands listener-gadget "toolbar" }
-"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."
+{ $heading "Interactor commands" }
-{ $commands interactor }
+{ $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."
+{ $heading "Switching tools" }
-{ $commands workspace }
+"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" }

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 ? )

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
         ]
     }

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
         ]
     }

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
 

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"

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 ] }

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" } ;

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

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
 

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

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" }

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 ] }

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 ] }

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

library/ui/ui.factor

@@ -120,7 +120,7 @@ C: titled-gadget ( gadget title -- )
     windows get [ empty? not ] [ f ] if* ;
 
 : <toolbar> ( target classes -- toolbar )
-    [ commands "Toolbar" swap hash ] map concat
+    [ commands "toolbar" swap hash ] map concat
     [ <command-presentation> ] 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 -- )
+: commands. ( commands -- )
-    $heading
     [ command-gesture key-down? ] subset
     [ command-description ] map
-    { "Command" "Shortcut" } add* $table ;
+    { { $strong "Command" } { $strong "Shortcut" } } add*
-
+    $table ;
-: commands. ( hash -- )
-    hash>alist
-    [ [ first ] 2apply <=> ] sort
-    [ first2 swap command-table. ] each ;
 
 : $commands ( elt -- )
-    dup array? [ first ] when commands commands. ;
+    first2 swap commands hash commands. ;
 
 TUPLE: labelled-gadget content ;
 

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 ;