more cleanups; split up huge gadgets vocabulary

CHANGES.html

@@ -65,6 +65,7 @@ make-sbuf    ==> SBUF" " make
 <li>New <code>sleep ( ms -- )</code> word pauses current thread for a number of milliseconds.</li>
 <li>New <code>with-datastack ( stack word -- stack )</code> combinator.</li>
 <li>New <code>cond ( conditions -- )</code> combinator. It behaves like a set of nested <code>ifte</code>s, and compiles if each branch has the same stack effect. See its documentation comment for details.</li>
+<li>Formally documented method combination (<code>G:</code> syntax) in handbook.
 <li>Erlang/Termite-style concurrency library in <code>contrib/concurrency</code> (Chris Double).</li>
 <li>Completely redid infix algebra in <code>conrib/algebra/</code>. Now, vector operations are possible
 and the syntax doesn't use so many spaces. New way to write the quadratic formula:

TODO.FACTOR.txt

@@ -2,13 +2,14 @@
 - out of memory error when printing global namespace
 - removing unneeded #label
 - pprint trailing space regression
+- finish scrollbars
+- fix up the min thumb size hack
 
 + ui:
 
-- fix up the min thumb size hack
+- long lines of text fail in draw-surface
 - only redraw dirty gadgets
 - faster mouse tracking
-
 - off-by-one error in pick-up?
 - closing ui does not stop timers
 - adding/removing timers automatically for animated gadgets
@@ -66,8 +67,8 @@
 - the invalid recursion form case needs to be fixed, for inlines too
 - #jump-f #jump-f-label
 - re-introduce #target-label => #target optimization
-- recursion is iffy; no base case needs to throw an error, and if the
-  stack at the recursive call doesn't match up, throw an error
+- recursion is iffy; if the stack at the recursive call doesn't match
+  up, throw an error
 
 + kernel:
 

doc/handbook.tex

@@ -2543,21 +2543,6 @@ Outputs a new sequence with the reverse element order.
 }
 Tests if \texttt{s1} starts or ends with \texttt{s1}. If \texttt{s1} is longer than \texttt{s2}, outputs \texttt{f}.
 
-\wordtable{
-\vocabulary{sequences}
-\ordinaryword{cut}{cut ( seq n -- s1 s2 )}
-}
-Outputs a pair of sequences that equal the original sequence when appended. The first sequence has length $n$, the second has length $l-n$ where $l$ is the length of the input.
-\begin{alltt}
-  "Hello world" 5 cut .s
-\textbf{" world"
-"Hello"}
-\end{alltt}
-This word has a simple definition:
-\begin{verbatim}
-: cut ( n seq -- seq seq )
-    [ head ] 2keep tail ;
-\end{verbatim}
 \wordtable{
 \vocabulary{sequences}
 \ordinaryword{?head}{?head~( s1 s2 -- seq ?~)}

library/alien/compiler.factor

@@ -167,5 +167,5 @@ M: compound (uncrossref)
         drop
     ] [
         dup { "infer-effect" "base-case" "no-effect" }
-        reset-props decompile
+        reset-props update-xt
     ] ifte ;

library/bootstrap/boot-stage1.factor

@@ -54,6 +54,7 @@ sequences io vectors words ;
         "/library/collections/queues.factor"
 
         "/library/math/matrices.factor"
+        "/library/math/parse-numbers.factor"
 
         "/library/words.factor"
         "/library/vocabularies.factor"
@@ -71,7 +72,6 @@ sequences io vectors words ;
         "/library/io/directories.factor"
         "/library/io/binary.factor"
 
-        "/library/syntax/parse-numbers.factor"
         "/library/syntax/parse-words.factor"
         "/library/syntax/parse-errors.factor"
         "/library/syntax/parser.factor"
@@ -95,20 +95,17 @@ sequences io vectors words ;
 
         "/library/io/logging.factor"
 
-        "/library/tools/gensym.factor"
         "/library/tools/interpreter.factor"
         "/library/tools/debugger.factor"
         "/library/tools/memory.factor"
         "/library/tools/listener.factor"
-        "/library/tools/word-tools.factor"
         "/library/tools/walker.factor"
         "/library/tools/jedit.factor"
-
-        "/library/test/test.factor"
-
         "/library/tools/annotations.factor"
         "/library/tools/inspector.factor"
 
+        "/library/test/test.factor"
+        
         "/library/syntax/see.factor"
 
         "/library/threads.factor"

library/bootstrap/primitives.factor

@@ -38,8 +38,8 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
     { ">bignum" "math"                      }
     { ">float" "math"                       }
     { "(fraction>)" "math-internals"        }
-    { "str>float" "parser"                  }
-    { "(unparse-float)" "parser"            }
+    { "string>float" "math-internals"       }
+    { "float>string" "math-internals"       }
     { "float>bits" "math"                   }
     { "double>bits" "math"                  }
     { "bits>float" "math"                   }

library/collections/namespaces.factor

@@ -106,6 +106,10 @@ SYMBOL: building
     #! Append to the sequence being built with make-seq.
     building get swap nappend ;
 
+: # ( n -- )
+    #! Only useful with "" make.
+    number>string % ;
+
 ! Building hashtables, and computing a transitive closure.
 SYMBOL: hash-buffer
 

library/compiler/compiler.factor

@@ -48,15 +48,8 @@ M: compound (compile) ( word -- )
 
 : compile-all ( -- ) [ try-compile ] each-word ;
 
-: decompile ( word -- )
-    dup compiled? [
-        "Decompiling " write dup . update-xt
-    ] [
-        drop
-    ] ifte ;
-
 : recompile ( word -- )
-    dup decompile compile ;
+    dup update-xt compile ;
 
 : compile-1 ( quot -- word )
     #! Compute a quotation into an uninterned word, for testing

library/generic/generic.factor

@@ -140,3 +140,12 @@ M: generic definer drop \ G: ;
 : define-class ( class metaclass -- )
     dupd "metaclass" set-word-prop
     dup types number-sort typemap get set-hash ;
+
+: implementors ( class -- list )
+    #! Find a list of generics that implement a method
+    #! specializing on this class.
+    [ "methods" word-prop ?hash ] word-subset-with ;
+
+: classes ( -- list )
+    #! Output a list of all defined classes.
+    [ metaclass ] word-subset ;

library/help/tutorial.factor

@@ -30,7 +30,7 @@ M: general-list tutorial-line
 
 : <page> ( list -- gadget )
     [ tutorial-line ] map
-    1 <pile> [ add-gadgets ] keep
+    <pile> dup 1 over set-pack-fill [ add-gadgets ] keep
     empty-border ;
 
 : tutorial-pages

library/httpd/file-responder.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004,2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: file-responder
-USING: html httpd kernel lists namespaces parser sequences
+USING: html httpd kernel lists math namespaces parser sequences
 io strings ;
 
 : serving-path ( filename -- filename )

library/httpd/html.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: html
-USING: generic http io kernel lists namespaces parser
+USING: generic http io kernel lists math namespaces parser
 presentation sequences strings styles words ;
 
 : html-entities ( -- alist )
@@ -35,7 +35,7 @@ presentation sequences strings styles words ;
     [ "text-decoration: underline; " % ] when ;
 
 : size-css, ( size -- )
-    "font-size: " % number>string % "; " % ;
+    "font-size: " % # "; " % ;
 
 : font-css, ( font -- )
     "font-family: " % % "; " % ;

library/httpd/http-client.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: http-client
-USING: errors http kernel lists namespaces parser sequences
+USING: errors http kernel lists math namespaces parser sequences
 io strings ;
 
 : parse-host ( url -- host port )

library/httpd/httpd.factor

@@ -38,7 +38,7 @@ sequences ;
     [ (handle-request) serve-responder ] with-scope ;
 
 : parse-request ( request -- )
-    dup log
+    dup log-message
     " " split1 dup [
         " HTTP" split1 drop url>path secure-path dup [
             swap handle-request

library/httpd/responder.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: httpd
-USING: hashtables http kernel lists namespaces parser sequences
-io strings ;
+USING: hashtables http kernel lists math namespaces parser
+sequences io strings ;
 
 ! Variables
 SYMBOL: vhosts
@@ -66,7 +66,7 @@ SYMBOL: responders
 
 : log-user-agent ( alist -- )
     "User-Agent" swap assoc* [
-        unswons [ % ": " % % ] "" make log
+        unswons [ % ": " % % ] "" make log-message
     ] when* ;
 
 : prepare-url ( url -- url )
@@ -138,7 +138,7 @@ SYMBOL: responders
     "default" responder call-responder ;
 
 : log-responder ( path -- )
-    "Calling responder " swap append log ;
+    "Calling responder " swap append log-message ;
 
 : trim-/ ( url -- url )
     #! Trim a leading /, if there is one.

library/inference/known-words.factor

@@ -113,13 +113,13 @@ memory parser sequences strings vectors words prettyprint ;
 \ (fraction>) t "flushable" set-word-prop
 \ (fraction>) t "foldable" set-word-prop
 
-\ str>float [ [ string ] [ float ] ] "infer-effect" set-word-prop
-\ str>float t "flushable" set-word-prop
-\ str>float t "foldable" set-word-prop
+\ string>float [ [ string ] [ float ] ] "infer-effect" set-word-prop
+\ string>float t "flushable" set-word-prop
+\ string>float t "foldable" set-word-prop
 
-\ (unparse-float) [ [ float ] [ string ] ] "infer-effect" set-word-prop
-\ (unparse-float) t "flushable" set-word-prop
-\ (unparse-float) t "foldable" set-word-prop
+\ float>string [ [ float ] [ string ] ] "infer-effect" set-word-prop
+\ float>string t "flushable" set-word-prop
+\ float>string t "foldable" set-word-prop
 
 \ float>bits [ [ real ] [ integer ] ] "infer-effect" set-word-prop
 \ float>bits t "flushable" set-word-prop

library/io/logging.factor

@@ -1,28 +1,25 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: io
-USING: io kernel namespaces parser sequences strings ;
+USING: io kernel math namespaces parser sequences strings ;
 
 ! A simple logging framework.
 SYMBOL: log-stream
 
-: log ( msg -- )
+: log-message ( msg -- )
     #! Log a message to the log stream, either stdio or a file.
-    log-stream get [
-        [ stream-print ] keep stream-flush
-    ] [
-        print flush
-    ] ifte* ;
+    log-stream get [ stdio get ] unless*
+    [ stream-print ] keep stream-flush ;
 
-: log-error ( error -- ) "Error: " swap append log ;
+: log-error ( error -- ) "Error: " swap append log-message ;
 
 : log-client ( client-stream -- )
     [
         "Accepted connection from " %
         dup client-stream-host %
         CHAR: : ,
-        client-stream-port number>string % 
-    ] "" make log ;
+        client-stream-port # 
+    ] "" make log-message ;
 
 : with-log-file ( file quot -- )
     #! Calls to log inside quot will output to a file.

library/math/math.factor

@@ -86,3 +86,6 @@ GENERIC: abs ( z -- |z| )
     ] [
         dup 1 = [ drop 0 ] [ 2 /i log2 1 + ] ifte
     ] ifte ; foldable
+
+GENERIC: string>number ( str -- num ) foldable
+GENERIC: number>string ( str -- num ) foldable

library/math/parse-numbers.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: parser
-USING: errors generic kernel math namespaces sequences strings ;
+IN: math
+USING: errors generic kernel math-internals namespaces sequences
+strings ;
 
 ! Number parsing
 
@@ -26,9 +27,7 @@ M: object digit> not-a-number ;
 : base> ( str base -- num )
     #! Convert a string to an integer. Throw an error if
     #! conversion fails.
-    swap "-" ?head [ (base>) neg ] [ (base>) ] ifte ;
-
-GENERIC: string>number ( str -- num )
+    swap "-" ?head >r (base>) r> [ neg ] when ;
 
 M: string string>number 10 base> ;
 
@@ -37,24 +36,18 @@ M: potential-ratio string>number ( str -- num )
     "/" split1 >r 10 base> r> 10 base> / ;
 
 PREDICATE: string potential-float CHAR: . swap member? ;
-M: potential-float string>number ( str -- num )
-    str>float ;
+M: potential-float string>number ( str -- num ) string>float ;
 
 : bin> 2 base> ;
 : oct> 8 base> ;
 : hex> 16 base> ;
 
-GENERIC: number>string ( str -- num )
-
 : >digit ( n -- ch )
     dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
 
 : integer, ( num radix -- )
-    dup >r /mod >digit , dup 0 > [
-        r> integer,
-    ] [
-        r> 2drop
-    ] ifte ;
+    dup >r /mod >digit , dup 0 >
+    [ r> integer, ] [ r> 2drop ] ifte ;
 
 : >base ( num radix -- string )
     #! Convert a number to a string in a certain base.
@@ -73,17 +66,9 @@ GENERIC: number>string ( str -- num )
 M: integer number>string ( obj -- str ) 10 >base ;
 
 M: ratio number>string ( num -- str )
-    [
-        dup
-        numerator number>string %
-        CHAR: / ,
-        denominator number>string %
-    ] "" make ;
-
-: fix-float ( str -- str )
-    #! This is terrible. Will go away when we do our own float
-    #! output.
-    CHAR: . over member? [ ".0" append ] unless ;
+    [ dup numerator # CHAR: / , denominator # ] "" make ;
 
 M: float number>string ( float -- str )
-    (unparse-float) fix-float ;
+    #! This is terrible. Will go away when we do our own float
+    #! output.
+    float>string CHAR: . over member? [ ".0" append ] unless ;

library/sdl/sdl-video.factor

@@ -69,8 +69,8 @@ BEGIN-STRUCT: surface
     FIELD: void*       hwdata
     FIELD: short       clip-x
     FIELD: short       clip-y
-    FIELD: ushort       clip-w
-    FIELD: ushort       clip-h
+    FIELD: ushort      clip-w
+    FIELD: ushort      clip-h
     FIELD: uint        unused1
     FIELD: uint        locked
     FIELD: int         map

library/syntax/parse-stream.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: parser
-USING: kernel lists namespaces sequences io ;
+USING: kernel lists namespaces sequences io words ;
 
 : file-vocabs ( -- )
     "scratchpad" "in" set
@@ -38,3 +38,12 @@ USING: kernel lists namespaces sequences io ;
 
 : run-resource ( file -- )
     parse-resource call ;
+
+: word-file ( word -- file )
+    "file" word-prop dup [
+        "resource:/" ?head [ resource-path swap path+ ] when
+    ] when ;
+
+: reload ( word -- )
+    #! Reload the source file the word originated from.
+    word-file run-file ;

library/syntax/prettyprint.factor

@@ -11,7 +11,6 @@ SYMBOL: last-newline
 SYMBOL: recursion-check
 SYMBOL: line-count
 SYMBOL: end-printing
-SYMBOL: newline-ok?
 
 ! Configuration
 SYMBOL: tab-size
@@ -30,7 +29,6 @@ global [
     0 last-newline set
     0 line-count set
     string-limit off
-    newline-ok? off
 ] bind
 
 TUPLE: pprinter stack ;
@@ -48,9 +46,6 @@ C: section ( length -- section )
 : section-fits? ( section -- ? )
     section-end last-newline get - indent get + margin get <= ;
 
-: insert-newline? ( section -- ? )
-    section-fits? not newline-ok? and ;
-
 : line-limit? ( -- ? )
     line-limit get dup [ line-count get <= ] when ;
 
@@ -58,10 +53,14 @@ C: section ( length -- section )
 
 : fresh-line ( n -- )
     #! n is current column position.
-    last-newline set
-    line-count inc
-    line-limit? [ "..." write end-printing get call ] when
-    "\n" write do-indent ;
+    dup last-newline get = [
+        drop
+    ] [
+        last-newline set
+        line-count inc
+        line-limit? [ "..." write end-printing get call ] when
+        "\n" write do-indent
+    ] ifte ;
 
 TUPLE: text string style ;
 
@@ -71,7 +70,7 @@ C: text ( string style -- section )
     [ set-text-string ] keep ;
 
 M: text pprint-section*
-    dup text-string swap text-style format  " " write ;
+    dup text-string swap text-style format " " write ;
 
 TUPLE: block sections ;
 
@@ -107,8 +106,8 @@ C: block ( -- block )
     [ section-end fresh-line ] [ drop ] ifte ;
 
 : pprint-section ( section -- )
-    dup insert-newline? newline-ok? on
-    [ inset-section ] [ pprint-section* ] ifte ;
+    dup section-fits?
+    [ pprint-section* ] [ inset-section ] ifte ;
 
 TUPLE: newline ;
 
@@ -116,7 +115,7 @@ C: newline ( -- section )
     0 <section> over set-delegate ;
 
 M: newline pprint-section* ( newline -- )
-    section-start fresh-line newline-ok? off ;
+    section-start fresh-line ;
 
 M: block pprint-section* ( block -- )
     block-sections [ pprint-section ] each ;

library/syntax/see.factor

@@ -118,3 +118,14 @@ M: word class. drop ;
 
 : see ( word -- )
     [ dup in. dup (see) dup class. methods. ] with-pprint ;
+
+: (apropos) ( substring -- seq )
+    vocabs [
+        words [ word-name subseq? ] subset-with
+    ] map-with concat ;
+
+: apropos ( substring -- )
+    #! List all words that contain a string.
+    (apropos) [
+        "IN: " write dup word-vocabulary write " " write .
+    ] each ;

library/test/test.factor

@@ -21,10 +21,7 @@ M: assert error.
     #! Evaluates the given code and prints the time taken to
     #! execute it.
     millis >r gc-time >r call gc-time r> - millis r> -
-    [
-        number>string % " ms run / " %
-        number>string % " ms GC time" %
-    ] "" make print ;
+    [ # " ms run / " % # " ms GC time" % ] "" make print ;
 
 : unit-test ( output input -- )
     [

library/tools/gensym.factor

@@ -1,14 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: words
-USING: hashtables kernel math namespaces parser sequences
-strings ;
-
-: gensym ( -- word )
-    #! Return a word that is distinct from every other word, and
-    #! is not contained in any vocabulary.
-    "G:"
-    global [ \ gensym dup inc get ] bind
-    number>string append f <word> ;
-
-0 \ gensym global set-hash

library/tools/jedit.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: jedit
-USING: errors io kernel lists namespaces parser prettyprint
+USING: errors io kernel lists math namespaces parser prettyprint
 sequences strings unparser vectors words ;
 
 ! Some words to send requests to a running jEdit instance to

library/tools/telnetd.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: telnetd
-USING: errors listener kernel namespaces io threads parser ;
+USING: errors listener kernel math namespaces io threads parser ;
 
 : telnet-client ( socket -- )
     dup [ log-client print-banner listener ] with-stream ;

library/tools/word-tools.factor

@@ -1,43 +0,0 @@
-! Copyright (C) 2003, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: words
-USING: generic inspector lists kernel namespaces
-prettyprint io strings sequences math hashtables parser ;
-
-: vocab-apropos ( substring vocab -- list )
-    #! Push a list of all words in a vocabulary whose names
-    #! contain a string.
-    words [ word-name subseq? ] subset-with ;
-
-: vocab-apropos. ( substring vocab -- )
-    #! List all words in a vocabulary that contain a string.
-    tuck vocab-apropos dup [
-        "IN: " write swap print sequence.
-    ] [
-        2drop
-    ] ifte ;
-
-: apropos. ( substring -- )
-    #! List all words that contain a string.
-    vocabs [ vocab-apropos. ] each-with ;
-
-: word-file ( word -- file )
-    "file" word-prop dup [
-        "resource:/" ?head [
-            resource-path swap path+
-        ] when
-    ] when ;
-
-: reload ( word -- )
-    #! Reload the source file the word originated from.
-    word-file run-file ;
-
-: implementors ( class -- list )
-    #! Find a list of generics that implement a method
-    #! specializing on this class.
-    [
-        "methods" word-prop [ dupd hash ] [ f ] ifte*
-    ] word-subset nip ;
-
-: classes ( -- list )
-    [ metaclass ] word-subset ;

library/ui/books.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math matrices sequences ;
+IN: gadgets-books
+USING: gadgets gadgets-buttons gadgets-labels gadgets-layouts
+generic kernel lists math matrices sequences ;
 
 TUPLE: book page ;
 
@@ -46,7 +47,7 @@ TUPLE: book-browser book ;
         { ">"  [ find-book next-page  ] }
         { ">|" [ find-book last-page  ] }
     ] [ 2unseq >r <label> r> <button> ] map
-    0 <shelf> [ add-gadgets ] keep ;
+    <shelf> [ add-gadgets ] keep ;
 
 C: book-browser ( book -- gadget )
     <frame> over set-delegate

library/ui/borders.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors generic hashtables kernel lists math matrices
+IN: gadgets-borders
+USING: errors gadgets generic hashtables kernel lists math
 namespaces sdl vectors ;
 
 TUPLE: border size ;

library/ui/buttons.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic io kernel lists math namespaces prettyprint sdl
-sequences sequences styles threads ;
+IN: gadgets-buttons
+USING: gadgets gadgets-borders generic io kernel lists math
+namespaces sdl sequences sequences styles threads ;
 
 : button-down? ( n -- ? ) hand hand-buttons member? ;
 

library/ui/editors.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel math matrices namespaces sdl sequences
-strings styles threads vectors ;
+IN: gadgets-editors
+USING: gadgets gadgets-labels gadgets-scrolling generic kernel
+math namespaces sdl sequences strings styles threads vectors ;
 
 ! A blinking caret
 TUPLE: caret ;

library/ui/frames.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math namespaces sequences vectors ;
+IN: gadgets-layouts
+USING: gadgets generic kernel lists math namespaces sequences
+vectors ;
 
 ! A frame arranges gadgets in a 3x3 grid, where the center
 ! gadgets gets left-over space.

library/ui/incremental.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel math ;
+IN: gadgets-layouts
+USING: gadgets generic kernel math ;
 
 ! Incremental layout allows adding lines to panes to be O(1).
 ! Note that incremental packs are distinct from ordinary packs

library/ui/labels.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic hashtables io kernel lists math namespaces sdl
-sequences styles vectors ;
+IN: gadgets-labels
+USING: gadgets generic hashtables io kernel lists math
+namespaces sdl sequences styles vectors ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;

library/ui/layouts.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors generic hashtables kernel lists math matrices
-namespaces sdl sequences ;
+IN: gadgets-layouts
+USING: errors gadgets generic hashtables kernel lists math
+matrices namespaces sdl sequences ;
 
 : layout ( gadget -- )
     #! Set the gadget's width and height to its preferred width
@@ -26,36 +26,24 @@ TUPLE: pack align fill vector ;
     >r >r pack-vector r> r> [ pick set-axis ] 2map nip ;
 
 : packed-dim-2 ( gadget sizes -- list )
-    [
-        over rect-dim { 1 1 1 } vmax over v-
-        rot pack-fill v*n v+
-    ] map-with ;
-
-: (packed-dims) ( gadget sizes -- seq )
-    2dup packed-dim-2 swap orient ;
+    [ over rect-dim over v- rot pack-fill v*n v+ ] map-with ;
 
 : packed-dims ( gadget sizes -- seq )
-    over gadget-children >r (packed-dims) r>
-    [ set-gadget-dim ] 2each ;
+    2dup packed-dim-2 swap orient ;
 
 : packed-loc-1 ( sizes -- seq )
     { 0 0 0 } [ v+ ] accumulate ;
 
 : packed-loc-2 ( gadget sizes -- seq )
-    >r dup rect-dim { 1 1 1 } vmax over r>
-    packed-dim-2 [ v- ] map-with
-    >r dup pack-align swap rect-dim { 1 1 1 } vmax r>
-    [ >r 2dup r> v- n*v ] map 2nip ;
+    [ >r dup pack-align swap rect-dim r> v- n*v ] map-with ;
 
-: (packed-locs) ( gadget sizes -- seq )
+: packed-locs ( gadget sizes -- seq )
     dup packed-loc-1 >r dupd packed-loc-2 r> orient ;
 
-: packed-locs ( gadget sizes -- )
-    over gadget-children >r (packed-locs) r>
-    [ set-rect-loc ] 2each ;
-
 : packed-layout ( gadget sizes -- )
-    2dup packed-locs packed-dims ;
+    over gadget-children
+    >r dupd packed-dims r> 2dup [ set-gadget-dim ] 2each
+    >r packed-locs r> [ set-rect-loc ] 2each ;
 
 C: pack ( fill vector -- pack )
     #! gap: between each child.
@@ -65,9 +53,9 @@ C: pack ( fill vector -- pack )
     [ set-pack-fill ] keep
     0 over set-pack-align ;
 
-: <pile> ( fill -- pack ) { 0 1 0 } <pack> ;
+: <pile> ( -- pack ) { 0 1 0 } <pack> ;
 
-: <shelf> ( fill -- pack ) { 1 0 0 } <pack> ;
+: <shelf> ( -- pack ) { 1 0 0 } <pack> ;
 
 M: pack pref-dim ( pack -- dim )
     [
@@ -94,7 +82,8 @@ TUPLE: stack ;
 
 C: stack ( -- gadget )
     #! A stack lays out all its children on top of each other.
-    1 { 0 0 1 } <pack> over set-delegate ;
+    { 0 0 1 } <pack> over set-delegate
+    1 over set-pack-fill ;
 
 M: stack children-on ( point stack -- gadget )
     nip gadget-children ;

library/ui/listener.factor

@@ -3,8 +3,10 @@
 IN: help
 DEFER: <tutorial-button>
 
-IN: gadgets
-USING: generic help io kernel listener lists math namespaces
+IN: gadgets-listener
+USING: gadgets gadgets-labels gadgets-layouts gadgets-panes
+gadgets-presentations gadgets-scrolling gadgets-splitters
+generic help io kernel listener lists math namespaces
 prettyprint sdl sequences shells styles threads words ;
 
 SYMBOL: datastack-display
@@ -25,14 +27,11 @@ TUPLE: display title pane ;
 C: display ( -- display )
     <frame> over set-delegate
     "" <display-title> over add-display-title
-    0 <pile> 2dup swap set-display-pane
+    <pile> 2dup swap set-display-pane
     <scroller> over add-center ;
 
 : make-presentations ( seq -- seq )
-    [
-        dup presented swons unit swap unparse-short
-        <presentation>
-    ] map ;
+    [ <object-presentation> ] map ;
 
 : present-stack ( seq title display -- )
     [ display-title set-label-text ] keep

library/ui/menus.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math namespaces sequences ;
+IN: gadgets-menus
+USING: gadgets gadgets-borders gadgets-buttons gadgets-layouts
+gadgets-labels generic kernel lists math namespaces sequences ;
 
 : menu-actions ( glass -- )
     [ drop hide-glass ] [ button-down 1 ] set-action ;
@@ -22,7 +23,7 @@ USING: generic kernel lists math namespaces sequences ;
     #! Given an association list mapping labels to quotations.
     #! Prepend a call to hide-menu to each quotation.
     [ uncons \ hide-glass swons >r <label> r> <roll-button> ] map
-    1 <pile> [ add-gadgets ] keep ;
+    <pile> 1 over set-pack-fill [ add-gadgets ] keep ;
 
 : menu-theme ( menu -- )
     << solid f >> interior set-paint-prop ;

library/ui/panes.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic hashtables io kernel line-editor listener lists
+IN: gadgets-panes
+USING: gadgets gadgets-editors gadgets-labels gadgets-layouts
+gadgets-scrolling generic hashtables io kernel line-editor lists
 math namespaces prettyprint sequences strings styles threads
 vectors ;
 
@@ -19,7 +20,7 @@ TUPLE: pane output active current input continuation ;
 : add-input 2dup set-pane-input add-gadget ;
 
 : <active-line> ( input current -- line )
-    2vector 0 <shelf> [ add-gadgets ] keep ;
+    2vector <shelf> [ add-gadgets ] keep ;
 
 : init-active-line ( pane -- )
     dup pane-active unparent
@@ -54,18 +55,22 @@ SYMBOL: structured-input
     [ pane-input editor-commit ] keep
     2dup stream-print pane-eval ;
 
+: pane-clear ( pane -- )
+    dup pane-output clear-incremental pane-current clear-gadget ;
+ 
 : pane-actions ( line -- )
     [
         [[ [ button-down 1 ] [ pane-input click-editor ] ]]
         [[ [ "RETURN" ] [ pane-return ] ]]
         [[ [ "UP" ] [ pane-input [ history-prev ] with-editor ] ]]
         [[ [ "DOWN" ] [ pane-input [ history-next ] with-editor ] ]]
+        [[ [ "CTRL" "l" ] [ pane get pane-clear ] ]]
     ] swap add-actions ;
 
 C: pane ( -- pane )
-    0 <pile> over set-delegate
-    0 <pile> <incremental> over add-output
-    0 <shelf> over set-pane-current
+    <pile> over set-delegate
+    <pile> <incremental> over add-output
+    <shelf> over set-pane-current
     "" <editor> over set-pane-input
     dup init-active-line
     dup pane-actions ;
@@ -73,9 +78,6 @@ C: pane ( -- pane )
 M: pane focusable-child* ( pane -- editor )
     pane-input ;
 
-: pane-clear ( pane -- )
-    dup pane-output clear-incremental pane-current clear-gadget ;
-
 : pane-write-1 ( style text pane -- )
     pick not pick empty? and [
         3drop
@@ -96,7 +98,7 @@ M: pane focusable-child* ( pane -- editor )
 
 : pane-terpri ( pane -- )
     dup pane-current over pane-print-1
-    0 <shelf> over set-pane-current init-active-line ;
+    <shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )
     3dup car swap pane-write-1 cdr dup

library/ui/presentations.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: compiler generic hashtables inference inspector io jedit
-kernel lists memory namespaces parser prettyprint sequences
-styles vectors words ;
+IN: gadgets-presentations
+USING: compiler gadgets gadgets-buttons gadgets-labels
+gadgets-menus gadgets-panes generic hashtables inference
+inspector io jedit kernel lists memory namespaces parser
+prettyprint sequences styles vectors words ;
 
 SYMBOL: commands
 
@@ -43,6 +44,9 @@ SYMBOL: commands
     gadget pick assoc dup
     [ 2nip ] [ drop <styled-label> init-commands ] ifte ;
 
+: <object-presentation> ( object -- gadget )
+    dup presented swons unit swap unparse-short <presentation> ;
+
 : gadget. ( gadget -- )
     gadget swons unit
     "This stream does not support live gadgets"
@@ -62,7 +66,6 @@ SYMBOL: commands
 [ compound? ] "Annotate with breakpoint" [ break ] define-command
 [ compound? ] "Annotate with profiling" [ profile ] define-command
 [ word? ] "Compile" [ recompile ] define-command
-[ word? ] "Decompile" [ decompile ] define-command
 [ word? ] "Show stack effect" [ unit infer . ] define-command
 [ word? ] "Show dataflow IR" [ word-def t dataflow. ] define-command
 [ word? ] "Show linear IR" [ precompile ] define-command

library/ui/scrolling.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math matrices namespaces sequences
-threads vectors styles ;
+IN: gadgets-scrolling
+USING: gadgets gadgets-layouts generic kernel lists math
+namespaces sequences threads vectors styles ;
 
 ! A viewport can be scrolled.
 TUPLE: viewport ;
@@ -83,5 +83,6 @@ M: scroller focusable-child* ( scroller -- viewport )
 M: scroller layout* ( scroller -- )
     dup scroller-bottom? [
         f over set-scroller-bottom?
-        dup dup scroller-viewport viewport-dim scroll
+        dup dup scroller-viewport viewport-dim
+        { 0 1 0 } v* scroll
     ] when delegate layout* ;

library/ui/sliders.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math matrices namespaces sequences
-threads vectors styles ;
+IN: gadgets-scrolling
+USING: gadgets gadgets-buttons gadgets-layouts generic kernel
+lists math namespaces sequences threads vectors styles ;
 
 ! An elevator has a thumb that may be moved up and down.
 TUPLE: elevator ;

library/ui/splitters.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel lists math matrices namespaces sequences
-styles vectors ;
+IN: gadgets-splitters
+USING: gadgets gadgets-layouts generic kernel lists math
+namespaces sequences styles vectors ;
 
 TUPLE: divider splitter ;
 
@@ -31,9 +31,10 @@ C: divider ( -- divider )
     dup divider-actions ;
 
 C: splitter ( first second split vector -- splitter )
-    [ >r 1 swap <pack> r> set-delegate ] keep
+    [ >r <pack> r> set-delegate ] keep
     [ set-splitter-split ] keep
-    [ >r >r <divider> r> 3vector r> add-gadgets ] keep ;
+    [ >r >r <divider> r> 3vector r> add-gadgets ] keep
+    1 over set-pack-fill ;
 
 : <x-splitter> ( first second split -- splitter )
     { 0 1 0 } <splitter> ;

library/ui/text.factor

@@ -6,12 +6,10 @@ sequences strings styles ;
 
 : draw-surface ( x y surface -- )
     surface get SDL_UnlockSurface
-    [
-        [ surface-rect ] keep swap surface get 0 0
-    ] keep surface-rect swap rot SDL_UpperBlit drop
-    surface get dup must-lock-surface? [
-        SDL_LockSurface
-    ] when drop ;
+    [ [ surface-rect ] keep swap surface get 0 0 ] keep
+    surface-rect swap rot SDL_UpperBlit drop
+    surface get dup must-lock-surface?
+    [ SDL_LockSurface ] when drop ;
 
 : filter-nulls ( str -- str )
     [ dup 0 = [ drop CHAR: \s ] when ] map ;

library/ui/ui.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic help io kernel listener lists math namespaces
-prettyprint sdl sequences shells styles threads words ;
+USING: gadgets-listener generic help io kernel listener lists
+math namespaces prettyprint sdl sequences shells styles threads
+words ;
 
 : init-world
     global [

library/ui/world.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien errors generic io kernel lists math memory
-namespaces prettyprint sdl sequences sequences strings threads
-vectors ;
+USING: alien errors gadgets-layouts generic io kernel lists math
+memory namespaces prettyprint sdl sequences sequences strings
+threads vectors ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the

library/unix/io.factor

@@ -77,11 +77,8 @@ M: port set-timeout ( timeout port -- )
     dup port-error f rot set-port-error throw ;
 
 : report-error ( error port -- )
-    [
-        "Error on fd " %
-        dup port-handle number>string %
-        ": " % swap %
-    ] "" make swap set-port-error ;
+    [ "Error on fd " % dup port-handle # ": " % swap % ] "" make
+    swap set-port-error ;
 
 : defer-error ( port -- ? )
     #! Return t if it is an unrecoverable error.

library/unix/sockets.factor

@@ -81,10 +81,10 @@ C: accept-task ( port -- task )
 
 : inet-ntoa ( n -- str )
     ntohl [
-        dup -24 shift HEX: ff bitand number>string % CHAR: . ,
-        dup -16 shift HEX: ff bitand number>string % CHAR: . ,
-        dup -8  shift HEX: ff bitand number>string % CHAR: . ,
-                      HEX: ff bitand number>string %
+        dup -24 shift HEX: ff bitand # CHAR: . ,
+        dup -16 shift HEX: ff bitand # CHAR: . ,
+        dup -8  shift HEX: ff bitand # CHAR: . ,
+                      HEX: ff bitand #
     ] "" make ;
 
 : do-accept ( port sockaddr fd -- )

library/words.factor

@@ -20,38 +20,36 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
     #! Sort a list of words by name.
     [ swap word-name swap word-name lexi ] sort ;
 
+: uses ( word -- uses )
+    #! Outputs a list of words that this word directly calls.
+    [
+        dup word-def [
+            dup word? [ 2dup eq? [ dup , ] unless ] when 2drop
+        ] tree-each-with
+    ] { } make prune ;
+
 ! The cross-referencer keeps track of word dependencies, so that
 ! words can be recompiled when redefined.
 SYMBOL: crossref
 
-: (add-crossref)
-    dup word? [
-        crossref get [ dupd nest set-hash ] bind
-    ] [
-        2drop
-    ] ifte ;
+: (add-crossref) crossref get [ dupd nest set-hash ] bind ;
 
 : add-crossref ( word -- )
     #! Marks each word in the quotation as being a dependency
     #! of the word.
     crossref get [
-        dup word-def [ (add-crossref) ] tree-each-with
+        dup uses [ (add-crossref) ] each-with
     ] [
         drop
     ] ifte ;
 
-: (remove-crossref)
-    dup word? [
-        crossref get [ nest remove-hash ] bind
-    ] [
-        2drop
-    ] ifte ;
+: (remove-crossref) crossref get [ nest remove-hash ] bind ;
 
 : remove-crossref ( word -- )
     #! Marks each word in the quotation as not being a
     #! dependency of the word.
     crossref get [
-        dup word-def [ (remove-crossref) ] tree-each-with
+        dup uses [ (remove-crossref) ] each-with
     ] [
         drop
     ] ifte ;
@@ -126,3 +124,12 @@ M: object literalize ;
 M: word literalize <wrapper> ;
 
 M: wrapper literalize <wrapper> ;
+
+: gensym ( -- word )
+    #! Return a word that is distinct from every other word, and
+    #! is not contained in any vocabulary.
+    "G:"
+    global [ \ gensym dup inc get ] bind
+    number>string append f <word> ;
+
+0 \ gensym global set-hash