fix a few minor menu bugs

library/ui/editors.factor

@@ -9,11 +9,17 @@ sdl sequences strings styles vectors ;
 
 TUPLE: editor line caret ;
 
+: with-editor ( editor quot -- )
+    #! Execute a quotation in the line editor scope, then
+    #! update the display.
+    swap [ editor-line swap bind ] keep
+    dup relayout scroll>bottom ; inline
+
 : editor-text ( editor -- text )
     editor-line [ line-text get ] bind ;
 
 : set-editor-text ( text editor -- )
-    editor-line [ set-line-text ] bind ;
+    [ set-line-text ] with-editor ;
 
 : focus-editor ( editor -- )
     dup editor-caret swap add-gadget ;
@@ -21,11 +27,6 @@ TUPLE: editor line caret ;
 : unfocus-editor ( editor -- )
     editor-caret unparent ;
 
-: with-editor ( editor quot -- )
-    #! Execute a quotation in the line editor scope, then
-    #! update the display.
-    swap [ editor-line swap bind ] keep relayout ; inline
-
 : run-char-widths ( str -- wlist )
     #! List of x co-ordinates of each character.
     0 swap >list
@@ -84,8 +85,7 @@ C: editor ( text -- )
     shape-dim { 0 1 1 } v* { 1 0 0 } v+ ;
 
 M: editor user-input* ( ch editor -- ? )
-    [ [ insert-char ] with-editor ] keep
+    [ insert-char ] with-editor  t ;
-    scroll>bottom  t ;
 
 M: editor pref-dim ( editor -- dim )
     dup editor-text label-size { 1 0 0 } v+ ;

library/ui/gadgets.factor

@@ -27,12 +27,12 @@ DEFER: relayout
 DEFER: add-invalid
 
 : invalidate ( gadget -- )
-    t over set-gadget-redraw?
     t swap set-gadget-relayout? ;
 
 : relayout ( gadget -- )
     #! Relayout and redraw a gadget and its parent before the
     #! next iteration of the event loop.
+    dup redraw
     dup gadget-relayout? [
         drop
     ] [

library/ui/menus.factor

@@ -17,13 +17,13 @@ USING: generic kernel lists math namespaces sequences ;
 TUPLE: menu ;
 
 : menu-actions ( menu -- )
-    [ drop world get hide-glass ] [ button-down 1 ] set-action ;
+    [ drop hide-glass ] [ button-down 1 ] set-action ;
 
 : assoc>menu ( assoc menu -- )
     #! Given an association list mapping labels to quotations.
     #! Prepend a call to hide-menu to each quotation.
     [
-        uncons \ hide-menu swons <menu-item> swap add-gadget
+        uncons \ hide-glass swons <menu-item> swap add-gadget
     ] each-with ;
 
 C: menu ( assoc -- gadget )

library/ui/paint.factor

@@ -7,12 +7,7 @@ io strings sequences ;
 : redraw ( gadget -- )
     #! Redraw a gadget before the next iteration of the event
     #! loop.
-    dup gadget-redraw? [
+    drop  t world get set-gadget-redraw? ;
-        drop
-    ] [
-        t over set-gadget-redraw?
-        gadget-parent [ redraw ] when*
-    ] ifte ;
 
 ! Clipping
 

library/ui/panes.factor

@@ -84,6 +84,3 @@ M: pane stream-write-attr ( string style stream -- )
     [ rot "\n" split pane-write ] keep scroll>bottom ;
 
 M: pane stream-close ( stream -- ) drop ;
-
-: <console> ( -- pane )
-    <pane> <scroller> ;

library/ui/presentations.factor

@@ -20,14 +20,20 @@ DEFER: pane-call
 : command-menu ( pane -- menu )
     presented get dup applicable [
         3dup third [
-            [ swap literal, % ] make-list , , \ pane-call ,
+            [ swap literal, % ] make-list , ,
+            [ pane-call drop ] %
         ] make-list >r second r> cons
     ] map 2nip ;
 
 : init-commands ( gadget pane -- )
-    over presented paint-prop
+    over presented paint-prop [
-    [ [ command-menu <menu> show-menu ] cons button-gestures ]
+        [ drop ] swap
-    [ 2drop ] ifte ;
+        unit
+        [ command-menu <menu> show-menu ] append3
+        button-gestures
+    ] [
+        2drop
+    ] ifte ;
 
 : <styled-label> ( style text -- label )
     <label> swap alist>hash over set-gadget-paint ;