minor pane optimization

TODO.FACTOR.txt

@@ -5,6 +5,8 @@
 
 + ui:
 
+- off-by-one error in pickup?
+- closing ui does not stop timers
 - adding/removing timers automatically for animated gadgets
 - fix listener prompt display after presentation commands invoked
 - theme abstraction in ui
@@ -13,7 +15,6 @@
 - gaps in pack layout
 - find out why so many small bignums get consed
 - faster mouse tracking
-- binary search to locate visible children of packs
 - rewrite frame layout for new style
 - an interior paint that is only painted on rollover and mouse press;
   use it for menu items. give menus a gradient background

library/compiler/compiler.factor

@@ -63,3 +63,7 @@ M: compound (compile) ( word -- )
     #! Compute a quotation into an uninterned word, for testing
     #! purposes.
     gensym [ swap define-compound ] keep dup compile execute ;
+
+\ optimize profile
+\ linearize profile
+\ simplify profile

library/syntax/prettyprint.factor

@@ -321,7 +321,7 @@ M: wrapper pprint* ( wrapper -- )
 : short. ( object -- )
     dup unparse-short swap write-object terpri ;
 
-: [.] ( sequence -- ) [ unparse-short. ] each ;
+: [.] ( sequence -- ) [ short. ] each ;
 
 : stack. reverse-slice [.] ;
 

library/tools/annotations.factor

@@ -1,25 +1,23 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: words
+USING: interpreter io kernel lists math namespaces prettyprint
+sequences strings test ;
 
 ! The annotation words let you flag a word for either tracing
 ! or single-stepping. Note that currently, words referring to
-! annotated words cannot be compiled; and annotating a word has
+! annotated words cannot be compiled.
-! no effect of compiled calls to that word.
-USING: interpreter io kernel lists namespaces prettyprint
-sequences strings test ;
-
 : annotate ( word quot -- | quot: word def -- def )
     over >r >r dup word-def r> call r> swap define-compound ;
     inline
 
 : (watch) ( word def -- def )
     [
-        "===> Entering: " pick word-name append , \ print ,
+        "===> Entering: " pick word-name append ,
-        \ .s ,
+        [ print .s ] %
         %
-        "===> Leaving:  " swap word-name append , \ print ,
+        "===> Leaving:  " swap word-name append ,
-        \ .s ,
+        [ print .s ] %
     ] make-list ;
 
 : watch ( word -- )
@@ -31,6 +29,16 @@ sequences strings test ;
     #! Cause the word to start the code walker when executed.
     [ nip [ walk ] cons ] annotate ;
 
-: timer ( word -- )
+: +@ ( n var -- ) dup get [ swap >r + r> ] when* set ;
-    #! Print the time taken to execute the word when it's called.
+
-    [ nip [ time ] cons ] annotate ;
+: with-profile ( quot word -- )
+    millis >r >r call r> millis r> - swap global [ +@ ] bind ;
+    inline
+
+: (profile) ( word def -- def )
+    [ , literalize , \ with-profile , ] make-list ;
+
+: profile ( word -- )
+    #! When the word is called, time it, and add the time to
+    #! the value in a global variable named by the word.
+    [ (profile) ] annotate ;

library/tools/walker.factor

@@ -15,8 +15,7 @@ sequences io strings vectors words ;
 : &r
     #! Print stepper call stack, as well as the currently
     #! executing quotation.
-    meta-cf get unparse-short.
+    meta-cf get short. meta-executing get . meta-r get stack. ;
-    meta-executing get . meta-r get stack. ;
 
 : &get ( var -- value )
     #! Get stepper variable value.

library/ui/panes.factor

@@ -66,24 +66,26 @@ M: pane focusable-child* ( pane -- editor )
 : pane-clear ( pane -- )
     dup pane-output clear-incremental pane-current clear-gadget ;
 
-: pane-ignore? ( style text pane -- ? )
-    #! If we already have stuff in the current pack, and there
-    #! is no style information or text to write, ignore it.
-    #! Otherwise, we either have a fancy style (like an icon
-    #! or gadget being output), or we want the current pack to
-    #! have a minimal height so we put the empty label there.
-    pane-current gadget-children empty? not
-    rot not and swap empty? and ;
-
 : pane-write-1 ( style text pane -- )
-    3dup pane-ignore? [
+    pick not pick empty? and [
         3drop
     ] [
         >r <presentation> r> pane-current add-gadget
     ] ifte ;
 
+: prepare-print ( current -- gadget )
+    #! Optimization: if line has 1 child, add the child.
+    dup gadget-children {
+        { [ dup empty? ] [ 2drop "" <label> ] }
+        { [ dup length 1 = ] [ nip first ] }
+        { [ t ] [ drop ] }
+    } cond ;
+
+: pane-print-1 ( current pane -- )
+    >r prepare-print r> pane-output add-incremental ;
+
 : pane-terpri ( pane -- )
-    dup pane-current over pane-output add-incremental
+    dup pane-current over pane-print-1
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )