Fix text corruption in UI

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index e6a100ee9fa4bf04a869796da20de2aa443d3e1c..a28e5bf968e417e0d1fbf35ad5683e8d46caca82 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,10 +1,11 @@
 + 0.85:
 
-- font corruption now that books don't add/remove their children
+- :edit should apply to the innermost error
 - doc sweep
 - the editor should fill up the interior of the scroller completely
 - pane output in UI should use less memory
 - signal 4 on datastack underflow on mac intel??
+- test alien-indirect
 - buffer-ptr should be an alien
 - fix this:
   [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 ] .
@@ -15,18 +16,29 @@
 - problem if major gc happens during relocation
   - in fact relocation should not cons at all
 - better way of dealing with compiler errors
+  - messages tool
+    - sort into warnings and errors
+    - quick way to navigate to offending word
 - variable width word wrap
+  - 
 - add-gadget, model-changed, set-model should compile
 - graphical module manager tool
+  - list of modules -- loaded, not loaded
+  - each module has a list of files
+  - files can be reloaded and edited
+  - modules can be (re)loaded
+  - keyboard navigation
 - editor:
   - more efficient multi-line inserts
   - write "foo| " and put caret at | then select word element: selects
     space
 - we have trouble drawing rectangles
 - ui browser: show currently selected vocab & words
+  - keyboard-navigatable list gadget of some kind
 
 + ui:
 
+- tuple= in dataflow view
 - hide empty command groups in $commands
 - ui quick start doc
 - auto-update browser and help when sources reload
@@ -53,6 +65,7 @@
   - transpose char/word/line
   - page up/down
   - search and replace
+  - drag scroll
 - slider needs to be modelized
 - fonts/ should go inside the .app -- we need multi-tier resource-path
 - should be possible to drop an image file on the .app to run it

diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor
index e3fbd68b5e4215d354aac4b15bd40f427e1693cf..676ef4729a901395de99815804a9cd920741af34 100644 (file)
--- a/library/ui/gadgets/presentations.factor
+++ b/library/ui/gadgets/presentations.factor
@@ -21,15 +21,20 @@ C: presentation ( button object command -- button )
 : <command-presentation> ( target command -- button )
     dup command-name f <bevel-button> -rot <presentation> ;
 
-: presentation-command* ( presentation gesture -- cmd )
+: presentation-command* ( presentation gesture -- obj cmd )
     over presentation-command [
-        T{ button-up f f 1 } = swap presentation-command f ?
+        dup T{ button-up f f 1 } = [
+            drop
+            dup presentation-object swap presentation-command
+        ] [
+            >r presentation-command dup r> mouse-operation
+        ] if
     ] [
-        >r presentation-object r> mouse-operation
+        >r presentation-object dup r> mouse-operation
     ] if ;
 
 : invoke-presentation ( gadget modifiers button# -- )
-    <button-up> >r [ presentation-object ] keep r>
+    <button-up>
     presentation-command* dup [ invoke-command ] [ 2drop ] if ;
 
 : show-mouse-help ( presentation -- )
@@ -65,7 +70,7 @@ presentation H{
 : <gesture-help> ( model gesture -- gadget )
     [
         over [
-            tuck presentation-command* dup [
+            tuck presentation-command* nip dup [
                 >r gesture>string ": " r> command-name append3
             ] [
                 2drop ""

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 5715ca03f7da25a2f61fb0532cc23a5df4883a95..92bce05893d1648f2baecf0b23c00740cc2f9241 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -6,7 +6,8 @@ IN: gadgets
 
 DEFER: relayout-1
 
-: invalidate ( gadget -- ) \ relayout-1 swap set-gadget-state ;
+: invalidate ( gadget -- )
+    \ relayout-1 swap set-gadget-state ;
 
 : forget-pref-dim ( gadget -- ) f swap set-gadget-pref-dim ;
 
@@ -34,7 +35,7 @@ DEFER: relayout
     [ drop ] [ invalidate* ] if ;
 
 : relayout-1 ( gadget -- )
-    #! Relayout and redraw a gadget before th next iteration of
+    #! Relayout and redraw a gadget before the next iteration of
     #! the event loop. Should be used if the gadget should be
     #! repainted, or if its internal layout changed, but its
     #! preferred size did not change.
@@ -59,9 +60,13 @@ DEFER: relayout
 
 GENERIC: pref-dim* ( gadget -- dim )
 
+: ?set-gadget-pref-dim ( dim gadget -- )
+    dup gadget-state [ 2drop ] [ set-gadget-pref-dim ] if ;
+
 : pref-dim ( gadget -- dim )
+    #! Do not cache the pref-dim if it is potentially invalid.
     dup gadget-pref-dim [ ] [
-        dup pref-dim* dup rot set-gadget-pref-dim
+        [ pref-dim* dup ] keep ?set-gadget-pref-dim
     ] ?if ;
 
 M: gadget pref-dim* rect-dim ;

diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor
index 6174f1e00e2ca71fc9e8b105911cac086871f440..53e99bcdc51cea313973ee35c19337f8b5427d45 100644 (file)
--- a/library/ui/tools/operations.factor
+++ b/library/ui/tools/operations.factor
@@ -46,6 +46,14 @@ M: operation invoke-command ( target operation -- )
     { +listener+ t }
 } define-operation
 
+! Commands
+[ [ command? ] is? ] H{
+    { +mouse+ T{ button-up f { S+ } 3 } }
+    { +name+ "Inspect" }
+    { +quot+ [ inspect ] }
+    { +listener+ t }
+} define-operation
+
 ! Input
 [ input? ] H{
     { +mouse+ T{ button-up f f 1 } }