From a100968f030fc1d67fa69c22f69045182c11974e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Wed, 19 Nov 2008 20:32:28 -0600
Subject: [PATCH 01/47] boids: another indentation fix

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

diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor
index 3d4cd392ca..097b952db9 100644
--- a/extra/boids/boids.factor
+++ b/extra/boids/boids.factor
@@ -156,7 +156,7 @@ VAR: separation-radius
   2&& ;
 
 : alignment-neighborhood ( self -- boids )
-boids> [ within-alignment-neighborhood? ] with filter ;
+  boids> [ within-alignment-neighborhood? ] with filter ;
 
 : alignment-force ( self -- force )
   alignment-neighborhood

From 825ad4e59de9bb6a2afea502850c9e7590bfb33f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Nov 2008 21:02:21 -0600
Subject: [PATCH 02/47] Remove unmaintained/io/ since basis/io/ now has all of
 the features from the old I/O library

---
 unmaintained/io/load.factor           | 24 -------
 unmaintained/io/os-unix-shell.factor  | 46 -------------
 unmaintained/io/os-unix.factor        | 24 -------
 unmaintained/io/os-winnt-shell.factor | 55 ---------------
 unmaintained/io/os-winnt.factor       | 96 ---------------------------
 unmaintained/io/shell.factor          | 40 -----------
 unmaintained/io/test/io.factor        | 42 ------------
 unmaintained/io/test/mmap.factor      | 21 ------
 8 files changed, 348 deletions(-)
 delete mode 100644 unmaintained/io/load.factor
 delete mode 100644 unmaintained/io/os-unix-shell.factor
 delete mode 100644 unmaintained/io/os-unix.factor
 delete mode 100644 unmaintained/io/os-winnt-shell.factor
 delete mode 100644 unmaintained/io/os-winnt.factor
 delete mode 100644 unmaintained/io/shell.factor
 delete mode 100644 unmaintained/io/test/io.factor
 delete mode 100644 unmaintained/io/test/mmap.factor

diff --git a/unmaintained/io/load.factor b/unmaintained/io/load.factor
deleted file mode 100644
index ac9b9542c5..0000000000
--- a/unmaintained/io/load.factor
+++ /dev/null
@@ -1,24 +0,0 @@
-USING: kernel ;
-
-REQUIRES: libs/calendar libs/shuffle ;
-
-PROVIDE: libs/io
-{ +files+ {
-    "io.factor"
-    "mmap.factor"
-    "shell.factor"
-    { "os-unix.factor" [ unix? ] }
-    { "os-unix-shell.factor" [ unix? ] }
-    { "mmap-os-unix.factor" [ unix? ] }
-
-    { "os-winnt.factor" [ winnt? ] }
-    { "os-winnt-shell.factor" [ winnt? ] }
-    { "mmap-os-winnt.factor" [ winnt? ] }
-
-    { "os-wince.factor" [ wince? ] }
-} }
-{ +tests+ {
-    "test/io.factor"
-    "test/mmap.factor"
-} } ;
-
diff --git a/unmaintained/io/os-unix-shell.factor b/unmaintained/io/os-unix-shell.factor
deleted file mode 100644
index 6c3919ddb2..0000000000
--- a/unmaintained/io/os-unix-shell.factor
+++ /dev/null
@@ -1,46 +0,0 @@
-USING: arrays kernel libs-io sequences prettyprint unix-internals
-calendar namespaces math ;
-USE: io
-IN: shell
-
-TUPLE: unix-shell ;
-
-T{ unix-shell } \ shell set-global
-
-TUPLE: file name mode nlink uid gid size mtime symbol ;
-
-M: unix-shell directory* ( path -- seq )
-    dup (directory) [ tuck >r "/" r> 3append stat* 2array ] map-with ;
-
-M: unix-shell make-file ( path -- file )
-    first2
-    [ stat-mode ] keep
-    [ stat-nlink ] keep
-    [ stat-uid ] keep
-    [ stat-gid ] keep
-    [ stat-size ] keep
-    [ stat-mtime timespec>timestamp >local-time ] keep
-    stat-mode mode>symbol <file> ;
-
-M: unix-shell file. ( file -- )
-    [ [ file-mode >oct write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-nlink unparse write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-uid unparse write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-gid unparse write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-size unparse write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-mtime file-time-string write ] keep ] with-cell
-    [ bl ] with-cell
-    [ file-name write ] with-cell ;
-
-USE: unix-internals
-M: unix-shell touch-file ( path -- )
-    dup open-append dup -1 = [
-        drop now dup set-file-times
-    ] [
-        nip [ now dup set-file-times* ] keep close
-    ] if ;
diff --git a/unmaintained/io/os-unix.factor b/unmaintained/io/os-unix.factor
deleted file mode 100644
index 280908b406..0000000000
--- a/unmaintained/io/os-unix.factor
+++ /dev/null
@@ -1,24 +0,0 @@
-! Copyright (C) 2007 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays calendar errors io io-internals kernel
-math nonblocking-io sequences unix-internals unix-io ;
-IN: libs-io
-
-: O_APPEND  HEX: 100 ; inline
-: O_EXCL    HEX: 800 ; inline
-: SEEK_SET 0 ; inline
-: SEEK_CUR 1 ; inline
-: SEEK_END 2 ; inline
-: EEXIST 17 ; inline
-
-: mode>symbol ( mode -- ch )
-    S_IFMT bitand
-    {
-        { [ dup S_IFDIR = ] [ drop "/" ] }
-        { [ dup S_IFIFO = ] [ drop "|" ] }
-        { [ dup S_IXUSR = ] [ drop "*" ] }
-        { [ dup S_IFLNK = ] [ drop "@" ] }
-        { [ dup S_IFWHT = ] [ drop "%" ] }
-        { [ dup S_IFSOCK = ] [ drop "=" ] }
-        { [ t ] [ drop "" ] }
-    } cond ;
diff --git a/unmaintained/io/os-winnt-shell.factor b/unmaintained/io/os-winnt-shell.factor
deleted file mode 100644
index a2be22daf8..0000000000
--- a/unmaintained/io/os-winnt-shell.factor
+++ /dev/null
@@ -1,55 +0,0 @@
-USING: alien calendar io io-internals kernel libs-io math
-namespaces prettyprint sequences windows-api ;
-IN: shell
-
-TUPLE: winnt-shell ;
-
-T{ winnt-shell } \ shell set-global
-
-TUPLE: file name size mtime attributes ;
-
-: ((directory*)) ( handle -- )
-    "WIN32_FIND_DATA" <c-object> [ FindNextFile ] 2keep
-    rot zero? [ 2drop ] [ , ((directory*)) ] if ;
-
-: (directory*) ( path -- )
-    "WIN32_FIND_DATA" <c-object> [
-        FindFirstFile dup INVALID_HANDLE_VALUE = [
-            win32-error
-        ] when
-    ] keep ,
-    [ ((directory*)) ] keep FindClose win32-error=0/f ;
-
-: append-star ( path -- path )
-    dup peek CHAR: \\ = "*" "\\*" ? append ;
-
-M: winnt-shell directory* ( path -- seq )
-    normalize-pathname append-star [ (directory*) ] { } make ;
-
-: WIN32_FIND_DATA>file-size ( WIN32_FILE_ATTRIBUTE_DATA -- n )
-    [ WIN32_FIND_DATA-nFileSizeLow ] keep
-    WIN32_FIND_DATA-nFileSizeHigh 32 shift + ; 
-
-M: winnt-shell make-file ( WIN32_FIND_DATA -- file )
-    [ WIN32_FIND_DATA-cFileName alien>u16-string ] keep
-    [ WIN32_FIND_DATA>file-size ] keep
-    [
-        WIN32_FIND_DATA-ftCreationTime
-        FILETIME>timestamp >local-time
-    ] keep
-    WIN32_FIND_DATA-dwFileAttributes <file> ;
-
-M: winnt-shell file. ( file -- )
-    [ [ file-attributes >oct write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-size unparse write ] keep ] with-cell
-    [ bl ] with-cell
-    [ [ file-mtime file-time-string write ] keep ] with-cell
-    [ bl ] with-cell
-    [ file-name write ] with-cell ;
-
-M: winnt-shell touch-file ( path -- )
-    #! Set the file write time to 'now'
-    normalize-pathname
-    dup maybe-create-file [ drop ] [ now set-file-write-time ] if ;
-
diff --git a/unmaintained/io/os-winnt.factor b/unmaintained/io/os-winnt.factor
deleted file mode 100644
index 971ae79097..0000000000
--- a/unmaintained/io/os-winnt.factor
+++ /dev/null
@@ -1,96 +0,0 @@
-USING: alien calendar errors generic io io-internals kernel
-math namespaces nonblocking-io parser quotations sequences
-shuffle windows-api words ;
-IN: libs-io
-
-: stat* ( path -- WIN32_FIND_DATA )
-    "WIN32_FIND_DATA" <c-object>
-    [
-        FindFirstFile
-        [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
-        FindClose win32-error=0/f
-    ] keep ;
-
-: set-file-time ( path timestamp/f timestamp/f timestamp/f -- )
-    #! timestamp order: creation access write
-    >r >r >r open-existing dup r> r> r>
-    [ timestamp>FILETIME ] 3 napply
-    SetFileTime win32-error=0/f
-    close-handle ;
-
-: set-file-times ( path timestamp/f timestamp/f -- )
-    f -rot set-file-time ;
-
-: set-file-create-time ( path timestamp -- )
-    f f set-file-time ;
-
-: set-file-access-time ( path timestamp -- )
-    >r f r> f set-file-time ;
-
-: set-file-write-time ( path timestamp -- )
-    >r f f r> set-file-time ;
-
-: maybe-make-filetime ( ? -- FILETIME/f )
-    [ "FILETIME" <c-object> ] [ f ] if ;
-
-: file-time ( path ? ? ? -- FILETIME/f FILETIME/f FILETIME/f )
-    >r >r >r open-existing dup r> r> r>
-    [ maybe-make-filetime ] 3 napply
-    [ GetFileTime win32-error=0/f close-handle ] 3keep ;
-
-: file-times ( path -- FILETIME FILETIME FILETIME )
-    t t t file-time [ FILETIME>timestamp ] 3 napply ;
-
-: file-create-time ( path -- FILETIME )
-    t f f file-time 2drop FILETIME>timestamp ;
-
-: file-access-time ( path -- FILETIME )
-    f t f file-time drop nip FILETIME>timestamp ;
-
-: file-write-time ( path -- FILETIME )
-    f f t file-time 2nip FILETIME>timestamp ;
-
-: attrib ( path -- n )
-    [ stat* WIN32_FIND_DATA-dwFileAttributes ] catch
-    [ drop 0 ] when ;
-
-: (read-only?) ( mode -- ? )
-    FILE_ATTRIBUTE_READONLY bit-set? ;
-
-: read-only? ( path -- ? )
-    attrib (read-only?) ;
-
-: (hidden?) ( mode -- ? )
-    FILE_ATTRIBUTE_HIDDEN bit-set? ;
-
-: hidden? ( path -- ? )
-    attrib (hidden?) ;
-
-: (system?) ( mode -- ? )
-    FILE_ATTRIBUTE_SYSTEM bit-set? ;
-
-: system? ( path -- ? )
-    attrib (system?) ;
-
-: (directory?) ( mode -- ? )
-    FILE_ATTRIBUTE_DIRECTORY bit-set? ;
-
-: directory? ( path -- ? )
-    attrib (directory?) ;
-
-: (archive?) ( mode -- ? )
-    FILE_ATTRIBUTE_ARCHIVE bit-set? ;
-    
-: archive? ( path -- ? )
-    attrib (archive?) ;
-
-! FILE_ATTRIBUTE_DEVICE
-! FILE_ATTRIBUTE_NORMAL
-! FILE_ATTRIBUTE_TEMPORARY
-! FILE_ATTRIBUTE_SPARSE_FILE
-! FILE_ATTRIBUTE_REPARSE_POINT
-! FILE_ATTRIBUTE_COMPRESSED
-! FILE_ATTRIBUTE_OFFLINE
-! FILE_ATTRIBUTE_NOT_CONTENT_INDEXED
-! FILE_ATTRIBUTE_ENCRYPTED
-
diff --git a/unmaintained/io/shell.factor b/unmaintained/io/shell.factor
deleted file mode 100644
index 5213eb22c7..0000000000
--- a/unmaintained/io/shell.factor
+++ /dev/null
@@ -1,40 +0,0 @@
-USING: calendar io io-internals kernel math namespaces
-nonblocking-io prettyprint quotations sequences ;
-IN: shell
-
-SYMBOL: shell
-HOOK: directory* shell ( path -- seq )
-HOOK: make-file shell ( bytes -- file )
-HOOK: file. shell ( file -- )
-HOOK: touch-file shell ( path -- )
-
-: (ls) ( path -- )
-    >r H{ } r> directory*
-    [
-        [ [ make-file file. ] with-row ] each
-    ] curry tabular-output ;
-
-: ls ( -- )
-    cwd (ls) ;
-
-: pwd ( -- )
-    cwd pprint nl ;
-
-: (slurp) ( quot -- )
-    >r default-buffer-size read r> over [
-        dup slip (slurp)
-    ] [
-        2drop
-    ] if ;
-
-: slurp ( stream quot -- )
-    [ (slurp) ] curry with-stream ;
-
-: cat ( path -- )
-     <file-reader> stdio get
-     duplex-stream-out <duplex-stream>
-     [ write ] slurp ;
-
-: copy-file ( path path -- )
-    >r <file-reader> r>
-    <file-writer> <duplex-stream> [ write ] slurp ;
diff --git a/unmaintained/io/test/io.factor b/unmaintained/io/test/io.factor
deleted file mode 100644
index 379e1233f0..0000000000
--- a/unmaintained/io/test/io.factor
+++ /dev/null
@@ -1,42 +0,0 @@
-USING: calendar errors io kernel libs-io math namespaces sequences
-shell test ;
-IN: temporary
-
-SYMBOL: file "file-appender-test.txt" \ file set
-[ \ file get delete-file ] catch drop
-[ f ] [ \ file get exists? ] unit-test
-\ file get <file-appender> [ "asdf" write ] with-stream
-[ t ] [ \ file get exists? ] unit-test
-[ 4 ] [ \ file get file-length ] unit-test
-\ file get <file-appender> [ "jkl;" write ] with-stream
-[ t ] [ \ file get exists? ] unit-test
-[ 8 ] [ \ file get file-length ] unit-test
-[ "asdfjkl;" ] [ \ file get <file-reader> contents ] unit-test
-\ file get delete-file
-[ f ] [ \ file get exists? ] unit-test
-
-SYMBOL: directory "test-directory" \ directory set
-\ directory get create-directory
-[ t ] [ \ directory get directory? ] unit-test
-\ directory get delete-directory
-[ f ] [ \ directory get directory? ] unit-test
-
-SYMBOL: time "time-test.txt" \ time set
-[ \ time get delete-file ] catch drop
-\ time get touch-file
-[ 0 ] [ \ time get file-length ] unit-test
-[ t ] [ \ time get exists? ] unit-test
-\ time get 0 unix-time>timestamp dup set-file-times
-[ t ] [ \ time get file-write-time 0 unix-time>timestamp = ] unit-test
-[ t ] [ \ time get file-access-time 0 unix-time>timestamp = ] unit-test
-\ time get touch-file
-[ t ] [ now \ time get file-write-time timestamp- 10 < ] unit-test
-\ time get delete-file
-
-SYMBOL: longname "" 255 CHAR: a pad-left \ longname set
-\ longname get touch-file
-[ t ] [ \ longname get exists? ] unit-test
-[ 0 ] [ \ longname get file-length ] unit-test
-\ longname get delete-file
-[ f ] [ \ longname get exists? ] unit-test
-
diff --git a/unmaintained/io/test/mmap.factor b/unmaintained/io/test/mmap.factor
deleted file mode 100644
index faeca551c0..0000000000
--- a/unmaintained/io/test/mmap.factor
+++ /dev/null
@@ -1,21 +0,0 @@
-USING: alien errors io kernel libs-io mmap namespaces test ;
-
-IN: temporary
-SYMBOL: mmap "mmap-test.txt" \ mmap set
-
-[ \ mmap get delete-file ] catch drop
-\ mmap get [
-    "Four" write
-] with-file-writer
-
-\ mmap get [
-    >r CHAR: R r> mmap-address 3 set-alien-unsigned-1
-] with-mmap
-
-\ mmap get [
-    mmap-address 3 alien-unsigned-1 CHAR: R = [
-        "mmap test failed" throw
-    ] unless
-] with-mmap
-
-[ \ mmap get delete-file ] catch drop

From 8f0b335f4b7c3acbbd3240231ceef6bd415626d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Nov 2008 21:13:50 -0600
Subject: [PATCH 03/47] Clean up

---
 basis/ui/gadgets/frames/frames.factor | 29 +++++++++++++--------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index c210d1b7e2..2005fefed7 100644
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -11,16 +11,16 @@ TUPLE: frame < grid ;
 
 : <frame-grid> ( -- grid ) 9 [ <gadget> ] replicate 3 group ;
 
-: @center 1 1 ;
-: @left 0 1 ;
-: @right 2 1 ;
-: @top 1 0 ;
-: @bottom 1 2 ;
+: @center 1 1 ; inline
+: @left 0 1 ; inline
+: @right 2 1 ; inline
+: @top 1 0 ; inline
+: @bottom 1 2 ; inline
 
-: @top-left 0 0 ;
-: @top-right 2 0 ;
-: @bottom-left 0 2 ;
-: @bottom-right 2 2 ;
+: @top-left 0 0 ; inline
+: @top-right 2 0 ; inline
+: @bottom-left 0 2 ; inline
+: @bottom-right 2 2 ; inline
 
 : new-frame ( class -- frame )
     <frame-grid> swap new-grid ; inline
@@ -28,13 +28,12 @@ TUPLE: frame < grid ;
 : <frame> ( -- frame )
     frame new-frame ;
 
-: (fill-center) ( vec n -- )
-    over first pick third v+ [v-] 1 rot set-nth ;
+: (fill-center) ( n vec -- )
+    [ [ first ] [ third ] bi v+ [v-] ] keep set-second ;
 
-: fill-center ( horiz vert dim -- )
-    tuck (fill-center) (fill-center) ;
+: fill-center ( dim horiz vert -- )
+    [ over ] dip [ (fill-center) ] 2bi@ ;
 
 M: frame layout*
     dup compute-grid
-    [ rot rect-dim fill-center ] 3keep
-    grid-layout ;
+    [ [ rect-dim ] 2dip fill-center ] [ grid-layout ] 3bi ;

From 5a99526598d7df109c76b5bca5b50cf1bd0593e6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Wed, 19 Nov 2008 21:15:29 -0600
Subject: [PATCH 04/47] boids: adjust 'USING:' line

---
 extra/boids/boids.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor
index 097b952db9..eeebe1c12d 100644
--- a/extra/boids/boids.factor
+++ b/extra/boids/boids.factor
@@ -1,5 +1,5 @@
 
-USING: combinators.short-circuit kernel namespaces
+USING: kernel namespaces
        math
        math.constants
        math.functions
@@ -10,6 +10,7 @@ USING: combinators.short-circuit kernel namespaces
        math.physics.vel
        combinators arrays sequences random vars
        combinators.lib
+       combinators.short-circuit
        accessors ;
 
 IN: boids

From bcd2ffc830fa5d35b39872462fe52cc7d8e00cbb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Nov 2008 21:57:59 -0600
Subject: [PATCH 05/47] If rendering an error popup fails, don't open an
 endless stream

---
 basis/ui/gadgets/worlds/worlds.factor   |  4 ++--
 basis/ui/tools/debugger/debugger.factor | 10 +++++++++-
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 6f901c37ee..e338d6d4f4 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -30,7 +30,7 @@ ERROR: no-world-found ;
 
 : (request-focus) ( child world ? -- )
     pick parent>> pick eq? [
-        >r >r dup parent>> dup r> r>
+        [ dup parent>> dup ] 2dip
         [ (request-focus) ] keep
     ] unless focus-child ;
 
@@ -80,7 +80,7 @@ SYMBOL: ui-error-hook
 : ui-error ( error -- )
     ui-error-hook get [ call ] [ print-error ] if* ;
 
-[ rethrow ] ui-error-hook set-global
+ui-error-hook global [ [ rethrow ] or ] change-at
 
 : draw-world ( world -- )
     dup draw-world? [
diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor
index 4ba4374bb8..1f019fca7c 100644
--- a/basis/ui/tools/debugger/debugger.factor
+++ b/basis/ui/tools/debugger/debugger.factor
@@ -35,7 +35,15 @@ M: debugger focusable-child* restarts>> ;
     #! No restarts for the debugger window
     f [ drop ] <debugger> "Error" open-window ;
 
-[ debugger-window ] ui-error-hook set-global
+GENERIC: error-in-debugger? ( error -- ? )
+
+M: world-error error-in-debugger? world>> gadget-child debugger? ;
+
+M: object error-in-debugger? drop f ;
+
+[
+    dup error-in-debugger? [ rethrow ] [ debugger-window ] if 
+] ui-error-hook set-global
 
 M: world-error error.
     "An error occurred while drawing the world " write

From 4af2592369d2ddeb41436398b84be36e45a09a6f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Nov 2008 21:58:45 -0600
Subject: [PATCH 06/47] Fix some scrollers problems

---
 .../gadgets/scrollers/scrollers-tests.factor  | 23 ++++++-
 basis/ui/gadgets/scrollers/scrollers.factor   | 62 ++++++++++---------
 2 files changed, 53 insertions(+), 32 deletions(-)

diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor
index 625bfd7880..d6792abd49 100644
--- a/basis/ui/gadgets/scrollers/scrollers-tests.factor
+++ b/basis/ui/gadgets/scrollers/scrollers-tests.factor
@@ -2,7 +2,8 @@ USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
 kernel models models.compose models.range ui.gadgets.viewports
 ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
 ui.gadgets.sliders math math.vectors arrays sequences
-tools.test.ui math.geometry.rect accessors ;
+tools.test.ui math.geometry.rect accessors ui.gadgets.buttons
+ui.gadgets.packs ;
 IN: ui.gadgets.scrollers.tests
 
 [ ] [
@@ -74,7 +75,7 @@ dup layout
         "g2" get scroll>gadget
         "s" get layout
         "s" get scroller-value
-    ] map [ { 3 0 } = ] all?
+    ] map [ { 2 0 } = ] all?
 ] unit-test
 
 [ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
@@ -86,4 +87,22 @@ dup layout
 [ t ] [ "s" get @right grid-child slider? ] unit-test
 [ f ] [ "s" get @right grid-child find-scroller* ] unit-test
 
+[ ] [
+    "Click Me" [ [ scroll>gadget ] [ unparent ] bi ] <bevel-button>
+    [ <pile> swap add-gadget <scroller> ] keep
+    dup quot>> call
+    layout
+] unit-test
+
+[ t ] [
+    <gadget> { 200 200 } >>dim
+    [ [ scroll>gadget ] [ unparent ] bi ] <bevel-button>
+    dup
+    <pile> swap add-gadget <scroller> { 100 100 } >>dim dup layout
+    swap dup quot>> call
+    dup layout
+    model>> dependencies>> [ range-max value>> ] map
+    viewport-gap 2 v*n =
+] unit-test
+
 \ <scroller> must-infer
diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index 045ecc7990..37f6e83e0c 100644
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@@ -3,9 +3,8 @@
 USING: accessors arrays ui.gadgets ui.gadgets.viewports
 ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme
 ui.gadgets.sliders ui.gestures kernel math namespaces sequences
-models models.range models.compose
-combinators math.vectors classes.tuple math.geometry.rect
-combinators.short-circuit ;
+models models.range models.compose combinators math.vectors
+classes.tuple math.geometry.rect combinators.short-circuit ;
 IN: ui.gadgets.scrollers
 
 TUPLE: scroller < frame viewport x y follows ;
@@ -22,9 +21,10 @@ TUPLE: scroller < frame viewport x y follows ;
 : scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ;
 
 : do-mouse-scroll ( scroller -- )
-    scroll-direction get-global first2
-    pick y>> slide-by-line
-    swap x>> slide-by-line ;
+    scroll-direction get-global
+    [ first swap x>> slide-by-line ]
+    [ second swap y>> slide-by-line ]
+    2bi ;
 
 scroller H{
     { T{ mouse-scroll } [ do-mouse-scroll ] }
@@ -49,8 +49,8 @@ scroller H{
 
 : scroll ( value scroller -- )
     [
-        dup viewport>> rect-dim { 0 0 }
-        rot viewport>> viewport-dim 4array flip
+        viewport>> [ rect-dim { 0 0 } ] [ viewport-dim ] bi
+        4array flip
     ] keep
     2dup control-value = [ 2drop ] [ set-control-value ] if ;
 
@@ -58,15 +58,14 @@ scroller H{
     [ [ loc>> ] [ dim>> ] bi ] dip vmin <rect> ;
 
 : (scroll>rect) ( rect scroller -- )
-    [
-        scroller-value vneg offset-rect
-        viewport-gap offset-rect
-    ] keep
-    [ viewport>> dim>> rect-min ] keep
-    [
-        viewport>> 2rect-extent
-        [ v- { 1 1 } v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] 2bi* v+
-    ] keep dup scroller-value rot v+ swap scroll ;
+    [ [ loc>> { 1 1 } v- ] [ dim>> { 1 1 } v+ ] bi <rect> ] dip
+    {
+        [ scroller-value vneg offset-rect viewport-gap offset-rect ]
+        [ viewport>> dim>> rect-min ]
+        [ viewport>> 2rect-extent [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] 2bi* v+ ]
+        [ scroller-value v+ ]
+        [ scroll ]
+    } cleave ;
 
 : relative-scroll-rect ( rect gadget scroller -- newrect )
     viewport>> gadget-child relative-loc offset-rect ;
@@ -81,14 +80,17 @@ scroller H{
         [ relative-scroll-rect ] keep
         swap >>follows
         relayout
-    ] [
-        3drop
-    ] if ;
+    ] [ 3drop ] if ;
+
+: (update-scroller) ( scroller -- )
+    [ scroller-value ] keep scroll ;
 
 : (scroll>gadget) ( gadget scroller -- )
-    >r { 0 0 } over pref-dim <rect> swap r>
-    [ relative-scroll-rect ] keep
-    (scroll>rect) ;
+    2dup swap child? [
+        [ [ pref-dim { 0 0 } swap <rect> ] keep ] dip
+        [ relative-scroll-rect ] keep
+        (scroll>rect)
+    ] [ f >>follows (update-scroller) drop ] if ;
 
 : scroll>gadget ( gadget -- )
     dup find-scroller* dup [
@@ -99,7 +101,7 @@ scroller H{
     ] if ;
 
 : (scroll>bottom) ( scroller -- )
-    dup viewport>> viewport-dim { 0 1 } v* swap scroll ;
+    [ viewport>> viewport-dim { 0 1 } v* ] keep scroll ;
 
 : scroll>bottom ( gadget -- )
     find-scroller [ t >>follows relayout-1 ] when* ;
@@ -115,19 +117,19 @@ 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: f update-scroller drop (update-scroller) ;
 
 M: scroller layout*
-    dup call-next-method
-    dup follows>>
-    2dup update-scroller
-    >>follows drop ;
+    [ call-next-method ] [
+        dup follows>>
+        [ update-scroller ] [ >>follows drop ] 2bi
+    ] bi ; 
 
 M: scroller focusable-child*
     viewport>> ;
 
 M: scroller model-changed
-    nip f >>follows drop ;
+    f >>follows 2drop ;
 
 TUPLE: limited-scroller < scroller
 { min-dim initial: { 0 0 } }

From 375a9df29b234ebd7341e8bb9c29a0e8ed913583 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Nov 2008 21:59:11 -0600
Subject: [PATCH 07/47] Fix shift-click in editor nested inside a pane

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

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index d42df93b72..a1c4f3d04e 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -453,7 +453,7 @@ editor "caret-motion" f {
     T{ doc-elt } editor-select-next ;
 
 editor "selection" f {
-    { T{ button-down f { S+ } } extend-selection }
+    { T{ button-down f { S+ } 1 } extend-selection }
     { T{ drag } drag-selection }
     { T{ gain-focus } focus-editor }
     { T{ lose-focus } unfocus-editor }

From 248cb0df5ed7bf97c7fdd08bc647293934350a50 Mon Sep 17 00:00:00 2001
From: slava <slava@slava-laptop.(none)>
Date: Thu, 20 Nov 2008 03:47:39 -0600
Subject: [PATCH 08/47] Add some error checking to the X11 UI: if an event
 handler throws an error, we open a debugger window, as on other platforms,
 instead of stopping the UI

---
 basis/ui/x11/x11.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor
index e3c8421080..fd599635b1 100644
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@@ -185,7 +185,7 @@ M: world client-event
 
 M: x11-ui-backend do-events
     wait-event dup XAnyEvent-window window dup
-    [ [ 2dup handle-event ] assert-depth ] when 2drop ;
+    [ [ [ 2dup handle-event ] ui-try ] assert-depth ] when 2drop ;
 
 : x-clipboard@ ( gadget clipboard -- prop win )
     atom>> swap

From 1477a0f6f5c5733a2c20db37e692a3421b00a1ce Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 18:11:25 -0600
Subject: [PATCH 09/47] Code cleanups

---
 basis/ui/gadgets/frames/frames.factor       | 2 +-
 basis/ui/gadgets/viewports/viewports.factor | 8 +++++---
 basis/ui/tools/search/search.factor         | 2 +-
 basis/ui/ui.factor                          | 4 ++--
 4 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index 2005fefed7..b5c3736896 100644
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic kernel math namespaces sequences words
 splitting grouping math.vectors ui.gadgets.grids ui.gadgets
diff --git a/basis/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor
index 5f714a526b..f01ef3bf42 100644
--- a/basis/ui/gadgets/viewports/viewports.factor
+++ b/basis/ui/gadgets/viewports/viewports.factor
@@ -21,9 +21,11 @@ TUPLE: viewport < gadget ;
         swap add-gadget ;
 
 M: viewport layout*
-    dup rect-dim viewport-gap 2 v*n v-
-    over gadget-child pref-dim vmax
-    swap gadget-child (>>dim) ;
+    [
+        [ rect-dim viewport-gap 2 v*n v- ]
+        [ gadget-child pref-dim ]
+        bi vmax
+    ] [ gadget-child ] bi (>>dim) ;
 
 M: viewport focusable-child*
     gadget-child ;
diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor
index b88fe8454e..3081eb1cdc 100644
--- a/basis/ui/tools/search/search.factor
+++ b/basis/ui/tools/search/search.factor
@@ -48,7 +48,7 @@ search-field H{
 } set-gestures
 
 : <search-model> ( live-search producer -- live-search filter )
-    >r dup field>> model>>                   ! live-search model :: producer
+    >r dup field>> model>>
     ui-running? [ 1/5 seconds <delay> ] when
     [ "\n" join ] r> append <filter> ;
 
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index f561f3cd49..db0ac9a624 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -129,8 +129,8 @@ SYMBOL: ui-hook
 
 : notify ( gadget -- )
     dup graft-state>>
-    dup first { f f } { t t } ?
-    pick (>>graft-state) {
+    [ first { f f } { t t } ? >>graft-state ] keep
+    {
         { { f t } [ dup activate-control graft* ] }
         { { t f } [ dup deactivate-control ungraft* ] }
     } case ;

From d74af138e18e3c97de1cdfc342787a690daaf885 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 18:30:08 -0600
Subject: [PATCH 10/47] Fix shift-drag selection in panes

---
 basis/ui/gadgets/panes/panes.factor | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index ef5745809e..c1b3df3857 100644
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -363,7 +363,11 @@ M: f sloppy-pick-up*
     dup hand-rel over sloppy-pick-up >>caret
     dup relayout-1 ;
 
-: begin-selection ( pane -- ) move-caret f >>mark drop ;
+: begin-selection ( pane -- )
+    f >>selecting?
+    move-caret
+    f >>mark
+    drop ;
 
 : extend-selection ( pane -- )
     hand-moved? [
@@ -389,6 +393,7 @@ M: f sloppy-pick-up*
     ] if ;
 
 : select-to-caret ( pane -- )
+    t >>selecting?
     dup mark>> [ caret>mark ] unless
     move-caret
     dup request-focus

From 44c090d0a7f0e8155e361b4c7ecfda4c2e8960ef Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 19:04:10 -0600
Subject: [PATCH 11/47] Strip out print-use-hook to reduce image size

---
 basis/tools/deploy/shaker/shaker.factor | 1 +
 1 file changed, 1 insertion(+)

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index f8f9680c16..1992dbcda3 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -267,6 +267,7 @@ IN: tools.deploy.shaker
                 layouts:type-numbers
                 lexer-factory
                 listener:listener-hook
+                parser:print-use-hook
                 root-cache
                 vocab-roots
                 vocabs:dictionary

From 2620a101071c345c329e868da316ad362a45170e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 20:34:49 -0600
Subject: [PATCH 12/47] Display help in browser tool

---
 basis/help/help-docs.factor           |  9 +++++++--
 basis/help/help.factor                |  9 ++++++++-
 basis/ui/tools/browser/browser.factor | 19 ++++++++++---------
 3 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor
index 277d965e39..4a06235c69 100644
--- a/basis/help/help-docs.factor
+++ b/basis/help/help-docs.factor
@@ -129,12 +129,17 @@ HELP: $title
 { $values { "topic" "a help article name or a word" } }
 { $description "Prints a help article's title, or a word's " { $link summary } ", depending on the type of " { $snippet "topic" } "." } ;
 
+HELP: print-topic
+{ $values { "topic" "an article name or a word" } }
+{ $description
+    "Displays a help topic on " { $link output-stream } "."
+} ;
+
 HELP: help
 { $values { "topic" "an article name or a word" } }
 { $description
-    "Displays a help article or documentation associated to a word on " { $link output-stream } "."
+    "Displays a help topic."
 } ;
-
 HELP: about
 { $values { "vocab" "a vocabulary specifier" } }
 { $description
diff --git a/basis/help/help.factor b/basis/help/help.factor
index 686578f1b6..f9775e2668 100644
--- a/basis/help/help.factor
+++ b/basis/help/help.factor
@@ -89,10 +89,17 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
         ] with-nesting
     ] with-style nl ;
 
-: help ( topic -- )
+: print-topic ( topic -- )
     last-element off dup $title
     article-content print-content nl ;
 
+SYMBOL: help-hook
+
+help-hook global [ [ print-topic ] or ] change-at
+
+: help ( topic -- )
+    help-hook get call ;
+
 : about ( vocab -- )
     dup require
     dup vocab [ ] [
diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor
index 83a3b7ff68..b717bbb2f9 100644
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@@ -4,17 +4,17 @@ USING: debugger ui.tools.workspace help help.topics kernel
 models models.history ui.commands ui.gadgets ui.gadgets.panes
 ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
 ui.gadgets.buttons compiler.units assocs words vocabs
-accessors ;
+accessors fry combinators.short-circuit ;
 IN: ui.tools.browser
 
 TUPLE: browser-gadget < track pane history ;
 
 : show-help ( link help -- )
-    dup history>> add-history
-    >r >link r> history>> set-model ;
+    history>> dup add-history
+    [ >link ] dip set-model ;
 
 : <help-pane> ( browser-gadget -- gadget )
-    history>> [ [ help ] curry try ] <pane-control> ;
+    history>> [ '[ _ print-topic ] try ] <pane-control> ;
 
 : init-history ( browser-gadget -- )
     "handbook" >link <history> >>history drop ;
@@ -22,7 +22,7 @@ TUPLE: browser-gadget < track pane history ;
 : <browser-gadget> ( -- gadget )
     { 0 1 } browser-gadget new-track
         dup init-history
-        dup <toolbar> f track-add
+        add-toolbar
         dup <help-pane> >>pane
         dup pane>> <scroller> 1 track-add ;
 
@@ -38,10 +38,11 @@ M: browser-gadget ungraft*
     [ call-next-method ] [ remove-definition-observer ] bi ;
 
 : showing-definition? ( defspec assoc -- ? )
-    [ key? ] 2keep
-    [ >r dup word-link? [ name>> ] when r> key? ] 2keep
-    >r dup vocab-link? [ vocab ] when r> key?
-    or or ;
+    {
+        [ key? ]
+        [ [ dup word-link? [ name>> ] when ] dip key? ]
+        [ [ dup vocab-link? [ vocab ] when ] dip key? ]
+    } 2|| ;
 
 M: browser-gadget definitions-changed ( assoc browser -- )
     history>>

From 98d109a9a8caf8bc1d62a9f964c46cc6c6ce381b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 20:35:01 -0600
Subject: [PATCH 13/47] Rename do-what-i-mean? to auto-use?

---
 core/parser/parser.factor | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 007120fd19..414e9ea499 100644
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -82,17 +82,20 @@ ERROR: no-word-error name ;
 
 SYMBOL: amended-use?
 
-SYMBOL: do-what-i-mean?
+SYMBOL: auto-use?
 
 : no-word-restarted ( restart-value -- word )
-    dup word?
-    [ amended-use? on dup vocabulary>> (use+) ]
-    [ create-in ]
-    if ;
+    dup word? [
+        amended-use? on
+        dup vocabulary>>
+        [ (use+) ] [
+            "Added ``" swap "'' vocabulary to search path" 3append note.
+        ] bi
+    ] [ create-in ] if ;
 
 : no-word ( name -- newword )
     dup words-named [ forward-reference? not ] filter
-    dup length 1 = do-what-i-mean? get and
+    dup length 1 = auto-use? get and
     [ nip first no-word-restarted ]
     [ <no-word-error> throw-restarts no-word-restarted ]
     if ;

From 00869b6ad4df23591182d6ad677a267ad61ace35 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 20:35:58 -0600
Subject: [PATCH 14/47] Documentation update

---
 basis/prettyprint/prettyprint-docs.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor
index 159421c18c..3c004e5b30 100644
--- a/basis/prettyprint/prettyprint-docs.factor
+++ b/basis/prettyprint/prettyprint-docs.factor
@@ -17,7 +17,8 @@ ARTICLE: "prettyprint-stacks" "Prettyprinting stacks"
 "Prettyprinting any stack:"
 { $subsection stack. }
 "Prettyprinting any call stack:"
-{ $subsection callstack. } ;
+{ $subsection callstack. }
+"Note that calls to " { $link .s } " can also be included inside words as a debugging aid, however a more convenient way to achieve this is to use the annotation facility. See " { $link "tools.annotations" } "." ;
 
 ARTICLE: "prettyprint-variables" "Prettyprint control variables"
 "The following variables affect the " { $link . } " and " { $link pprint } " words if set in the current dynamic scope:"

From 25ec44b0b31ee774b2b7d65bfb5d6945bcc44a64 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 20:37:34 -0600
Subject: [PATCH 15/47] Listener now displays stacks and can watch variables

---
 basis/listener/listener-docs.factor | 25 +++++++-----
 basis/listener/listener.factor      | 59 +++++++++++++++++++++++------
 2 files changed, 62 insertions(+), 22 deletions(-)

diff --git a/basis/listener/listener-docs.factor b/basis/listener/listener-docs.factor
index beea9005b4..9b2903970a 100644
--- a/basis/listener/listener-docs.factor
+++ b/basis/listener/listener-docs.factor
@@ -1,34 +1,39 @@
 USING: help.markup help.syntax kernel io system prettyprint ;
 IN: listener
 
+ARTICLE: "listener-watch" "Watching variables in the listener"
+"The listener prints the concepts of the data and retain stacks after every expression. It can also print values of dynamic variables which are added to a watch list:"
+{ $subsection visible-vars }
+"To add or remove a single variable:"
+{ $subsection watch-var }
+{ $subsection unwatch-var }
+"To add and remove multiple variables:"
+{ $subsection watch-vars }
+{ $subsection unwatch-vars } ;
+
 ARTICLE: "listener" "The listener"
 "The listener evaluates Factor expressions read from a stream. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
 $nl
 "The classical first program can be run in the listener:"
 { $example "\"Hello, world\" print" "Hello, world" }
-"Multi-line phrases are supported:"
+"Multi-line expressions are supported:"
 { $example "{ 1 2 3 } [\n    .\n] each" "1\n2\n3" }
 "The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them."
-$nl
-"A very common operation is to inspect the contents of the data stack in the listener:"
-{ $subsection .s }
-"Note that calls to " { $link .s } " can also be included inside words as a debugging aid, however a more convenient way to achieve this is to use the annotation facility. See " { $link "tools.annotations" } "."
-$nl
+{ $subsection "listener-watch" }
 "You can start a nested listener or exit a listener using the following words:"
 { $subsection listener }
 { $subsection bye }
-"The following variables can be rebound inside a nested scope to customize the behavior of a listener; this can be done to create a development tool with a custom interaction loop:"
-{ $subsection listener-hook }
 "Finally, the multi-line expression reading word can be used independently of the rest of the listener:"
 { $subsection read-quot } ;
 
 ABOUT: "listener"
 
+<PRIVATE
+
 HELP: quit-flag
 { $var-description "Variable set to true by " { $link bye } " word; it forces the next iteration of the " { $link listener } " loop to end." } ;
 
-HELP: listener-hook
-{ $var-description "Variable holding a quotation called by the listener before reading an input expression. The UI sets this variable to a quotation which updates the stack display in a listener gadget." } ;
+PRIVATE>
 
 HELP: read-quot
 { $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index feddbdc042..ee16f6369a 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -3,16 +3,10 @@
 USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
-definitions compiler.units accessors colors ;
-
+definitions compiler.units accessors colors prettyprint fry
+sets ;
 IN: listener
 
-SYMBOL: quit-flag
-
-SYMBOL: listener-hook
-
-[ ] listener-hook set-global
-
 GENERIC: stream-read-quot ( stream -- quot/f )
 
 : parse-lines-interactive ( lines -- quot/f )
@@ -38,18 +32,57 @@ M: object stream-read-quot
 
 : read-quot ( -- quot/f ) input-stream get stream-read-quot ;
 
+<PRIVATE
+
+SYMBOL: quit-flag
+
+PRIVATE>
+
 : bye ( -- ) quit-flag on ;
 
-: prompt. ( -- )
-    "( " in get " )" 3append
-    H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
+SYMBOL: visible-vars
+
+: watch-var ( sym -- ) visible-vars  [ swap suffix ] change ;
+
+: watch-vars ( seq -- ) visible-vars [ swap union ] change ;
+
+: unwatch-var ( sym -- ) visible-vars [ remove ] change ;
+
+: unwatch-vars ( seq -- ) visible-vars [ swap diff ] change ;
 
 SYMBOL: error-hook
 
 [ print-error-and-restarts ] error-hook set-global
 
+<PRIVATE
+
+: title. ( string -- )
+    H{ { foreground T{ rgba f 0.3 0.3 0.3 1 } } } format nl ;
+
+: visible-vars. ( -- )
+    visible-vars get [
+        nl "--- Watched variables:" title.
+        standard-table-style [
+            [
+                [
+                    [ [ short. ] with-cell ]
+                    [ [ get short. ] with-cell ]
+                    bi
+                ] with-row
+            ] each
+        ] tabular-output
+    ] unless-empty ;
+
+: stacks. ( -- )
+    datastack [ nl "--- Data stack:" title. stack. ] unless-empty
+    retainstack [ nl "--- Retain stack:" title. stack. ] unless-empty ;
+
+: prompt. ( -- )
+    "( " in get auto-use? get [ " - auto" append ] when " )" 3append
+    H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
+
 : listen ( -- )
-    listener-hook get call prompt.
+    visible-vars. stacks. prompt.
     [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
     [
         dup lexer-error? [
@@ -62,6 +95,8 @@ SYMBOL: error-hook
 : until-quit ( -- )
     quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
 
+PRIVATE>
+
 : listener ( -- )
     [ until-quit ] with-interactive-vocabs ;
 

From 3b037c89474341fcfff8eddfea52714758fcd59c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:54:07 -0600
Subject: [PATCH 16/47] Fix load error in tools.deploy.shaker

---
 basis/tools/deploy/shaker/shaker.factor | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 1992dbcda3..f5778e410f 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -266,8 +266,7 @@ IN: tools.deploy.shaker
                 layouts:tag-numbers
                 layouts:type-numbers
                 lexer-factory
-                listener:listener-hook
-                parser:print-use-hook
+                print-use-hook
                 root-cache
                 vocab-roots
                 vocabs:dictionary

From 786ca76d02245480b5cb28a0f8acab6379b005be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:54:28 -0600
Subject: [PATCH 17/47] Listener now displays stacks and watched variables

---
 basis/listener/listener-docs.factor | 8 ++++----
 basis/listener/listener.factor      | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/basis/listener/listener-docs.factor b/basis/listener/listener-docs.factor
index 9b2903970a..8ef49ca0d9 100644
--- a/basis/listener/listener-docs.factor
+++ b/basis/listener/listener-docs.factor
@@ -5,11 +5,11 @@ ARTICLE: "listener-watch" "Watching variables in the listener"
 "The listener prints the concepts of the data and retain stacks after every expression. It can also print values of dynamic variables which are added to a watch list:"
 { $subsection visible-vars }
 "To add or remove a single variable:"
-{ $subsection watch-var }
-{ $subsection unwatch-var }
+{ $subsection show-var }
+{ $subsection hide-var }
 "To add and remove multiple variables:"
-{ $subsection watch-vars }
-{ $subsection unwatch-vars } ;
+{ $subsection show-vars }
+{ $subsection hide-vars } ;
 
 ARTICLE: "listener" "The listener"
 "The listener evaluates Factor expressions read from a stream. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index ee16f6369a..5d58cafe29 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -42,13 +42,13 @@ PRIVATE>
 
 SYMBOL: visible-vars
 
-: watch-var ( sym -- ) visible-vars  [ swap suffix ] change ;
+: show-var ( sym -- ) visible-vars  [ swap suffix ] change ;
 
-: watch-vars ( seq -- ) visible-vars [ swap union ] change ;
+: show-vars ( seq -- ) visible-vars [ swap union ] change ;
 
-: unwatch-var ( sym -- ) visible-vars [ remove ] change ;
+: hide-var ( sym -- ) visible-vars [ remove ] change ;
 
-: unwatch-vars ( seq -- ) visible-vars [ swap diff ] change ;
+: hide-vars ( seq -- ) visible-vars [ swap diff ] change ;
 
 SYMBOL: error-hook
 

From 2e2856b9a490e80a568cdebbba8e389535619d5f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:54:38 -0600
Subject: [PATCH 18/47] Document auto-use? feature

---
 core/parser/parser-docs.factor | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor
index d3c2cff19d..92e5922802 100644
--- a/core/parser/parser-docs.factor
+++ b/core/parser/parser-docs.factor
@@ -41,13 +41,15 @@ $nl
 }
 "The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ;
 
-ARTICLE: "vocabulary-search-errors" "Word lookup errors"
-"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies. Then, one of three things happen:"
-{ $list
-    { "If there are no words having this name at all, an error is thrown and parsing stops." }
-    { "If there are vocabularies which contain words with this name, a restartable error is thrown, with a restart for each vocabulary in question. The restarts add the vocabulary to the search path and continue parsing." }
-}
-"When writing a new vocabulary, one approach is to ignore " { $link POSTPONE: USING: } " declarations altogether, then to load the vocabulary and observe any parser notes and restarts and use this information to write the correct " { $link POSTPONE: USING: } " declaration." ;
+ARTICLE: "vocabulary-search-errors"  "Word lookup errors"
+"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies."
+$nl
+"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used."
+$nl
+"If " { $link auto-use? } " mode is on and only one vocabulary has a word with this name, the vocabulary is added to the search path and parsing continues."
+$nl
+"If any restarts were invoked, or if " { $link auto-use? } " is on, the parser will print the correct " { $link POSTPONE: USING: } " after parsing completes. This form can be copy and pasted back into the source file."
+{ $subsection auto-use? } ;
 
 ARTICLE: "vocabulary-search" "Vocabulary search path"
 "When the parser reads a token, it attempts to look up a word named by that token. The lookup is performed by searching each vocabulary in the search path, in order."
@@ -353,3 +355,7 @@ HELP: staging-violation
 { $description "Throws a " { $link staging-violation } " error." }
 { $error-description "Thrown by the parser if a parsing word is used in the same compilation unit as where it was defined; see " { $link "compilation-units" } "." }
 { $notes "One possible workaround is to use the " { $link POSTPONE: << } " word to execute code at parse time. However, executing words defined in the same source file at parse time is still prohibited." } ;
+
+HELP: auto-use?
+{ $var-description "If set to a true value, the behavior of the parser when encountering an unknown word name is changed. If only one loaded vocabulary has a word with this name, instead of throwing an error, the parser adds the vocabulary to the search path and prints a parse note. Off by default." }
+{ $notes "This feature is intended to help during development. To generate a " { $link POSTPONE: USING: } " form automatically, enable " { $link auto-use? } ", load the source file, and copy and paste the " { $link POSTPONE: USING: } " form printed by the parser back into the file, then disable " { $link auto-use? } ". See " { $link "vocabulary-search-errors" } "." } ;

From 2eac58c271e2eaaeacb25931905ef87e2ecc292d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:57:56 -0600
Subject: [PATCH 19/47] Fix '0 track-add'

---
 basis/ui/gadgets/tracks/tracks-tests.factor | 7 +++++++
 basis/ui/gadgets/tracks/tracks.factor       | 8 ++++++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/basis/ui/gadgets/tracks/tracks-tests.factor b/basis/ui/gadgets/tracks/tracks-tests.factor
index 93f2d14528..5381eebb01 100644
--- a/basis/ui/gadgets/tracks/tracks-tests.factor
+++ b/basis/ui/gadgets/tracks/tracks-tests.factor
@@ -14,3 +14,10 @@ IN: ui.gadgets.tracks.tests
         <gadget> { 100 100 } >>dim 1 track-add
     pref-dim
 ] unit-test
+
+[ { 10 10 } ] [
+    { 0 1 } <track>
+        <gadget> { 10 10 } >>dim 1 track-add
+        <gadget> { 10 10 } >>dim 0 track-add
+    pref-dim
+] unit-test
diff --git a/basis/ui/gadgets/tracks/tracks.factor b/basis/ui/gadgets/tracks/tracks.factor
index 771c489ce3..dc176b5bf7 100644
--- a/basis/ui/gadgets/tracks/tracks.factor
+++ b/basis/ui/gadgets/tracks/tracks.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel namespaces fry
 math math.vectors math.geometry.rect math.order
-sequences words ui.gadgets ui.gadgets.packs ;
+sequences words ui.gadgets ui.gadgets.packs ui.gadgets.buttons ;
 
 IN: ui.gadgets.tracks
 
@@ -41,7 +41,8 @@ M: track layout* ( track -- ) dup track-layout pack-layout ;
 : track-pref-dims-2 ( track -- dim )
     [
         [ children>> pref-dims ] [ normalized-sizes ] bi
-        [ [ v/n ] when* ] 2map max-dim [ >fixnum ] map
+        [ dup { 0 f } memq? [ drop ] [ v/n ] if ] 2map
+        max-dim [ >fixnum ] map
     ]
     [ [ gap>> ] [ children>> length 1 [-] ] bi v*n ] bi
     v+ ;
@@ -56,6 +57,9 @@ M: track pref-dim* ( gadget -- dim )
 : track-add ( track gadget constraint -- track )
     pick sizes>> push add-gadget ;
 
+: add-toolbar ( track -- track )
+    dup <toolbar> f track-add ;
+
 : track-remove ( track gadget -- track )
     dupd dup [
         [ swap children>> index ]

From f27ebdd1ef225344101fe9793a6013cee2b62a49 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:58:30 -0600
Subject: [PATCH 20/47] Use add-toolbar word in a few places

---
 basis/ui/gadgets/slots/slots.factor       |  2 +-
 basis/ui/tools/debugger/debugger.factor   |  2 +-
 basis/ui/tools/inspector/inspector.factor |  2 +-
 basis/ui/tools/profiler/profiler.factor   |  2 +-
 basis/ui/tools/search/search.factor       | 72 ++++++++++++-----------
 basis/ui/tools/traceback/traceback.factor |  2 +-
 basis/ui/tools/walker/walker.factor       |  4 +-
 basis/ui/tools/workspace/workspace.factor | 18 +++---
 8 files changed, 53 insertions(+), 51 deletions(-)

diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor
index 1cf23e2d06..ff2220b60e 100644
--- a/basis/ui/gadgets/slots/slots.factor
+++ b/basis/ui/gadgets/slots/slots.factor
@@ -71,7 +71,7 @@ M: value-ref finish-editing
 : <slot-editor> ( ref -- gadget )
     { 0 1 } slot-editor new-track
         swap >>ref
-        dup <toolbar> f track-add
+        add-toolbar
         <source-editor> >>text
         dup text>> <scroller> 1 track-add
         dup revert ;
diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor
index 1f019fca7c..641763c0b1 100644
--- a/basis/ui/tools/debugger/debugger.factor
+++ b/basis/ui/tools/debugger/debugger.factor
@@ -25,7 +25,7 @@ TUPLE: debugger < track restarts ;
 
 : <debugger> ( error restarts restart-hook -- gadget )
     { 0 1 } debugger new-track
-        dup <toolbar> f track-add
+        add-toolbar
         -rot <restart-list> >>restarts
         dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
 
diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index dcb3a3f8ad..579210325b 100644
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -17,7 +17,7 @@ TUPLE: inspector-gadget < track object pane ;
 
 : <inspector-gadget> ( -- gadget )
     { 0 1 } inspector-gadget new-track
-        dup <toolbar> f track-add
+        add-toolbar
         <pane> >>pane
         dup pane>> <scroller> 1 track-add ;
 
diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor
index c60d0dac09..05d1ccdb82 100644
--- a/basis/ui/tools/profiler/profiler.factor
+++ b/basis/ui/tools/profiler/profiler.factor
@@ -9,7 +9,7 @@ TUPLE: profiler-gadget < track pane ;
 
 : <profiler-gadget> ( -- gadget )
     { 0 1 } profiler-gadget new-track
-        dup <toolbar> f track-add
+        add-toolbar
         <pane> >>pane
         dup pane>> <scroller> 1 track-add ;
 
diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor
index 3081eb1cdc..033aacc1b3 100644
--- a/basis/ui/tools/search/search.factor
+++ b/basis/ui/tools/search/search.factor
@@ -1,14 +1,14 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs ui.tools.interactor ui.tools.listener
-ui.tools.workspace help help.topics io.files io.styles kernel
-models models.delay models.filter namespaces prettyprint
+USING: accessors assocs help help.topics io.files io.styles
+kernel models models.delay models.filter namespaces prettyprint
 quotations sequences sorting source-files definitions strings
-tools.completion tools.crossref classes.tuple ui.commands
-ui.gadgets ui.gadgets.editors ui.gadgets.lists
-ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations
-vocabs words vocabs.loader tools.vocabs unicode.case calendar ui
-;
+tools.completion tools.crossref classes.tuple vocabs words
+vocabs.loader tools.vocabs unicode.case calendar locals
+ui.tools.interactor ui.tools.listener ui.tools.workspace
+ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists
+ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.borders
+ui.gestures ui.operations ui ;
 IN: ui.tools.search
 
 TUPLE: live-search < track field list ;
@@ -23,7 +23,7 @@ TUPLE: live-search < track field list ;
 M: live-search handle-gesture ( gesture live-search -- ? )
     tuck search-gesture dup [
         over find-workspace hide-popup
-        >r search-value r> invoke-command f
+        [ search-value ] dip invoke-command f
     ] [
         2drop t
     ] if ;
@@ -47,27 +47,29 @@ search-field H{
     { T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
 } set-gestures
 
-: <search-model> ( live-search producer -- live-search filter )
-    >r dup field>> model>>
-    ui-running? [ 1/5 seconds <delay> ] when
-    [ "\n" join ] r> append <filter> ;
+: <search-model> ( live-search producer -- filter )
+    [
+        field>> model>>
+        ui-running? [ 1/5 seconds <delay> ] when
+    ] dip [ "\n" join ] prepend <filter> ;
 
-: <search-list> ( live-search seq limited? presenter -- live-search list )
-    >r
-    [ limited-completions ] [ completions ] ? curry
-    <search-model>
-    >r [ find-workspace hide-popup ] r> r>
-    swap <list> ;
+: init-search-model ( live-search seq limited? -- live-search )
+    [ 2drop ]
+    [ [ limited-completions ] [ completions ] ? curry <search-model> ] 3bi
+    >>model ; inline
 
-: <live-search> ( string seq limited? presenter -- gadget )
+: <search-list> ( presenter live-search -- list )
+    [ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* <list> ;
+
+:: <live-search> ( string seq limited? presenter -- gadget )
     { 0 1 } live-search new-track
         <search-field> >>field
-        dup field>> f track-add
-        -roll <search-list> >>list
+        seq limited? init-search-model
+        presenter over <search-list> >>list
+        dup field>> 1 <border> { 0 0 } >>align f track-add
         dup list>> <scroller> 1 track-add
-    swap                         
-        over field>> set-editor-string
-    dup field>> end-of-document ;
+        string over field>> set-editor-string
+        dup field>> end-of-document ;
 
 M: live-search focusable-child* field>> ;
 
@@ -80,26 +82,27 @@ M: live-search pref-dim* drop { 400 200 } ;
     [ dup synopsis >lower ] { } map>assoc sort-values ;
 
 : <definition-search> ( string words limited? -- gadget )
-    >r definition-candidates r> [ synopsis ] <live-search> ;
+    [ definition-candidates ] dip [ synopsis ] <live-search> ;
 
 : word-candidates ( words -- candidates )
     [ dup name>> >lower ] { } map>assoc ;
 
 : <word-search> ( string words limited? -- gadget )
-    >r word-candidates r> [ synopsis ] <live-search> ;
+    [ word-candidates ] dip [ synopsis ] <live-search> ;
 
 : com-words ( workspace -- )
     dup current-word all-words t <word-search>
     "Word search" show-titled-popup ;
 
 : show-vocab-words ( workspace vocab -- )
-    "" over words natural-sort f <word-search>
-    "Words in " rot vocab-name append show-titled-popup ;
+    [ "" swap words natural-sort f <word-search> ]
+    [ "Words in " swap vocab-name append ]
+    bi show-titled-popup ;
 
 : show-word-usage ( workspace word -- )
-    "" over smart-usage f <definition-search>
-    "Words and methods using " rot name>> append
-    show-titled-popup ;
+    [ "" swap smart-usage f <definition-search> ]
+    [ "Words and methods using " swap name>> append ]
+    bi show-titled-popup ;
 
 : help-candidates ( seq -- candidates )
     [ dup >link swap article-title >lower ] { } map>assoc
@@ -127,8 +130,9 @@ M: live-search pref-dim* drop { 400 200 } ;
     "Source file search" show-titled-popup ;
 
 : show-vocab-files ( workspace vocab -- )
-    "" over vocab-files <source-file-search>
-    "Source files in " rot vocab-name append show-titled-popup ;
+    [ "" swap vocab-files <source-file-search> ]
+    [ "Source files in " swap vocab-name append ]
+    bi show-titled-popup ;
 
 : vocab-candidates ( -- candidates )
     all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor
index 7e2158e0e9..45f15b1ffc 100644
--- a/basis/ui/tools/traceback/traceback.factor
+++ b/basis/ui/tools/traceback/traceback.factor
@@ -36,7 +36,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
 
     dup model>> <callstack-display> 2/3 track-add
 
-    dup <toolbar> f track-add ;
+    add-toolbar ;
 
 : <namestack-display> ( model -- gadget )
     [ [ name>> namestack. ] when* ]
diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor
index 7bc42ea676..9c825d4920 100644
--- a/basis/ui/tools/walker/walker.factor
+++ b/basis/ui/tools/walker/walker.factor
@@ -62,9 +62,9 @@ M: walker-gadget focusable-child*
         swap >>status
         dup continuation>> <traceback-gadget> >>traceback
 
-        dup <toolbar>                     f track-add
+        add-toolbar
         dup status>> self <thread-status> f track-add
-        dup traceback>>                   1 track-add ;
+        dup traceback>> 1 track-add ;
     
 : walker-help ( -- ) "ui-walker" help-window ;
 
diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor
index f06e0aae26..6536cb8c7d 100644
--- a/basis/ui/tools/workspace/workspace.factor
+++ b/basis/ui/tools/workspace/workspace.factor
@@ -1,12 +1,12 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
-       sequences ui ui.backend ui.tools.debugger ui.gadgets
-       ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
-       ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
-       ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
-       ui.commands ui.gestures assocs arrays namespaces accessors ;
-
+sequences assocs arrays namespaces accessors math.vectors ui
+ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
+ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
+ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
+ui.gadgets.presentations ui.gadgets.status-bar ui.commands
+ui.gestures ;
 IN: ui.tools.workspace
 
 TUPLE: workspace < track book listener popup ;
@@ -32,8 +32,6 @@ M: gadget tool-scroller drop f ;
     [ find-tool swap ] keep book>> model>>
     set-model ;
 
-: select-tool ( workspace class -- ) swap show-tool drop ;
-
 : get-workspace* ( quot -- workspace )
     [ >r dup workspace? r> [ drop f ] if ] curry find-window
     [ dup raise-window gadget-child ]
@@ -81,7 +79,7 @@ SYMBOL: workspace-dim
 
 { 600 700 } workspace-dim set-global
 
-M: workspace pref-dim* drop workspace-dim get ;
+M: workspace pref-dim* call-next-method workspace-dim get vmax ;
 
 M: workspace focusable-child*
     dup popup>> [ ] [ listener>> ] ?if ;

From 08f7e02a3be61e64a4743771fa1b01a3102c7b17 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 21:59:22 -0600
Subject: [PATCH 21/47] Remove stack display from listener tool, and tweak
 appearance

---
 basis/ui/tools/interactor/interactor.factor |  4 -
 basis/ui/tools/listener/listener.factor     | 86 ++++++++++-----------
 basis/ui/tools/tools-docs.factor            |  2 +-
 basis/ui/tools/tools.factor                 | 25 +++---
 4 files changed, 54 insertions(+), 63 deletions(-)

diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor
index a36610a7f5..36ce67e57b 100644
--- a/basis/ui/tools/interactor/interactor.factor
+++ b/basis/ui/tools/interactor/interactor.factor
@@ -178,10 +178,6 @@ M: interactor stream-read-quot
         ]
     } cond ;
 
-M: interactor pref-dim*
-    [ line-height 4 * 0 swap 2array ] [ call-next-method ] bi
-    vmax ;
-
 interactor "interactor" f {
     { T{ key-down f f "RET" } evaluate-input }
     { T{ key-down f { C+ } "k" } clear-input }
diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 49ce5203d3..4e2cb0b1e9 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -1,20 +1,21 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: inspector ui.tools.interactor ui.tools.inspector
-ui.tools.workspace help.markup io io.styles
-kernel models namespaces parser quotations sequences ui.commands
+USING: inspector help help.markup io io.styles
+kernel models namespaces parser quotations sequences  vocabs words
+prettyprint listener debugger threads boxes concurrency.flags
+math arrays generic accessors combinators assocs fry ui.commands
 ui.gadgets ui.gadgets.editors ui.gadgets.labelled
 ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
-ui.gadgets.tracks ui.gestures ui.operations vocabs words
-prettyprint listener debugger threads boxes concurrency.flags
-math arrays generic accessors combinators assocs ;
+ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations
+ui.tools.browser ui.tools.interactor ui.tools.inspector
+ui.tools.workspace ;
 IN: ui.tools.listener
 
-TUPLE: listener-gadget < track input output stack ;
+TUPLE: listener-gadget < track input output ;
 
 : listener-output, ( listener -- listener )
-    <scrolling-pane> >>output
-    dup output>> <scroller> "Output" <labelled-gadget> 1 track-add ;
+    <scrolling-pane>
+    [ >>output ] [ <scroller> 1 track-add ] bi ;
 
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> ] bi ;
@@ -23,17 +24,13 @@ TUPLE: listener-gadget < track input output stack ;
     output>> <pane-stream> <interactor> ;
 
 : listener-input, ( listener -- listener )
-    dup <listener-input> >>input
-    dup input>>
-        <limited-scroller>
-            { 0 100 } >>min-dim
-            { 1/0. 100 } >>max-dim
-        "Input" <labelled-gadget>
-    f track-add ;
+    dup <listener-input>
+    [ >>input ] [ 1 <border> { 0 0 } >>align f track-add ] bi ;
 
 : welcome. ( -- )
     "If this is your first time with Factor, please read the " print
-    "handbook" ($link) "." print nl ;
+    "handbook" ($link) ". To see a list of keyboard shortcuts," print
+    "press F1." print nl ;
 
 M: listener-gadget focusable-child*
     input>> ;
@@ -60,7 +57,7 @@ M: listener-gadget tool-scroller
 
 : call-listener ( quot -- )
     [ workspace-busy? not ] get-workspace* listener>>
-    [ dup wait-for-listener (call-listener) ] 2curry
+    '[ _ _ dup wait-for-listener (call-listener) ]
     "Listener call" spawn drop ;
 
 M: listener-command invoke-command ( target command -- )
@@ -76,7 +73,7 @@ M: listener-operation invoke-command ( target command -- )
 
 : listener-run-files ( seq -- )
     [
-        [ [ run-file ] each ] curry call-listener
+        '[ _ [ run-file ] each ] call-listener
     ] unless-empty ;
 
 : com-end ( listener -- )
@@ -122,20 +119,8 @@ M: engine-word word-completion-string
     [ select-all ]
     2bi ;
 
-TUPLE: stack-display < track ;
-
-: <stack-display> ( workspace -- gadget )
-    listener>>
-    { 0 1 } stack-display new-track
-    over <toolbar> f track-add
-    swap stack>> [ [ stack. ] curry try ] t "Data stack" <labelled-pane>
-    1 track-add ;
-
-M: stack-display tool-scroller
-    find-workspace listener>> tool-scroller ;
-
-: ui-listener-hook ( listener -- )
-    >r datastack r> stack>> set-model ;
+: ui-help-hook ( topic -- )
+    browser-gadget call-tool ;
 
 : ui-error-hook ( error listener -- )
     find-workspace debugger-popup ;
@@ -146,17 +131,20 @@ M: stack-display tool-scroller
 
 : listener-thread ( listener -- )
     dup listener-streams [
-        [ [ ui-listener-hook ] curry listener-hook set ]
-        [ [ ui-error-hook ] curry error-hook set ]
-        [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+        [ ui-help-hook ] help-hook set
+        [ '[ _ ui-error-hook ] error-hook set ]
+        [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
         welcome.
         listener
     ] with-streams* ;
 
 : start-listener-thread ( listener -- )
-    [
-        [ input>> register-self ] [ listener-thread ] bi
-    ] curry "Listener" spawn drop ;
+    '[
+        _
+        [ input>> register-self ]
+        [ listener-thread ]
+        bi
+    ] "Listener" spawn drop ;
 
 : restart-listener ( listener -- )
     #! Returns when listener is ready to receive input.
@@ -168,12 +156,9 @@ M: stack-display tool-scroller
         [ wait-for-listener ]
     } cleave ;
 
-: init-listener ( listener -- )
-    f <model> >>stack drop ;
-
 : <listener-gadget> ( -- gadget )
     { 0 1 } listener-gadget new-track
-        dup init-listener
+        add-toolbar
         listener-output,
         listener-input, ;
 
@@ -181,12 +166,21 @@ M: stack-display tool-scroller
 
 \ listener-help H{ { +nullary+ t } } define-command
 
+: com-auto-use ( -- )
+    auto-use? [ not ] change ;
+
+\ com-auto-use H{ { +nullary+ t } { +listener+ t } } define-command
+
+listener-gadget "misc" "Miscellaneous commands" {
+    { T{ key-down f f "F1" } listener-help }
+} define-command-map
+
 listener-gadget "toolbar" f {
     { f restart-listener }
-    {  T{ key-down f { A+ } "c" } clear-output }
-    {  T{ key-down f { A+ } "C" } clear-stack }
+    { T{ key-down f { A+ } "a" } com-auto-use }
+    { T{ key-down f { A+ } "c" } clear-output }
+    { T{ key-down f { A+ } "C" } clear-stack }
     { T{ key-down f { C+ } "d" } com-end }
-    { T{ key-down f f "F1" } listener-help }
 } define-command-map
 
 M: listener-gadget handle-gesture ( gesture gadget -- ? )
diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor
index f54e1e4041..6368737460 100644
--- a/basis/ui/tools/tools-docs.factor
+++ b/basis/ui/tools/tools-docs.factor
@@ -32,7 +32,7 @@ ARTICLE: "ui-listener" "UI listener"
 { $heading "Editing commands" }
 "The text editing commands are standard; see " { $link "gadgets-editors" } "."
 { $heading "Implementation" }
-"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } "), and an input area (instance of " { $link interactor } "), and a stack display kept up to date using a " { $link listener-hook } "." ;
+"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } ")." ;
 
 ARTICLE: "ui-inspector" "UI inspector"
 "The graphical inspector builds on the terminal inspector (see " { $link "inspector" } ") and provides in-place editing of slot values."
diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor
index aed4b9d675..3310a3e0a5 100644
--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@@ -19,8 +19,7 @@ IN: ui.tools
     <toggle-buttons> ;
 
 : <workspace-book> ( workspace -- gadget )
-    dup
-        <stack-display>
+        <gadget>
         <browser-gadget>
         <inspector-gadget>
         <profiler-gadget>
@@ -34,14 +33,14 @@ IN: ui.tools
         dup <workspace-book> >>book
 
         dup <workspace-tabs> f track-add
-        dup book>> 1/5 track-add
-        dup listener>> 4/5 track-add
-        dup <toolbar> f track-add ;
+        dup book>> 0 track-add
+        dup listener>> 1 track-add
+        add-toolbar ;
 
 : resize-workspace ( workspace -- )
-    dup sizes>> over control-value zero? [
-        1/5 over set-second
-        4/5 swap set-third
+    dup sizes>> over control-value 0 = [
+        0 over set-second
+        1 swap set-third
     ] [
         2/3 over set-second
         1/3 swap set-third
@@ -55,13 +54,15 @@ M: workspace model-changed
 
 [ workspace-window ] ui-hook set-global
 
-: com-listener ( workspace -- ) stack-display select-tool ;
+: select-tool ( workspace n -- ) swap book>> model>> set-model ;
 
-: com-browser ( workspace -- ) browser-gadget select-tool ;
+: com-listener ( workspace -- ) 0 select-tool ;
 
-: com-inspector ( workspace -- ) inspector-gadget select-tool ;
+: com-browser ( workspace -- ) 1 select-tool ;
 
-: com-profiler ( workspace -- ) profiler-gadget select-tool ;
+: com-inspector ( workspace -- ) 2 select-tool ;
+
+: com-profiler ( workspace -- ) 3 select-tool ;
 
 workspace "tool-switching" f {
     { T{ key-down f { A+ } "1" } com-listener }

From f24036834ef29ab7678c92b8afc357a7957adc0d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 22:13:24 -0600
Subject: [PATCH 22/47] Usability fix

---
 basis/ui/tools/listener/listener.factor | 2 +-
 basis/ui/tools/search/search.factor     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 4e2cb0b1e9..250fc371c7 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -25,7 +25,7 @@ TUPLE: listener-gadget < track input output ;
 
 : listener-input, ( listener -- listener )
     dup <listener-input>
-    [ >>input ] [ 1 <border> { 0 0 } >>align f track-add ] bi ;
+    [ >>input ] [ 1 <border> { 1 1 } >>fill f track-add ] bi ;
 
 : welcome. ( -- )
     "If this is your first time with Factor, please read the " print
diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor
index 033aacc1b3..cf980cfc23 100644
--- a/basis/ui/tools/search/search.factor
+++ b/basis/ui/tools/search/search.factor
@@ -66,7 +66,7 @@ search-field H{
         <search-field> >>field
         seq limited? init-search-model
         presenter over <search-list> >>list
-        dup field>> 1 <border> { 0 0 } >>align f track-add
+        dup field>> 1 <border> { 1 1 } >>fill f track-add
         dup list>> <scroller> 1 track-add
         string over field>> set-editor-string
         dup field>> end-of-document ;

From 17b2566017ddd378c57a6fc12a8becb54848836d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 22:13:32 -0600
Subject: [PATCH 23/47] Blinking cursor

---
 basis/ui/gadgets/editors/editors.factor | 95 ++++++++++++++++---------
 1 file changed, 61 insertions(+), 34 deletions(-)

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index a1c4f3d04e..2ab39ada31 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -2,17 +2,17 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays documents io kernel math models
 namespaces make opengl opengl.gl sequences strings io.styles
-math.vectors sorting colors combinators assocs math.order
-ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures
-math.geometry.rect ;
+math.vectors sorting colors combinators assocs math.order fry
+calendar alarms ui.clipboards ui.commands ui.gadgets
+ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.wrappers
+ui.render ui.gestures math.geometry.rect ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
 font color caret-color selection-color
 caret mark
-focused? ;
+focused? blink blink-alarm ;
 
 : <loc> ( -- loc ) { 0 0 } <model> ;
 
@@ -64,14 +64,14 @@ M: editor ungraft*
     caret>> set-model ;
 
 : change-caret ( editor quot -- )
-    over >r >r dup editor-caret* swap model>> r> call r>
+    [ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
     set-caret ; inline
 
 : mark>caret ( editor -- )
-    dup editor-caret* swap mark>> set-model ;
+    [ editor-caret* ] [ mark>> ] bi set-model ;
 
 : change-caret&mark ( editor quot -- )
-    over >r change-caret r> mark>caret ; inline
+    [ change-caret ] [ drop mark>caret ] 2bi ; inline
 
 : editor-line ( n editor -- str ) control-value nth ;
 
@@ -85,8 +85,8 @@ M: editor ungraft*
 
 : point>loc ( point editor -- loc )
     [
-        >r first2 r> tuck y>line dup ,
-        >r dup editor-font* r>
+        [ first2 ] dip tuck y>line dup ,
+        [ dup editor-font* ] dip
         rot editor-line x>offset ,
     ] { } make ;
 
@@ -94,11 +94,35 @@ M: editor ungraft*
     [ hand-rel ] keep point>loc ;
 
 : click-loc ( editor model -- )
-    >r clicked-loc r> set-model ;
+    [ clicked-loc ] dip set-model ;
 
-: focus-editor ( editor -- ) t >>focused? relayout-1 ;
+: blink-caret ( editor -- )
+    [ not ] change-blink relayout-1 ;
 
-: unfocus-editor ( editor -- ) f >>focused? relayout-1 ;
+: start-blinking ( editor -- )
+    t >>blink
+    dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
+
+: stop-blinking ( editor -- )
+    blink-alarm>> cancel-alarm ;
+
+: restart-blinking ( editor -- )
+    dup focused?>> [
+        [ stop-blinking ]
+        [ start-blinking ]
+        [ relayout-1 ]
+        tri
+    ] [ drop ] if ;
+
+: focus-editor ( editor -- )
+    dup start-blinking
+    t >>focused?
+    relayout-1 ;
+
+: unfocus-editor ( editor -- )
+    dup stop-blinking
+    f >>focused?
+    relayout-1 ;
 
 : (offset>x) ( font col# str -- x )
     swap head-slice string-width ;
@@ -106,7 +130,7 @@ M: editor ungraft*
 : offset>x ( col# line# editor -- x )
     [ editor-line ] keep editor-font* -rot (offset>x) ;
 
-: loc>x ( loc editor -- x ) >r first2 swap r> offset>x ;
+: loc>x ( loc editor -- x ) [ first2 swap ] dip offset>x ;
 
 : line>y ( lines# editor -- y )
     line-height * ;
@@ -126,7 +150,7 @@ M: editor ungraft*
     ] [ drop ] if ;
 
 : draw-caret ( -- )
-    editor get focused?>> [
+    editor get [ focused?>> ] [ blink>> ] bi and [
         editor get
         [ caret-color>> gl-color ]
         [
@@ -143,7 +167,7 @@ M: editor ungraft*
     line-translation gl-translate ;
 
 : draw-line ( editor str -- )
-    >r font>> r> { 0 0 } draw-string ;
+    [ font>> ] dip { 0 0 } draw-string ;
 
 : first-visible-line ( editor -- n )
     clip get rect-loc second origin get second -
@@ -169,7 +193,7 @@ M: editor ungraft*
     rot control-value <slice> ;
 
 : with-editor-translation ( n quot -- )
-    >r line-translation origin get v+ r> with-translation ;
+    [ line-translation origin get v+ ] dip with-translation ;
     inline
 
 : draw-lines ( -- )
@@ -199,7 +223,7 @@ M: editor ungraft*
     editor get selection-start/end
     over first [
         2dup [
-            >r 2dup r> draw-selected-line
+            [ 2dup ] dip draw-selected-line
             1 translate-lines
         ] each-line 2drop
     ] with-editor-translation ;
@@ -217,7 +241,7 @@ M: editor pref-dim*
     drop relayout ;
 
 : caret/mark-changed ( model editor -- )
-    nip [ relayout-1 ] [ scroll>caret ] bi ;
+    nip [ restart-blinking ] [ scroll>caret ] bi ;
 
 M: editor model-changed
     {
@@ -247,7 +271,9 @@ M: editor user-input*
 M: editor gadget-text* editor-string % ;
 
 : extend-selection ( editor -- )
-    dup request-focus dup caret>> click-loc ;
+    dup request-focus
+    dup restart-blinking
+    dup caret>> click-loc ;
 
 : mouse-elt ( -- element )
     hand-click# get {
@@ -259,14 +285,15 @@ M: editor gadget-text* editor-string % ;
     editor-mark* before? ;
 
 : drag-selection-caret ( loc editor element -- loc )
-    >r [ drag-direction? ] 2keep
-    model>>
-    r> prev/next-elt ? ;
+    [
+        [ drag-direction? ] 2keep model>>
+    ] dip prev/next-elt ? ;
 
 : drag-selection-mark ( loc editor element -- loc )
-    >r [ drag-direction? not ] 2keep
-    nip dup editor-mark* swap model>>
-    r> prev/next-elt ? ;
+    [
+        [ drag-direction? not ] keep
+        [ editor-mark* ] [ model>> ] bi
+    ] dip prev/next-elt ? ;
 
 : drag-caret&mark ( editor -- caret mark )
     dup clicked-loc swap mouse-elt
@@ -285,15 +312,16 @@ M: editor gadget-text* editor-string % ;
     over gadget-selection? [
         drop nip remove-selection
     ] [
-        over >r >r dup editor-caret* swap model>>
-        r> call r> model>> remove-doc-range
+        [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
+        [ drop model>> ]
+        2bi remove-doc-range
     ] if ; inline
 
 : editor-delete ( editor elt -- )
-    swap [ over >r rot next-elt r> swap ] delete/backspace ;
+    swap [ over [ rot next-elt ] dip swap ] delete/backspace ;
 
 : editor-backspace ( editor elt -- )
-    swap [ over >r rot prev-elt r> ] delete/backspace ;
+    swap [ over [ rot prev-elt ] dip ] delete/backspace ;
 
 : editor-select-prev ( editor elt -- )
     swap [ rot prev-elt ] change-caret ;
@@ -311,9 +339,8 @@ M: editor gadget-text* editor-string % ;
     tuck caret>> set-model mark>> set-model ;
 
 : select-elt ( editor elt -- )
-    over >r
-    >r dup editor-caret* swap model>> r> prev/next-elt
-    r> editor-select ;
+    [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
+    editor-select ;
 
 : start-of-document ( editor -- ) T{ doc-elt } editor-prev ;
 

From decdcbe120487fec050b2fe8de070c20a087734d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 22:14:35 -0600
Subject: [PATCH 24/47] Stop blinking in ungraft just in case

---
 basis/ui/gadgets/editors/editors.factor | 37 +++++++++++++------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 2ab39ada31..ebe092aa10 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -45,6 +45,24 @@ focused? blink blink-alarm ;
     dup deactivate-model
     swap model>> remove-loc ;
 
+: blink-caret ( editor -- )
+    [ not ] change-blink relayout-1 ;
+
+: start-blinking ( editor -- )
+    t >>blink
+    dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
+
+: stop-blinking ( editor -- )
+    blink-alarm>> cancel-alarm ;
+
+: restart-blinking ( editor -- )
+    dup focused?>> [
+        [ stop-blinking ]
+        [ start-blinking ]
+        [ relayout-1 ]
+        tri
+    ] [ drop ] if ;
+
 M: editor graft*
     dup
     dup caret>> activate-editor-model
@@ -52,6 +70,7 @@ M: editor graft*
 
 M: editor ungraft*
     dup
+    dup stop-blinking
     dup caret>> deactivate-editor-model
     dup mark>> deactivate-editor-model ;
 
@@ -96,24 +115,6 @@ M: editor ungraft*
 : click-loc ( editor model -- )
     [ clicked-loc ] dip set-model ;
 
-: blink-caret ( editor -- )
-    [ not ] change-blink relayout-1 ;
-
-: start-blinking ( editor -- )
-    t >>blink
-    dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
-
-: stop-blinking ( editor -- )
-    blink-alarm>> cancel-alarm ;
-
-: restart-blinking ( editor -- )
-    dup focused?>> [
-        [ stop-blinking ]
-        [ start-blinking ]
-        [ relayout-1 ]
-        tri
-    ] [ drop ] if ;
-
 : focus-editor ( editor -- )
     dup start-blinking
     t >>focused?

From 53646a076b21d2c03578d6e94689036b74915895 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 22:15:07 -0600
Subject: [PATCH 25/47] Set blink-alarm to f after we stop it

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

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index ebe092aa10..e8b79bed72 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -53,7 +53,7 @@ focused? blink blink-alarm ;
     dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
 
 : stop-blinking ( editor -- )
-    blink-alarm>> cancel-alarm ;
+    [ [ cancel-alarm ] when* f ] change-blink-alarm drop ;
 
 : restart-blinking ( editor -- )
     dup focused?>> [

From 5911ad913f305d26bf6a4016052417b65719788e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 23:29:16 -0600
Subject: [PATCH 26/47] Make blink interval configurable

---
 basis/ui/gadgets/editors/editors.factor | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index e8b79bed72..b5d30dd2d6 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -48,9 +48,13 @@ focused? blink blink-alarm ;
 : blink-caret ( editor -- )
     [ not ] change-blink relayout-1 ;
 
+SYMBOL: blink-interval
+
+750 milliseconds blink-interval set-global
+
 : start-blinking ( editor -- )
     t >>blink
-    dup '[ _ blink-caret ] 750 milliseconds every >>blink-alarm drop ;
+    dup '[ _ blink-caret ] blink-interval get every >>blink-alarm drop ;
 
 : stop-blinking ( editor -- )
     [ [ cancel-alarm ] when* f ] change-blink-alarm drop ;

From 9d68d5882a9d746745115659301fee7688c3df5e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Nov 2008 23:54:27 -0600
Subject: [PATCH 27/47] Fix circularity

---
 basis/ui/gadgets/buttons/buttons.factor | 34 ++++++++++++-------------
 basis/ui/gadgets/tracks/tracks.factor   |  5 +---
 2 files changed, 17 insertions(+), 22 deletions(-)

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index d74284cbd6..6b687f7e20 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math models namespaces sequences
 strings quotations assocs combinators classes colors
-classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
-ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
-ui.render math.geometry.rect locals alien.c-types ;
+classes.tuple locals alien.c-types fry opengl opengl.gl
+math.vectors ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.labels ui.gadgets.theme ui.gadgets.tracks
+ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.render
+math.geometry.rect ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;
@@ -27,7 +28,7 @@ TUPLE: button < border pressed? selected? quot ;
     relayout-1 ;
 
 : if-clicked ( button quot -- )
-    >r dup button-update dup button-rollover? r> [ drop ] if ;
+    [ dup button-update dup button-rollover? ] dip [ drop ] if ;
 
 : button-clicked ( button -- ) dup quot>> if-clicked ;
 
@@ -219,9 +220,8 @@ M: radio-control model-changed
     over value>> = >>selected?
     relayout-1 ;
 
-: <radio-controls> ( parent model assoc quot -- parent )
-    #! quot has stack effect ( value model label -- )
-    swapd [ swapd call add-gadget ] 2curry assoc-each ; inline
+: <radio-controls> ( assoc model parent quot: ( value model label -- ) -- parent )
+    '[ _ swap _ call add-gadget ] assoc-each ; inline
 
 : radio-button-theme ( gadget -- gadget )
     { 5 5 } >>gap
@@ -232,8 +232,7 @@ M: radio-control model-changed
 
 : <radio-buttons> ( model assoc -- gadget )
     <filled-pile>
-        -rot
-        [ <radio-button> ] <radio-controls>
+        spin [ <radio-button> ] <radio-controls>
         { 5 5 } >>gap ;
 
 : <toggle-button> ( value model label -- gadget )
@@ -241,20 +240,19 @@ M: radio-control model-changed
 
 : <toggle-buttons> ( model assoc -- gadget )
     <shelf>
-        -rot
-        [ <toggle-button> ] <radio-controls> ;
+        spin [ <toggle-button> ] <radio-controls> ;
 
 : command-button-quot ( target command -- quot )
-    [ invoke-command drop ] 2curry ;
+    '[ _ _ invoke-command drop ] ;
 
 : <command-button> ( target gesture command -- button )
-    [ command-string ] keep
-    swapd
-    command-button-quot
-    <bevel-button> ;
+    [ command-string swap ] keep command-button-quot <bevel-button> ;
 
 : <toolbar> ( target -- toolbar )
     <shelf>
         swap
         "toolbar" over class command-map commands>> swap
-        [ -rot <command-button> add-gadget ] curry assoc-each ;
+        '[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
+
+: add-toolbar ( track -- track )
+    dup <toolbar> f track-add ;
diff --git a/basis/ui/gadgets/tracks/tracks.factor b/basis/ui/gadgets/tracks/tracks.factor
index dc176b5bf7..ddc7cf18fd 100644
--- a/basis/ui/gadgets/tracks/tracks.factor
+++ b/basis/ui/gadgets/tracks/tracks.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel namespaces fry
 math math.vectors math.geometry.rect math.order
-sequences words ui.gadgets ui.gadgets.packs ui.gadgets.buttons ;
+sequences words ui.gadgets ui.gadgets.packs ;
 
 IN: ui.gadgets.tracks
 
@@ -57,9 +57,6 @@ M: track pref-dim* ( gadget -- dim )
 : track-add ( track gadget constraint -- track )
     pick sizes>> push add-gadget ;
 
-: add-toolbar ( track -- track )
-    dup <toolbar> f track-add ;
-
 : track-remove ( track gadget -- track )
     dupd dup [
         [ swap children>> index ]

From 1addde156769f22131d0cc4ebf699c466fbdd43a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 00:18:25 -0600
Subject: [PATCH 28/47] If 'search' was called outside of the parser, note.
 might be called, which would fail if no lexer was set

---
 core/parser/parser-tests.factor | 2 ++
 core/parser/parser.factor       | 2 +-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index d2d407e147..f621cbb84a 100644
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -496,3 +496,5 @@ DEFER: blah
 
 [ "IN: parser.tests USE: kernel TUPLE: blah < tuple ; : blah ; TUPLE: blah < tuple ; : blah ;" eval ]
 [ error>> error>> def>> \ blah eq? ] must-fail-with
+
+[ ] [ f lexer set f file set "Hello world" note. ] unit-test
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 414e9ea499..1728b471e2 100644
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -25,7 +25,7 @@ t parser-notes set-global
 : note. ( str -- )
     parser-notes? [
         file get [ path>> write ":" write ] when* 
-        lexer get line>> number>string write ": " write
+        lexer get [ line>> number>string write ": " write ] when*
         "Note: " write dup print
     ] when drop ;
 

From 27503bf67f2af840d150c8f3e830d9759999daa9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 01:54:45 -0600
Subject: [PATCH 29/47] Faster /mod and /i primitives

---
 vm/math.c | 43 ++++++++++++++++++++++++++++---------------
 1 file changed, 28 insertions(+), 15 deletions(-)

diff --git a/vm/math.c b/vm/math.c
index c6b91bc8f7..6a0acf7180 100644
--- a/vm/math.c
+++ b/vm/math.c
@@ -33,18 +33,18 @@ void primitive_float_to_fixnum(void)
 
 #define POP_FIXNUMS(x,y) \
 	F_FIXNUM y = untag_fixnum_fast(dpop()); \
-	F_FIXNUM x = untag_fixnum_fast(dpop());
+	F_FIXNUM x = untag_fixnum_fast(dpeek());
 
 void primitive_fixnum_add(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x + y);
+	drepl(allot_integer(x + y));
 }
 
 void primitive_fixnum_subtract(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x - y);
+	drepl(allot_integer(x - y));
 }
 
 /* Multiply two integers, and trap overflow.
@@ -54,20 +54,20 @@ void primitive_fixnum_multiply(void)
 	POP_FIXNUMS(x,y)
 
 	if(x == 0 || y == 0)
-		dpush(tag_fixnum(0));
+		drepl(tag_fixnum(0));
 	else
 	{
 		F_FIXNUM prod = x * y;
 		/* if this is not equal, we have overflow */
 		if(prod / x == y)
-			box_signed_cell(prod);
+			drepl(allot_integer(prod));
 		else
 		{
 			F_ARRAY *bx = fixnum_to_bignum(x);
 			REGISTER_BIGNUM(bx);
 			F_ARRAY *by = fixnum_to_bignum(y);
 			UNREGISTER_BIGNUM(bx);
-			dpush(tag_bignum(bignum_multiply(bx,by)));
+			drepl(tag_bignum(bignum_multiply(bx,by)));
 		}
 	}
 }
@@ -75,14 +75,27 @@ void primitive_fixnum_multiply(void)
 void primitive_fixnum_divint(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x / y);
+	F_FIXNUM result = x / y;
+	if(result == -FIXNUM_MIN)
+		drepl(allot_integer(-FIXNUM_MIN));
+	else
+		drepl(tag_fixnum(result));
 }
 
 void primitive_fixnum_divmod(void)
 {
-	POP_FIXNUMS(x,y)
-	box_signed_cell(x / y);
-	dpush(tag_fixnum(x % y));
+	F_FIXNUM y = get(ds);
+	F_FIXNUM x = get(ds - CELLS);
+	if(y == -1 && x == tag_fixnum(FIXNUM_MIN))
+	{
+		put(ds - CELLS,allot_integer(-FIXNUM_MIN));
+		put(ds,tag_fixnum(0));
+	}
+	else
+	{
+		put(ds - CELLS,tag_fixnum(x / y));
+		put(ds,x % y);
+	}
 }
 
 /*
@@ -96,15 +109,15 @@ void primitive_fixnum_shift(void)
 
 	if(x == 0 || y == 0)
 	{
-		dpush(tag_fixnum(x));
+		drepl(tag_fixnum(x));
 		return;
 	}
 	else if(y < 0)
 	{
 		if(y <= -WORD_SIZE)
-			dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
+			drepl(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
 		else
-			dpush(tag_fixnum(x >> -y));
+			drepl(tag_fixnum(x >> -y));
 		return;
 	}
 	else if(y < WORD_SIZE - TAG_BITS)
@@ -112,12 +125,12 @@ void primitive_fixnum_shift(void)
 		F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
 		if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
 		{
-			dpush(tag_fixnum(x << y));
+			drepl(tag_fixnum(x << y));
 			return;
 		}
 	}
 
-	dpush(tag_bignum(bignum_arithmetic_shift(
+	drepl(tag_bignum(bignum_arithmetic_shift(
 		fixnum_to_bignum(x),y)));
 }
 

From 79bffecc2ec2733a0a9745b096e2b941793428a2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 01:54:56 -0600
Subject: [PATCH 30/47] Add type function for /mod

---
 .../tree/propagation/known-words/known-words.factor         | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 3b698e0001..f6e2bc0940 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -138,6 +138,12 @@ most-negative-fixnum most-positive-fixnum [a,b]
 \ mod [ [ interval-mod ] [ real-valued ] binary-op ] each-derived-op
 \ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
 
+{ /mod fixnum/mod } [
+    \ /i \ mod
+    [ "outputs" word-prop ] bi@
+    '[ _ _ 2bi ] "outputs" set-word-prop
+] each
+
 \ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op
 \ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op
 

From ae4f9a2809dc9806c9c2cac5059ff34834fc0273 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 02:11:36 -0600
Subject: [PATCH 31/47] Add fixnum/mod-fast and fixnum/i-fast subprimitives

---
 basis/cpu/ppc/bootstrap.factor                | 18 +++++++++++++
 basis/cpu/x86/bootstrap.factor                | 25 ++++++++++++++++---
 .../partial-dispatch/partial-dispatch.factor  |  2 ++
 core/bootstrap/primitives.factor              |  2 ++
 4 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index aee0f3f4f3..efe55f9a22 100644
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -335,6 +335,24 @@ big-endian on
     7 ds-reg 0 STW
 ] f f f \ fixnum-mod define-sub-primitive
 
+[
+    3 ds-reg 0 LWZ
+    ds-reg ds-reg 4 SUBI
+    4 ds-reg 0 LWZ
+    5 4 3 DIVW
+    5 ds-reg 0 STW
+] f f f \ fixnum/i-fast define-sub-primitive
+
+[
+    3 ds-reg 0 LWZ
+    4 ds-reg -4 LWZ
+    5 4 3 DIVW
+    6 5 3 MULLW
+    7 6 4 SUBF
+    5 ds-reg -4 STW
+    7 ds-reg 0 STW
+] f f f \ fixnum-/mod-fast define-sub-primitive
+
 [
     3 ds-reg 0 LWZ
     3 3 1 SRAWI
diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 1ee74a434b..2c54880788 100644
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -305,16 +305,33 @@ big-endian off
     ds-reg [] arg1 MOV                         ! push to stack
 ] f f f \ fixnum-shift-fast define-sub-primitive
 
-[
+: jit-fixnum-/mod
     temp-reg ds-reg [] MOV                     ! load second parameter
-    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
-    div-arg ds-reg [] MOV                      ! load first parameter
+    div-arg ds-reg bootstrap-cell neg [+] MOV  ! load first parameter
     mod-arg div-arg MOV                        ! make a copy
     mod-arg bootstrap-cell-bits 1- SAR         ! sign-extend
-    temp-reg IDIV                              ! divide
+    temp-reg IDIV ;                            ! divide
+
+[
+    jit-fixnum-/mod
+    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
     ds-reg [] mod-arg MOV                      ! push to stack
 ] f f f \ fixnum-mod define-sub-primitive
 
+[
+    jit-fixnum-/mod
+    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
+    div-arg tag-bits get SHL                   ! tag it
+    ds-reg [] div-arg MOV                      ! push to stack
+] f f f \ fixnum/i-fast define-sub-primitive
+
+[
+    jit-fixnum-/mod
+    div-arg tag-bits get SHL                   ! tag it
+    ds-reg [] mod-arg MOV                      ! push to stack
+    ds-reg bootstrap-cell neg [+] div-arg MOV
+] f f f \ fixnum/mod-fast define-sub-primitive
+
 [
     arg0 ds-reg [] MOV                         ! load local number
     fixnum>slot@                               ! turn local number into offset
diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index 6874b79d2e..ddde4e1244 100644
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -29,6 +29,8 @@ M: word integer-op-input-classes
         { fixnum- fixnum-fast }
         { fixnum* fixnum*fast }
         { fixnum-shift fixnum-shift-fast }
+        { fixnum/i fixnum/i-fast }
+        { fixnum/mod fixnum/mod-fast }
     } at ;
 
 : modular-variant ( op -- fast-op )
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 24faf81662..20113d0e25 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -341,6 +341,8 @@ tuple
     { "fixnum-bitnot" "math.private" }
     { "fixnum-mod" "math.private" }
     { "fixnum-shift-fast" "math.private" }
+    { "fixnum/i-fast" "math.private" }
+    { "fixnum/mod-fast" "math.private" }
     { "fixnum<" "math.private" }
     { "fixnum<=" "math.private" }
     { "fixnum>" "math.private" }

From 0255f83be2776e3f56e76cea6e8a12b449a076b4 Mon Sep 17 00:00:00 2001
From: prunedtree <mew@.(none)>
Date: Fri, 21 Nov 2008 17:16:16 +0900
Subject: [PATCH 32/47] Committer: prunedtree

notepad2 integration
---
 basis/editors/notepad2/authors.txt     |  1 +
 basis/editors/notepad2/notepad2.factor | 16 ++++++++++++++++
 basis/editors/notepad2/summary.txt     |  1 +
 basis/editors/notepad2/tags.txt        |  1 +
 4 files changed, 19 insertions(+)
 create mode 100644 basis/editors/notepad2/authors.txt
 create mode 100644 basis/editors/notepad2/notepad2.factor
 create mode 100644 basis/editors/notepad2/summary.txt
 create mode 100644 basis/editors/notepad2/tags.txt

diff --git a/basis/editors/notepad2/authors.txt b/basis/editors/notepad2/authors.txt
new file mode 100644
index 0000000000..7852139357
--- /dev/null
+++ b/basis/editors/notepad2/authors.txt
@@ -0,0 +1 @@
+Marc Fauconneau
diff --git a/basis/editors/notepad2/notepad2.factor b/basis/editors/notepad2/notepad2.factor
new file mode 100644
index 0000000000..4d333e45dd
--- /dev/null
+++ b/basis/editors/notepad2/notepad2.factor
@@ -0,0 +1,16 @@
+USING: editors io.files io.launcher kernel math.parser
+namespaces sequences windows.shell32 make ;
+IN: editors.notepad2
+
+: notepad2-path ( -- str )
+    \ notepad2-path get-global [
+        program-files "C:\\Windows\\system32\\notepad.exe" append-path
+   ] unless* ;
+
+: notepad2 ( file line -- )
+    [
+        notepad2-path ,
+        "/g" , number>string , ,
+    ] { } make run-detached drop ;
+
+[ notepad2 ] edit-hook set-global
\ No newline at end of file
diff --git a/basis/editors/notepad2/summary.txt b/basis/editors/notepad2/summary.txt
new file mode 100644
index 0000000000..ab4a8ce377
--- /dev/null
+++ b/basis/editors/notepad2/summary.txt
@@ -0,0 +1 @@
+Notepad2 editor integration
diff --git a/basis/editors/notepad2/tags.txt b/basis/editors/notepad2/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/editors/notepad2/tags.txt
@@ -0,0 +1 @@
+unportable

From d5559d41320b743ca45d443026f185dc871c756c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 02:24:37 -0600
Subject: [PATCH 33/47] Add fixnum/mod and fixnum/i subprimitives on PowerPC

---
 basis/cpu/ppc/bootstrap.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index efe55f9a22..014d2b31a0 100644
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -351,7 +351,7 @@ big-endian on
     7 6 4 SUBF
     5 ds-reg -4 STW
     7 ds-reg 0 STW
-] f f f \ fixnum-/mod-fast define-sub-primitive
+] f f f \ fixnum/mod-fast define-sub-primitive
 
 [
     3 ds-reg 0 LWZ

From af29312a9ee471a119ec5d675103331dbf916243 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 02:25:43 -0600
Subject: [PATCH 34/47] Fix parser tests

---
 core/parser/parser-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index f621cbb84a..ca80533a2e 100644
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -2,7 +2,7 @@ USING: arrays math parser tools.test kernel generic words
 io.streams.string namespaces classes effects source-files
 assocs sequences strings io.files definitions continuations
 sorting classes.tuple compiler.units debugger vocabs
-vocabs.loader accessors eval combinators ;
+vocabs.loader accessors eval combinators lexer ;
 IN: parser.tests
 
 [

From 9e0db58c0fce43b39620ed5b77fb2b49020482dc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 02:26:08 -0600
Subject: [PATCH 35/47] Remove display-stack since its functionaly was merged
 into the listener

---
 extra/display-stack/display-stack.factor | 43 ------------------------
 1 file changed, 43 deletions(-)
 delete mode 100644 extra/display-stack/display-stack.factor

diff --git a/extra/display-stack/display-stack.factor b/extra/display-stack/display-stack.factor
deleted file mode 100644
index 98af43fec8..0000000000
--- a/extra/display-stack/display-stack.factor
+++ /dev/null
@@ -1,43 +0,0 @@
-
-USING: kernel namespaces sequences math
-       listener io prettyprint sequences.lib bake bake.fry ;
-
-IN: display-stack
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: watched-variables
-
-: watch-var ( sym -- ) watched-variables get push ;
-
-: watch-vars ( seq -- ) watched-variables get [ push ] curry each ;
-
-: unwatch-var ( sym -- ) watched-variables get delete ;
-
-: unwatch-vars ( seq -- ) watched-variables get [ delete ] curry each ;
-
-: print-watched-variables ( -- )
-  watched-variables get length 0 >
-    [
-      "----------" print
-      watched-variables get
-        watched-variables get [ unparse ] map longest length 2 +
-        '[ [ unparse ": " append , 32 pad-right write ] [ get . ] bi ]
-      each
-
-    ]
-  when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: display-stack ( -- )
-  V{ } clone watched-variables set
-    [
-      print-watched-variables
-      "----------" print
-      datastack [ . ] each
-      "----------" print
-      retainstack reverse [ . ] each
-    ]
-  listener-hook set ;
-

From 0b6916158de7415e948533bac958d48bbf1261f4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 03:36:37 -0600
Subject: [PATCH 36/47] Fix [ ] nsequence

---
 basis/generalizations/generalizations-tests.factor | 2 ++
 basis/generalizations/generalizations.factor       | 7 +++++--
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index 75985c9368..1ebe528f35 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -36,3 +36,5 @@ IN: generalizations.tests
 [ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test
 [ ] [ { } 0 firstn ] unit-test
 [ "a" ] [ { "a" } 1 firstn ] unit-test
+
+[ [ 1 2 ] ] [ 1 2 2 [ ] nsequence ] unit-test
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 069d59cee1..c63c2b66ca 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -6,8 +6,11 @@ math.ranges combinators macros quotations fry arrays ;
 IN: generalizations
 
 MACRO: nsequence ( n seq -- quot )
-    [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
-    [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;
+    [
+        [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
+        [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
+    ] keep
+    '[ @ _ like ] ;
 
 MACRO: narray ( n -- quot )
     '[ _ { } nsequence ] ;

From 23550ebe16d3c9c67532f613e919edc153058f17 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 04:00:28 -0600
Subject: [PATCH 37/47] Clean up combinators.short-circuit

---
 .../short-circuit/short-circuit.factor        | 53 +++++++++----------
 1 file changed, 24 insertions(+), 29 deletions(-)

diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor
index 7b6c1d126d..e6a4bfe913 100644
--- a/basis/combinators/short-circuit/short-circuit.factor
+++ b/basis/combinators/short-circuit/short-circuit.factor
@@ -1,35 +1,30 @@
-
 USING: kernel combinators quotations arrays sequences assocs
-       locals generalizations macros fry ;
-
+locals generalizations macros fry ;
 IN: combinators.short-circuit
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+MACRO:: n&& ( quots n -- quot )
+    [let | pairs [
+        quots [| q | { [ drop n ndup q dup not ] [ drop n ndrop f ] } ] map
+        { [ t ] [ n nnip ] } suffix
+    ] |
+        [ f pairs cond ]
+    ] ;
 
-:: n&&-rewrite ( quots N -- quot )
-   quots
-     [ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
-   map
-   [ t ] [ N nnip ] 2array suffix
-   '[ f _ cond ] ;
+MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
+MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ;
+MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
+MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
 
-MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
-MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
-MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
-MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
+MACRO:: n|| ( quots n -- quot )
+    [let | pairs [
+        quots
+        [| q | { [ drop n ndup q dup ] [ n nnip ] } ] map
+        { [ drop n ndrop t ] [ f ] } suffix
+    ] |
+        [ f pairs cond ]
+    ] ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: n||-rewrite ( quots N -- quot )
-   quots
-     [ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
-   map
-   [ drop N ndrop t ] [ f ] 2array suffix
-   '[ f _ cond ] ;
-
-MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
-MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
-MACRO: 2|| ( quots -- quot ) 2 n||-rewrite ;
-MACRO: 3|| ( quots -- quot ) 3 n||-rewrite ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;
+MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ;
+MACRO: 2|| ( quots -- quot ) '[ _ 2 n|| ] ;
+MACRO: 3|| ( quots -- quot ) '[ _ 3 n|| ] ;

From c678e6e362257a49257f31166b3bc75c26d3ecec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 04:00:37 -0600
Subject: [PATCH 38/47] Don't use combinators.short-circuit in compiler

---
 basis/compiler/tree/propagation/info/info.factor | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index e89a9c6211..771d3800df 100644
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes classes.algebra classes.tuple
 classes.tuple.private kernel accessors math math.intervals
-namespaces sequences words combinators combinators.short-circuit
+namespaces sequences words combinators
 arrays compiler.tree.propagation.copy ;
 IN: compiler.tree.propagation.info
 
@@ -253,12 +253,13 @@ DEFER: (value-info-union)
         { [ over not ] [ 2drop f ] }
         [
             {
-                [ [ class>> ] bi@ class<= ]
-                [ [ interval>> ] bi@ interval-subset? ]
-                [ literals<= ]
-                [ [ length>> ] bi@ value-info<= ]
-                [ [ slots>> ] bi@ [ value-info<= ] 2all? ]
-            } 2&&
+                { [ 2dup [ class>> ] bi@ class<= not ] [ f ] }
+                { [ 2dup [ interval>> ] bi@ interval-subset? not ] [ f ] }
+                { [ 2dup literals<= not ] [ f ] }
+                { [ 2dup [ length>> ] bi@ value-info<= not ] [ f ] }
+                { [ 2dup [ slots>> ] bi@ [ value-info<= ] 2all? not ] [ f ] }
+                [ t ]
+            } cond 2nip
         ]
     } cond ;
 

From 34b8bcf3050d92ee4acc5cbe33283ad247ec78fa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 04:36:18 -0600
Subject: [PATCH 39/47] Clean up short-circuit combinators

---
 .../short-circuit/short-circuit-docs.factor   | 14 ++++++------
 .../short-circuit/short-circuit.factor        | 22 ++++++++-----------
 .../short-circuit/smart/smart.factor          |  8 +++----
 3 files changed, 19 insertions(+), 25 deletions(-)

diff --git a/basis/combinators/short-circuit/short-circuit-docs.factor b/basis/combinators/short-circuit/short-circuit-docs.factor
index 54fc3aac43..b1e4a6cf21 100644
--- a/basis/combinators/short-circuit/short-circuit-docs.factor
+++ b/basis/combinators/short-circuit/short-circuit-docs.factor
@@ -52,17 +52,17 @@ HELP: 3||
      { "quot" quotation } }
 { $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
 
-HELP: n&&-rewrite
+HELP: n&&
 { $values
      { "quots" "a sequence of quotations" } { "N" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each AND quotation." } ;
+{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
 
-HELP: n||-rewrite
+HELP: n||
 { $values
-     { "quots" "a sequence of quotations" } { "N" integer }
+     { "quots" "a sequence of quotations" } { "n" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ;
+{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
 
 ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
 "The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
@@ -77,8 +77,8 @@ ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
 { $subsection 2|| }
 { $subsection 3|| }
 "Generalized combinators:"
-{ $subsection n&&-rewrite }
-{ $subsection n||-rewrite }
+{ $subsection n&& }
+{ $subsection n|| }
 ;
 
 ABOUT: "combinators.short-circuit"
diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor
index e6a4bfe913..2b4e522789 100644
--- a/basis/combinators/short-circuit/short-circuit.factor
+++ b/basis/combinators/short-circuit/short-circuit.factor
@@ -3,12 +3,10 @@ locals generalizations macros fry ;
 IN: combinators.short-circuit
 
 MACRO:: n&& ( quots n -- quot )
-    [let | pairs [
-        quots [| q | { [ drop n ndup q dup not ] [ drop n ndrop f ] } ] map
-        { [ t ] [ n nnip ] } suffix
-    ] |
-        [ f pairs cond ]
-    ] ;
+    [ f ]
+    quots [| q | { [ drop n ndup q call dup not ] [ drop n ndrop f ] } ] map
+    [ n nnip ] suffix 1array
+    [ cond ] 3append ;
 
 MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
 MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ;
@@ -16,13 +14,11 @@ MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
 MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
 
 MACRO:: n|| ( quots n -- quot )
-    [let | pairs [
-        quots
-        [| q | { [ drop n ndup q dup ] [ n nnip ] } ] map
-        { [ drop n ndrop t ] [ f ] } suffix
-    ] |
-        [ f pairs cond ]
-    ] ;
+    [ f ]
+    quots
+    [| q | { [ drop n ndup q call dup ] [ n nnip ] } ] map
+    { [ drop n ndrop t ] [ f ] } suffix 1array
+    [ cond ] 3append ;
 
 MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;
 MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ;
diff --git a/basis/combinators/short-circuit/smart/smart.factor b/basis/combinators/short-circuit/smart/smart.factor
index ca659cacbe..b80e7294d1 100644
--- a/basis/combinators/short-circuit/smart/smart.factor
+++ b/basis/combinators/short-circuit/smart/smart.factor
@@ -1,7 +1,5 @@
-
 USING: kernel sequences math stack-checker effects accessors macros
-       combinators.short-circuit ;
-
+fry combinators.short-circuit ;
 IN: combinators.short-circuit.smart
 
 <PRIVATE
@@ -13,6 +11,6 @@ IN: combinators.short-circuit.smart
 
 PRIVATE>
 
-MACRO: && ( quots -- quot ) dup arity n&&-rewrite ;
+MACRO: && ( quots -- quot ) dup arity '[ _ _ n&& ] ;
 
-MACRO: || ( quots -- quot ) dup arity n||-rewrite ;
+MACRO: || ( quots -- quot ) dup arity '[ _ _ n|| ] ;

From 883ad5389ca1e8246783f5e35331892a687877e9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 04:36:52 -0600
Subject: [PATCH 40/47] Don't throw if macro expansion fails; this allows
 macros-in-locals to work in more cases

---
 basis/macros/expander/expander.factor | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/basis/macros/expander/expander.factor b/basis/macros/expander/expander.factor
index 3666fa2423..cdd2b49d9c 100644
--- a/basis/macros/expander/expander.factor
+++ b/basis/macros/expander/expander.factor
@@ -37,9 +37,17 @@ M: wrapper expand-macros* wrapped>> literal ;
         [ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
     ] bi ;
 
-: expand-macro ( quot -- )
-    stack [ swap with-datastack >vector ] change
-    stack get pop >quotation end (expand-macros) ;
+: word, ( word -- ) end , ;
+
+: expand-macro ( word quot -- )
+    '[
+        drop
+        stack [ _ with-datastack >vector ] change
+        stack get pop >quotation end (expand-macros)
+    ] [
+        drop
+        word,
+    ] recover ;
 
 : expand-macro? ( word -- quot ? )
     dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
@@ -47,11 +55,9 @@ M: wrapper expand-macros* wrapped>> literal ;
         stack get length <=
     ] [ 2drop f f ] if ;
 
-: word, ( word -- ) end , ;
-
 M: word expand-macros*
     dup expand-dispatch? [ drop expand-dispatch ] [
-        dup expand-macro? [ nip expand-macro ] [
+        dup expand-macro? [ expand-macro ] [
             drop word,
         ] if
     ] if ;

From 89440b2a2316f101c73f5462dd7f1e2c9f73dd1f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 04:37:17 -0600
Subject: [PATCH 41/47] curry and compose now check their inputs

---
 core/bootstrap/primitives.factor        | 19 +++++++++++++++++--
 core/quotations/quotations-tests.factor |  2 +-
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 20113d0e25..65731dd1ad 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -303,7 +303,13 @@ tuple
     [ f "inline" set-word-prop ]
     [ make-flushable ]
     [ ]
-    [ tuple-layout [ <tuple-boa> ] curry ]
+    [
+        [
+            callable instance-check-quot %
+            tuple-layout ,
+            \ <tuple-boa> ,
+        ] [ ] make
+    ]
 } cleave
 (( obj quot -- curry )) define-declared
 
@@ -319,7 +325,16 @@ tuple
     [ f "inline" set-word-prop ]
     [ make-flushable ]
     [ ]
-    [ tuple-layout [ <tuple-boa> ] curry ]
+    [
+        [
+            \ >r ,
+            callable instance-check-quot %
+            \ r> ,
+            callable instance-check-quot %
+            tuple-layout ,
+            \ <tuple-boa> ,
+        ] [ ] make
+    ]
 } cleave
 (( quot1 quot2 -- compose )) define-declared
 
diff --git a/core/quotations/quotations-tests.factor b/core/quotations/quotations-tests.factor
index d311dfad71..29e1304334 100644
--- a/core/quotations/quotations-tests.factor
+++ b/core/quotations/quotations-tests.factor
@@ -15,4 +15,4 @@ IN: quotations.tests
 
 [ [ "hi" ] ] [ "hi" 1quotation ] unit-test
 
-! [ 1 \ + curry ] must-fail
+[ 1 \ + curry ] must-fail

From 3e29a31493b20a45a94804ce67bcd4015d7ab885 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 05:17:20 -0600
Subject: [PATCH 42/47] Residual fixes for curry/compose change

---
 basis/prettyprint/backend/backend.factor   | 23 ++--------------------
 basis/prettyprint/prettyprint-tests.factor |  9 ---------
 core/classes/tuple/tuple.factor            |  2 +-
 3 files changed, 3 insertions(+), 31 deletions(-)

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 2af0224e32..f1fd749666 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -216,27 +216,8 @@ M: object pprint* pprint-object ;
 M: vector pprint* pprint-object ;
 M: byte-vector pprint* pprint-object ;
 M: hashtable pprint* pprint-object ;
-
-GENERIC: valid-callable? ( obj -- ? )
-
-M: object valid-callable? drop f ;
-
-M: quotation valid-callable? drop t ;
-
-M: curry valid-callable? quot>> valid-callable? ;
-
-M: compose valid-callable?
-    [ first>> ] [ second>> ] bi [ valid-callable? ] both? ;
-
-M: curry pprint*
-    dup valid-callable? [ pprint-object ] [
-        "( invalid curry )" swap present-text
-    ] if ;
-
-M: compose pprint*
-    dup valid-callable? [ pprint-object ] [
-        "( invalid compose )" swap present-text
-    ] if ;
+M: curry pprint* pprint-object ;
+M: compose pprint* pprint-object ;
 
 M: wrapper pprint*
     dup wrapped>> word? [
diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor
index 7fa3c5a1a3..96698fc18f 100644
--- a/basis/prettyprint/prettyprint-tests.factor
+++ b/basis/prettyprint/prettyprint-tests.factor
@@ -323,10 +323,6 @@ M: class-see-layout class-see-layout ;
     [ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
 ] unit-test
 
-[ ] [ 1 \ + curry unparse drop ] unit-test
-
-[ ] [ 1 \ + compose unparse drop ] unit-test
-
 GENERIC: generic-see-test-with-f ( obj -- obj )
 
 M: f generic-see-test-with-f ;
@@ -365,8 +361,3 @@ M: started-out-hustlin' ended-up-ballin' ; inline
 [ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
     [ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer
 ] unit-test
-
-[ "( invalid curry )" ] [ 1 2 curry unparse ] unit-test
-[ "( invalid curry )" ] [ 1 2 3 curry curry unparse ] unit-test
-[ "( invalid compose )" ] [ 1 2 compose unparse ] unit-test
-[ "( invalid compose )" ] [ [ 1 ] 2 3 curry compose unparse ] unit-test
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index a56a4df029..70b189852f 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -121,7 +121,7 @@ ERROR: bad-superclass class ;
     [
         \ dup ,
         [ "predicate" word-prop % ]
-        [ [ bad-slot-value ] curry , ] bi
+        [ [ literalize , \ bad-slot-value , ] [ ] make , ] bi
         \ unless ,
     ] [ ] make ;
 

From 420ff0a447dba13efebbd798e8f352ea563b74ec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 05:17:51 -0600
Subject: [PATCH 43/47] Fry now throws a parse time error if it detects >r r>
 usage, tweak fry to better interact with locals

---
 basis/fry/fry-docs.factor           |  8 +++++-
 basis/fry/fry-tests.factor          | 16 ++++++------
 basis/fry/fry.factor                | 38 ++++++++++++++++-------------
 core/combinators/combinators.factor |  5 +---
 4 files changed, 37 insertions(+), 30 deletions(-)

diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor
index 8f402f2e8c..b5d1b8d8d2 100644
--- a/basis/fry/fry-docs.factor
+++ b/basis/fry/fry-docs.factor
@@ -19,6 +19,9 @@ HELP: '[
 { $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }
 { $examples "See " { $link "fry.examples" } "." } ;
 
+HELP: >r/r>-in-fry-error
+{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ;
+
 ARTICLE: "fry.examples" "Examples of fried quotations"
 "The easiest way to understand fried quotations is to look at some examples."
 $nl
@@ -73,7 +76,10 @@ ARTICLE: "fry.philosophy" "Fried quotation philosophy"
 } ;
 
 ARTICLE: "fry.limitations" "Fried quotation limitations"
-"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead." ;
+"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead."
+$nl
+"An error thrown if a fried quotation contains calls to " { $link >r } " and " { $link r> } ":"
+{ $subsection >r/r>-in-fry-error } ;
 
 ARTICLE: "fry" "Fried quotations"
 "The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with ``holes'' (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."
diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor
index d4a3b8b734..27d5430d33 100644
--- a/basis/fry/fry-tests.factor
+++ b/basis/fry/fry-tests.factor
@@ -1,23 +1,20 @@
 IN: fry.tests
 USING: fry tools.test math prettyprint kernel io arrays
-sequences ;
+sequences eval accessors ;
 
 [ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
 
 [ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
 
-[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
+[ [ 1 [ + ] call ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
 
-[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
+[ [ 1 [ + ] call . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
 
-[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
+[ [ [ + ] [ - ] [ call ] dip call ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
 
-[ [ "a" write "b" print ] ]
+[ [ "a" "b" [ write ] dip print ] ]
 [ "a" "b" '[ _ write _ print ] ] unit-test
 
-[ [ 1 2 + 3 4 - ] ]
-[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
-
 [ 1/2 ] [
     1 '[ [ _ ] dip / ] 2 swap call
 ] unit-test
@@ -58,3 +55,6 @@ sequences ;
 [ { { { 3 } } } ] [
     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test
+
+[ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
+[ error>> >r/r>-in-fry-error? ] must-fail-with
diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index 87c59e18a0..bab49de108 100644
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -1,33 +1,37 @@
 ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences combinators parser splitting math
-quotations arrays make words ;
+quotations arrays make words locals.backend summary sets ;
 IN: fry
 
 : _ ( -- * ) "Only valid inside a fry" throw ;
 : @ ( -- * ) "Only valid inside a fry" throw ;
 
+ERROR: >r/r>-in-fry-error ;
+
 <PRIVATE
 
-DEFER: (shallow-fry)
-DEFER: shallow-fry
+: [ncurry] ( n -- quot )
+    {
+        { 0 [ [ ] ] }
+        { 1 [ [ curry ] ] }
+        { 2 [ [ 2curry ] ] }
+        { 3 [ [ 3curry ] ] }
+        [ [ curry ] <repetition> ]
+    } case ;
 
-: ((shallow-fry)) ( accum quot adder -- result )
-    >r shallow-fry r>
-    append swap [
-        [ prepose ] curry append
-    ] unless-empty ; inline
+M: >r/r>-in-fry-error summary
+    drop
+    "Explicit retain stack manipulation is not permitted in fried quotations" ;
 
-: (shallow-fry) ( accum quot -- result )
-    [ 1quotation ] [
-        unclip {
-            { \ _ [ [ curry ] ((shallow-fry)) ] }
-            { \ @ [ [ compose ] ((shallow-fry)) ] }
-            [ swap >r suffix r> (shallow-fry) ]
-        } case
-    ] if-empty ;
+: check-fry ( quot -- quot )
+    dup { >r r> load-locals get-local drop-locals } intersect
+    empty? [ >r/r>-in-fry-error ] unless ;
 
-: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
+: shallow-fry ( quot -- quot' )
+    check-fry
+    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
+    { _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
 
 PREDICATE: fry-specifier < word { _ @ } memq? ;
 
diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 8cfa671a8b..82744276fd 100644
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -28,10 +28,7 @@ IN: combinators
 
 ! spread
 : spread>quot ( seq -- quot )
-    [ ] [
-        [ dup empty? [ [ >r ] swap [ r> ] 3append ] unless ] dip
-        append
-    ] reduce ;
+    [ ] [ [ dup empty? [ [ dip ] curry ] unless ] dip append ] reduce ;
 
 : spread ( objs... seq -- )
     spread>quot call ;

From 6324b4dd651999b8f115cb9953f3f9d9c8ea7cba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 05:18:41 -0600
Subject: [PATCH 44/47] Fix some bugs in locals, throw a parse time error if
 usage of >r r> is detected

---
 basis/locals/locals-docs.factor  |  4 ++--
 basis/locals/locals-tests.factor | 24 +++++++++++++++++++-
 basis/locals/locals.factor       | 38 +++++++++++++++++++++-----------
 3 files changed, 50 insertions(+), 16 deletions(-)

diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index 35e0536530..18488ed1dd 100644
--- a/basis/locals/locals-docs.factor
+++ b/basis/locals/locals-docs.factor
@@ -132,8 +132,8 @@ $nl
 "Unlike some languages such as Python and Java, writing to mutable locals in outer scopes is fully supported and has the expected semantics." ;
 
 ARTICLE: "locals-limitations" "Limitations of locals"
-"The first limitation is that the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator."
-$nl
+"The first limitation is also shared by " { $vocab-link "fry" } ": the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator. An error is thrown at parse time if an attempt is made to use " { $link >r } " and " { $link r> } " inside a lambda body:"
+{ $subsection >r/r>-in-lambda-error }
 "Another limitation concerns combinators implemented as macros. Locals can only be used with such combinators if the input array immediately precedes the combinator call. For example, the following will work:"
 { $code
     ":: good-cond-usage ( a -- ... )"
diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 04e077fc4f..60e40b9629 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
 combinators.short-circuit.smart math.order math.functions
-definitions compiler.units ;
+definitions compiler.units fry ;
 IN: locals.tests
 
 :: foo ( a b -- a a ) a a ;
@@ -286,6 +286,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
         { [ a b > ] [ 5 ] }
     } cond ;
 
+\ cond-test must-infer
+
 [ 3 ] [ 1 2 cond-test ] unit-test
 [ 4 ] [ 2 2 cond-test ] unit-test
 [ 5 ] [ 3 2 cond-test ] unit-test
@@ -293,6 +295,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 :: 0&&-test ( a -- ? )
     { [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ;
 
+\ 0&&-test must-infer
+
 [ f ] [ 1.5 0&&-test ] unit-test
 [ f ] [ 3 0&&-test ] unit-test
 [ f ] [ 8 0&&-test ] unit-test
@@ -301,6 +305,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 :: &&-test ( a -- ? )
     { [ a integer? ] [ a even? ] [ a 10 > ] } && ;
 
+\ &&-test must-infer
+
 [ f ] [ 1.5 &&-test ] unit-test
 [ f ] [ 3 &&-test ] unit-test
 [ f ] [ 8 &&-test ] unit-test
@@ -346,6 +352,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 
 { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
 
+ERROR: punned-class x ;
+
+[ T{ punned-class f 3 } ] [ 3 [| a | T{ punned-class f a } ] call ] unit-test
+
 :: literal-identity-test ( -- a b )
     { } V{ } ;
 
@@ -390,6 +400,18 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test
 
+[
+    "USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval
+] [ error>> >r/r>-in-fry-error? ] must-fail-with
+
+:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
+: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
+
+\ funny-macro-test must-infer
+
+[ t ] [ 3 funny-macro-test ] unit-test
+[ f ] [ 2 funny-macro-test ] unit-test
+
 ! :: wlet-&&-test ( a -- ? )
 !     [wlet | is-integer? [ a integer? ]
 !             is-even? [ a even? ]
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index 7de9d10436..1e205e10b0 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -6,12 +6,18 @@ quotations debugger macros arrays macros splitting combinators
 prettyprint.backend definitions prettyprint hashtables
 prettyprint.sections sets sequences.private effects
 effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes ;
+locals.backend memoize macros.expander lexer classes summary ;
 IN: locals
 
 ! Inspired by
 ! http://cat-language.googlecode.com/svn/trunk/CatPointFreeForm.cs
 
+ERROR: >r/r>-in-lambda-error ;
+
+M: >r/r>-in-lambda-error summary
+    drop
+    "Explicit retain stack manipulation is not permitted in lambda bodies" ;
+
 <PRIVATE
 
 TUPLE: lambda vars body ;
@@ -141,20 +147,17 @@ GENERIC: free-vars* ( form -- )
 : free-vars ( form -- vars )
     [ free-vars* ] { } make prune ;
 
-: add-if-free ( object -- )
-    {
-        { [ dup local-writer? ] [ "local-reader" word-prop , ] }
-        { [ dup lexical? ] [ , ] }
-        { [ dup quote? ] [ local>> , ] }
-        { [ t ] [ free-vars* ] }
-    } cond ;
+M: local-writer free-vars* "local-reader" word-prop , ;
+
+M: lexical free-vars* , ;
+
+M: quote free-vars* , ;
 
 M: object free-vars* drop ;
 
-M: quotation free-vars* [ add-if-free ] each ;
+M: quotation free-vars* [ free-vars* ] each ;
 
-M: lambda free-vars*
-    [ vars>> ] [ body>> ] bi free-vars swap diff % ;
+M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ;
 
 GENERIC: lambda-rewrite* ( obj -- )
 
@@ -201,6 +204,8 @@ M: special rewrite-literal? drop t ;
 
 M: array rewrite-literal? [ rewrite-literal? ] contains? ;
 
+M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+
 M: hashtable rewrite-literal? drop t ;
 
 M: vector rewrite-literal? drop t ;
@@ -215,17 +220,20 @@ GENERIC: rewrite-element ( obj -- )
     [ rewrite-element ] each ;
 
 : rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;
+    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
 
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
 
+M: quotation rewrite-element
+    dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
+
 M: vector rewrite-element rewrite-sequence ;
 
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 
 M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ;
+    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
 
 M: local rewrite-element , ;
 
@@ -243,6 +251,10 @@ M: tuple local-rewrite* rewrite-element ;
 
 M: hashtable local-rewrite* rewrite-element ;
 
+M: word local-rewrite*
+    dup { >r r> } memq?
+    [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
+
 M: object lambda-rewrite* , ;
 
 M: object local-rewrite* , ;

From 322d115d2e9f7eec2ff631e8dc4784540e8c1632 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 05:18:55 -0600
Subject: [PATCH 45/47] /mod didn't handle overflow correctly

---
 vm/math.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/math.c b/vm/math.c
index 6a0acf7180..07493a947f 100644
--- a/vm/math.c
+++ b/vm/math.c
@@ -86,7 +86,7 @@ void primitive_fixnum_divmod(void)
 {
 	F_FIXNUM y = get(ds);
 	F_FIXNUM x = get(ds - CELLS);
-	if(y == -1 && x == tag_fixnum(FIXNUM_MIN))
+	if(y == tag_fixnum(-1) && x == tag_fixnum(FIXNUM_MIN))
 	{
 		put(ds - CELLS,allot_integer(-FIXNUM_MIN));
 		put(ds,tag_fixnum(0));

From 4886f6184b540855e550d1a9a7ddfcf832e4e065 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 21 Nov 2008 05:47:47 -0600
Subject: [PATCH 46/47] Fix fry with > 3 holes

---
 basis/fry/fry-tests.factor | 4 ++++
 basis/fry/fry.factor       | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor
index 27d5430d33..0137e8be22 100644
--- a/basis/fry/fry-tests.factor
+++ b/basis/fry/fry-tests.factor
@@ -58,3 +58,7 @@ sequences eval accessors ;
 
 [ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
 [ error>> >r/r>-in-fry-error? ] must-fail-with
+
+[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
+    1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
+] unit-test
diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index bab49de108..ac036f58ad 100644
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -17,7 +17,7 @@ ERROR: >r/r>-in-fry-error ;
         { 1 [ [ curry ] ] }
         { 2 [ [ 2curry ] ] }
         { 3 [ [ 3curry ] ] }
-        [ [ curry ] <repetition> ]
+        [ \ curry <repetition> ]
     } case ;
 
 M: >r/r>-in-fry-error summary

From a87fb04098bcf26abe017c7274ca750cc921fc47 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 21 Nov 2008 07:12:35 -0600
Subject: [PATCH 47/47] combinators.short-circuit docs: Fix typo

---
 basis/combinators/short-circuit/short-circuit-docs.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/combinators/short-circuit/short-circuit-docs.factor b/basis/combinators/short-circuit/short-circuit-docs.factor
index b1e4a6cf21..6cd18201fe 100644
--- a/basis/combinators/short-circuit/short-circuit-docs.factor
+++ b/basis/combinators/short-circuit/short-circuit-docs.factor
@@ -56,13 +56,13 @@ HELP: n&&
 { $values
      { "quots" "a sequence of quotations" } { "N" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
+{ $description "A macro that rewrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
 
 HELP: n||
 { $values
      { "quots" "a sequence of quotations" } { "n" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
+{ $description "A macro that rewrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
 
 ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
 "The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl