UI cleanup

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 53454963a162a1cd57957ba7fa427decd68f2bbe..d177a9d54de6d1c22eeb83673b833f643ea0ce24 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,8 +1,10 @@
+- print-quot -- present commands directly
 - auto-invoke code gc
 - fix alien-callback/SEH bug on win32
 
 + ui:
 
+- control delegating to a pane is wrong
 - the mouse button overload sucks, use popup menus instead
 - nested presentation mouse over is not right
 - ui quick start doc

diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts
index 4644ac64e40d9d2af2b5e53994d8e2ece7296ede..8d0b77e3a947fdcdda8b031b29842fbfed011e99 100644 (file)
--- a/doc/handbook/tools.facts
+++ b/doc/handbook/tools.facts
@@ -93,7 +93,7 @@ ARTICLE: "inspector" "The inspector"
 "The prettyprinter (see " { $link "prettyprint" } ") can turn any object into a source representation. Sometimes this source representation is hard to read for a human, so the inspector provides an alternative tabular view of an object:"
 { $subsection inspect }
 "The inspector supports a number of commands which operate on the most recently inspected object:"
-{ $subsection inspecting }
+{ $subsection me }
 { $subsection go }
 { $subsection up }
 "Word for getting very brief descriptions of words and general objects:"

diff --git a/library/io/stdio.factor b/library/io/stdio.factor
index bc0ec9a5cae54f174d98a328f80a2ae3ef740942..0a6b1aa45910f541110fba545f1952bb5760c74e 100644 (file)
--- a/library/io/stdio.factor
+++ b/library/io/stdio.factor
@@ -46,7 +46,12 @@ SYMBOL: stdio
 : write-outliner ( str obj content -- )
     outline associate [ write-object ] with-nesting ;
 
-: print-input ( string input -- )
-    <input> presented associate
-    [ H{ { font-style bold } } format ] with-nesting
+: (print-input/quot)
+    associate [ H{ { font-style bold } } format ] with-nesting
     terpri ;
+
+: print-input ( string input -- )
+    <input> presented (print-input/quot) ;
+
+: print-quot ( string quot -- )
+    quotation (print-input/quot) ;

diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 1c221d0bdafc578d03940ac6559ef1b38485b03d..7c16ce3c84e62622ddfe881e18a6e8e8b9fedf4d 100644 (file)
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -58,7 +58,7 @@ SYMBOL: restarts
 
 : restart. ( restart n -- )
     [ [ # " :res  " % first % ] "" make ] keep
-    [ :res ] curry print-input ;
+    [ :res ] curry print-quot ;
 
 : restarts. ( -- )
     restarts get dup empty? [
@@ -74,13 +74,13 @@ SYMBOL: restarts
     terpri
     "Debugger commands:" print
     terpri
-    ":help - documentation for this error" [ :help ] print-input
-    ":s    - data stack at exception time" [ :s ] print-input
-    ":r    - retain stack at exception time" [ :r ] print-input
-    ":c    - call stack at exception time" [ :c ] print-input
+    ":help - documentation for this error" [ :help ] print-quot
+    ":s    - data stack at exception time" [ :s ] print-quot
+    ":r    - retain stack at exception time" [ :r ] print-quot
+    ":c    - call stack at exception time" [ :c ] print-quot
 
     error get [ parse-error? ] is? [
-        ":edit - jump to source location" [ :edit ] print-input
+        ":edit - jump to source location" [ :edit ] print-quot
     ] when
 
     ":get  ( var -- value ) accesses variables at time of the error" print

diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor
index cd8df8451a205985d25616cbc3496d5d4cce779b..cac8f83691bc8a5994378d47115398f10f474d2e 100644 (file)
--- a/library/tools/inspector.factor
+++ b/library/tools/inspector.factor
@@ -12,7 +12,7 @@ SYMBOL: inspector-slots
 
 SYMBOL: inspector-stack
 
-: inspecting ( -- obj ) inspector-stack get peek ;
+: me ( -- obj ) inspector-stack get peek ;
 
 : (inspect) ( obj -- )
     dup inspector-stack get push
@@ -25,8 +25,8 @@ SYMBOL: inspector-stack
 
 : inspector-help ( -- )
     "Object inspector." print
-    "up -- return to previous object" [ up ] print-input
-    "inspecting ( -- obj ) push current object" [ inspecting ] print-input
+    "up -- return to previous object" [ up ] print-quot
+    "me ( -- obj ) push this object" [ me ] print-quot
     "go ( n -- ) inspect nth slot" print
     terpri ;
 

diff --git a/library/tools/inspector.facts b/library/tools/inspector.facts
index 696de231f9a4fceb62d85a649a168afbe40e077d..a8493d590d232ac6d5031a1ca0dfa646b22586e7 100644 (file)
--- a/library/tools/inspector.facts
+++ b/library/tools/inspector.facts
@@ -9,18 +9,18 @@ HELP: inspector-stack
 { $var-description "If the inspector is running, this variable holds previously-inspected objects." }
 { $see-also go up } ;
 
-HELP: inspecting
+HELP: me
 { $description "If the inspector is running, outputs the object currently being inspected." } ;
 
 HELP: inspector
 { $values { "obj" "an object" } }
 { $description "Starts a new inspector and prints a brief help message. If an inspector is already running, this starts a nested inspector. An alternative word that reuses the current inspector instance is " { $link inspect } "." }
-{ $see-also go up inspecting } ;
+{ $see-also go up me } ;
 
 HELP: inspect
 { $values { "obj" "an object" } }
 { $description "If an inspector is already running, displays the slots of the object in the current inspector. If an inspector is not running, starts a new inspector." }
-{ $see-also go up inspecting } ;
+{ $see-also go up me } ;
 
 HELP: go
 { $values { "n" "a non-negative integer" } }

diff --git a/library/ui/cocoa/services.factor b/library/ui/cocoa/services.factor
index c1f4312447fe50aae03355565e347e714ea7724f..cf24e1d94158d1cf53f9075f0e65b2257c4a65b0 100644 (file)
--- a/library/ui/cocoa/services.factor
+++ b/library/ui/cocoa/services.factor
@@ -29,7 +29,7 @@ parser prettyprint styles gadgets-listener gadgets-workspace ;
         { "id" "SEL" "id" "id" "void*" }
         [
             nip
-            [ <input> listener-gadget call-tool f ]
+            [ call-listener f ]
             do-service
             2drop
         ]

diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor
index badc216a33c7cd6aea023abdb689bfd2273e8b14..1d21b51042963884707ad74055e65035064f7b91 100644 (file)
--- a/library/ui/tools/listener.factor
+++ b/library/ui/tools/listener.factor
@@ -47,27 +47,8 @@ C: listener-gadget ( -- gadget )
 M: listener-gadget focusable-child*
     listener-gadget-input ;
 
-: listener-available? ( gadget -- ? )
-    dup listener-gadget? [
-        listener-gadget-input interactor-busy? not
-    ] [
-        drop f
-    ] if ;
-
-G: call-listener ( quot/string listener -- )
-    1 standard-combination ;
-
-M: quotation call-listener
-    listener-gadget-input interactor-call ;
-
-M: string call-listener
-    listener-gadget-input set-editor-text ;
-
-M: input call-listener
-    >r input-string r> call-listener ;
-
-M: listener-gadget call-tool* ( quot/string listener -- )
-    call-listener ;
+M: listener-gadget call-tool* ( input listener -- )
+    >r input-string r> listener-gadget-input set-editor-text ;
 
 M: listener-gadget tool-scroller
     listener-gadget-output find-scroller ;
@@ -75,11 +56,17 @@ M: listener-gadget tool-scroller
 M: listener-gadget tool-help
     drop "ui-listener" ;
 
+: find-listener ( -- listener )
+    listener-gadget find-workspace show-tool tool-gadget ;
+
+: call-listener ( quot -- )
+    find-listener listener-gadget-input interactor-call ;
+
 : listener-run-files ( seq -- )
     dup empty? [
         drop
     ] [
-        [ [ run-file ] each ] curry listener-gadget call-tool
+        [ [ run-file ] each ] curry call-listener
     ] if ;
 
 : listener-eof ( listener -- )

diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor
index 6a944e1834934750cc4d5c39521d15ba649590fe..ef214ca765c10cc5b042f85a102d7412dd13fcbe 100644 (file)
--- a/library/ui/tools/operations.factor
+++ b/library/ui/tools/operations.factor
@@ -14,7 +14,7 @@ V{ } clone operations set-global
 
 M: operation invoke-command ( target operation -- )
     dup command-quot swap operation-listener?
-    [ curry listener-gadget call-tool ] [ call ] if ;
+    [ curry call-listener ] [ call ] if ;
 
 : modify-operation ( quot operation -- operation )
     clone

diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor
index dd0b99711c0f7ec68bffc1dc734b5c0ef73a3e4e..7a7abe94fbeb68ae0334b6a1ef4b3d0377e78126 100644 (file)
--- a/library/ui/tools/walker.factor
+++ b/library/ui/tools/walker.factor
@@ -71,7 +71,7 @@ M: walker-gadget tool-help drop "ui-walker" ;
 
 : walker-inspect ( walker -- )
     walker-gadget-ns [ meta-interp get ] bind
-    [ inspect ] curry listener-gadget call-tool ;
+    [ inspect ] curry call-listener ;
 
 : walker-step-all ( walker -- )
     dup [ step-all ] walker-command reset-walker

diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor
index d6e2e899c377b617c5f61b658d28afa5ebce0e7c..72fb5da606cba10a05b730b823353fcdbcc3b0ea 100644 (file)
--- a/library/ui/tools/workspace.factor
+++ b/library/ui/tools/workspace.factor
@@ -97,6 +97,6 @@ workspace "Tool window commands" {
 } define-commands
 
 workspace "Workflow commands" {
-    { "Reload changed sources" T{ key-down f f "F8" } [ drop [ reload-modules ] listener-gadget call-tool ] }
-    { "Recompile changed words" T{ key-down f { S+ } "F8" } [ drop [ recompile ] listener-gadget call-tool ] }
+    { "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/world.factor b/library/ui/world.factor
index 389cba158adfe633bb4c5326177ec09036e66bb0..fbddd3a5deb2fba7c4c8925f1bc09e47932c3ec0 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -43,21 +43,15 @@ C: world ( gadget -- world )
 M: world pref-dim*
     delegate pref-dim* [ >fixnum ] map { 1024 768 } vmin ;
 
-: activate-world-model ( world model -- )
-    [ add-connection ] keep activate-model ;
-
 M: world graft*
-    dup dup world-title activate-world-model
-    dup dup world-status activate-world-model
+    dup dup world-title add-connection
+    dup dup world-status add-connection
     model-changed ;
 
-: deactivate-world-model ( world model -- )
-    [ remove-connection ] keep deactivate-model ;
-
 M: world ungraft*
     dup
-    dup world-title deactivate-world-model
-    dup world-status deactivate-world-model ;
+    dup world-title remove-connection
+    dup world-status remove-connection ;
 
 M: world model-changed
     dup world-title model-value swap set-title ;