diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor
index 681cd94a38..08836cf497 100644
--- a/basis/io/files/unique/unique-docs.factor
+++ b/basis/io/files/unique/unique-docs.factor
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io io.ports kernel math
-io.pathnames io.directories math.parser io.files ;
+io.pathnames io.directories math.parser io.files strings ;
 IN: io.files.unique
 
 HELP: temporary-path
@@ -30,7 +30,7 @@ HELP: make-unique-file ( prefix suffix -- path )
 
 HELP: make-unique-file*
 { $values
-     { "prefix" null } { "suffix" null }
+     { "prefix" string } { "suffix" string }
      { "path" "a pathname string" }
 }
 { $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ;
@@ -55,11 +55,11 @@ HELP: with-unique-directory ( quot -- )
 
 ARTICLE: "io.files.unique" "Temporary files"
 "The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
-"Files:"
+"Creating temporary files:"
 { $subsection make-unique-file }
 { $subsection make-unique-file* }
 { $subsection with-unique-file }
-"Directories:"
+"Creating temporary directories:"
 { $subsection make-unique-directory }
 { $subsection with-unique-directory } ;
 
diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor
index 5bc7ce1db6..0dbf94b1c6 100644
--- a/extra/L-system/L-system.factor
+++ b/extra/L-system/L-system.factor
@@ -207,7 +207,8 @@ DEFER: default-L-parser-values
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : save-turtle    ( turtle -- turtle ) dup clone over saved>> push ;
-: restore-turtle ( turtle -- turtle )                saved>> pop  ;
+
+: restore-turtle ( turtle -- turtle ) saved>> pop dup color>> set-color ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
diff --git a/extra/L-system/models/tree-5/tree-5.factor b/extra/L-system/models/tree-5/tree-5.factor
new file mode 100644
index 0000000000..2647698351
--- /dev/null
+++ b/extra/L-system/models/tree-5/tree-5.factor
@@ -0,0 +1,37 @@
+
+USING: accessors ui L-system ;
+
+IN: L-system.models.tree-5
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: tree-5 ( <L-system> -- <L-system> )
+
+  L-parser-dialect >>commands
+
+  [ 5 >>angle ] >>turtle-values
+
+  "c(4)FFS" >>axiom
+
+  {
+    { "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" }
+    { "R" "[Ba]" }
+    { "a" "$tF[Cx]Fb" }
+    { "b" "$tF[Dy]Fa" }
+    { "B" "&B" }
+    { "C" "+C" }
+    { "D" "-D" }
+
+    { "x" "a" }
+    { "y" "b" }
+
+    { "F" "'(1.25)F'(.8)" }
+  }
+    >>rules ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: main ( -- ) [ L-system tree-5 "L-system" open-window ] with-ui ;
+
+MAIN: main
+  
\ No newline at end of file
diff --git a/extra/curses/authors.txt b/extra/curses/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/extra/curses/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/curses/curses-tests.factor b/extra/curses/curses-tests.factor
new file mode 100644
index 0000000000..21463b207b
--- /dev/null
+++ b/extra/curses/curses-tests.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors curses kernel threads tools.test ;
+IN: curses.tests
+
+: hello-curses ( -- )
+    [
+        curses-window new
+            "mainwin" >>name
+        add-curses-window
+
+        "mainwin" "hi" curses-printf
+
+        2000000 sleep
+    ] with-curses ;
+
+[
+] [ hello-curses ] unit-test
diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor
new file mode 100644
index 0000000000..f11b26333b
--- /dev/null
+++ b/extra/curses/curses.factor
@@ -0,0 +1,155 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.strings assocs byte-arrays
+combinators continuations destructors fry io.encodings.8-bit
+io io.encodings.string io.encodings.utf8 kernel math
+namespaces prettyprint sequences
+strings threads curses.ffi ;
+IN: curses
+
+SYMBOL: curses-windows
+SYMBOL: current-window
+
+: ERR -1 ; inline
+: FALSE 0 ; inline
+: TRUE 1 ; inline
+: >BOOLEAN ( n -- TRUE/FALSE ) >boolean TRUE FALSE ? ; inline
+
+ERROR: duplicate-window window ;
+ERROR: unnamed-window window ;
+ERROR: window-not-found window ;
+ERROR: curses-failed ;
+
+: get-window ( string -- window )
+    dup curses-windows get at*
+    [ nip ] [ drop window-not-found ] if ;
+
+: window-ptr ( string -- window ) get-window ptr>> ;
+
+: curses-error ( n -- ) ERR = [ curses-failed ] when ;
+
+: with-curses ( quot -- )
+    H{ } clone curses-windows [
+        initscr curses-error
+        [
+            curses-windows get values [ dispose ] each
+            nocbreak curses-error
+            echo curses-error
+            endwin curses-error
+        ] [ ] cleanup
+    ] with-variable ; inline
+
+: with-window ( name quot -- )
+    [ window-ptr current-window ] dip with-variable ; inline
+
+TUPLE: curses-window
+    name
+    parent-name
+    ptr
+    { lines integer initial: 0 }
+    { columns integer initial: 0 }
+    { y integer initial: 0 }
+    { x integer initial: 0 }
+
+    { cbreak initial: t }
+    { echo initial: t }
+    { raw initial: f }
+
+    { scrollok initial: t }
+    { leaveok initial: f }
+
+    idcok idlok immedok
+    { keypad initial: f } ;
+
+M: curses-window dispose ( window -- )
+    ptr>> delwin curses-error ;
+
+<PRIVATE
+
+: add-window ( window -- )
+    dup name>> [ unnamed-window ] unless*
+    curses-windows get 2dup key?
+    [ duplicate-window ] [ set-at ] if ;
+
+: delete-window ( window -- )
+    curses-windows get 2dup key?
+    [ delete-at ] [ drop window-not-found ] if ;
+
+: window-params ( window -- lines columns y x )
+    { [ lines>> ] [ columns>> ] [ y>> ] [ x>> ] } cleave ;
+
+: setup-window ( window -- )
+    {
+        [
+            dup
+            dup parent-name>> [
+                window-ptr swap window-params derwin
+            ] [
+                window-params newwin
+            ] if* [ curses-error ] keep >>ptr drop
+        ]
+        [ cbreak>> [ cbreak ] [ nocbreak ] if curses-error ]
+        [ echo>> [ echo ] [ noecho ] if curses-error ]
+        [ raw>> [ raw ] [ noraw ] if curses-error ]
+        [ [ ptr>> ] [ scrollok>> >BOOLEAN ] bi scrollok curses-error ]
+        [ [ ptr>> ] [ leaveok>> >BOOLEAN ] bi leaveok curses-error ]
+        [ [ ptr>> ] [ keypad>> >BOOLEAN ] bi keypad curses-error ]
+        [ add-window ]
+    } cleave ;
+
+PRIVATE>
+
+: add-curses-window ( window -- )
+    [ setup-window ] [ ] [ dispose ] cleanup ;
+
+: (curses-window-refresh) ( window-ptr -- ) wrefresh curses-error ;
+: wnrefresh ( window -- ) window-ptr (curses-window-refresh) ;
+: curses-refresh ( -- ) current-window get (curses-window-refresh) ;
+
+: (curses-wprint) ( window-ptr string -- )
+    waddstr curses-error ;
+
+: curses-nwrite ( window string -- )
+    [ window-ptr ] dip (curses-wprint) ;
+
+: curses-wprint ( window string -- )
+    [ window-ptr dup ] dip (curses-wprint) "\n" (curses-wprint) ;
+
+: curses-printf ( window string -- )
+    [ window-ptr dup dup ] dip (curses-wprint)
+    "\n" (curses-wprint)
+    (curses-window-refresh) ;
+
+: curses-writef ( window string -- )
+    [ window-ptr dup ] dip (curses-wprint) (curses-window-refresh) ;
+
+: (curses-read) ( window-ptr n encoding -- string )
+    [ [ <byte-array> tuck ] keep wgetnstr curses-error ] dip alien>string ;
+
+: curses-read ( window n -- string )
+    utf8 [ window-ptr ] 2dip (curses-read) ;
+
+: curses-erase ( window -- ) window-ptr werase curses-error ;
+
+: move-cursor ( window-name y x -- )
+    [
+        window-ptr
+        {
+            [ ]
+            [ (curses-window-refresh) ]
+            [ c-window-_curx ]
+            [ c-window-_cury ]
+        } cleave
+    ] 2dip mvcur curses-error (curses-window-refresh) ;
+
+: delete-line ( window-name y -- )
+    [ window-ptr dup ] dip
+    0 wmove curses-error wdeleteln curses-error ;
+
+: insert-blank-line ( window-name y -- )
+    [ window-ptr dup ] dip
+    0 wmove curses-error winsertln curses-error ;
+
+: insert-line ( window-name y string -- )
+    [ dupd insert-blank-line ] dip
+    curses-writef ;
diff --git a/extra/curses/ffi/ffi.factor b/extra/curses/ffi/ffi.factor
new file mode 100644
index 0000000000..8d4a7ddb4b
--- /dev/null
+++ b/extra/curses/ffi/ffi.factor
@@ -0,0 +1,231 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.syntax combinators kernel system ;
+IN: curses.ffi
+
+<< "curses" {
+    { [ os winnt? ]  [ "libcurses.dll" ] }
+    { [ os macosx? ] [ "libcurses.dylib" ] }
+    { [ os unix?  ]  [ "libcurses.so" ] }
+} cond "cdecl" add-library >>
+
+TYPEDEF: void* WINDOW*
+TYPEDEF: void* SCREEN*
+TYPEDEF: void* va_list
+
+TYPEDEF: uint chtype
+TYPEDEF: chtype attr_t
+TYPEDEF: short NCURSES_SIZE_T
+TYPEDEF: ushort wchar_t
+
+: CCHARW_MAX  5 ; inline
+
+C-STRUCT: cchar_t
+    { "attr_t" "attr" }
+    { { "wchar_t" CCHARW_MAX } "chars" } ;
+
+C-STRUCT: pdat
+    { "NCURSES_SIZE_T" "_pad_y" }
+    { "NCURSES_SIZE_T" "_pad_x" }
+    { "NCURSES_SIZE_T" "_pad_top" }
+    { "NCURSES_SIZE_T" "_pad_left" }
+    { "NCURSES_SIZE_T" "_pad_bottom" }
+    { "NCURSES_SIZE_T" "_pad_right" } ;
+
+C-STRUCT: c-window
+    { "NCURSES_SIZE_T" "_cury" }
+    { "NCURSES_SIZE_T" "_curx" }
+
+    { "NCURSES_SIZE_T" "_maxy" }
+    { "NCURSES_SIZE_T" "_maxx" }
+    { "NCURSES_SIZE_T" "_begy" }
+    { "NCURSES_SIZE_T" "_begx" }
+
+    { "short"  " _flags" }
+
+    { "attr_t"  "_attrs" }
+    { "chtype"  "_bkgd" }
+
+    { "bool"    "_notimeout" }
+    { "bool"    "_clear" }
+    { "bool"    "_leaveok" }
+    { "bool"    "_scroll" }
+    { "bool"    "_idlok" }
+    { "bool"    "_idcok" }
+    { "bool"    "_immed" }
+    { "bool"    "_sync" }
+    { "bool"    "_use_keypad" }
+    { "int"     "_delay" }
+
+    { "char*" "_line" }
+    { "NCURSES_SIZE_T" "_regtop" }
+    { "NCURSES_SIZE_T" "_regbottom" }
+
+    { "int" "_parx" }
+    { "int" "_pary" }
+    { "WINDOW*" "_parent" }
+
+    { "pdat" "_pad" }
+
+    { "NCURSES_SIZE_T" "_yoffset" }
+
+    { "cchar_t"  "_bkgrnd" } ;
+
+LIBRARY: curses
+
+: stdscr ( -- alien )
+    "stdscr" "curses" library dll>> dlsym ;
+
+FUNCTION: WINDOW* initscr ( ) ;
+FUNCTION: int endwin ( ) ;
+FUNCTION: bool isendwin ( ) ;
+FUNCTION: SCREEN* newterm ( char* type, FILE* outfd, FILE* infd ) ;
+FUNCTION: SCREEN* set_term ( SCREEN* new ) ;
+FUNCTION: void delscreen ( SCREEN* sp ) ;
+
+FUNCTION: int def_prog_mode ( ) ;
+FUNCTION: int def_shell_mode ( ) ;
+FUNCTION: int reset_prog_mode ( ) ;
+FUNCTION: int reset_shell_mode ( ) ;
+FUNCTION: int resetty ( ) ;
+FUNCTION: int savetty ( ) ;
+FUNCTION: int ripoffline ( int line, void* callback ) ;
+FUNCTION: int curs_set ( int visibility ) ;
+FUNCTION: int napms ( int ms ) ;
+
+FUNCTION: WINDOW* newwin ( int nlines, int ncols, int begin_y, int begin_x ) ;
+FUNCTION: int delwin ( WINDOW* win ) ;
+FUNCTION: int mvwin ( WINDOW* win, int y, int x ) ;
+FUNCTION: WINDOW* subwin ( WINDOW* orig, int nlines, int ncols, int begin_y, int begin_x ) ;
+FUNCTION: WINDOW* derwin ( WINDOW* orig, int nlines, int ncols, int begin_y, int begin_x ) ;
+FUNCTION: int mvderwin ( WINDOW* win, int par_y, int par_x ) ;
+FUNCTION: WINDOW* dupwin ( WINDOW* win ) ;
+FUNCTION: void wsyncup ( WINDOW* win ) ;
+FUNCTION: int syncok ( WINDOW* win, bool bf ) ;
+FUNCTION: void wcursyncup ( WINDOW* win ) ;
+FUNCTION: void wsyncdown ( WINDOW* win ) ;
+
+FUNCTION: int cbreak ( ) ;
+FUNCTION: int nocbreak ( ) ;
+FUNCTION: int echo ( ) ;
+FUNCTION: int noecho ( ) ;
+FUNCTION: int halfdelay ( int tenths ) ;
+FUNCTION: int intrflush ( WINDOW* win, bool bf ) ;
+FUNCTION: int keypad ( WINDOW* win, bool bf ) ;
+FUNCTION: int meta ( WINDOW* win, bool bf ) ;
+FUNCTION: int nodelay ( WINDOW* win, bool bf ) ;
+FUNCTION: int raw ( ) ;
+FUNCTION: int noraw ( ) ;
+FUNCTION: void noqiflush ( ) ;
+FUNCTION: void qiflush ( ) ;
+FUNCTION: int notimeout ( WINDOW* win, bool bf ) ;
+FUNCTION: void timeout ( int delay ) ;
+FUNCTION: void wtimeout ( WINDOW* win, int delay ) ;
+FUNCTION: int typeahead ( int fd ) ;
+
+FUNCTION: int clearok ( WINDOW* win, bool bf ) ;
+FUNCTION: int idlok ( WINDOW* win, bool bf ) ;
+FUNCTION: void idcok ( WINDOW* win, bool bf ) ;
+FUNCTION: void immedok ( WINDOW* win, bool bf ) ;
+FUNCTION: int leaveok ( WINDOW* win, bool bf ) ;
+FUNCTION: int setscrreg ( int top, int bot ) ;
+FUNCTION: int wsetscrreg ( WINDOW* win, int top, int bot ) ;
+FUNCTION: int scrollok ( WINDOW* win, bool bf ) ;
+FUNCTION: int nl ( ) ;
+FUNCTION: int nonl ( ) ;
+
+FUNCTION: int erase (  ) ;
+FUNCTION: int werase ( WINDOW* win ) ;
+FUNCTION: int clear (  ) ;
+FUNCTION: int wclear ( WINDOW* win ) ;
+FUNCTION: int clrtobot (  ) ;
+FUNCTION: int wclrtobot ( WINDOW* win ) ;
+FUNCTION: int clrtoeol (  ) ;
+FUNCTION: int wclrtoeol ( WINDOW* win ) ;
+
+FUNCTION: int refresh ( ) ;
+FUNCTION: int wrefresh ( WINDOW* win ) ;
+FUNCTION: int wnoutrefresh ( WINDOW* win ) ;
+FUNCTION: int doupdate ( ) ;
+FUNCTION: int redrawwin ( WINDOW* win ) ;
+FUNCTION: int wredrawln ( WINDOW* win, int beg_line, int num_lines ) ;
+
+FUNCTION: int getch ( ) ;
+FUNCTION: int wgetch ( WINDOW* win ) ;
+FUNCTION: int mvgetch ( int y, int x ) ;
+FUNCTION: int mvwgetch ( WINDOW* win, int y, int x ) ;
+FUNCTION: int ungetch ( int ch ) ;
+FUNCTION: int has_key ( int ch ) ;
+
+FUNCTION: int getstr ( char* str ) ;
+FUNCTION: int getnstr ( char* str, int n ) ;
+FUNCTION: int wgetstr ( WINDOW* win, char* str ) ;
+FUNCTION: int wgetnstr ( WINDOW* win, char* str, int n ) ;
+FUNCTION: int mvgetstr ( int y, int x, char* str ) ;
+FUNCTION: int mvwgetstr ( WINDOW* win, int y, int x, char* str ) ;
+FUNCTION: int mvgetnstr ( int y, int x, char* str, int n ) ;
+FUNCTION: int mvwgetnstr ( WINDOW* win, int y, int x, char* str, int n ) ;
+
+FUNCTION: int printw ( char* fmt, int lol ) ;
+FUNCTION: int wprintw ( WINDOW* win, char* fmt, int lol ) ;
+FUNCTION: int mvprintw ( int y, int x, char* fmt, int lol ) ;
+FUNCTION: int mvwprintw ( WINDOW* win, int y, int x, char* fmt, int lol ) ;
+FUNCTION: int vwprintw ( WINDOW* win, char* fmt, va_list varglist ) ;
+FUNCTION: int vw_printw ( WINDOW* win, char* fmt, va_list varglist ) ;
+
+FUNCTION: int move ( int y, int x ) ;
+FUNCTION: int wmove ( WINDOW* win, int y, int x ) ;
+
+
+FUNCTION: int scroll ( WINDOW* win ) ;
+FUNCTION: int scrl ( int n ) ;
+FUNCTION: int wscrl ( WINDOW* win, int n ) ;
+
+       ! int setupterm(char *term, int fildes, int *errret);
+       ! int setterm(char *term);
+       ! TERMINAL *set_curterm(TERMINAL *nterm);
+       ! int del_curterm(TERMINAL *oterm);
+       ! int restartterm(const char *term, int fildes, int *errret);
+       ! char *tparm(char *str, ...);
+       ! int tputs(const char *str, int affcnt, int (*putc)(int));
+       ! int putp(const char *str);
+       ! int vidputs(chtype attrs, int (*putc)(int));
+       ! int vidattr(chtype attrs);
+       ! int vid_puts(attr_t attrs, short pair, void *opts, int (*putc)(char));
+       ! int vid_attr(attr_t attrs, short pair, void *opts);
+FUNCTION: int mvcur ( int oldrow, int oldcol, int newrow, int newcol ) ;
+       ! int tigetflag(char *capname);
+       ! int tigetnum(char *capname);
+       ! char *tigetstr(char *capname);
+
+FUNCTION: int touchwin ( WINDOW* win ) ;
+FUNCTION: int touchline ( WINDOW* win, int start, int count ) ;
+FUNCTION: int untouchwin ( WINDOW* win ) ;
+FUNCTION: int wtouchln ( WINDOW* win, int y, int n, int changed ) ;
+FUNCTION: bool is_linetouched ( WINDOW* win, int line ) ;
+FUNCTION: bool is_wintouched ( WINDOW* win ) ;
+
+FUNCTION: int insch ( chtype ch ) ;
+FUNCTION: int winsch ( WINDOW* win, chtype ch ) ;
+FUNCTION: int mvinsch ( int y, int x, chtype ch ) ;
+FUNCTION: int mvwinsch ( WINDOW* win, int y, int x, chtype ch ) ;
+FUNCTION: int delch ( ) ;
+FUNCTION: int wdelch ( WINDOW* win ) ;
+FUNCTION: int mvdelch ( int y, int x ) ;
+FUNCTION: int mvwdelch ( WINDOW* win, int y, int x ) ;
+
+FUNCTION: int deleteln ( ) ;
+FUNCTION: int wdeleteln ( WINDOW* win ) ;
+FUNCTION: int insdelln ( int n ) ;
+FUNCTION: int winsdelln ( WINDOW* win, int n ) ;
+FUNCTION: int insertln ( ) ;
+FUNCTION: int winsertln ( WINDOW* win ) ;
+
+FUNCTION: int addstr ( char* str ) ;
+FUNCTION: int addnstr ( char* str, int n ) ;
+FUNCTION: int waddstr ( WINDOW* win, char* str ) ;
+FUNCTION: int waddnstr ( WINDOW* win, char* str, int n ) ;
+FUNCTION: int mvaddstr ( int y, int x, char* str ) ;
+FUNCTION: int mvaddnstr ( int y, int x, char* str, int n ) ;
+FUNCTION: int mvwaddstr ( WINDOW* win, int y, int x, char* str ) ;
+FUNCTION: int mvwaddnstr ( WINDOW* win, int y, int x, char* str, int n ) ;
diff --git a/extra/curses/ffi/tags.txt b/extra/curses/ffi/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/extra/curses/ffi/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/extra/curses/summary.txt b/extra/curses/summary.txt
new file mode 100644
index 0000000000..0eb839c524
--- /dev/null
+++ b/extra/curses/summary.txt
@@ -0,0 +1 @@
+ncurses binding
diff --git a/extra/curses/tags.txt b/extra/curses/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/extra/curses/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/extra/git-tool/git-tool.factor b/extra/git-tool/git-tool.factor
new file mode 100644
index 0000000000..1b079ed0ac
--- /dev/null
+++ b/extra/git-tool/git-tool.factor
@@ -0,0 +1,446 @@
+
+USING: accessors combinators.cleave combinators.short-circuit
+concurrency.combinators destructors fry io io.directories
+io.encodings io.encodings.utf8 io.launcher io.pathnames
+io.pipes io.ports kernel locals math namespaces sequences
+splitting strings ui ui.gadgets ui.gadgets.buttons
+ui.gadgets.editors ui.gadgets.labels ui.gadgets.packs
+ui.gadgets.tracks ;
+
+IN: git-status
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: head** ( seq obj -- seq/f ) dup number? [ head ] [ dupd find drop head ] if ;
+
+: tail** ( seq obj -- seq/f )
+  dup number?
+    [ tail ]
+    [ dupd find drop [ tail ] [ drop f ] if* ]
+  if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: <process-stdout-stderr-reader> ( DESC -- process stream stream )
+  [
+    [let | STDOUT-PIPE [ (pipe) |dispose ]
+           STDERR-PIPE [ (pipe) |dispose ] |
+
+      [let | PROCESS [ DESC >process ] |
+
+        PROCESS
+          [ STDOUT-PIPE out>> or ] change-stdout
+          [ STDERR-PIPE out>> or ] change-stderr
+        run-detached
+
+        STDOUT-PIPE out>> dispose
+        STDERR-PIPE out>> dispose
+
+        STDOUT-PIPE in>> <input-port> utf8 <decoder>
+        STDERR-PIPE in>> <input-port> utf8 <decoder> ] ]
+  ]
+  with-destructors ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: run-process/result ( desc -- process )
+  <process-stdout-stderr-reader>
+  {
+    [ contents [ string-lines ] [ f ] if* ]
+    [ contents [ string-lines ] [ f ] if* ]
+  }
+  parallel-spread
+  [ >>stdout ] [ >>stderr ] bi*
+  dup wait-for-process >>status ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! process popup windows
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: popup-window ( title contents -- )
+  dup string? [ ] [ "\n" join ] if
+  <editor> tuck set-editor-string swap open-window ;
+
+: popup-process-window ( process -- )
+  [ stdout>> [ "output" swap popup-window ] when* ]
+  [ stderr>> [ "error"  swap popup-window ] when* ]
+  [
+    [ stdout>> ] [ stderr>> ] bi or not
+    [ "Process" "NO OUTPUT" popup-window ]
+    when
+  ]
+  tri ;
+
+: popup-if-error ( process -- )
+  { [ status>> 0 = not ] [ popup-process-window t ] } 1&& drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: git-process ( REPO DESC -- process )
+  REPO [ DESC run-process/result ] with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-status-section ( lines section -- lines/f )
+  '[ _ = ] tail**
+    [
+      [ "#\t" head?      ] tail**
+      [ "#\t" head?  not ] head**
+      [ 2 tail ] map
+    ]
+    [ f ]
+  if* ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: colon ( -- ch ) CHAR: : ;
+: space ( -- ch ) 32      ;
+
+: git-status-line-file ( line -- file )
+  { [ colon = ] 1 [ space = not ] } [ tail** ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <git-status>
+  repository
+  to-commit-new
+  to-commit-modified
+  to-commit-deleted
+  modified
+  deleted
+  untracked ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: check-empty ( seq -- seq/f ) dup empty? [ drop f ] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: refresh-git-status ( GIT-STATUS -- GIT-STATUS )
+
+  [let | LINES [ GIT-STATUS repository>> "git-status" git-process stdout>> ] |
+
+    GIT-STATUS
+    
+      LINES "# Changes to be committed:" git-status-section
+        [ "new file:" head? ] filter
+        [ git-status-line-file ] map
+        check-empty
+      >>to-commit-new
+    
+      LINES "# Changes to be committed:" git-status-section
+        [ "modified:" head? ] filter
+        [ git-status-line-file ] map
+        check-empty
+      >>to-commit-modified
+
+      LINES "# Changes to be committed:" git-status-section
+        [ "deleted:" head? ] filter
+        [ git-status-line-file ] map
+        check-empty
+      >>to-commit-deleted
+
+      LINES "# Changed but not updated:" git-status-section
+        [ "modified:" head? ] filter
+        [ git-status-line-file ] map
+        check-empty
+      >>modified
+    
+      LINES "# Changed but not updated:" git-status-section
+        [ "deleted:" head? ] filter
+        [ git-status-line-file ] map
+        check-empty
+      >>deleted
+
+      LINES "# Untracked files:" git-status-section >>untracked ] ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: git-status ( REPO -- <git-status> )
+
+  <git-status> new REPO >>repository refresh-git-status ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: factor-git-status ( -- <git-status> ) "resource:" git-status ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! git-tool
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: to-commit ( <git-status> -- seq )
+  { to-commit-new>> to-commit-modified>> to-commit-deleted>> } 1arr concat ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: refresh-status-pile ( STATUS PILE -- )
+
+  STATUS refresh-git-status drop
+
+  PILE clear-gadget
+
+  PILE
+
+  ! Commit section
+
+  [wlet | add-commit-path-button [| TEXT PATH |
+
+            { 1 0 } <track>
+
+              TEXT <label> 2/8 track-add
+              PATH <label> 6/8 track-add
+
+              "Reset"
+              [
+                drop
+                
+                STATUS repository>>
+                { "git" "reset" "HEAD" PATH }
+                git-process
+                drop
+                
+                STATUS PILE refresh-status-pile
+              ]
+              <bevel-button> f track-add
+
+            add-gadget ] |
+
+    STATUS to-commit
+    [
+      "Changes to be committed" <label> reverse-video-theme add-gadget
+
+      STATUS to-commit-new>>
+      [| PATH | "new file: " PATH add-commit-path-button ]
+      each
+
+      STATUS to-commit-modified>>
+      [| PATH | "modified: " PATH add-commit-path-button ]
+      each
+
+      STATUS to-commit-deleted>>
+      [| PATH | "deleted: " PATH add-commit-path-button ]
+      each
+
+      <pile> 1 >>fill
+
+        [let | EDITOR [ <editor> "COMMIT MESSAGE" over set-editor-string ] |
+
+          EDITOR add-gadget
+  
+          "Commit"
+          [
+           drop
+           [let | MSG [ EDITOR editor-string ] |
+
+              STATUS repository>>
+              { "git" "commit" "-m" MSG } git-process
+              popup-if-error ]
+           STATUS PILE refresh-status-pile
+          ]
+          <bevel-button>
+          add-gadget ]
+       
+      add-gadget
+
+    ]
+    when ]
+
+  ! Modified section
+
+  STATUS modified>>
+  [
+    "Modified but not updated" <label> reverse-video-theme add-gadget
+
+    STATUS modified>>
+    [| PATH |
+
+      <shelf>
+
+        PATH <label> add-gadget
+
+        "Add"
+        [
+          drop
+          STATUS repository>> { "git" "add" PATH } git-process popup-if-error
+          STATUS PILE refresh-status-pile
+        ]
+        <bevel-button> add-gadget
+
+        "Diff"
+        [
+          drop
+          STATUS repository>> { "git-diff" PATH } git-process
+          popup-process-window
+        ]
+        <bevel-button> add-gadget
+
+      add-gadget
+      
+    ]
+    each
+    
+  ]
+  when
+
+  ! Untracked section
+
+  STATUS untracked>>
+  [
+    "Untracked files" <label> reverse-video-theme add-gadget
+
+    STATUS untracked>>
+    [| PATH |
+
+      { 1 0 } <track>
+
+        PATH <label> f track-add
+
+        "Add"
+        [
+          drop
+          STATUS repository>> { "git" "add" PATH } git-process popup-if-error
+          STATUS PILE refresh-status-pile
+        ]
+        <bevel-button> f track-add
+
+      add-gadget
+
+    ]
+    each
+    
+  ]
+  when
+
+  ! Refresh button
+
+  "Refresh" [ drop STATUS PILE refresh-status-pile ] <bevel-button> add-gadget
+
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: git-remote-branches ( REPO NAME -- seq )
+  REPO { "git-remote" "show" NAME } git-process stdout>>
+  "  Tracked remote branches" over index 1 + tail first " " split
+  [ empty? not ] filter ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: refresh-remotes-pile ( REPO PILE -- )
+
+  PILE clear-gadget
+
+  PILE
+  
+  "Remotes" <label> reverse-video-theme add-gadget
+
+  REPO "git-remote" git-process stdout>> [ empty? not ] filter
+
+  [| NAME |
+
+    [let | BRANCH! [ "master" ] |
+  
+      { 1 0 } <track>
+  
+        NAME <label> 1 track-add
+
+        [let | BRANCH-BUTTON [ "master" [ drop ] <bevel-button> ] |
+
+          BRANCH-BUTTON
+          [
+            drop
+                  
+            <pile>
+                  
+              1 >>fill
+    
+              REPO NAME git-remote-branches
+                [| OTHER-BRANCH |
+                  OTHER-BRANCH
+                    [
+                      drop
+                          
+                      OTHER-BRANCH BRANCH!
+                          
+                      OTHER-BRANCH BRANCH-BUTTON gadget-child set-label-string
+                          
+                    ]
+                  <bevel-button>
+                  add-gadget
+                ]
+              each
+                    
+            "Select a branch" open-window
+           ]
+           >>quot
+
+           1 track-add ]
+  
+        "Fetch"
+        [ drop REPO { "git-fetch" NAME } git-process popup-process-window ]
+        <bevel-button>
+        1 track-add
+  
+        "..remote/branch"
+        [
+          drop
+          [let | ARG [ { ".." NAME "/" BRANCH } concat ] |
+            REPO { "git-log" ARG } git-process popup-process-window ]
+        ]
+        <bevel-button>
+        1 track-add
+  
+        "Merge"
+        [
+          drop
+          [let | ARG [ { NAME "/" BRANCH } concat ] |
+            REPO { "git-merge" ARG } git-process popup-process-window ]
+        ]
+        <bevel-button>
+        1 track-add
+  
+        "remote/branch.."
+        [
+          drop
+          [let | ARG [ { NAME "/" BRANCH ".." } concat ] |
+            REPO { "git-log" ARG } git-process popup-process-window ]
+        ]
+        <bevel-button>
+        1 track-add
+  
+        "Push"
+        [
+          drop
+          REPO { "git-push" NAME "master" } git-process popup-process-window 
+        ]
+        <bevel-button>
+        1 track-add
+
+        add-gadget ]
+
+    ]
+  each
+
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: git-tool ( REPO -- )
+
+  <pile> 1 >>fill
+
+    "Repository: " REPO [ current-directory get ] with-directory append
+    <label>
+    add-gadget
+
+    REPO git-status <pile> 1 >>fill tuck refresh-status-pile  add-gadget
+    REPO            <pile> 1 >>fill tuck refresh-remotes-pile add-gadget
+
+  "Git" open-window ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: factor-git-tool ( -- ) "resource:" git-tool ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+