diff --git a/extra/backtrack/authors.txt b/extra/backtrack/authors.txt
new file mode 100755
index 0000000000..50c9c38812
--- /dev/null
+++ b/extra/backtrack/authors.txt
@@ -0,0 +1 @@
+William Schlieper
\ No newline at end of file
diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor
new file mode 100755
index 0000000000..7ab11abd6d
--- /dev/null
+++ b/extra/backtrack/backtrack.factor
@@ -0,0 +1,20 @@
+! Copyright (C) 2008 William Schlieper
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: kernel continuations sequences namespaces fry ;
+
+IN: backtrack
+
+SYMBOL: failure
+
+: amb ( seq -- elt )
+    failure get
+    '[ , _ '[ , '[ failure set , , continue-with ] callcc0 ] each
+       , continue ] callcc1 ;
+
+: fail ( -- )
+    f amb drop ;
+
+: require ( ? -- )
+    [ fail ] unless ;
+
diff --git a/extra/backtrack/description.txt b/extra/backtrack/description.txt
new file mode 100755
index 0000000000..d2d3918a98
--- /dev/null
+++ b/extra/backtrack/description.txt
@@ -0,0 +1 @@
+Simple non-determinism
\ No newline at end of file
diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor
index 2a66f3a701..6bb6a6328e 100644
--- a/extra/irc/client/client-docs.factor
+++ b/extra/irc/client/client-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax quotations kernel ;
+USING: help.markup help.syntax quotations kernel irc.messages ;
 IN: irc.client
 
 HELP: irc-client "IRC Client object"
@@ -21,13 +21,25 @@ HELP: connect-irc "Connecting to an irc server"
 { $description "Connects and logins " { $link irc-client } " using the settings specified on its " { $link irc-profile } "." } ;
 
 HELP: add-listener "Listening to irc channels/users/etc"
-{ $values { "irc-client" "an irc client object" } { "irc-listener" "an irc listener object" } }
+{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } }
 { $description "Registers " { $snippet "irc-listener" } " with " { $snippet "irc-client" } " and starts listening." } ;
 
+HELP: remove-listener "Stop an unregister listener"
+{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } }
+{ $description "Unregisters " { $snippet "irc-listener" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ;
+
 HELP: terminate-irc "Terminates an irc client"
 { $values { "irc-client" "an irc client object" } }
 { $description "Terminates all activity by " { $link irc-client } " cleaning up resources and notifying listeners." } ;
 
+HELP: write-message "Sends a message through a listener"
+{ $values { "message" "a string or irc message object" } { "irc-listener" "an irc listener object" } }
+{ $description "Sends " { $snippet "message" } " through " { $snippet "irc-listener" } ". Strings are automatically promoted to privmsg objects." } ;
+
+HELP: read-message "Reads a message from a listener"
+{ $values { "irc-listener" "an irc listener object" } { "message" "an irc message object" } }
+{ $description "Reads " { $snippet "message" } " from " { $snippet "irc-listener" } "." } ;
+
 ARTICLE: "irc.client" "IRC Client"
 "An IRC Client library"
 { $heading "IRC objects:" }
@@ -42,6 +54,9 @@ ARTICLE: "irc.client" "IRC Client"
 { $subsection connect-irc }
 { $subsection terminate-irc }
 { $subsection add-listener }
+{ $subsection remove-listener }
+{ $subsection read-message }
+{ $subsection write-message }
 { $heading "IRC messages" }
 "Some of the RFC defined irc messages as objects:"
 { $table
@@ -78,11 +93,11 @@ ARTICLE: "irc.client" "IRC Client"
   "! Create a channel listener"
   "\"#mychannel123\" <irc-channel-listener> mychannel set"
   "! Register and start listener (this joins the channel)"
-  "bot get mychannel get add-listener"
+  "mychannel get bot get add-listener"
   "! Send a message to the channel"
-  "\"what's up?\" mychannel get out-messages>> mailbox-put"
+  "\"what's up?\" mychannel get write-message"
   "! Read a message from the channel"
-  "mychannel get in-messages>> mailbox-get"
+  "mychannel get read-message"
 }
   ;
 
diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor
index 24a753d615..f7065664dd 100644
--- a/extra/irc/client/client-tests.factor
+++ b/extra/irc/client/client-tests.factor
@@ -14,7 +14,7 @@ IN: irc.client.tests
    swap [ 2nip <test-stream> f ] curry >>connect ;
 
 : set-nick ( irc-client nickname -- )
-     [ nick>> ] dip >>name drop ;
+     swap profile>> (>>nickname) ;
 
 : with-dummy-client ( quot -- )
      rot with-variable ; inline
@@ -42,9 +42,9 @@ privmsg new
   parse-irc-line f >>timestamp ] unit-test
 
 { "" } make-client dup "factorbot" set-nick current-irc-client [
-    { t } [ irc> nick>> name>> me? ] unit-test
+    { t } [ irc> profile>> nickname>> me? ] unit-test
 
-    { "factorbot" } [ irc> nick>> name>> ] unit-test
+    { "factorbot" } [ irc> profile>> nickname>> ] unit-test
 
     { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
 
@@ -63,7 +63,7 @@ privmsg new
                     ":some.where 001 factorbot :Welcome factorbot"
                   } make-client
                   [ connect-irc ] keep 1 seconds sleep
-                    nick>> name>> ] unit-test
+                    profile>> nickname>> ] unit-test
 
 { join_ "#factortest" } [
              { ":factorbot!n=factorbo@some.where JOIN :#factortest"
diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor
index 5b8fbf62ee..472805f5ae 100644
--- a/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@ -1,9 +1,11 @@
 ! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators concurrency.mailboxes fry io strings
-       io.encodings.8-bit io.sockets kernel namespaces sequences
-       splitting threads calendar classes.tuple
-       classes ascii assocs accessors destructors continuations ;
+USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
+       accessors destructors namespaces io assocs arrays qualified fry
+       continuations threads strings classes combinators
+       irc.messages irc.messages.private ;
+RENAME: join sequences => sjoin
+EXCLUDE: sequences => join ;
 IN: irc.client
 
 ! ======================================
@@ -14,18 +16,12 @@ SYMBOL: current-irc-client
 
 : irc-port 6667 ; ! Default irc port
 
-! "setup" objects
 TUPLE: irc-profile server port nickname password ;
 C: <irc-profile> irc-profile
 
-! "live" objects
-TUPLE: nick name channels log ;
-C: <nick> nick
-
-TUPLE: irc-client profile nick stream in-messages out-messages join-messages
+TUPLE: irc-client profile stream in-messages out-messages join-messages
        listeners is-running connect reconnect-time ;
 : <irc-client> ( profile -- irc-client )
-    f V{ } clone V{ } clone <nick>
     f <mailbox> <mailbox> <mailbox> H{ } clone f
     [ <inet> latin1 <client> ] 15 seconds irc-client boa ;
 
@@ -33,6 +29,7 @@ TUPLE: irc-listener in-messages out-messages ;
 TUPLE: irc-server-listener < irc-listener ;
 TUPLE: irc-channel-listener < irc-listener name password timeout ;
 TUPLE: irc-nick-listener < irc-listener name ;
+SYMBOL: +server-listener+
 
 : <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
 
@@ -54,20 +51,6 @@ SINGLETON: irc-disconnected ! sent when connection is lost
 SINGLETON: irc-connected    ! sent when connection is established
 UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
 
-TUPLE: irc-message line prefix command parameters trailing timestamp ;
-TUPLE: logged-in < irc-message name ;
-TUPLE: ping < irc-message ;
-TUPLE: join < irc-message ;
-TUPLE: part < irc-message name channel ;
-TUPLE: quit < irc-message ;
-TUPLE: privmsg < irc-message name ;
-TUPLE: kick < irc-message channel who ;
-TUPLE: roomlist < irc-message channel names ;
-TUPLE: nick-in-use < irc-message asterisk name ;
-TUPLE: notice < irc-message type ;
-TUPLE: mode < irc-message name channel mode ;
-TUPLE: unhandled < irc-message ;
-
 : terminate-irc ( irc-client -- )
     [ in-messages>> irc-end swap mailbox-put ]
     [ f >>is-running drop ]
@@ -88,13 +71,21 @@ TUPLE: unhandled < irc-message ;
 : unregister-listener ( name -- ) irc> listeners>> delete-at ;
 
 : to-listener ( message name -- )
-    listener> [ f listener> ] unless*
+    listener> [ +server-listener+ listener> ] unless*
     [ in-messages>> mailbox-put ] [ drop ] if* ;
 
 ! ======================================
 ! IRC client messages
 ! ======================================
 
+GENERIC: irc-message>string ( irc-message -- string )
+
+M: irc-message irc-message>string ( irc-message -- string )
+    [ command>> ]
+    [ parameters>> " " sjoin ]
+    [ trailing>> dup [ CHAR: : prefix ] when ]
+    tri 3array " " sjoin ;
+
 : /NICK ( nick -- )
     "NICK " irc-write irc-print ;
 
@@ -131,58 +122,12 @@ TUPLE: unhandled < irc-message ;
 : /PONG ( text -- )
     "PONG " irc-write irc-print ;
 
-! ======================================
-! Message parsing
-! ======================================
-
-: split-at-first ( seq separators -- before after )
-    dupd '[ , member? ] find
-        [ cut 1 tail ]
-        [ swap ]
-    if ;
-
-: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ;
-
-: parse-name ( string -- string )
-    remove-heading-: "!" split-at-first drop ;
-
-: split-prefix ( string -- string/f string )
-    dup ":" head?
-        [ remove-heading-: " " split1 ]
-        [ f swap ]
-    if ;
-
-: split-trailing ( string -- string string/f )
-    ":" split1 ;
-
-: string>irc-message ( string -- object )
-    dup split-prefix split-trailing
-    [ [ blank? ] trim " " split unclip swap ] dip
-    now irc-message boa ;
-
-: parse-irc-line ( string -- message )
-    string>irc-message
-    dup command>> {
-        { "PING" [ \ ping ] }
-        { "NOTICE" [ \ notice ] }
-        { "001" [ \ logged-in ] }
-        { "433" [ \ nick-in-use ] }
-        { "JOIN" [ \ join ] }
-        { "PART" [ \ part ] }
-        { "PRIVMSG" [ \ privmsg ] }
-        { "QUIT" [ \ quit ] }
-        { "MODE" [ \ mode ] }
-        { "KICK" [ \ kick ] }
-        [ drop \ unhandled ]
-    } case
-    [ [ tuple-slots ] [ parameters>> ] bi append ] dip prefix >tuple ;
-
 ! ======================================
 ! Server message handling
 ! ======================================
 
 : me? ( string -- ? )
-    irc> nick>> name>> = ;
+    irc> profile>> nickname>> = ;
 
 : irc-message-origin ( irc-message -- name )
     dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
@@ -193,10 +138,10 @@ TUPLE: unhandled < irc-message ;
 GENERIC: handle-incoming-irc ( irc-message -- )
 
 M: irc-message handle-incoming-irc ( irc-message -- )
-    f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
+    +server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
 
 M: logged-in handle-incoming-irc ( logged-in -- )
-    name>> irc> nick>> (>>name) ;
+    name>> irc> profile>> (>>nickname) ;
 
 M: ping handle-incoming-irc ( ping -- )
     trailing>> /PONG ;
@@ -208,8 +153,13 @@ M: privmsg handle-incoming-irc ( privmsg -- )
     dup irc-message-origin to-listener ;
 
 M: join handle-incoming-irc ( join -- )
-    dup trailing>> listener>
-    [ irc> join-messages>> ] unless* mailbox-put ;
+    [ [ prefix>> parse-name me? ] keep and
+      [ irc> join-messages>> mailbox-put ] when* ]
+    [ dup trailing>> to-listener ]
+    bi ;
+
+M: part handle-incoming-irc ( part -- )
+    dup channel>> to-listener ;
 
 M: kick handle-incoming-irc ( kick -- )
     [ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
@@ -224,8 +174,14 @@ M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
 
 GENERIC: handle-outgoing-irc ( obj -- )
 
+! M: irc-message handle-outgoing-irc ( irc-message -- )
+!    irc-message>string irc-print ;
+
 M: privmsg handle-outgoing-irc ( privmsg -- )
-   [ name>> ] [ trailing>> ] bi /PRIVMSG ;
+    [ name>> ] [ trailing>> ] bi /PRIVMSG ;
+
+M: part handle-outgoing-irc ( privmsg -- )
+    [ channel>> ] [ trailing>> "" or ] bi /PART ;
 
 ! ======================================
 ! Reader/Writer
@@ -306,6 +262,7 @@ DEFER: (connect-irc)
     2bi ;
 
 GENERIC: (add-listener) ( irc-listener -- )
+
 M: irc-channel-listener (add-listener) ( irc-channel-listener -- )
     [ [ name>> ] [ password>> ] bi /JOIN ]
     [ [ [ drop irc> join-messages>> ]
@@ -318,7 +275,20 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- )
     [ name>> ] keep set+run-listener ;
 
 M: irc-server-listener (add-listener) ( irc-server-listener -- )
-    f swap set+run-listener ;
+    +server-listener+ swap set+run-listener ;
+
+GENERIC: (remove-listener) ( irc-listener -- )
+
+M: irc-nick-listener (remove-listener) ( irc-nick-listener -- )
+    name>> unregister-listener ;
+
+M: irc-channel-listener (remove-listener) ( irc-channel-listener -- )
+    [ [ out-messages>> ] [ name>> ] bi
+      \ part new swap >>channel mailbox-put ] keep
+    name>> unregister-listener ;
+
+M: irc-server-listener (remove-listener) ( irc-server-listener -- )
+   drop +server-listener+ unregister-listener ;
 
 : (connect-irc) ( irc-client -- )
     [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep
@@ -326,13 +296,22 @@ M: irc-server-listener (add-listener) ( irc-server-listener -- )
         t >>is-running
     in-messages>> irc-connected swap mailbox-put ;
 
+: with-irc-client ( irc-client quot -- )
+    >r current-irc-client r> with-variable ; inline
+
 PRIVATE>
 
 : connect-irc ( irc-client -- )
-    dup current-irc-client [
+    dup [
         [ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi
         spawn-irc
-    ] with-variable ;
+    ] with-irc-client ;
 
 : add-listener ( irc-listener irc-client -- )
-    current-irc-client rot '[ , (add-listener) ] with-variable ;
+    swap '[ , (add-listener) ] with-irc-client ;
+
+: remove-listener ( irc-listener irc-client -- )
+    swap '[ , (remove-listener) ] with-irc-client ;
+
+: write-message ( message irc-listener -- ) out-messages>> mailbox-put ;
+: read-message ( irc-listener -- message ) in-messages>> mailbox-get ;
diff --git a/extra/irc/messages/authors.txt b/extra/irc/messages/authors.txt
new file mode 100644
index 0000000000..f4a8cb1dc2
--- /dev/null
+++ b/extra/irc/messages/authors.txt
@@ -0,0 +1 @@
+Bruno Deferrari
diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor
new file mode 100644
index 0000000000..f1beba9b26
--- /dev/null
+++ b/extra/irc/messages/messages.factor
@@ -0,0 +1,69 @@
+! Copyright (C) 2008 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel fry sequences splitting ascii calendar accessors combinators
+       classes.tuple math.order ;
+IN: irc.messages
+
+TUPLE: irc-message line prefix command parameters trailing timestamp ;
+TUPLE: logged-in < irc-message name ;
+TUPLE: ping < irc-message ;
+TUPLE: join < irc-message channel ;
+TUPLE: part < irc-message channel ;
+TUPLE: quit < irc-message ;
+TUPLE: privmsg < irc-message name ;
+TUPLE: kick < irc-message channel who ;
+TUPLE: roomlist < irc-message channel names ;
+TUPLE: nick-in-use < irc-message asterisk name ;
+TUPLE: notice < irc-message type ;
+TUPLE: mode < irc-message name channel mode ;
+TUPLE: unhandled < irc-message ;
+
+<PRIVATE
+! ======================================
+! Message parsing
+! ======================================
+
+: split-at-first ( seq separators -- before after )
+    dupd '[ , member? ] find
+        [ cut 1 tail ]
+        [ swap ]
+    if ;
+
+: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ;
+
+: parse-name ( string -- string )
+    remove-heading-: "!" split-at-first drop ;
+
+: split-prefix ( string -- string/f string )
+    dup ":" head?
+        [ remove-heading-: " " split1 ]
+        [ f swap ]
+    if ;
+
+: split-trailing ( string -- string string/f )
+    ":" split1 ;
+
+: string>irc-message ( string -- object )
+    dup split-prefix split-trailing
+    [ [ blank? ] trim " " split unclip swap ] dip
+    now irc-message boa ;
+
+: parse-irc-line ( string -- message )
+    string>irc-message
+    dup command>> {
+        { "PING" [ \ ping ] }
+        { "NOTICE" [ \ notice ] }
+        { "001" [ \ logged-in ] }
+        { "433" [ \ nick-in-use ] }
+        { "JOIN" [ \ join ] }
+        { "PART" [ \ part ] }
+        { "PRIVMSG" [ \ privmsg ] }
+        { "QUIT" [ \ quit ] }
+        { "MODE" [ \ mode ] }
+        { "KICK" [ \ kick ] }
+        [ drop \ unhandled ]
+    } case
+    [ [ tuple-slots ] [ parameters>> ] bi append ] dip
+    [ all-slots over [ length ] bi@ min head ] keep slots>tuple ;
+
+PRIVATE>
diff --git a/extra/irc/ui/authors.txt b/extra/irc/ui/authors.txt
new file mode 100755
index 0000000000..50c9c38812
--- /dev/null
+++ b/extra/irc/ui/authors.txt
@@ -0,0 +1 @@
+William Schlieper
\ No newline at end of file
diff --git a/extra/irc/ui/summary.txt b/extra/irc/ui/summary.txt
new file mode 100755
index 0000000000..284672b951
--- /dev/null
+++ b/extra/irc/ui/summary.txt
@@ -0,0 +1 @@
+A simple IRC client
\ No newline at end of file
diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
new file mode 100755
index 0000000000..ef2bfd3d55
--- /dev/null
+++ b/extra/irc/ui/ui.factor
@@ -0,0 +1,130 @@
+! Copyright (C) 2008 William Schlieper
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors kernel threads combinators concurrency.mailboxes
+       sequences strings hashtables splitting fry assocs hashtables
+       ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers
+       ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs
+       io io.styles namespaces irc.client irc.messages ;
+
+IN: irc.ui
+
+SYMBOL: client
+
+TUPLE: ui-window client tabs ;
+
+: write-color ( str color -- )
+    foreground associate format ;
+: red { 0.5 0 0 1 } ;
+: green { 0 0.5 0 1 } ;
+: blue { 0 0 1 1 } ;
+
+: prefix>nick ( prefix -- nick )
+    "!" split first ;
+
+GENERIC: write-irc ( irc-message -- )
+
+M: privmsg write-irc
+    "<" blue write-color
+    [ prefix>> prefix>nick write ] keep
+    ">" blue write-color
+    " " write
+    trailing>> write ;
+
+M: join write-irc
+    "* " green write-color
+    prefix>> prefix>nick write
+    " has entered the channel." green write-color ;
+
+M: part write-irc
+    "* " red write-color
+    [ prefix>> prefix>nick write ] keep
+    " has left the channel(" red write-color
+    trailing>> write
+    ")" red write-color ;
+
+M: quit write-irc
+    "* " red write-color
+    [ prefix>> prefix>nick write ] keep
+    " has left IRC(" red write-color
+    trailing>> write
+    ")" red write-color ;
+
+M: irc-end write-irc
+    drop "* You have left IRC" red write-color ;
+
+M: irc-disconnected write-irc
+    drop "* Disconnected" red write-color ;
+
+M: irc-connected write-irc
+    drop "* Connected" green write-color ;
+
+M: irc-message write-irc
+    drop ; ! catch all unimplemented writes, THIS WILL CHANGE    
+
+: print-irc ( irc-message -- )
+    write-irc nl ;
+
+: send-message ( message listener client -- )
+    "<" blue write-color
+    profile>> nickname>> bold font-style associate format
+    ">" blue write-color
+    " " write
+    over write nl
+    out-messages>> mailbox-put ;
+
+: display ( stream listener -- )
+    '[ , [ [ t ]
+           [ , read-message print-irc ]
+           [  ] while ] with-output-stream ] "ircv" spawn drop ;
+
+: <irc-pane> ( listener -- pane )
+    <scrolling-pane>
+    [ <pane-stream> swap display ] keep ;
+
+TUPLE: irc-editor outstream listener client ;
+
+: <irc-editor> ( pane listener client -- editor )
+    [ <editor> irc-editor construct-editor
+    swap >>listener swap <pane-stream> >>outstream
+    ] dip client>> >>client ;
+
+: editor-send ( irc-editor -- )
+    { [ outstream>> ]
+      [ editor-string ]
+      [ listener>> ]
+      [ client>> ]
+      [ "" swap set-editor-string ] } cleave
+    '[ , , , send-message ] with-output-stream ;
+
+irc-editor "general" f {
+    { T{ key-down f f "RET" } editor-send }
+    { T{ key-down f f "ENTER" } editor-send }
+} define-command-map
+
+: irc-page ( name pane editor tabbed -- )
+    [ [ <scroller> @bottom frame, ! editor
+        <scroller> @center frame, ! pane
+      ] make-frame swap ] dip add-page ;
+
+: join-channel ( name ui-window -- )
+    [ dup <irc-channel-listener> ] dip
+    [ client>> add-listener ]
+    [ drop <irc-pane> dup ]
+    [ [ <irc-editor> ] keep ] 2tri
+    tabs>> irc-page ;
+
+: irc-window ( ui-window -- )
+    [ tabs>> ]
+    [ client>> profile>> server>> ] bi
+    open-window ;
+
+: ui-connect ( profile -- ui-window )
+    <irc-client> ui-window new over >>client swap
+    [ connect-irc ]
+    [ listeners>> +server-listener+ swap at <irc-pane> <scroller>
+      "Server" associate <tabbed> >>tabs ] bi ;
+
+: freenode-connect ( -- ui-window )
+    "irc.freenode.org" 8001 "factor-irc" f
+    <irc-profile> ui-connect [ irc-window ] keep ;
diff --git a/extra/ui/gadgets/tabs/authors.txt b/extra/ui/gadgets/tabs/authors.txt
new file mode 100755
index 0000000000..50c9c38812
--- /dev/null
+++ b/extra/ui/gadgets/tabs/authors.txt
@@ -0,0 +1 @@
+William Schlieper
\ No newline at end of file
diff --git a/extra/ui/gadgets/tabs/summary.txt b/extra/ui/gadgets/tabs/summary.txt
new file mode 100755
index 0000000000..a55610bcc0
--- /dev/null
+++ b/extra/ui/gadgets/tabs/summary.txt
@@ -0,0 +1 @@
+Tabbed windows
\ No newline at end of file
diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
new file mode 100755
index 0000000000..113ea84443
--- /dev/null
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -0,0 +1,51 @@
+! Copyright (C) 2008 William Schlieper
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
+       hashtables models models.range models.compose combinators
+       ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
+       ui.gadgets.incremental ui.gadgets.viewports ui.gadgets.books ;
+
+IN: ui.gadgets.tabs
+
+TUPLE: tabbed names model toggler content ;
+
+DEFER: (del-page)
+
+: add-toggle ( model n name toggler -- )
+    [ [ gadget-parent '[ , , , (del-page) ] "X" swap
+       <bevel-button> @right frame, ] 3keep 
+      [ swapd <toggle-button> @center frame, ] dip ] make-frame
+    swap add-gadget ;
+
+: redo-toggler ( tabbed -- )
+     [ names>> ] [ model>> ] [ toggler>> ] tri
+     [ clear-gadget ] keep
+     [ [ length ] keep ] 2dip
+    '[ , _ _ , add-toggle ] 2each ;
+
+: (del-page) ( n name tabbed -- )
+    { [ [ remove ] change-names redo-toggler ]
+      [ [ names>> length ] [ model>> ] bi
+        [ [ = ] keep swap [ 1- ] when
+          [ > ] keep swap [ 1- ] when dup ] change-model ]
+      [ content>> nth-gadget unparent ]
+      [ model>> [ ] change-model ] ! refresh
+    } cleave ;
+
+: add-page ( page name tabbed -- )
+    [ names>> push ] 2keep
+    [ [ model>> swap ]
+      [ names>> length 1 - swap ]
+      [ toggler>> ] tri add-toggle ]
+    [ content>> add-gadget ] bi ;
+
+: del-page ( name tabbed -- )
+    [ names>> index ] 2keep (del-page) ;
+
+: <tabbed> ( assoc -- tabbed )
+    tabbed new
+    [ <pile> 1 >>fill g-> (>>toggler) @left frame,
+      [ keys >vector g (>>names) ]
+      [ values 0 <model> [ <book> g-> (>>content) @center frame, ] keep ] bi
+      g swap >>model redo-toggler ] build-frame ;