From fea1350790f7ffdebcc92527056ceefa70935617 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:01:28 +0100
Subject: [PATCH 01/14] Wordtimer vocab for time-profiling words and vocabs

---
 extra/wordtimer/authors.txt            |  1 +
 extra/wordtimer/summary.txt            |  1 +
 extra/wordtimer/wordtimer-docs.factor  | 34 +++++++++++
 extra/wordtimer/wordtimer-tests.factor | 10 ++++
 extra/wordtimer/wordtimer.factor       | 81 ++++++++++++++++++++++++++
 5 files changed, 127 insertions(+)
 create mode 100644 extra/wordtimer/authors.txt
 create mode 100644 extra/wordtimer/summary.txt
 create mode 100644 extra/wordtimer/wordtimer-docs.factor
 create mode 100644 extra/wordtimer/wordtimer-tests.factor
 create mode 100644 extra/wordtimer/wordtimer.factor

diff --git a/extra/wordtimer/authors.txt b/extra/wordtimer/authors.txt
new file mode 100644
index 0000000000..0be42b2faa
--- /dev/null
+++ b/extra/wordtimer/authors.txt
@@ -0,0 +1 @@
+Phil Dawes
diff --git a/extra/wordtimer/summary.txt b/extra/wordtimer/summary.txt
new file mode 100644
index 0000000000..efe591da27
--- /dev/null
+++ b/extra/wordtimer/summary.txt
@@ -0,0 +1 @@
+Microsecond precision code timer/profiler.
diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor
new file mode 100644
index 0000000000..7d9de34252
--- /dev/null
+++ b/extra/wordtimer/wordtimer-docs.factor
@@ -0,0 +1,34 @@
+USING: help.syntax help.markup kernel prettyprint sequences ;
+IN: wordtimer
+
+HELP: reset-word-timer
+{ $description "resets the global wordtimes datastructure. Must be called before calling any word-timer annotated code"
+} ;
+
+HELP: add-timer
+{ $values { "word" "a word" } } 
+{ $description "annotates the word with timing code which stores timing information globally. You can then view the info with print-word-timings"
+} ;
+
+HELP: add-timers
+{ $values { "vocab" "a string" } } 
+{ $description "annotates all the words in the vocab with timer code. After profiling you can remove the annotations with reset-vocab"
+} ;
+
+
+HELP: reset-vocab
+{ $values { "vocab" "a string" } } 
+{ $description "removes the annotations from all the words in the vocab"
+} ;
+
+HELP: print-word-timings
+{ $description "Displays the timing information for each word-timer annotated word. Columns are: total time taken in microseconds, number of invocations, wordname"
+} ;
+
+HELP: correct-for-timing-overhead
+{ $description "attempts to correct the timings to take into account the overhead of the timing function. This is pretty error-prone but can be handy when you're timing words that only take a handful of milliseconds but are called a lot" } ;
+    
+ARTICLE: "wordtimer" "Word Timer"
+"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. You first annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then you reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } "." ;
+    
+ABOUT: "wordtimer"
diff --git a/extra/wordtimer/wordtimer-tests.factor b/extra/wordtimer/wordtimer-tests.factor
new file mode 100644
index 0000000000..47287179ce
--- /dev/null
+++ b/extra/wordtimer/wordtimer-tests.factor
@@ -0,0 +1,10 @@
+USING: tools.test wordtimer math kernel tools.annotations prettyprint ;
+IN: wordtimer.tests
+
+: testfn ( a b c d -- a+b c+d )
+  + [ + ] dip ;
+    
+[ 3 7 ]
+[ reset-word-timer
+  \ testfn [ reset ] [ add-timer ] bi
+  1 2 3 4 testfn ] unit-test
\ No newline at end of file
diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor
new file mode 100644
index 0000000000..1ce5f13a81
--- /dev/null
+++ b/extra/wordtimer/wordtimer.factor
@@ -0,0 +1,81 @@
+USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics ;
+IN: wordtimer
+
+SYMBOL: *wordtimes*
+SYMBOL: *calling*
+
+: reset-word-timer ( -- ) 
+  H{ } clone *wordtimes* set-global
+  H{ } clone *calling* set-global ;
+    
+: lookup-word-time ( wordname -- utime n )
+  *wordtimes* get-global [ drop { 0 0 } ] cache first2 ;
+
+: update-times ( utime current-utime current-numinvokes -- utime' invokes' )
+  rot [ + ] curry [ 1+ ] bi* ;
+
+: register-time ( utime word -- )
+  word-name
+  [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ;
+
+: calling ( word -- )
+  dup *calling* get-global set-at ; inline
+
+: finished ( word -- )
+  *calling* get-global delete-at ; inline
+
+: called-recursively? ( word -- t/f )
+  *calling* get-global at ; inline
+    
+: timed-call ( quot word -- )
+  [ calling ] [ >r micro-time r> register-time ] [ finished ] tri ; inline
+
+: time-unless-recursing ( quot word -- )
+  dup called-recursively? not
+  [ timed-call ] [ drop call ] if ; inline
+    
+: (add-timer) ( word quot -- quot' )
+  [ swap time-unless-recursing ] 2curry ; 
+
+: add-timer ( word -- )
+  dup [ (add-timer) ] annotate ;
+
+: add-timers ( vocabspec -- )
+  words [ add-timer ] each ;
+
+: reset-vocab ( vocabspec -- )
+  words [ reset ] each ;
+
+: dummy-word ( -- ) ;
+
+: time-dummy-word ( -- n )
+  [ 100000 [ [ dummy-word ] micro-time , ] times ] { } make median ;
+
+: subtract-overhead ( {oldtime,n} overhead -- {newtime,n} )
+  [ first2 ] dip
+  swap [ * - ] keep 2array ;
+  
+: change-global ( variable quot -- )
+  global swap change-at ;
+
+: (correct-for-timing-overhead) ( timingshash -- timingshash )
+  time-dummy-word [ subtract-overhead ] curry assoc-map ;  
+
+: correct-for-timing-overhead ( -- )
+  *wordtimes* [ (correct-for-timing-overhead) ] change-global ;
+    
+: print-word-timings ( -- )
+  *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ;
+
+
+: profile-vocab ( vocabspec quot -- )
+  "annotating vocab..." print flush
+  over [ reset-vocab ] [ add-timers ] bi
+  reset-word-timer
+  "executing quotation..." print flush
+  [ call ] micro-time >r
+  "resetting annotations..." print flush
+  swap reset-vocab
+  correct-for-timing-overhead
+  "total time:" write r> pprint
+  print-word-timings ;
\ No newline at end of file

From f485c63f22cb1f21eaee5b7ed39d11b203e5a86b Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:32:34 +0100
Subject: [PATCH 02/14] fixed to use new-style accessor for word-name

---
 extra/wordtimer/wordtimer.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor
index 1ce5f13a81..e9ed0c8cf0 100644
--- a/extra/wordtimer/wordtimer.factor
+++ b/extra/wordtimer/wordtimer.factor
@@ -1,4 +1,4 @@
-USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics ;
+USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics accessors ;
 IN: wordtimer
 
 SYMBOL: *wordtimes*
@@ -15,7 +15,7 @@ SYMBOL: *calling*
   rot [ + ] curry [ 1+ ] bi* ;
 
 : register-time ( utime word -- )
-  word-name
+  name>>
   [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ;
 
 : calling ( word -- )

From 8e24fb9e051e69af1a88edb476605273df84ab9e Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:50:49 +0100
Subject: [PATCH 03/14] Added doc for profile-vocab

---
 extra/wordtimer/wordtimer-docs.factor | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor
index 7d9de34252..47b85bb007 100644
--- a/extra/wordtimer/wordtimer-docs.factor
+++ b/extra/wordtimer/wordtimer-docs.factor
@@ -27,8 +27,15 @@ HELP: print-word-timings
 
 HELP: correct-for-timing-overhead
 { $description "attempts to correct the timings to take into account the overhead of the timing function. This is pretty error-prone but can be handy when you're timing words that only take a handful of milliseconds but are called a lot" } ;
+
+HELP: profile-vocab
+{ $values { "vocabspec" "string name of a vocab" }
+          { "quot" "a quotation to run" } }
+{ $description "Annotates the words in the vocab with timing code then runs the quotation. Finally resets the words and prints the timings information."
+} ;
+
     
 ARTICLE: "wordtimer" "Word Timer"
-"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. You first annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then you reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } "." ;
+"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } ". Alternatively if you just want to time the contents of a vocabulary you can use profile-vocab." ;
     
 ABOUT: "wordtimer"

From e3ce229c1f52de65730abcea66ad5a1811042945 Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Thu, 10 Jul 2008 23:55:45 +0200
Subject: [PATCH 04/14] Fix a stack underflow

---
 extra/wordtimer/wordtimer.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor
index e9ed0c8cf0..5da17e28d5 100644
--- a/extra/wordtimer/wordtimer.factor
+++ b/extra/wordtimer/wordtimer.factor
@@ -75,7 +75,7 @@ SYMBOL: *calling*
   "executing quotation..." print flush
   [ call ] micro-time >r
   "resetting annotations..." print flush
-  swap reset-vocab
+  reset-vocab
   correct-for-timing-overhead
   "total time:" write r> pprint
   print-word-timings ;
\ No newline at end of file

From 698a66d076f2e118b95ee6540f445cbd7c88c1d4 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 11 Jul 2008 11:56:05 -0500
Subject: [PATCH 05/14] newfx: purge and purge!

---
 extra/newfx/newfx.factor | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor
index 9cc63fd57e..825c70001e 100644
--- a/extra/newfx/newfx.factor
+++ b/extra/newfx/newfx.factor
@@ -1,5 +1,5 @@
 
-USING: kernel sequences assocs qualified circular sets ;
+USING: kernel sequences assocs qualified circular sets fry sequences.lib ;
 
 USING: math multi-methods ;
 
@@ -242,4 +242,11 @@ METHOD: as-mutate { object object assoc }       set-at ;
 
 : insert ( seq i obj -- seq ) >r cut r> prefix append ;
 
-: splice ( seq i seq -- seq ) >r cut r> prepend append ;
\ No newline at end of file
+: splice ( seq i seq -- seq ) >r cut r> prepend append ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: purge ( seq quot -- seq ) [ not ] compose filter ;
+
+: purge! ( seq quot -- seq )
+  dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ;

From 8ab25384c4108b04d6e32af3e9ea660d179435d6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 11 Jul 2008 13:27:04 -0500
Subject: [PATCH 06/14] builder.util: remove old code

---
 extra/builder/util/util.factor | 8 --------
 1 file changed, 8 deletions(-)

diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor
index 320f0e0448..47db4c52c9 100644
--- a/extra/builder/util/util.factor
+++ b/extra/builder/util/util.factor
@@ -41,14 +41,6 @@ DEFER: to-strings
 
 : host-name* ( -- name ) host-name "." split first ;
 
-! : datestamp ( -- string )
-!   now `{ ,[ dup timestamp-year   ]
-!          ,[ dup timestamp-month  ]
-!          ,[ dup timestamp-day    ]
-!          ,[ dup timestamp-hour   ]
-!          ,[     timestamp-minute ] }
-!   [ pad-00 ] map "-" join ;
-
 : datestamp ( -- string )
   now
     { year>> month>> day>> hour>> minute>> } <arr>

From 137742df4faf1e0aea30d2aa183cd8be4127ac35 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 13:46:59 -0500
Subject: [PATCH 07/14] Fix load error on x11

---
 extra/ui/x11/x11.factor | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor
index c1ccb1f635..35f22ec64f 100755
--- a/extra/ui/x11/x11.factor
+++ b/extra/ui/x11/x11.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2005, 2007 Eduardo Cavazos and Slava Pestov
+! Copyright (C) 2005, 2008 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays ui ui.gadgets ui.gestures
-ui.backend ui.clipboards ui.gadgets.worlds ui.render assocs
-kernel math namespaces opengl sequences strings x11.xlib
+USING: accessors alien alien.c-types arrays ui ui.gadgets
+ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
+assocs kernel math namespaces opengl sequences strings x11.xlib
 x11.events x11.xim x11.glx x11.clipboard x11.constants
 x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators debugger command-line qualified

From ba0e227d2de440c8331b1024647e850b753979aa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 13:49:00 -0500
Subject: [PATCH 08/14] Fix buttons tests

---
 extra/ui/gadgets/buttons/buttons-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/gadgets/buttons/buttons-tests.factor b/extra/ui/gadgets/buttons/buttons-tests.factor
index 94801145e3..6c5d757dd4 100755
--- a/extra/ui/gadgets/buttons/buttons-tests.factor
+++ b/extra/ui/gadgets/buttons/buttons-tests.factor
@@ -16,7 +16,7 @@ TUPLE: foo-gadget ;
 T{ foo-gadget } <toolbar> "t" set
 
 [ 2 ] [ "t" get gadget-children length ] unit-test
-[ "Foo A" ] [ "t" get gadget-child gadget-child gadget-child label-string ] unit-test
+[ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
 
 [ ] [
     2 <model> {

From e703dd2b8d04fa356d22e679f6f6f503109ee238 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 14:43:51 -0500
Subject: [PATCH 09/14] Cleaning up some code

---
 extra/ui/gadgets/frames/frames.factor       |  4 ++--
 extra/ui/gadgets/gadgets-docs.factor        |  4 ++--
 extra/ui/gadgets/gadgets.factor             | 12 +++++-------
 extra/ui/gadgets/labelled/labelled.factor   | 16 ++++++----------
 extra/ui/gadgets/packs/packs.factor         |  6 +++---
 extra/ui/gadgets/scrollers/scrollers.factor | 10 ++++------
 extra/ui/gadgets/sliders/sliders.factor     | 12 ++++++------
 extra/ui/gadgets/slots/slots.factor         | 10 ++++------
 extra/ui/gadgets/tracks/tracks.factor       |  4 ++--
 extra/ui/tools/browser/browser.factor       | 10 ++++------
 extra/ui/tools/debugger/debugger.factor     | 10 ++++------
 extra/ui/tools/deploy/deploy.factor         | 10 ++++------
 extra/ui/tools/inspector/inspector.factor   |  8 +++-----
 extra/ui/tools/listener/listener.factor     | 12 +++++-------
 extra/ui/tools/profiler/profiler.factor     | 10 ++++------
 extra/ui/tools/search/search.factor         | 10 ++++------
 extra/ui/tools/tools.factor                 | 16 +++++++---------
 extra/ui/tools/traceback/traceback.factor   | 14 ++++++++------
 extra/ui/tools/walker/walker.factor         | 11 +++++------
 extra/ui/ui-docs.factor                     |  2 +-
 20 files changed, 83 insertions(+), 108 deletions(-)

diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor
index df1b7aa654..096d916a9b 100644
--- a/extra/ui/gadgets/frames/frames.factor
+++ b/extra/ui/gadgets/frames/frames.factor
@@ -39,7 +39,7 @@ M: frame layout*
     grid-layout ;
 
 : make-frame ( quot -- frame )
-    <frame> make-gadget ; inline
+    <frame> swap make-gadget ; inline
 
 : frame, ( gadget i j -- )
-    \ make-gadget get -rot grid-add ;
+    gadget get -rot grid-add ;
diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index f05126fec3..8093aa5dc5 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -235,8 +235,8 @@ HELP: gadget,
 { $description "Adds a new child to the gadget being constructed. This word can only be used from a quotation passed to " { $link make-gadget } "." } ;
 
 HELP: make-gadget
-{ $values { "quot" quotation } { "gadget" gadget } }
-{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link make-gadget } " variable." } ;
+{ $values { "gadget" gadget } { "quot" quotation } }
+{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
 
 HELP: with-gadget
 { $values { "gadget" gadget } { "quot" quotation } } 
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 58b58d4fdc..5bfb5a1b05 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -391,19 +391,17 @@ M: f request-focus-on 2drop ;
 : focus-path ( world -- seq )
     [ gadget-focus ] follow ;
 
-: make-gadget ( quot gadget -- gadget )
-    [ \ make-gadget rot with-variable ] keep ; inline
-
-: gadget, ( gadget -- ) \ make-gadget get add-gadget ;
+: gadget, ( gadget -- ) gadget get add-gadget ;
 
 : g ( -- gadget ) gadget get ;
 
 : g-> ( x -- x x gadget ) dup g ;
 
 : with-gadget ( gadget quot -- )
-    [
-        swap dup \ make-gadget set gadget set call
-    ] with-scope ; inline
+    gadget swap with-variable ; inline
+
+: make-gadget ( gadget quot -- gadget )
+    [ with-gadget ] [ drop ] 2bi ; inline
 
 ! Deprecated
 : set-gadget-delegate ( gadget tuple -- )
diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
index ee27620273..2cb69d6061 100755
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -13,11 +13,9 @@ TUPLE: labelled-gadget < track content ;
 : <labelled-gadget> ( gadget title -- newgadget )
     { 0 1 } labelled-gadget new-track
     [
-        [
-            <label> reverse-video-theme f track,
-            g-> set-labelled-gadget-content 1 track,
-        ] with-gadget
-    ] keep ;
+        <label> reverse-video-theme f track,
+        g-> set-labelled-gadget-content 1 track,
+    ] make-gadget ;
 
 M: labelled-gadget focusable-child* labelled-gadget-content ;
 
@@ -54,10 +52,8 @@ TUPLE: closable-gadget < frame content ;
 : <closable-gadget> ( gadget title quot -- gadget )
     closable-gadget new-frame 
     [
-        [
-            <title-bar> @top frame,
-            g-> set-closable-gadget-content @center frame,
-        ] with-gadget
-    ] keep ;
+        <title-bar> @top frame,
+        g-> set-closable-gadget-content @center frame,
+    ] make-gadget ;
 
 M: closable-gadget focusable-child* closable-gadget-content ;
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index 3503d8e530..00f27af270 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -62,10 +62,10 @@ M: pack children-on ( rect gadget -- seq )
     [ fast-children-on ] keep <slice> ;
 
 : make-pile ( quot -- pack )
-    <pile> make-gadget ; inline
+    <pile> swap make-gadget ; inline
 
 : make-filled-pile ( quot -- pack )
-    <filled-pile> make-gadget ; inline
+    <filled-pile> swap make-gadget ; inline
 
 : make-shelf ( quot -- pack )
-    <shelf> make-gadget ; inline
+    <shelf> swap make-gadget ; inline
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index 7f8e5044eb..d1ee3da7b3 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -46,12 +46,10 @@ scroller H{
         <scroller-model> >>model
          faint-boundary
     [
-        [
-            x-model <x-slider> g-> set-scroller-x @bottom frame,
-            y-model <y-slider> g-> set-scroller-y @right frame,
-            viewport,
-        ] with-gadget
-    ] keep ;
+        x-model <x-slider> g-> set-scroller-x @bottom frame,
+        y-model <y-slider> g-> set-scroller-y @right frame,
+        viewport,
+    ] make-gadget ;
 
 : <scroller> ( gadget -- scroller )
     scroller new-scroller ;
diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor
index 56bfb0bc80..da18dea142 100755
--- a/extra/ui/gadgets/sliders/sliders.factor
+++ b/extra/ui/gadgets/sliders/sliders.factor
@@ -149,12 +149,12 @@ M: elevator layout*
 : <right-button> ( -- button )
     { 0 1 } arrow-right 1 <slide-button> ;
 
-: build-x-slider ( slider -- )
+: build-x-slider ( slider -- slider )
     [
         <left-button> @left frame,
         { 0 1 } elevator,
         <right-button> @right frame,
-    ] with-gadget ;
+    ] make-gadget ; inline
 
 : <up-button> ( -- button )
     { 1 0 } arrow-up -1 <slide-button> ;
@@ -162,12 +162,12 @@ M: elevator layout*
 : <down-button> ( -- button )
     { 1 0 } arrow-down 1 <slide-button> ;
 
-: build-y-slider ( slider -- )
+: build-y-slider ( slider -- slider )
     [
         <up-button> @top frame,
         { 1 0 } elevator,
         <down-button> @bottom frame,
-    ] with-gadget ;
+    ] make-gadget ; inline
 
 : <slider> ( range orientation -- slider )
     slider new-frame
@@ -176,10 +176,10 @@ M: elevator layout*
         32 >>line ;
 
 : <x-slider> ( range -- slider )
-    { 1 0 } <slider> dup build-x-slider ;
+    { 1 0 } <slider> build-x-slider ;
 
 : <y-slider> ( range -- slider )
-    { 0 1 } <slider> dup build-y-slider ;
+    { 0 1 } <slider> build-y-slider ;
 
 M: slider pref-dim*
     dup call-next-method
diff --git a/extra/ui/gadgets/slots/slots.factor b/extra/ui/gadgets/slots/slots.factor
index 1b101e5bf7..2c2831a2ee 100755
--- a/extra/ui/gadgets/slots/slots.factor
+++ b/extra/ui/gadgets/slots/slots.factor
@@ -72,12 +72,10 @@ M: value-ref finish-editing
     { 0 1 } slot-editor new-track
         swap >>ref
     [
-        [
-            toolbar,
-            <source-editor> g-> set-slot-editor-text
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep
+        toolbar,
+        <source-editor> g-> set-slot-editor-text
+        <scroller> 1 track,
+    ] make-gadget
     dup revert ;
 
 M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index d2d4275750..f9276fd1a1 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -50,10 +50,10 @@ M: track pref-dim*
     over track-sizes push add-gadget ;
 
 : track, ( gadget constraint -- )
-    \ make-gadget get swap track-add ;
+    gadget get swap track-add ;
 
 : make-track ( quot orientation -- track )
-    <track> make-gadget ; inline
+    <track> swap make-gadget ; inline
 
 : track-remove ( gadget track -- )
     over [
diff --git a/extra/ui/tools/browser/browser.factor b/extra/ui/tools/browser/browser.factor
index d8d2ac0104..421ffdbaaf 100755
--- a/extra/ui/tools/browser/browser.factor
+++ b/extra/ui/tools/browser/browser.factor
@@ -23,12 +23,10 @@ TUPLE: browser-gadget < track pane history ;
     { 0 1 } browser-gadget new-track
     dup init-history
     [
-        [
-            toolbar,
-            g <help-pane> g-> set-browser-gadget-pane
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        g <help-pane> g-> set-browser-gadget-pane
+        <scroller> 1 track,
+    ] make-gadget ;
 
 M: browser-gadget call-tool* show-help ;
 
diff --git a/extra/ui/tools/debugger/debugger.factor b/extra/ui/tools/debugger/debugger.factor
index ddf4b0106f..fbf9b28937 100644
--- a/extra/ui/tools/debugger/debugger.factor
+++ b/extra/ui/tools/debugger/debugger.factor
@@ -23,12 +23,10 @@ TUPLE: debugger < track restarts ;
 : <debugger> ( error restarts restart-hook -- gadget )
     { 0 1 } debugger new-track
     [
-        [
-            toolbar,
-            <restart-list> g-> set-debugger-restarts
-            swap <debugger-display> <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <restart-list> g-> set-debugger-restarts
+        swap <debugger-display> <scroller> 1 track,
+    ] make-gadget ;
 
 M: debugger focusable-child* debugger-restarts ;
 
diff --git a/extra/ui/tools/deploy/deploy.factor b/extra/ui/tools/deploy/deploy.factor
index d6b6683e29..3395c95663 100755
--- a/extra/ui/tools/deploy/deploy.factor
+++ b/extra/ui/tools/deploy/deploy.factor
@@ -109,12 +109,10 @@ deploy-gadget "toolbar" f {
         swap >>vocab
         { 0 1 } >>orientation
     [
-        [
-            g vocab>> <deploy-settings>
-            g-> set-deploy-gadget-settings gadget,
-            buttons,
-        ] with-gadget
-    ] keep
+        g vocab>> <deploy-settings>
+        g-> set-deploy-gadget-settings gadget,
+        buttons,
+    ] make-gadget
     dup deploy-settings-theme
     dup com-revert ;
 
diff --git a/extra/ui/tools/inspector/inspector.factor b/extra/ui/tools/inspector/inspector.factor
index bdb5c4d985..4aaf31881e 100644
--- a/extra/ui/tools/inspector/inspector.factor
+++ b/extra/ui/tools/inspector/inspector.factor
@@ -16,11 +16,9 @@ TUPLE: inspector-gadget < track object pane ;
 : <inspector-gadget> ( -- gadget )
     { 0 1 } inspector-gadget new-track
     [
-        [
-            toolbar,
-            <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
+    ] make-gadget ;
 
 : inspect-object ( obj inspector -- )
     [ set-inspector-gadget-object ] keep refresh ;
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 9b668142e8..3331999cc1 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -124,12 +124,10 @@ TUPLE: stack-display < track ;
     g workspace-listener
     { 0 1 } stack-display new-track
     [
-        [
-            dup <toolbar> f track,
-            stack>> [ [ stack. ] curry try ]
-            t "Data stack" <labelled-pane> 1 track,
-        ] with-gadget
-    ] keep ;
+        dup <toolbar> f track,
+        stack>> [ [ stack. ] curry try ]
+        t "Data stack" <labelled-pane> 1 track,
+    ] make-gadget ;
 
 M: stack-display tool-scroller
     find-workspace workspace-listener tool-scroller ;
@@ -174,7 +172,7 @@ M: stack-display tool-scroller
 : <listener-gadget> ( -- gadget )
     { 0 1 } listener-gadget new-track
     dup init-listener
-    [ [ listener-output, listener-input, ] with-gadget ] keep ;
+    [ listener-output, listener-input, ] make-gadget ;
 
 : listener-help ( -- ) "ui-listener" help-window ;
 
diff --git a/extra/ui/tools/profiler/profiler.factor b/extra/ui/tools/profiler/profiler.factor
index c86a0660a5..eca93cd8e1 100755
--- a/extra/ui/tools/profiler/profiler.factor
+++ b/extra/ui/tools/profiler/profiler.factor
@@ -10,12 +10,10 @@ TUPLE: profiler-gadget < track pane ;
 : <profiler-gadget> ( -- gadget )
     { 0 1 } profiler-gadget new-track
     [
-        [
-            toolbar,
-            <pane> g-> set-profiler-gadget-pane
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <pane> g-> set-profiler-gadget-pane
+        <scroller> 1 track,
+    ] make-gadget ;
 
 : with-profiler-pane ( gadget quot -- )
     >r profiler-gadget-pane r> with-pane ;
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index 3a48655a78..1d8f16de5a 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -62,12 +62,10 @@ search-field H{
 : <live-search> ( string seq limited? presenter -- gadget )
     { 0 1 } live-search new-track
     [
-        [
-            <search-field> g-> set-live-search-field f track,
-            <search-list> g-> set-live-search-list
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep
+        <search-field> g-> set-live-search-field f track,
+        <search-list> g-> set-live-search-list
+        <scroller> 1 track,
+    ] make-gadget
     [ live-search-field set-editor-string ] keep
     [ live-search-field end-of-document ] keep ;
 
diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor
index 9107454fa7..9b8affc649 100755
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@@ -30,15 +30,13 @@ IN: ui.tools
     { 0 1 } workspace new-track
         0 <model> >>model
     [
-        [
-            <listener-gadget> g set-workspace-listener
-            <workspace-book> g set-workspace-book
-            <workspace-tabs> f track,
-            g workspace-book 1/5 track,
-            g workspace-listener 4/5 track,
-            toolbar,
-        ] with-gadget
-    ] keep ;
+        <listener-gadget> g set-workspace-listener
+        <workspace-book> g set-workspace-book
+        <workspace-tabs> f track,
+        g workspace-book 1/5 track,
+        g workspace-listener 4/5 track,
+        toolbar,
+    ] make-gadget ;
 
 : resize-workspace ( workspace -- )
     dup track-sizes over control-value zero? [
diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor
index fa24d8c37d..e1743a4bc8 100755
--- a/extra/ui/tools/traceback/traceback.factor
+++ b/extra/ui/tools/traceback/traceback.factor
@@ -27,15 +27,17 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
     { 0 1 } traceback-gadget new-track
         swap >>model
     [
+        g model>>
         [
             [
-                g gadget-model <datastack-display> 1/2 track,
-                g gadget-model <retainstack-display> 1/2 track,
+                [ <datastack-display> 1/2 track, ]
+                [ <retainstack-display> 1/2 track, ]
+                bi
             ] { 1 0 } make-track 1/3 track,
-            g gadget-model <callstack-display> 2/3 track,
-            toolbar,
-        ] with-gadget
-    ] keep ;
+        ]
+        [ <callstack-display> 2/3 track, ] bi
+        toolbar,
+    ] make-gadget ;
 
 : <namestack-display> ( model -- gadget )
     [ [ continuation-name namestack. ] when* ]
diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor
index 59aa644505..3588b44644 100755
--- a/extra/ui/tools/walker/walker.factor
+++ b/extra/ui/tools/walker/walker.factor
@@ -60,13 +60,12 @@ M: walker-gadget focusable-child*
         swap >>thread
         swap >>continuation
         swap >>status
+        dup continuation>> <traceback-gadget> >>traceback
     [
-        [
-            toolbar,
-            g status>> self <thread-status> f track,
-            g continuation>> <traceback-gadget> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        g status>> self <thread-status> f track,
+        g traceback>> 1 track,
+    ] make-gadget ;
 
 : walker-help ( -- ) "ui-walker" help-window ;
 
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 3567ff6311..c037f13888 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -235,7 +235,7 @@ $nl
 $nl
 "Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
 { $subsection make-gadget }
-"Words such as " { $link gadget, } " and " { $link track, } " access the gadget through the " { $link make-gadget } " variable."
+"Words such as " { $link gadget, } " and " { $link track, } " access the gadget through the " { $link gadget } " variable."
 $nl
 "A combinator which stores a gadget in the " { $link gadget } " variable:"
 { $subsection with-gadget }

From bbdb00a5dd43f28f0df6d834ca6abb6175845781 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 14:52:36 -0500
Subject: [PATCH 10/14] Update documentation

---
 extra/ui/commands/commands-docs.factor        |  2 +-
 extra/ui/gadgets/buttons/buttons-docs.factor  |  2 +-
 extra/ui/gadgets/frames/frames-docs.factor    |  4 ++--
 extra/ui/gadgets/gadgets-tests.factor         |  4 ++--
 .../incremental/incremental-docs.factor       |  2 +-
 extra/ui/gadgets/packs/packs-docs.factor      |  6 ++---
 extra/ui/gadgets/scrollers/scrollers.factor   |  6 ++---
 extra/ui/gadgets/worlds/worlds-docs.factor    |  2 +-
 extra/ui/render/render-docs.factor            | 24 +++++++++----------
 extra/ui/ui-docs.factor                       |  8 +++----
 10 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/extra/ui/commands/commands-docs.factor b/extra/ui/commands/commands-docs.factor
index 134488fa8f..804236dadc 100644
--- a/extra/ui/commands/commands-docs.factor
+++ b/extra/ui/commands/commands-docs.factor
@@ -73,7 +73,7 @@ HELP: command-word
 HELP: command-map
 { $values { "group" string } { "class" "a class word" } { "command-map" "a " { $link command-map } " or " { $link f } } }
 { $description "Outputs a named command map defined on a class." }
-{ $class-description "A command map stores a group of related commands. Instances of this class delegate to arrays so behave like sequences; additionally the " { $link command-map-blurb } " slot stores a string description of the command group, or " { $link f } "."
+{ $class-description "A command map stores a group of related commands. The " { $snippet "commands" } " slot stores an association list mapping gestures to commands, and the " { $snippet "blurb" } " slot stores an optional one-line description string of this command map."
 $nl
 "Command maps are created by calling " { $link <command-map> } " or " { $link define-command-map } "." } ;
 
diff --git a/extra/ui/gadgets/buttons/buttons-docs.factor b/extra/ui/gadgets/buttons/buttons-docs.factor
index 02ddcc3d8a..64cc7bd1c8 100755
--- a/extra/ui/gadgets/buttons/buttons-docs.factor
+++ b/extra/ui/gadgets/buttons/buttons-docs.factor
@@ -11,7 +11,7 @@ $nl
 
 HELP: <button>
 { $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } }
-{ $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's delegate." } ;
+{ $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's only child." } ;
 
 HELP: <roll-button>
 { $values { "label" "a label specifier" } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" button } }
diff --git a/extra/ui/gadgets/frames/frames-docs.factor b/extra/ui/gadgets/frames/frames-docs.factor
index 26f72bcc57..bb759cf92e 100755
--- a/extra/ui/gadgets/frames/frames-docs.factor
+++ b/extra/ui/gadgets/frames/frames-docs.factor
@@ -3,7 +3,7 @@ quotations classes.tuple ui.gadgets.grids ;
 IN: ui.gadgets.frames
 
 ARTICLE: "ui-frame-layout" "Frame layouts"
-"Frames resemble " { $link "ui-grid-layout" } " except the size of grid is fixed at 3x3, and the center gadget fills up any available space. Because frames delegate to grids, grid layout words can be used to add and remove children."
+"Frames resemble " { $link "ui-grid-layout" } " except the size of grid is fixed at 3x3, and the center gadget fills up any available space. Because frames inherit from grids, grid layout words can be used to add and remove children."
 { $subsection frame }
 "Creating empty frames:"
 { $subsection <frame> }
@@ -38,7 +38,7 @@ HELP: @bottom-right $ui-frame-constant ;
 HELP: frame
 { $class-description "A frame is a gadget which lays out its children in a 3x3 grid. If the frame is enlarged past its preferred size, the center gadget fills up available room."
 $nl
-"Frames are constructed by calling " { $link <frame> } " and since they delegate to " { $link grid } " instances, children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ;
+"Frames are constructed by calling " { $link <frame> } " and since they inherit from " { $link grid } ", children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ;
 
 HELP: <frame>
 { $values { "frame" frame } }
diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor
index 3afe98ad2c..ca8829a082 100755
--- a/extra/ui/gadgets/gadgets-tests.factor
+++ b/extra/ui/gadgets/gadgets-tests.factor
@@ -104,10 +104,10 @@ prettyprint io.streams.string ;
 
 [ t ] [ { 25 25 } "g1" get pick-up "g4" get eq? ] unit-test
 
-TUPLE: mock-gadget graft-called ungraft-called ;
+TUPLE: mock-gadget < gadget graft-called ungraft-called ;
 
 : <mock-gadget> ( -- gadget )
-    0 0 mock-gadget boa <gadget> over set-delegate ;
+    mock-gadget new-gadget 0 >>graft-called 0 >>ungraft-called ;
 
 M: mock-gadget graft*
     dup mock-gadget-graft-called 1+
diff --git a/extra/ui/gadgets/incremental/incremental-docs.factor b/extra/ui/gadgets/incremental/incremental-docs.factor
index cbeb34bf74..83b007a99f 100755
--- a/extra/ui/gadgets/incremental/incremental-docs.factor
+++ b/extra/ui/gadgets/incremental/incremental-docs.factor
@@ -2,7 +2,7 @@ USING: ui.gadgets help.markup help.syntax ui.gadgets.packs ;
 IN: ui.gadgets.incremental
 
 HELP: incremental
-{ $class-description "An incremental layout gadget delegates to a " { $link pack } " and implements an optimization which the relayout operation after adding a child to be done in constant time."
+{ $class-description "Incremental layout gadgets inherit from " { $link pack } " and implement an optimization where the relayout operation after adding a child to be done in constant time."
 $nl
 "Incremental layout gadgets are created by calling " { $link <incremental> } "."
 $nl
diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/extra/ui/gadgets/packs/packs-docs.factor
index cd82e9054c..d44c9fa87d 100755
--- a/extra/ui/gadgets/packs/packs-docs.factor
+++ b/extra/ui/gadgets/packs/packs-docs.factor
@@ -34,13 +34,13 @@ HELP: pack
     { { $link pack-fill } " a rational number between 0 and 1, where 0 gives each gadget its preferred size and 1 fills the dimension perpendicular to the pack's orientation" }
     { { $link pack-gap } " a pair of integers, the horizontal and vertical gap between children" }
 }
-"Gadgets can delegate to packs and implement their own " { $link pref-dim* } " and " { $link layout* } " methods, reusing pack layout logic by calling " { $link pack-pref-dim } " and " { $link pack-layout } "." } ;
+"Custom gadgets can inherit from the " { $link pack } " class and implement their own " { $link pref-dim* } " and " { $link layout* } " methods, reusing pack layout logic by calling " { $link pack-pref-dim } " and " { $link pack-layout } "." } ;
 
 HELP: pack-layout
 { $values { "pack" "a new " { $link pack } } { "sizes" "a sequence of pairs of integers" } }
 { $description "Lays out the pack's children along the " { $link gadget-orientation } " of the pack, with each gadget receiving its size from the corresponding index of the " { $snippet "sizes" } " sequence." }
 { $notes
-    "This word is useful if you are writing your own layout gadget which delegates to a " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
+    "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
 HELP: <pack>
@@ -61,7 +61,7 @@ HELP: pack-pref-dim
 { $values { "gadget" gadget } { "sizes" "a sequence of pairs of integers" } { "dim" "a pair of integers" } }
 { $description "Computes the preferred size of a pack, with each gadget receiving its size from the corresponding index of the " { $snippet "sizes" } " sequence." }
 { $notes
-    "This word is useful if you are writing your own layout gadget which delegates to a " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
+    "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
 HELP: make-pile
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index d1ee3da7b3..7276d0e05d 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -30,15 +30,15 @@ scroller H{
 } set-gestures
 
 : viewport, ( child -- )
-    g gadget-model <viewport>
+    g model>> <viewport>
     g-> set-scroller-viewport @center frame, ;
 
 : <scroller-model> ( -- model )
     0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ;
 
-: x-model ( -- model ) g gadget-model model-dependencies first ;
+: x-model ( -- model ) g model>> dependencies>> first ;
 
-: y-model ( -- model ) g gadget-model model-dependencies second ;
+: y-model ( -- model ) g model>> dependencies>> second ;
 
 : new-scroller ( gadget class -- scroller )
     new-frame
diff --git a/extra/ui/gadgets/worlds/worlds-docs.factor b/extra/ui/gadgets/worlds/worlds-docs.factor
index 75a4f4ff12..50b100bee7 100755
--- a/extra/ui/gadgets/worlds/worlds-docs.factor
+++ b/extra/ui/gadgets/worlds/worlds-docs.factor
@@ -27,7 +27,7 @@ HELP: focus-path
 { $notes "This word is used to avoid sending " { $link gain-focus } " gestures to a gadget which requests focus on an unfocused top-level window, so that, for instance, a text editing caret does not appear in this case." } ;
 
 HELP: world
-{ $class-description "A gadget which appears at the top of the gadget hieararchy, and in turn may be displayed in a native window. Worlds delegate to " { $link gadget } " instances and have the following slots:"
+{ $class-description "A gadget which appears at the top of the gadget hieararchy, and in turn may be displayed in a native window. Worlds have the following slots:"
     { $list
         { { $snippet "active?" } " - if set to " { $link f } ", the world will not be drawn. This slot is set to " { $link f } " if an error is thrown while drawing the world; this prevents multiple debugger windows from being shown." }
         { { $snippet "glass" } " - a glass pane in front of the primary gadget, used to implement behaviors such as popup menus which are hidden when the mouse is clicked outside the menu." }
diff --git a/extra/ui/render/render-docs.factor b/extra/ui/render/render-docs.factor
index 98adf379df..d48d7c99d9 100755
--- a/extra/ui/render/render-docs.factor
+++ b/extra/ui/render/render-docs.factor
@@ -5,21 +5,21 @@ IN: ui.render
 HELP: gadget
 { $class-description "An object which displays itself on the screen and acts on user input gestures. Gadgets have the following slots:"
     { $list
-        { { $link gadget-pref-dim } " - a cached value for " { $link pref-dim } "; do not read or write this slot directly." }
-        { { $link gadget-parent } " - the gadget containing this one, or " { $link f } " if this gadget is not part of the visible gadget hierarchy." }
-        { { $link gadget-children } " - a vector of child gadgets. Do not modify this vector directly, instead use " { $link add-gadget } ", " { $link add-gadgets } ", " { $link unparent } " or " { $link clear-gadget } "." }
-        { { $link gadget-orientation } " - an orientation specifier. This slot is used by layout gadgets." }
-        { { $link gadget-layout-state } " - stores the layout state of the gadget. Do not read or write this slot directly, instead call " { $link relayout } " and " { $link relayout-1 } " if the gadget needs to be re-laid out." }
-        { { $link gadget-visible? } " - a boolean indicating if the gadget should display and receive user input." }
-        { { $link gadget-root? } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
-        { { $link gadget-clipped? } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
-        { { $link gadget-interior } " - an object whose class implements the " { $link draw-interior } " generic word." }
-        { { $link gadget-boundary } " - an object whose class implements the " { $link draw-boundary } " generic word." }
-        { { $link gadget-model } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
+        { { $link "pref-dim" } " - a cached value for " { $link pref-dim } "; do not read or write this slot directly." }
+        { { $link "parent" } " - the gadget containing this one, or " { $link f } " if this gadget is not part of the visible gadget hierarchy." }
+        { { $link "children" } " - a vector of child gadgets. Do not modify this vector directly, instead use " { $link add-gadget } ", " { $link add-gadgets } ", " { $link unparent } " or " { $link clear-gadget } "." }
+        { { $link "orientation" } " - an orientation specifier. This slot is used by layout gadgets." }
+        { { $link "layout-state" } " - stores the layout state of the gadget. Do not read or write this slot directly, instead call " { $link relayout } " and " { $link relayout-1 } " if the gadget needs to be re-laid out." }
+        { { $link "visible?" } " - a boolean indicating if the gadget should display and receive user input." }
+        { { $link "root?" } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
+        { { $link "clipped?" } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
+        { { $link "interior" } " - an object whose class implements the " { $link draw-interior } " generic word." }
+        { { $link "boundary" } " - an object whose class implements the " { $link draw-boundary } " generic word." }
+        { { $link "model" } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
     }
 "Gadgets subclass the " { $link rect } " class, and thus all instances have " { $snippet "loc" } " and " { $snippet "dim" } " instances holding their location and dimensions." }
 { $notes
-"Other classes may delegate to " { $link gadget } " in order to re-implement generic words such as " { $link draw-gadget* } " and " { $link user-input* } ", or to define gestures with " { $link set-gestures } "." } ;
+"Other classes may inherit from " { $link gadget } " in order to re-implement generic words such as " { $link draw-gadget* } " and " { $link user-input* } ", or to define gestures with " { $link set-gestures } "." } ;
 
 HELP: clip
 { $var-description "The current clipping rectangle." } ;
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index c037f13888..1a541090c5 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -74,14 +74,14 @@ ARTICLE: "ui-glossary" "UI glossary"
             }
         }
     }
-    { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) delegate to " { $link gadget } " instances." } }
+    { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) inherit from " { $link gadget } "." } }
     { "label specifier" { "a string, " { $link f } " or a gadget. See " { $link "ui.gadgets.buttons" } } }
     { "orientation specifier" { "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ", with the former denoting vertical orientation and the latter denoting horizontal. Using a vector instead of symbolic constants allows these values to be directly useful in co-ordinate calculations" } }
     { "point" "a pair of integers denoting a pixel location on screen" }
 } ;
 
 ARTICLE: "building-ui" "Building user interfaces"
-"A gadget is a graphical element which responds to user input. Gadgets are implemented as tuples which (directly or indirectly) delegate to instances of " { $link gadget } ", which in turn delegates to " { $link rect } "."
+"A gadget is a graphical element which responds to user input. Gadgets are implemented as tuples which (directly or indirectly) inherit from " { $link gadget } ", which in turn inherits from " { $link rect } "."
 { $subsection gadget }
 "Gadgets are arranged in a hierarchy, and all visible gadgets except for instances of " { $link world } " are contained in a parent gadget, stored in the " { $link gadget-parent } " slot."
 { $subsection "ui-geometry" }
@@ -104,7 +104,7 @@ ARTICLE: "gadgets" "Pre-made UI gadgets"
 { $subsection "ui.gadgets.lists" } ;
 
 ARTICLE: "ui-geometry" "Gadget geometry"
-"Instances of " { $link gadget } " (and thus all gadgets) delegate to rectangles which specify the gadget's bounding box:"
+"The " { $link gadget } " class inherits from the " { $link rect } " class, and thus all gadgets have a bounding box:"
 { $subsection rect }
 "Rectangles can be taken apart:"
 { $subsection rect-loc }
@@ -261,7 +261,7 @@ ARTICLE: "ui-layout-impl" "Implementing layout gadgets"
 { $subsection max-dim }
 { $subsection dim-sum }
 { $warning
-    "When implementing the " { $link layout* } " generic word for a gadget which intends to delegate to another layout, the " { $link children-on } " word might have to be re-implemented as well."
+    "When implementing the " { $link layout* } " generic word for a gadget which inherits from another layout, the " { $link children-on } " word might have to be re-implemented as well."
     $nl
     "For example, suppose you want a " { $link grid } " layout which also displays a popup gadget on top. The implementation of " { $link children-on } " for the " { $link grid } " class determines which children of the grid are visible at one time, and this will never include your popup, so it will not be rendered, nor will it respond to gestures. The solution is to re-implement " { $link children-on } " on your class."
 } ;

From 373a7adc6accd8677f17a64fb413da769eddcaeb Mon Sep 17 00:00:00 2001
From: William Schlieper <schlieper@unc.edu>
Date: Fri, 11 Jul 2008 16:06:44 -0400
Subject: [PATCH 11/14] ui.gadgets.tabs no longer uses delegation

---
 extra/ui/gadgets/tabs/tabs.factor | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index 18542f1089..1b4f633609 100755
--- a/extra/ui/gadgets/tabs/tabs.factor
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -4,11 +4,11 @@
 USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
        hashtables models models.range models.compose combinators
        ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
-       ui.gadgets.incremental ui.gadgets.viewports ui.gadgets.books ;
+       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books ;
 
 IN: ui.gadgets.tabs
 
-TUPLE: tabbed names model toggler content ;
+TUPLE: tabbed < frame names toggler content ;
 
 DEFER: (del-page)
 
@@ -48,8 +48,9 @@ DEFER: (del-page)
     [ names>> index ] 2keep (del-page) ;
 
 : <tabbed> ( assoc -- tabbed )
-    tabbed new
-    [ <pile> 1 >>fill g-> (>>toggler) @left frame,
-      [ keys >vector g (>>names) ]
-      [ values 0 <model> [ <book> g-> (>>content) @center frame, ] keep ] bi
-      g swap >>model redo-toggler ] build-frame ;
+    tabbed new-frame
+    [ g 0 <model> >>model
+      <pile> 1 >>fill [ >>toggler ] keep swap @left grid-add
+      [ keys g swap >>names ]
+      [ values g model>> <book> [ >>content ] keep swap @center grid-add ] bi
+      g redo-toggler g ] with-gadget ;

From 49d4e874c7e31aa52e18f0389ba9a812f2001fd8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 15:07:46 -0500
Subject: [PATCH 12/14] Fix shift-enter

---
 extra/ui/gadgets/editors/editors.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor
index 8cdc65b388..1732d404ca 100755
--- a/extra/ui/gadgets/editors/editors.factor
+++ b/extra/ui/gadgets/editors/editors.factor
@@ -480,7 +480,7 @@ multiline-editor "general" f {
     { T{ key-down f f "ENTER" } insert-newline }
 } define-command-map
 
-TUPLE: source-editor < editor ;
+TUPLE: source-editor < multiline-editor ;
 
 : <source-editor> ( -- editor )
     source-editor new-editor ;

From b0f8680438af7b650b8224ee54649309fcb021e4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 15:19:54 -0500
Subject: [PATCH 13/14] Fix scrollers

---
 extra/ui/gadgets/gadgets-tests.factor       |  8 ++++----
 extra/ui/gadgets/scrollers/scrollers.factor | 18 ++++++++++--------
 2 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor
index ca8829a082..dbb2919277 100755
--- a/extra/ui/gadgets/gadgets-tests.factor
+++ b/extra/ui/gadgets/gadgets-tests.factor
@@ -1,8 +1,8 @@
 IN: ui.gadgets.tests
-USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
-namespaces models kernel dlists dequeues math sets
-math.parser ui sequences hashtables assocs io arrays
-prettyprint io.streams.string ;
+USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
+tools.test namespaces models kernel dlists dequeues math sets
+math.parser ui sequences hashtables assocs io arrays prettyprint
+io.streams.string ;
 
 [ T{ rect f { 10 10 } { 20 20 } } ]
 [
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index 7276d0e05d..8cac3f4400 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -76,7 +76,7 @@ scroller H{
     ] keep dup scroller-value rot v+ swap scroll ;
 
 : relative-scroll-rect ( rect gadget scroller -- newrect )
-    scroller-viewport gadget-child relative-loc offset-rect ;
+    viewport>> gadget-child relative-loc offset-rect ;
 
 : find-scroller* ( gadget -- scroller )
     dup find-scroller dup [
@@ -119,13 +119,15 @@ scroller H{
 : scroll>top ( gadget -- )
     <zero-rect> swap scroll>rect ;
 
-: update-scroller ( scroller follows -- )
-    {
-        { [ dup t eq? ] [ drop (scroll>bottom) ] }
-        { [ dup rect? ] [ swap (scroll>rect) ] }
-        { [ dup ] [ swap (scroll>gadget) ] }
-        [ drop dup scroller-value swap scroll ]
-    } cond ;
+GENERIC: update-scroller ( scroller follows -- )
+
+M: t update-scroller drop (scroll>bottom) ;
+
+M: gadget update-scroller swap (scroll>gadget) ;
+
+M: rect update-scroller swap (scroll>rect) ;
+
+M: f update-scroller drop dup scroller-value swap scroll ;
 
 M: scroller layout*
     dup call-next-method

From d03c97174c19e70f0b4f078596011daf4837ea78 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 11 Jul 2008 15:45:06 -0500
Subject: [PATCH 14/14] update.backup: run backup in a try

---
 extra/update/backup/backup.factor | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/extra/update/backup/backup.factor b/extra/update/backup/backup.factor
index bb6d17f6dd..0dcf853b98 100644
--- a/extra/update/backup/backup.factor
+++ b/extra/update/backup/backup.factor
@@ -1,5 +1,5 @@
 
-USING: namespaces io.files bootstrap.image builder.util ;
+USING: namespaces debugger io.files bootstrap.image builder.util ;
 
 IN: update.backup
 
@@ -20,6 +20,9 @@ IN: update.backup
 
 : backup ( -- )
   datestamp "datestamp" set
-  backup-boot-image
-  backup-image
-  backup-vm ;
+    [
+      backup-boot-image
+      backup-image
+      backup-vm
+    ]
+  try ;