Merge branch 'master' of git://factorcode.org/git/factor

basis/calendar/calendar-docs.factor

@@ -184,7 +184,7 @@ HELP: time+
 { $description "Adds two durations to produce a duration or adds a timestamp and a duration to produce a timestamp. The calculation takes timezones into account." }
 { $examples
     { $example "USING: calendar math.order prettyprint ;"
-               "10 months 2 months time+ 1 year <=> ."
+               "10 months 2 months time+ 1 years <=> ."
                "+eq+"
     }
     { $example "USING: accessors calendar math.order prettyprint ;"
@@ -193,3 +193,109 @@ HELP: time+
     }
 } ;
 
+HELP: dt>years
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in years." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "6 months dt>years ."
+               "1/2"
+    }
+} ;
+
+HELP: dt>months
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in months." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "30 days dt>months ."
+               "16000/16233"
+    }
+} ;
+
+HELP: dt>days
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in days." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "6 hours dt>days ."
+               "1/4"
+    }
+} ;
+
+HELP: dt>hours
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in hours." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "3/4 days dt>hours ."
+               "18"
+    }
+} ;
+HELP: dt>minutes
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in minutes." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "6 hours dt>minutes ."
+               "360"
+    }
+} ;
+HELP: dt>seconds
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in seconds." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "6 minutes dt>seconds ."
+               "360"
+    }
+} ;
+
+HELP: dt>milliseconds
+{ $values { "duration" duration } { "x" number } }
+{ $description "Calculates the length of a duration in milliseconds." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "6 seconds dt>milliseconds ."
+               "6000"
+    }
+} ;
+
+{ dt>years dt>months dt>days dt>hours dt>minutes dt>seconds dt>milliseconds } related-words
+
+
+HELP: time-
+{ $values { "time1" "timestamp or duration" } { "time2" "timestamp or duration" } { "time3" "timestamp or duration" } }
+{ $description "Subtracts two durations to produce a duration or subtracts a duration from a timestamp to produce a timestamp. The calculation takes timezones into account." }
+{ $examples
+    { $example "USING: calendar math.order prettyprint ;"
+               "10 months 2 months time- 8 months <=> ."
+               "+eq+"
+    }
+    { $example "USING: accessors calendar math.order prettyprint ;"
+               "2010 1 1 <date> 3 days time- day>> ."
+               "29"
+    }
+} ;
+
+{ time+ time- } related-words
+
+HELP: convert-timezone
+{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp" timestamp } }
+{ $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
+{ $examples
+    { $example "USING: accessors calendar prettyprint ;"
+               "gmt noon instant -5 >>hour convert-timezone gmt-offset>> hour>> ."
+               "-5"
+    }
+} ;
+
+HELP: >local-time
+{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
+{ $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
+{ $examples
+    { $example "USING: accessors calendar kernel prettyprint ;"
+               "now gmt >local-time [ gmt-offset>> ] bi@ = ."
+               "t"
+    }
+} ;

basis/calendar/calendar.factor

@@ -60,6 +60,8 @@ PRIVATE>
 : month-abbreviation ( n -- string )
     check-month 1- month-abbreviations nth ;
 
+: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
+
 : day-names ( -- array )
     {
         "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
@@ -116,7 +118,7 @@ PRIVATE>
 : >time< ( timestamp -- hour minute second )
     [ hour>> ] [ minute>> ] [ second>> ] tri ;
 
-MEMO: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
+: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
 : years ( x -- duration ) instant clone swap >>year ;
 : months ( x -- duration ) instant clone swap >>month ;
 : days ( x -- duration ) instant clone swap >>day ;
@@ -258,7 +260,7 @@ M: duration <=> [ dt>years ] compare ;
 : dt>seconds ( duration -- x ) dt>years seconds-per-year * ;
 : dt>milliseconds ( duration -- x ) dt>seconds 1000 * ;
 
-GENERIC: time- ( time1 time2 -- time )
+GENERIC: time- ( time1 time2 -- time3 )
 
 : convert-timezone ( timestamp duration -- timestamp )
     over gmt-offset>> over = [ drop ] [
@@ -323,12 +325,9 @@ MEMO: unix-1970 ( -- timestamp )
     unix-1970 millis milliseconds time+ ;
 
 : now ( -- timestamp ) gmt >local-time ;
-
 : hence ( duration -- timestamp ) now swap time+ ;
 : ago ( duration -- timestamp ) now swap time- ;
 
-: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
-
 : zeller-congruence ( year month day -- n )
     #! Zeller Congruence
     #! http://web.textfiles.com/computers/formulas.txt
@@ -395,7 +394,6 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
 : time-since-midnight ( timestamp -- duration )
     dup midnight time- ;
 
-
 M: timestamp sleep-until timestamp>millis sleep-until ;
 
 M: duration sleep hence sleep-until ;

basis/compiler/tests/alien.factor

@@ -84,6 +84,13 @@ FUNCTION: tiny ffi_test_17 int x ;
 
 [ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test
 
+: indirect-test-1' ( ptr -- )
+    "int" { } "cdecl" alien-indirect drop ;
+
+{ 1 0 } [ indirect-test-1' ] must-infer-as
+
+[ ] [ "ffi_test_1" f dlsym indirect-test-1' ] unit-test
+
 [ -1 indirect-test-1 ] must-fail
 
 : indirect-test-2 ( x y ptr -- result )

basis/compiler/tree/dead-code/simple/simple.factor

@@ -81,11 +81,19 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
         drop-values
     ] ;
 
-: drop-dead-outputs ( node -- nodes )
+: drop-dead-outputs ( node -- #shuffle )
     dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
 
+: some-outputs-dead? ( #call -- ? )
+    out-d>> [ live-value? not ] contains? ;
+
+: maybe-drop-dead-outputs ( node -- nodes )
+    dup some-outputs-dead? [
+        dup drop-dead-outputs 2array
+    ] when ;
+
 M: #introduce remove-dead-code* ( #introduce -- nodes )
-    dup drop-dead-outputs 2array ;
+    maybe-drop-dead-outputs ;
 
 M: #>r remove-dead-code*
     [ filter-live ] change-out-r
@@ -110,17 +118,9 @@ M: #push remove-dead-code*
     [ in-d>> #drop remove-dead-code* ]
     bi ;
 
-: some-outputs-dead? ( #call -- ? )
-    out-d>> [ live-value? not ] contains? ;
-
 M: #call remove-dead-code*
-    dup dead-flushable-call? [
+    dup dead-flushable-call?
-        remove-flushable-call
+    [ remove-flushable-call ] [ maybe-drop-dead-outputs ] if ;
-    ] [
-        dup some-outputs-dead? [
-            dup drop-dead-outputs 2array
-        ] when
-    ] if ;
 
 M: #shuffle remove-dead-code*
     [ filter-live ] change-in-d
@@ -136,3 +136,9 @@ M: #copy remove-dead-code*
 M: #terminate remove-dead-code*
     [ filter-live ] change-in-d
     [ filter-live ] change-in-r ;
+
+M: #alien-invoke remove-dead-code*
+    maybe-drop-dead-outputs ;
+
+M: #alien-indirect remove-dead-code*
+    maybe-drop-dead-outputs ;

basis/help/lint/lint.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors sequences parser kernel help help.markup
+USING: fry accessors sequences parser kernel help help.markup
 help.topics words strings classes tools.vocabs namespaces io
 io.streams.string prettyprint definitions arrays vectors
 combinators combinators.short-circuit splitting debugger
@@ -39,7 +39,7 @@ IN: help.lint
         $predicate
         $class-description
         $error-description
-    } swap [ elements f like ] curry contains? ;
+    } swap '[ , elements empty? not ] contains? ;
 
 : check-values ( word element -- )
     {
@@ -108,12 +108,10 @@ M: help-error error.
     articles get keys
     vocabs [ dup vocab-docs-path swap ] H{ } map>assoc
     H{ } clone [
-        [
+        '[
-            [ dup >link where dup ] 2dip
+            dup >link where dup
-            [ >r >r first r> at r> push-at ] 2curry
+            [ first , at , push-at ] [ 2drop ] if
-            [ 2drop ]
+        ] each
-            if
-        ] 2curry each
     ] keep ;
 
 : check-about ( vocab -- )

basis/help/topics/topics-tests.factor

@@ -16,7 +16,7 @@ IN: help.topics.tests
 
 SYMBOL: foo
 
-[ ] [ { "test" "a" } "Test A" { { $subsection foo } } <article> add-article ] unit-test
+[ ] [ "Test A" { { $subsection foo } } <article> { "test" "a" } add-article ] unit-test
 
 ! Test article location recording
 

basis/io/windows/launcher/launcher.factor

@@ -6,7 +6,7 @@ windows.types math windows.kernel32
 namespaces io.launcher kernel sequences windows.errors
 splitting system threads init strings combinators
 io.backend accessors concurrency.flags io.files assocs
-io.files.private windows destructors classes.tuple.lib ;
+io.files.private windows destructors ;
 IN: io.windows.launcher
 
 TUPLE: CreateProcess-args
@@ -30,7 +30,19 @@ TUPLE: CreateProcess-args
     0 >>dwCreateFlags ;
 
 : call-CreateProcess ( CreateProcess-args -- )
-    CreateProcess-args >tuple< CreateProcess win32-error=0/f ;
+    {
+        [ lpApplicationName>> ]
+        [ lpCommandLine>> ]
+        [ lpProcessAttributes>> ]
+        [ lpThreadAttributes>> ]
+        [ bInheritHandles>> ]
+        [ dwCreateFlags>> ]
+        [ lpEnvironment>> ]
+        [ lpCurrentDirectory>> ]
+        [ lpStartupInfo>> ]
+        [ lpProcessInformation>> ]
+    } cleave
+    CreateProcess win32-error=0/f ;
 
 : count-trailing-backslashes ( str n -- str n )
     >r "\\" ?tail r> swap [

basis/io/windows/nt/backend/backend.factor

@@ -1,9 +1,8 @@
 USING: alien alien.c-types arrays assocs combinators
 continuations destructors io io.backend io.ports io.timeouts
 io.windows io.windows.files libc kernel math namespaces
-sequences threads classes.tuple.lib windows windows.errors
+sequences threads windows windows.errors windows.kernel32
-windows.kernel32 strings splitting io.files
+strings splitting io.files io.buffers qualified ascii system
-io.buffers qualified ascii system
 accessors locals ;
 QUALIFIED: windows.winsock
 IN: io.windows.nt.backend

basis/io/windows/nt/sockets/sockets.factor

@@ -1,9 +1,8 @@
 USING: alien alien.accessors alien.c-types byte-arrays
 continuations destructors io.ports io.timeouts io.sockets
 io.sockets io namespaces io.streams.duplex io.windows
-io.windows.sockets
+io.windows.sockets io.windows.nt.backend windows.winsock kernel
-io.windows.nt.backend windows.winsock kernel libc math sequences
+libc math sequences threads system combinators accessors ;
-threads classes.tuple.lib system combinators accessors ;
 IN: io.windows.nt.sockets
 
 : malloc-int ( object -- object )
@@ -28,71 +27,89 @@ M: winnt WSASocket-flags ( -- DWORD )
     ] keep *void* ;
 
 TUPLE: ConnectEx-args port
-    s* name* namelen* lpSendBuffer* dwSendDataLength*
+    s name namelen lpSendBuffer dwSendDataLength
-    lpdwBytesSent* lpOverlapped* ptr* ;
+    lpdwBytesSent lpOverlapped ptr ;
 
 : wait-for-socket ( args -- n )
-    [ lpOverlapped*>> ] [ port>> ] bi twiddle-thumbs ;
+    [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline
 
 : <ConnectEx-args> ( sockaddr size -- ConnectEx )
     ConnectEx-args new
-        swap >>namelen*
+        swap >>namelen
-        swap >>name*
+        swap >>name
-        f >>lpSendBuffer*
+        f >>lpSendBuffer
-        0 >>dwSendDataLength*
+        0 >>dwSendDataLength
-        f >>lpdwBytesSent*
+        f >>lpdwBytesSent
-        (make-overlapped) >>lpOverlapped* ;
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-ConnectEx ( ConnectEx -- )
-    ConnectEx-args >tuple*<
+    {
+        [ s>> ]
+        [ name>> ]
+        [ namelen>> ]
+        [ lpSendBuffer>> ]
+        [ dwSendDataLength>> ]
+        [ lpdwBytesSent>> ]
+        [ lpOverlapped>> ]
+        [ ptr>> ]
+    } cleave
     "int"
     { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" }
     "stdcall" alien-indirect drop
-    winsock-error-string [ throw ] when* ;
+    winsock-error-string [ throw ] when* ; inline
 
 M: object establish-connection ( client-out remote -- )
     make-sockaddr/size <ConnectEx-args>
         swap >>port
-        dup port>> handle>> handle>> >>s*
+        dup port>> handle>> handle>> >>s
-        dup s*>> get-ConnectEx-ptr >>ptr*
+        dup s>> get-ConnectEx-ptr >>ptr
         dup call-ConnectEx
         wait-for-socket drop ;
 
 TUPLE: AcceptEx-args port
-    sListenSocket* sAcceptSocket* lpOutputBuffer* dwReceiveDataLength*
+    sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength
-    dwLocalAddressLength* dwRemoteAddressLength* lpdwBytesReceived* lpOverlapped* ;
+    dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ;
 
 : init-accept-buffer ( addr AcceptEx -- )
     swap sockaddr-type heap-size 16 +
-        [ >>dwLocalAddressLength* ] [ >>dwRemoteAddressLength* ] bi
+        [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi
-        dup dwLocalAddressLength*>> 2 * malloc &free >>lpOutputBuffer*
+        dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer
-        drop ;
+        drop ; inline
 
 : <AcceptEx-args> ( server addr -- AcceptEx )
     AcceptEx-args new
         2dup init-accept-buffer
-        swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket*
+        swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket
-        over handle>> handle>> >>sListenSocket*
+        over handle>> handle>> >>sListenSocket
         swap >>port
-        0 >>dwReceiveDataLength*
+        0 >>dwReceiveDataLength
-        f >>lpdwBytesReceived*
+        f >>lpdwBytesReceived
-        (make-overlapped) >>lpOverlapped* ;
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-AcceptEx ( AcceptEx -- )
-    AcceptEx-args >tuple*< AcceptEx drop
+    {
-    winsock-error-string [ throw ] when* ;
+        [ sListenSocket>> ]
+        [ sAcceptSocket>> ]
+        [ lpOutputBuffer>> ]
+        [ dwReceiveDataLength>> ]
+        [ dwLocalAddressLength>> ]
+        [ dwRemoteAddressLength>> ]
+        [ lpdwBytesReceived>> ]
+        [ lpOverlapped>> ]
+    } cleave AcceptEx drop
+    winsock-error-string [ throw ] when* ; inline
 
 : extract-remote-address ( AcceptEx -- sockaddr )
     {
-        [ lpOutputBuffer*>> ]
+        [ lpOutputBuffer>> ]
-        [ dwReceiveDataLength*>> ]
+        [ dwReceiveDataLength>> ]
-        [ dwLocalAddressLength*>> ]
+        [ dwLocalAddressLength>> ]
-        [ dwRemoteAddressLength*>> ]
+        [ dwRemoteAddressLength>> ]
     } cleave
     f <void*>
     0 <int>
     f <void*>
-    [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
+    [ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline
 
 M: object (accept) ( server addr -- handle sockaddr )
     [
@@ -100,39 +117,49 @@ M: object (accept) ( server addr -- handle sockaddr )
         {
             [ call-AcceptEx ]
             [ wait-for-socket drop ]
-            [ sAcceptSocket*>> <win32-socket> ]
+            [ sAcceptSocket>> <win32-socket> ]
             [ extract-remote-address ]
         } cleave
     ] with-destructors ;
 
 TUPLE: WSARecvFrom-args port
-       s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd*
+       s lpBuffers dwBufferCount lpNumberOfBytesRecvd
-       lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ;
+       lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
 
 : make-receive-buffer ( -- WSABUF )
     "WSABUF" malloc-object &free
     default-buffer-size get over set-WSABUF-len
-    default-buffer-size get malloc &free over set-WSABUF-buf ;
+    default-buffer-size get malloc &free over set-WSABUF-buf ; inline
 
 : <WSARecvFrom-args> ( datagram -- WSARecvFrom )
     WSARecvFrom-args new
         swap >>port
-        dup port>> handle>> handle>> >>s*
+        dup port>> handle>> handle>> >>s
         dup port>> addr>> sockaddr-type heap-size
-            [ malloc &free >>lpFrom* ]
+            [ malloc &free >>lpFrom ]
-            [ malloc-int &free >>lpFromLen* ] bi
+            [ malloc-int &free >>lpFromLen ] bi
-        make-receive-buffer >>lpBuffers*
+        make-receive-buffer >>lpBuffers
-        1 >>dwBufferCount*
+        1 >>dwBufferCount
-        0 malloc-int &free >>lpFlags*
+        0 malloc-int &free >>lpFlags
-        0 malloc-int &free >>lpNumberOfBytesRecvd*
+        0 malloc-int &free >>lpNumberOfBytesRecvd
-        (make-overlapped) >>lpOverlapped* ;
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-WSARecvFrom ( WSARecvFrom -- )
-    WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ;
+    {
+        [ s>> ]
+        [ lpBuffers>> ]
+        [ dwBufferCount>> ]
+        [ lpNumberOfBytesRecvd>> ]
+        [ lpFlags>> ]
+        [ lpFrom>> ]
+        [ lpFromLen>> ]
+        [ lpOverlapped>> ]
+        [ lpCompletionRoutine>> ]
+    } cleave WSARecvFrom socket-error* ; inline
 
 : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
-    [ lpBuffers*>> WSABUF-buf swap memory>byte-array ]
+    [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
-    [ [ lpFrom*>> ] [ lpFromLen*>> *int ] bi memory>byte-array ] bi ;
+    [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
 
 M: winnt (receive) ( datagram -- packet addrspec )
     [
@@ -144,31 +171,41 @@ M: winnt (receive) ( datagram -- packet addrspec )
     ] with-destructors ;
 
 TUPLE: WSASendTo-args port
-       s* lpBuffers* dwBufferCount* lpNumberOfBytesSent*
+       s lpBuffers dwBufferCount lpNumberOfBytesSent
-       dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ;
+       dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
 
 : make-send-buffer ( packet -- WSABUF )
     "WSABUF" malloc-object &free
     [ >r malloc-byte-array &free r> set-WSABUF-buf ]
     [ >r length r> set-WSABUF-len ]
     [ nip ]
-    2tri ;
+    2tri ; inline
 
 : <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
     WSASendTo-args new
         swap >>port
-        dup port>> handle>> handle>> >>s*
+        dup port>> handle>> handle>> >>s
         swap make-sockaddr/size
             >r malloc-byte-array &free
-            r> [ >>lpTo* ] [ >>iToLen* ] bi*
+            r> [ >>lpTo ] [ >>iToLen ] bi*
-        swap make-send-buffer >>lpBuffers*
+        swap make-send-buffer >>lpBuffers
-        1 >>dwBufferCount*
+        1 >>dwBufferCount
-        0 >>dwFlags*
+        0 >>dwFlags
-        0 <uint> >>lpNumberOfBytesSent*
+        0 <uint> >>lpNumberOfBytesSent
-        (make-overlapped) >>lpOverlapped* ;
+        (make-overlapped) >>lpOverlapped ; inline
 
 : call-WSASendTo ( WSASendTo -- )
-    WSASendTo-args >tuple*< WSASendTo socket-error* ;
+    {
+        [ s>> ]
+        [ lpBuffers>> ]
+        [ dwBufferCount>> ]
+        [ lpNumberOfBytesSent>> ]
+        [ dwFlags>> ]
+        [ lpTo>> ]
+        [ iToLen>> ]
+        [ lpOverlapped>> ]
+        [ lpCompletionRoutine>> ]
+    } cleave WSASendTo socket-error* ; inline
 
 M: winnt (send) ( packet addrspec datagram -- )
     [

basis/tools/deploy/shaker/shaker.factor

@@ -136,7 +136,6 @@ IN: tools.deploy.shaker
                 "specializer"
                 "step-into"
                 "step-into?"
-                "superclass"
                 "transform-n"
                 "transform-quot"
                 "tuple-dispatch-generic"

basis/ui/gadgets/buttons/buttons.factor

@@ -67,9 +67,12 @@ M: button-paint draw-interior
 M: button-paint draw-boundary
     button-paint draw-boundary ;
 
+: align-left ( button -- button )
+    { 0 1/2 } >>align ; inline
+
 : roll-button-theme ( button -- button )
     f black <solid> dup f <button-paint> >>boundary
-    { 0 1/2 } >>align ; inline
+    align-left ; inline
 
 : <roll-button> ( label quot -- button )
     <button> roll-button-theme ;
@@ -141,7 +144,8 @@ TUPLE: checkbox < button ;
     <checkmark> label-on-right checkbox-theme
     [ model>> toggle-model ]
     checkbox new-button
-        swap >>model ;
+        swap >>model
+        align-left ;
 
 M: checkbox model-changed
     swap model-value over (>>selected?) relayout-1 ;
@@ -179,7 +183,8 @@ TUPLE: radio-control < button value ;
     [ [ value>> ] keep set-control-value ]
     radio-control new-button
         swap >>model
-        swap >>value ; inline
+        swap >>value
+        align-left ; inline
 
 M: radio-control model-changed
     swap model-value

basis/ui/gestures/gestures-docs.factor

@@ -30,13 +30,13 @@ HELP: motion
 { $examples { $code "T{ motion }" } } ;
 
 HELP: drag
-{ $class-description "Mouse drag gesture. The " { $link drag-# } " slot is either set to a mouse button number, or " { $link f } " indicating no specific button is expected." } ;
+{ $class-description "Mouse drag gesture. The " { $snippet "#" } " slot is either set to a mouse button number, or " { $link f } " indicating no specific button is expected." } ;
 
 HELP: button-up
 { $class-description "Mouse button up gesture. Instances have two slots:"
     { $list
-        { { $link button-up-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
+        { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
-        { { $link button-up-# } " - a mouse button number, or " { $link f } " indicating no specific button is expected" }
+        { { $snippet "#" } " - a mouse button number, or " { $link f } " indicating no specific button is expected" }
     }
 }
 { $examples { $code "T{ button-up f f 1 }" "T{ button-up }" } } ;
@@ -44,8 +44,8 @@ HELP: button-up
 HELP: button-down
 { $class-description "Mouse button down gesture. Instances have two slots:"
     { $list
-        { { $link button-down-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
+        { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
-        { { $link button-down-# } " - a mouse button number, or " { $link f } " indicating no specific button is expected" }
+        { { $snippet "#" } " - a mouse button number, or " { $link f } " indicating no specific button is expected" }
     }
 }
 { $examples { $code "T{ button-down f f 1 }" "T{ button-down }" } } ;
@@ -109,8 +109,8 @@ HELP: S+
 HELP: key-down
 { $class-description "Key down gesture. Instances have two slots:"
     { $list
-        { { $link key-down-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
+        { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
-    { { $link key-down-sym } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } }
+    { { $snippet "sym" } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } }
     }
 }
 { $examples { $code "T{ key-down f { C+ } \"a\" }" "T{ key-down f f \"TAB\" }" } } ;
@@ -118,8 +118,8 @@ HELP: key-down
 HELP: key-up
 { $class-description "Key up gesture. Instances have two slots:"
     { $list
-        { { $link key-up-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
+        { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } }
-    { { $link key-up-sym } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } }
+    { { $snippet "sym" } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } }
     }
 }
 { $examples { $code "T{ key-up f { C+ } \"a\" }" "T{ key-up f f \"TAB\" }" } } ;

basis/ui/gestures/gestures.factor

@@ -226,14 +226,14 @@ SYMBOL: drag-timer
 : send-button-down ( gesture loc world -- )
     move-hand
     start-drag-timer
-    dup button-down-#
+    dup #>>
     dup update-click# hand-buttons get-global push
     update-clicked
     button-gesture ;
 
 : send-button-up ( gesture loc world -- )
     move-hand
-    dup button-up-# hand-buttons get-global delete
+    dup #>> hand-buttons get-global delete
     stop-drag-timer
     button-gesture ;
 
@@ -261,21 +261,21 @@ GENERIC: gesture>string ( gesture -- string/f )
     [ name>> ] map concat >string ;
 
 M: key-down gesture>string
-    dup key-down-mods modifiers>string
+    dup mods>> modifiers>string
-    swap key-down-sym append ;
+    swap sym>> append ;
 
 M: button-up gesture>string
     [
-        dup button-up-mods modifiers>string %
+        dup mods>> modifiers>string %
         "Click Button" %
-        button-up-# [ " " % # ] when*
+        #>> [ " " % # ] when*
     ] "" make ;
 
 M: button-down gesture>string
     [
-        dup button-down-mods modifiers>string %
+        dup mods>> modifiers>string %
         "Press Button" %
-        button-down-# [ " " % # ] when*
+        #>> [ " " % # ] when*
     ] "" make ;
 
 M: left-action gesture>string drop "Swipe left" ;

basis/ui/operations/operations-docs.factor

@@ -22,11 +22,11 @@ HELP: operation
 $nl
 "Operations have the following slots:"
 { $list
-    { { $link operation-predicate } " - a quotation with stack effect " { $snippet "( obj -- ? )" } }
+    { { $snippet "predicate" } " - a quotation with stack effect " { $snippet "( obj -- ? )" } }
-    { { $link operation-command } " - a " { $link word } }
+    { { $snippet "command" } " - a " { $link word } }
-    { { $link operation-translator } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } }
+    { { $snippet "translator" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } }
-    { { $link operation-hook } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } }
+    { { $snippet "hook" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } }
-    { { $link operation-listener? } " - a boolean" }
+    { { $snippet "listener?" } " - a boolean" }
 } } ;
 
 HELP: operation-gesture
@@ -38,7 +38,7 @@ HELP: operations
 
 HELP: object-operations
 { $values { "obj" object } { "operations" "a sequence of " { $link operation } " instances" } }
-{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $link operation-predicate } " quotation in turn." } ;
+{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $snippet "predicate" } " quotation in turn." } ;
 
 HELP: primary-operation
 { $values { "obj" object } { "operation" "an " { $link operation  } " or " { $link f } } }

basis/ui/operations/operations.factor

@@ -19,34 +19,34 @@ TUPLE: operation predicate command translator hook listener? ;
         swap >>predicate ;
 
 PREDICATE: listener-operation < operation
-    dup operation-command listener-command?
+    dup command>> listener-command?
-    swap operation-listener? or ;
+    swap listener?>> or ;
 
 M: operation command-name
-    operation-command command-name ;
+    command>> command-name ;
 
 M: operation command-description
-    operation-command command-description ;
+    command>> command-description ;
 
-M: operation command-word operation-command command-word ;
+M: operation command-word command>> command-word ;
 
 : operation-gesture ( operation -- gesture )
-    operation-command +keyboard+ word-prop ;
+    command>> +keyboard+ word-prop ;
 
 SYMBOL: operations
 
 : object-operations ( obj -- operations )
-    operations get [ operation-predicate call ] with filter ;
+    operations get [ predicate>> call ] with filter ;
 
 : find-operation ( obj quot -- command )
     >r object-operations r> find-last nip ; inline
 
 : primary-operation ( obj -- operation )
-    [ operation-command +primary+ word-prop ] find-operation ;
+    [ command>> +primary+ word-prop ] find-operation ;
 
 : secondary-operation ( obj -- operation )
     dup
-    [ operation-command +secondary+ word-prop ] find-operation
+    [ command>> +secondary+ word-prop ] find-operation
     [ ] [ primary-operation ] ?if ;
 
 : default-flags ( -- assoc )
@@ -59,9 +59,9 @@ SYMBOL: operations
 
 : modify-operation ( hook translator operation -- operation )
     clone
-    tuck set-operation-translator
+    tuck (>>translator)
-    tuck set-operation-hook
+    tuck (>>hook)
-    t over set-operation-listener? ;
+    t over (>>listener?) ;
 
 : modify-operations ( operations hook translator -- operations )
     rot [ >r 2dup r> modify-operation ] map 2nip ;
@@ -76,9 +76,9 @@ SYMBOL: operations
 : operation-quot ( target command -- quot )
     [
         swap literalize ,
-        dup operation-translator %
+        dup translator>> %
-        operation-command ,
+        command>> ,
     ] [ ] make ;
 
 M: operation invoke-command ( target command -- )
-    [ operation-hook call ] keep operation-quot call ;
+    [ hook>> call ] keep operation-quot call ;

basis/ui/render/render-docs.factor

@@ -38,16 +38,16 @@ HELP: draw-boundary
 { $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ;
 
 HELP: solid
-{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $link solid-color } " slot stores a color specifier." } ;
+{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $snippet "color" } " slot stores a color specifier." } ;
 
 HELP: gradient
-{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $link gradient-colors } " slot stores a sequence of color specifiers and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." } ;
+{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $snippet "colors" } " slot stores a sequence of color specifiers and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." } ;
 
 HELP: polygon
 { $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"
     { $list
-        { { $link polygon-color } " - a color specifier" }
+        { { $snippet "color" } " - a color specifier" }
-        { { $link polygon-points } " - a sequence of points" }
+        { { $snippet "points" } " - a sequence of points" }
     }
 } ;
 

basis/ui/render/render.factor

@@ -95,7 +95,7 @@ C: <solid> solid
 
 ! Solid pen
 : (solid) ( gadget paint -- loc dim )
-    solid-color set-color rect-dim >r origin get dup r> v+ ;
+    color>> set-color rect-dim >r origin get dup r> v+ ;
 
 M: solid draw-interior (solid) gl-fill-rect ;
 
@@ -109,7 +109,7 @@ C: <gradient> gradient
 M: gradient draw-interior
     origin get [
         over orientation>>
-        swap gradient-colors
+        swap colors>>
         rot rect-dim
         gl-gradient
     ] with-translation ;
@@ -121,7 +121,7 @@ C: <polygon> polygon
 
 : draw-polygon ( polygon quot -- )
     origin get [
-        >r dup polygon-color set-color polygon-points r> call
+        >r dup color>> set-color points>> r> call
     ] with-translation ; inline
 
 M: polygon draw-boundary

basis/ui/tools/debugger/debugger.factor

@@ -29,7 +29,7 @@ TUPLE: debugger < track restarts ;
         -rot <restart-list> >>restarts
         dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
 
-M: debugger focusable-child* debugger-restarts ;
+M: debugger focusable-child* restarts>> ;
 
 : debugger-window ( error -- )
     #! No restarts for the debugger window

basis/ui/tools/deploy/deploy.factor

@@ -65,13 +65,13 @@ TUPLE: deploy-gadget < pack vocab settings ;
     [ deploy-gadget? ] find-parent ;
 
 : find-deploy-vocab ( gadget -- vocab )
-    find-deploy-gadget deploy-gadget-vocab ;
+    find-deploy-gadget vocab>> ;
 
 : find-deploy-config ( gadget -- config )
     find-deploy-vocab deploy-config ;
 
 : find-deploy-settings ( gadget -- settings )
-    find-deploy-gadget deploy-gadget-settings ;
+    find-deploy-gadget settings>> ;
 
 : com-revert ( gadget -- )
     dup find-deploy-config

basis/ui/tools/inspector/inspector.factor

@@ -47,4 +47,4 @@ inspector-gadget "multi-touch" f {
 } define-command-map
 
 M: inspector-gadget tool-scroller
-    inspector-gadget-pane find-scroller ;
+    pane>> find-scroller ;

basis/ui/tools/interactor/interactor.factor

@@ -76,7 +76,7 @@ M: interactor model-changed
     ] with-output-stream* ;
 
 : add-interactor-history ( str interactor -- )
-    over empty? [ 2drop ] [ interactor-history adjoin ] if ;
+    over empty? [ 2drop ] [ history>> adjoin ] if ;
 
 : interactor-continue ( obj interactor -- )
     mailbox>> mailbox-put ;

basis/ui/tools/listener/listener.factor

@@ -64,7 +64,7 @@ M: listener-command invoke-command ( target command -- )
     command-quot call-listener ;
 
 M: listener-operation invoke-command ( target command -- )
-    [ operation-hook call ] keep operation-quot call-listener ;
+    [ hook>> call ] keep operation-quot call-listener ;
 
 : eval-listener ( string -- )
     get-workspace
@@ -110,7 +110,7 @@ M: engine-word word-completion-string
     ] [ 2drop ] if ;
 
 : insert-word ( word -- )
-    get-workspace workspace-listener input>>
+    get-workspace listener>> input>>
     [ >r word-completion-string r> user-input ]
     [ interactor-use use-if-necessary ]
     2bi ;
@@ -131,10 +131,10 @@ TUPLE: stack-display < track ;
     1 track-add ;
 
 M: stack-display tool-scroller
-    find-workspace workspace-listener tool-scroller ;
+    find-workspace listener>> tool-scroller ;
 
 : ui-listener-hook ( listener -- )
-    >r datastack r> listener-gadget-stack set-model ;
+    >r datastack r> stack>> set-model ;
 
 : ui-error-hook ( error listener -- )
     find-workspace debugger-popup ;
@@ -168,7 +168,7 @@ M: stack-display tool-scroller
     } cleave ;
 
 : init-listener ( listener -- )
-    f <model> swap set-listener-gadget-stack ;
+    f <model> swap (>>stack) ;
 
 : <listener-gadget> ( -- gadget )
   { 0 1 } listener-gadget new-track

basis/ui/tools/profiler/profiler.factor

@@ -14,7 +14,7 @@ TUPLE: profiler-gadget < track pane ;
     dup pane>> <scroller> 1 track-add ;
     
 : with-profiler-pane ( gadget quot -- )
-    >r profiler-gadget-pane r> with-pane ;
+    >r pane>> r> with-pane ;
 
 : com-full-profile ( gadget -- )
     [ profile. ] with-profiler-pane ;

basis/ui/tools/search/search.factor

@@ -14,7 +14,7 @@ IN: ui.tools.search
 TUPLE: live-search < track field list ;
 
 : search-value ( live-search -- value )
-    live-search-list list-value ;
+    list>> list-value ;
 
 : search-gesture ( gesture live-search -- operation/f )
     search-value object-operations
@@ -32,7 +32,7 @@ M: live-search handle-gesture ( gesture live-search -- ? )
     [ live-search? ] find-parent ;
 
 : find-search-list ( gadget -- list )
-    find-live-search live-search-list ;
+    find-live-search list>> ;
 
 TUPLE: search-field < editor ;
 
@@ -70,12 +70,12 @@ search-field H{
     over field>> set-editor-string
   dup field>> end-of-document ;
 
-M: live-search focusable-child* live-search-field ;
+M: live-search focusable-child* field>> ;
 
 M: live-search pref-dim* drop { 400 200 } ;
 
 : current-word ( workspace -- string )
-    workspace-listener listener-gadget-input selected-word ;
+    listener>> input>> selected-word ;
 
 : definition-candidates ( words -- candidates )
     [ dup synopsis >lower ] { } map>assoc sort-values ;
@@ -149,10 +149,10 @@ M: live-search pref-dim* drop { 400 200 } ;
     f [ string>> ] <live-search> ;
 
 : listener-history ( listener -- seq )
-    listener-gadget-input interactor-history <reversed> ;
+    input>> history>> <reversed> ;
 
 : com-history ( workspace -- )
-    "" over workspace-listener listener-history <history-search>
+    "" over listener>> listener-history <history-search>
     "History search" show-titled-popup ;
 
 workspace "toolbar" f {

basis/ui/tools/tools.factor

@@ -54,7 +54,7 @@ IN: ui.tools
 
 M: workspace model-changed
     nip
-    dup workspace-listener listener-gadget-output scroll>bottom
+    dup listener>> output>> scroll>bottom
     dup resize-workspace
     request-focus ;
 

basis/ui/tools/walker/walker.factor

@@ -84,7 +84,7 @@ walker-gadget "toolbar" f {
 : walker-for-thread? ( thread gadget -- ? )
     {
         { [ dup walker-gadget? not ] [ 2drop f ] }
-        { [ dup walker-gadget-closing? ] [ 2drop f ] }
+        { [ dup closing?>> ] [ 2drop f ] }
         [ thread>> eq? ]
     } cond ;
 

basis/ui/tools/workspace/workspace.factor

@@ -29,7 +29,7 @@ M: gadget tool-scroller drop f ;
   book>> children>> [ class eq? ] with find ;
 
 : show-tool ( class workspace -- tool )
-    [ find-tool swap ] keep workspace-book model>>
+    [ find-tool swap ] keep book>> model>>
     set-model ;
 
 : select-tool ( workspace class -- ) swap show-tool drop ;
@@ -81,10 +81,10 @@ SYMBOL: workspace-dim
 M: workspace pref-dim* drop workspace-dim get ;
 
 M: workspace focusable-child*
-    dup workspace-popup [ ] [ workspace-listener ] ?if ;
+    dup popup>> [ ] [ listener>> ] ?if ;
 
 : workspace-page ( workspace -- gadget )
-    workspace-book current-page ;
+    book>> current-page ;
 
 M: workspace tool-scroller ( workspace -- scroller )
     workspace-page tool-scroller ;

basis/ui/traverse/traverse-tests.factor

@@ -1,9 +1,11 @@
-IN: ui.traverse.tests
+
-USING: ui.gadgets ui.gadgets.labels namespaces sequences kernel
+USING: accessors ui.gadgets ui.gadgets.labels namespaces sequences kernel
 math arrays tools.test io ui.gadgets.panes ui.traverse
 definitions compiler.units ;
 
-M: array gadget-children ;
+IN: ui.traverse.tests
+
+M: array children>> ;
 
 GENERIC: (flatten-tree) ( node -- )
 

core/generic/generic.factor

@@ -105,6 +105,10 @@ M: method-body crossref?
         drop [ <method> dup ] 2keep reveal-method
     ] if ;
 
+PREDICATE: default-method < word "default" word-prop ;
+
+M: default-method irrelevant? drop t ;
+
 : <default-method> ( generic combination -- method )
     [ drop object bootstrap-word swap <method> ] [ make-default-method ] 2bi
     [ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ;
@@ -137,7 +141,7 @@ M: method-body definer
 M: method-body forget*
     dup "forgotten" word-prop [ drop ] [
         [
-            dup "default" word-prop [ drop ] [
+            dup default-method? [ drop ] [
                 [
                     [ "method-class" word-prop ]
                     [ "method-generic" word-prop ] bi

core/generic/standard/standard.factor

@@ -26,10 +26,6 @@ ERROR: no-method object generic ;
 : error-method ( word -- quot )
     picker swap [ no-method ] curry append ;
 
-: default-method ( word -- pair )
-    "default-method" word-prop
-    object bootstrap-word swap 2array ;
-
 : push-method ( method specializer atomic assoc -- )
     [
         [ H{ } clone <predicate-dispatch-engine> ] unless*

extra/classes/tuple/lib/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/classes/tuple/lib/lib-docs.factor

@@ -1,29 +0,0 @@
-USING: help.syntax help.markup kernel prettyprint sequences ;
-IN: classes.tuple.lib
-
-HELP: >tuple<
-{ $values { "class" "a tuple class" } }
-{ $description "Explodes the tuple so that tuple slots are on the stack in the order listed in the tuple." }
-{ $example
-    "USING: kernel prettyprint classes.tuple.lib ;"
-    "IN: scratchpad"
-    "TUPLE: foo a b c ;"
-    "1 2 3 \\ foo boa \\ foo >tuple< .s"
-    "1\n2\n3"
-}
-{ $notes "Words using " { $snippet ">tuple<" } " may be compiled." }
-{ $see-also >tuple*< } ;
-
-HELP: >tuple*<
-{ $values { "class" "a tuple class" } }
-{ $description "Explodes the tuple so that tuple slots ending with '*' are on the stack in the order listed in the tuple." }
-{ $example
-    "USING: kernel prettyprint classes.tuple.lib ;"
-    "IN: scratchpad"
-    "TUPLE: foo a bb* ccc dddd* ;"
-    "1 2 3 4 \\ foo boa \\ foo >tuple*< .s"
-    "2\n4"
-}
-{ $notes "Words using " { $snippet ">tuple*<" } " may be compiled." }
-{ $see-also >tuple< } ;
-

extra/classes/tuple/lib/lib-tests.factor

@@ -1,8 +0,0 @@
-USING: kernel tools.test classes.tuple.lib ;
-IN: classes.tuple.lib.tests
-
-TUPLE: foo a b* c d* e f* ;
-
-[ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple< ] unit-test
-[ 2 4 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple*< ] unit-test
-

extra/classes/tuple/lib/lib.factor

@@ -1,18 +0,0 @@
-! Copyright (C) 2007 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel macros sequences slots words classes.tuple
-quotations combinators accessors ;
-IN: classes.tuple.lib
-
-: reader-slots ( seq -- quot )
-    [ reader>> 1quotation ] map [ cleave ] curry ;
-
-MACRO: >tuple< ( class -- )
-    all-slots rest-slice reader-slots ;
-
-MACRO: >tuple*< ( class -- )
-    all-slots
-    [ slot-spec-name "*" tail? ] filter
-    reader-slots ;
-
-

extra/obj/examples/todo/todo.factor

@@ -0,0 +1,83 @@
+
+USING: kernel sequences sets combinators.cleave
+       obj obj.view obj.util obj.print ;
+
+IN: obj.examples.todo
+
+SYM: person types adjoin
+SYM: todo   types adjoin
+
+SYM: owners properties adjoin
+SYM: eta    properties adjoin
+SYM: notes  properties adjoin
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: slava { type person } define-object
+SYM: doug  { type person } define-object
+SYM: ed    { type person } define-object
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: compiler-bugs
+  {
+    type todo
+    owners { slava }
+    notes  {
+             "Investitage FEP on Terrorist"
+             "Problem with cutler in VirtualBox?"
+           }
+  }
+define-object
+
+SYM: remove-old-accessors-from-core
+  {
+    type todo
+    owners { slava }
+  }
+define-object
+
+SYM: move-db-and-web-framework-to-basis
+  {
+   type todo
+   owners { slava }
+  }
+define-object
+
+SYM: remove-old-accessors-from-basis
+  {
+    type todo
+    owners { doug ed }
+  }
+define-object
+
+SYM: blas-on-bsd
+  {
+    type todo
+    owners { slava doug }
+  }
+define-object
+
+SYM: multi-methods-backend
+  {
+    type todo
+    owners { slava }
+  }
+define-object
+
+SYM: update-core-for-multi-methods { type todo owners { slava } } define-object
+SYM: update-basis-for-multi-methods { type todo } define-object
+SYM: update-extra-for-multi-methods { type todo } define-object
+
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: todo-list ( -- )
+  objects [ type -> todo = ] filter
+    [ { [ self -> ] [ owners -> ] [ eta -> ] } 1arr ]
+  map
+  { "ITEM" "OWNERS" "ETA" } prefix
+  print-table ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

extra/obj/view/view.factor

@@ -40,7 +40,13 @@ PREDICATE: obj-list < word \ objects = ;
 
 M: obj-list article-title ( objects -- title ) drop "Objects" ;
 
+! M: obj-list article-content ( objects -- title )
+!    execute
+!    [ [ type -> ] [ ] bi 2array ] map
+!    { $tab , } bake ;
+
 M: obj-list article-content ( objects -- title )
-   execute
+   drop
+   objects
    [ [ type -> ] [ ] bi 2array ] map
    { $tab , } bake ;

extra/spheres/deploy.factor

@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-reflection 1 }
+    { deploy-random? t }
+    { deploy-word-defs? f }
+    { deploy-word-props? f }
+    { deploy-name "Spheres" }
+    { deploy-compiler? t }
+    { deploy-math? t }
+    { deploy-io 1 }
+    { deploy-threads? t }
+    { "stop-after-last-window?" t }
+    { deploy-ui? t }
+    { deploy-c-types? f }
+}