Merge git://factorcode.org/git/factor

core/quotations/quotations-docs.factor

@@ -22,7 +22,7 @@ $nl
 ABOUT: "quotations"
 
 HELP: callable
-{ $class-description "The class whose instances can be passed to " { $link call } ". This includes quotations, " { $link f } " (which behaves like an empty quotation), and composed quotations built up with " { $link curry } "." } ;
+{ $class-description "The class whose instances can be passed to " { $link call } ". This includes quotations and composed quotations built up with " { $link curry } " or " { $link compose } "." } ;
 
 HELP: quotation
 { $description "The class of quotations. See " { $link "syntax-quots" } " for syntax and " { $link "quotations" } " for general information." } ;

extra/bake/bake.factor

@@ -1,6 +1,6 @@
 
-USING: kernel parser namespaces quotations vectors strings
+USING: kernel parser namespaces quotations arrays vectors strings
-sequences assocs tuples math combinators ;
+       sequences assocs tuples math combinators ;
 
 IN: bake
 
@@ -22,6 +22,10 @@ C: <splice-quot> splice-quot
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: ,u ( seq -- seq ) unclip building get push ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 SYMBOL: exemplar
 
 : reset-building ( -- ) 1024 <vector> building set ;
@@ -35,6 +39,7 @@ DEFER: bake
 : bake-item ( item -- )
   { { [ dup \ , = ]        [ drop , ] }
     { [ dup \ % = ] 	   [ drop % ] }
+    { [ dup \ ,u = ]	   [ drop ,u ] }
     { [ dup insert-quot? ] [ insert-quot-expr call , ] }
     { [ dup splice-quot? ] [ splice-quot-expr call % ] }
     { [ dup integer? ]     [ , ] }
@@ -49,3 +54,8 @@ DEFER: bake
 
 : bake ( seq -- seq )
   [ reset-building save-exemplar bake-items finish-baking ] with-scope ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
+

extra/documents/documents.factor

@@ -167,6 +167,12 @@ M: char-elt prev-elt
 M: char-elt next-elt
     drop [ drop 1 +col ] (next-char) ;
 
+TUPLE: one-char-elt ;
+
+M: one-char-elt prev-elt 2drop ;
+
+M: one-char-elt next-elt 2drop ;
+
 : (word-elt) ( loc document quot -- loc )
     pick >r
     >r >r first2 swap r> doc-line r> call

extra/macros/macros.factor

@@ -19,7 +19,7 @@ IN: macros
 : MACRO:
     (:) (MACRO:) ; parsing
 
-PREDICATE: word macro
+PREDICATE: compound macro
     "macro" word-prop >boolean ;
 
 M: macro definer drop \ MACRO: \ ; ;

extra/raptor/config.factor

@@ -1,5 +1,7 @@
 
-USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ;
+USING: namespaces threads
+       unix.process unix.linux.if unix.linux.ifreq unix.linux.route
+       raptor.cron ;
 
 IN: raptor
 
@@ -24,9 +26,20 @@ IN: raptor
   configure-route
 ] networking-hook set-global
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Filesystems
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+"/dev/hda1"     root-device     set-global
+
+{ "/dev/hda5" } swap-devices	set-global
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! boot-hook
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 [
+                                    start-wait-loop
 
   ! rcS.d
 
@@ -38,7 +51,12 @@ IN: raptor
   "mountdevsubfs" 		    start-service
   "module-init-tools" 		    start-service
   "procps.sh" 			    start-service
-  "checkroot.sh"		    start-service
+
+  !  "checkroot.sh"		    start-service
+
+     				    activate-swap
+				    mount-root
+
   "mtab"			    start-service
   "checkfs.sh" 			    start-service
   "mountall.sh"			    start-service
@@ -76,11 +94,17 @@ IN: raptor
   "rmnologin"			    start-service
 
   				    schedule-cron-jobs
-  				    start-listeners
+
-				    start-gettys
+  [ [ "/dev/tty2" tty-listener ] forever ] in-thread
+  [ [ "/dev/tty3" tty-listener ] forever ] in-thread
+  [ [ "/dev/tty4" tty-listener ] forever ] in-thread
+  [ [ "/dev/tty5" getty        ] forever ] in-thread
+  [ [ "/dev/tty6" getty        ] forever ] in-thread
 
 ] boot-hook set-global
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! reboot-hook
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 [
@@ -108,6 +132,8 @@ IN: raptor
   "reboot" 			    stop-service
 ] reboot-hook set-global
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! shutdown-hook
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 [

extra/raptor/cron/cron.factor

@@ -1,5 +1,6 @@
 
-USING: kernel threads sequences calendar combinators.cleave combinators.lib ;
+USING: kernel namespaces threads sequences calendar
+       combinators.cleave combinators.lib ;
 
 IN: raptor.cron
 
@@ -46,3 +47,16 @@ C: <when> when
 
 : schedule ( when quot -- ) [ recurring-job ] curry curry in-thread ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: cron-jobs-hourly
+SYMBOL: cron-jobs-daily
+SYMBOL: cron-jobs-weekly
+SYMBOL: cron-jobs-monthly
+
+: schedule-cron-jobs ( -- )
+  { 17 } f f f f         <when> [ cron-jobs-hourly  get call ] schedule
+  { 25 } { 6 } f f f     <when> [ cron-jobs-daily   get call ] schedule
+  { 47 } { 6 } f f { 7 } <when> [ cron-jobs-weekly  get call ] schedule
+  { 52 } { 6 } { 1 } f f <when> [ cron-jobs-monthly get call ] schedule ;
+

extra/raptor/cronjobs.factor

@@ -1,5 +1,6 @@
 
-USING: kernel threads arrays sequences combinators.cleave raptor raptor.cron ;
+USING: kernel namespaces threads arrays sequences combinators.cleave
+       raptor raptor.cron ;
 
 IN: raptor
 
@@ -7,41 +8,33 @@ IN: raptor
 
 : fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: run-script ( path -- ) 1array [ fork-exec-args-wait ] curry in-thread ;
-
-: cron-hourly ( -- ) ;
-
-: cron-daily ( -- )
-  { "/etc/cron.daily/apt"
-    "/etc/cron.daily/aptitude"
-    "/etc/cron.daily/bsdmainutils"
-    "/etc/cron.daily/find.notslocate"
-    "/etc/cron.daily/logrotate"
-    "/etc/cron.daily/man-db"
-    "/etc/cron.daily/ntp-server"
-    "/etc/cron.daily/slocate"
-    "/etc/cron.daily/standard"
-    "/etc/cron.daily/sysklogd"
-    "/etc/cron.daily/tetex-bin" }
-  [ 1array [ fork-exec-args-wait ] in-thread drop ] each ;
-    
-: cron-weekly ( -- )
-  { "/etc/cron.weekly/cvs"
-    "/etc/cron.weekly/man-db"
-    "/etc/cron.weekly/ntp-server"
-    "/etc/cron.weekly/popularity-contest"
-    "/etc/cron.weekly/sysklogd" }
-  [ 1array [ fork-exec-args-wait ] in-thread drop ] each ;
-
-: cron-monthly ( -- )
-  { "/etc/cron.monthly/scrollkeeper"
-    "/etc/cron.monthly/standard" }
-  [ 1array [ fork-exec-args-wait ] in-thread drop ] each ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: schedule-cron-jobs ( -- )
+[
-  { 17 } f f f f         <when> [ cron-hourly  ] schedule
+    "/etc/cron.daily/apt"             run-script
-  { 25 } { 6 } f f f     <when> [ cron-daily   ] schedule
+    "/etc/cron.daily/aptitude"	      run-script
-  { 47 } { 6 } f f { 7 } <when> [ cron-weekly  ] schedule
+    "/etc/cron.daily/bsdmainutils"    run-script
-  { 52 } { 6 } { 1 } f f <when> [ cron-monthly ] schedule ;
+    "/etc/cron.daily/find.notslocate" run-script
+    "/etc/cron.daily/logrotate"	      run-script
+    "/etc/cron.daily/man-db"	      run-script
+    "/etc/cron.daily/ntp-server"      run-script
+    "/etc/cron.daily/slocate"	      run-script
+    "/etc/cron.daily/standard"	      run-script
+    "/etc/cron.daily/sysklogd"	      run-script
+    "/etc/cron.daily/tetex-bin"	      run-script
+] cron-jobs-daily set-global
+    
+[
+  "/etc/cron.weekly/cvs"                run-script
+  "/etc/cron.weekly/man-db"		run-script
+  "/etc/cron.weekly/ntp-server"		run-script
+  "/etc/cron.weekly/popularity-contest" run-script
+  "/etc/cron.weekly/sysklogd"		run-script
+] cron-jobs-weekly set-global
+
+[
+  "/etc/cron.monthly/scrollkeeper" run-script
+  "/etc/cron.monthly/standard"     run-script
+] cron-jobs-monthly set-global

extra/raptor/raptor.factor

@@ -1,5 +1,6 @@
 
-USING: kernel parser namespaces threads unix.process combinators.cleave ;
+USING: kernel parser namespaces threads sequences unix unix.process
+       combinators.cleave bake ;
 
 IN: raptor
 
@@ -10,29 +11,29 @@ SYMBOL: reboot-hook
 SYMBOL: shutdown-hook
 SYMBOL: networking-hook
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : reload-raptor-config ( -- )
   "/etc/raptor/config.factor" run-file
   "/etc/raptor/cronjobs.factor" run-file ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-USING: sequences unix ;
+: fork-exec-wait ( pathname args -- )
+  fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: forever ( quot -- ) [ call ] [ forever ] bi ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : start-service ( name -- ) "/etc/init.d/" swap " start" 3append system drop ;
 : stop-service  ( name -- ) "/etc/init.d/" swap " stop"  3append system drop ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: fork-exec-wait ( pathname args -- )
+: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ;
-  fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid ] if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: respawn ( pathname args -- ) [ fork-exec-wait ] [ respawn ] 2bi ;
-
-: start-gettys ( -- )
-  [ "/sbin/getty" { "getty" "38400" "tty5" } respawn ] in-thread
-  [ "/sbin/getty" { "getty" "38400" "tty6" } respawn ] in-thread ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -40,16 +41,19 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
        listener ;
 
 : tty-listener ( tty -- )
-  [ <file-reader> <line-reader>  ]
+  [ <file-reader> ] [ <file-writer> ] bi <duplex-stream>
-  [ <file-writer> <plain-writer> ]
+  [ listener ] with-stream ;
-  bi <duplex-stream> [ listener ] with-stream ;
 
-: forever ( quot -- ) [ call ] [ forever ] bi ;
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: start-listeners ( -- )
+USING: unix.linux.swap unix.linux.fs ;
-  [ [ "/dev/tty2" tty-listener ] forever ] in-thread
+
-  [ [ "/dev/tty3" tty-listener ] forever ] in-thread
+SYMBOL: root-device
-  [ [ "/dev/tty4" tty-listener ] forever ] in-thread ;
+SYMBOL: swap-devices
+
+: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ;
+
+: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -60,3 +64,4 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
 : shutdown ( -- ) shutdown-hook get call ;
 
 MAIN: boot
+

extra/raptor/readme-0.1.1

@@ -8,9 +8,22 @@ Raptor Linux is a mod of Ubuntu 6.06 (Dapper Drake)
 This is unlikely to work on another version of Ubuntu, much less
 another Linux distribution.
 
+*** Features ***
+
+  * /sbin/init is replaced with Factor
+  * Virtual terminals managed by Factor
+  * Listeners run on virtual terminals
+  * Native support for static ip networking
+  * Crontab replacement
+
 *** Install ***
 
+  # mkdir -v /etc/raptor
+
+  # cp -v /scratch/factor/extra/raptor/{config,cronjobs}.factor /etc/raptor
+
   ( scratchpad ) USE: raptor
+  ( scratchpad ) reload-raptor-config
   ( scratchpad ) save
 
   # mv -v /sbin/{init,init.orig}
@@ -19,10 +32,6 @@ another Linux distribution.
 
   # cp -v /scratch/factor/factor.image /sbin/init.image
 
-  # mkdir -v /etc/raptor
-
-  # cp -v /scratch/factor/extra/raptor/config.factor /etc/raptor/config.factor
-
 *** Static IP networking ***
 
 If you use a static IP in your network then Factor can take care of

extra/tools/test/ui/ui.factor

@@ -1,5 +1,5 @@
 USING: dlists ui.gadgets kernel ui namespaces io.streams.string
-io ui.private ;
+io ;
 IN: tools.test.ui
 
 ! We can't print to stdio here because that might be a pane

extra/ui/gadgets/editors/editors-tests.factor

@@ -1,5 +1,5 @@
 USING: ui.gadgets.editors tools.test kernel io io.streams.plain
-definitions namespaces ui.gadgets ui.private
+definitions namespaces ui.gadgets
 ui.gadgets.grids prettyprint documents ui.gestures
 tools.test.inference tools.test.ui models ;
 

extra/ui/gadgets/editors/editors.factor

@@ -4,7 +4,7 @@ USING: arrays documents ui.clipboards ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
 ui.gadgets.scrollers ui.gadgets.theme ui.render ui.gestures io
 kernel math models namespaces opengl opengl.gl sequences strings
-io.styles math.vectors sorting colors combinators ;
+io.styles math.vectors sorting colors combinators assocs ;
 IN: ui.gadgets.editors
 
 TUPLE: editor
@@ -94,8 +94,11 @@ M: editor ungraft*
         rot editor-line x>offset ,
     ] { } make ;
 
+: clicked-loc ( editor -- loc )
+    [ hand-rel ] keep point>loc ;
+
 : click-loc ( editor model -- )
-    >r [ hand-rel ] keep point>loc r> set-model ;
+    >r clicked-loc r> set-model ;
 
 : focus-editor ( editor -- )
     t over set-editor-focused? relayout-1 ;
@@ -244,11 +247,37 @@ M: editor user-input*
 
 M: editor gadget-text* editor-string % ;
 
-: start-selection ( editor -- )
-    dup editor-caret click-loc ;
-
 : extend-selection ( editor -- )
-    dup request-focus start-selection ;
+    dup request-focus dup editor-caret click-loc ;
+
+: mouse-elt ( -- elelement )
+    hand-click# get {
+        { 2 T{ one-word-elt } }
+        { 3 T{ one-line-elt } }
+    } at T{ one-char-elt } or ;
+
+: drag-direction? ( loc editor -- ? )
+    editor-mark* <=> 0 < ;
+
+: drag-selection-caret ( loc editor element -- loc )
+    >r [ drag-direction? ] 2keep
+    gadget-model
+    r> prev/next-elt ? ;
+
+: drag-selection-mark ( loc editor element -- loc )
+    >r [ drag-direction? not ] 2keep
+    nip dup editor-mark* swap gadget-model
+    r> prev/next-elt ? ;
+
+: drag-caret&mark ( editor -- caret mark )
+    dup clicked-loc swap mouse-elt
+    [ drag-selection-caret ] 3keep
+    drag-selection-mark ;
+
+: drag-selection ( editor -- )
+    dup drag-caret&mark
+    pick editor-mark set-model
+    swap editor-caret set-model ;
 
 : editor-cut ( editor clipboard -- )
     dupd gadget-copy remove-selection ;
@@ -296,17 +325,10 @@ M: editor gadget-text* editor-string % ;
         dup T{ one-word-elt } select-elt
     ] unless gadget-selection ;
 
-: (position-caret) ( editor -- )
-    dup extend-selection
-    dup editor-mark click-loc ;
-
 : position-caret ( editor -- )
-    hand-click# get {
+    mouse-elt dup T{ one-char-elt } =
-        { 1 [ (position-caret) ] }
+    [ drop dup extend-selection dup editor-mark click-loc ]
-        { 2 [ T{ one-word-elt } select-elt ] }
+    [ select-elt ] if ;
-        { 3 [ T{ one-line-elt } select-elt ] }
-        [ 2drop ]
-    } case ;
 
 : insert-newline "\n" swap user-input ;
 
@@ -408,7 +430,7 @@ editor "caret-motion" f {
 
 editor "selection" f {
     { T{ button-down f { S+ } } extend-selection }
-    { T{ drag } start-selection }
+    { T{ drag } drag-selection }
     { T{ gain-focus } focus-editor }
     { T{ lose-focus } unfocus-editor }
     { T{ delete-action } remove-selection }

extra/ui/gadgets/gadgets-tests.factor

@@ -2,7 +2,7 @@ IN: temporary
 USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
 namespaces models kernel tools.test.inference dlists math
 math.parser ui sequences hashtables assocs io arrays
-prettyprint io.streams.string ui.private ;
+prettyprint io.streams.string ;
 
 [ T{ rect f { 10 10 } { 20 20 } } ]
 [

extra/ui/gadgets/scrollers/scrollers-tests.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: ui.gadgets ui.gadgets.scrollers ui.private
+USING: ui.gadgets ui.gadgets.scrollers
 namespaces tools.test kernel models ui.gadgets.viewports
 ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
 ui.gadgets.sliders math math.vectors arrays sequences

extra/ui/gestures/gestures.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs kernel math models namespaces
 sequences words strings system hashtables math.parser
-math.vectors tuples classes ui.gadgets timers ;
+math.vectors tuples classes ui.gadgets timers combinators.lib ;
 IN: ui.gestures
 
 : set-gestures ( class hash -- ) "gestures" set-word-prop ;
@@ -176,9 +176,22 @@ drag-timer construct-empty drag-timer set-global
 : hand-click-rel ( gadget -- loc )
     hand-click-loc get-global swap screen-loc v- ;
 
+: multi-click-timeout? ( -- ? )
+    millis hand-last-time get - double-click-timeout get <= ;
+
+: multi-click-button? ( button -- button ? )
+    dup hand-last-button get = ;
+
+: multi-click-position? ( -- ? )
+    hand-loc get hand-click-loc get v- norm 10 <= ;
+
 : multi-click? ( button -- ? )
-    millis hand-last-time get - double-click-timeout get <=
+    {
-    swap hand-last-button get = and ;
+        [ multi-click-timeout? ]
+        [ multi-click-button? ]
+        [ multi-click-position? ]
+        [ multi-click-position? ]
+    } && nip ;
 
 : update-click# ( button -- )
     global [

extra/ui/tools/browser/browser-tests.factor

@@ -1,6 +1,6 @@
 IN: temporary
 USING: tools.test tools.test.ui ui.tools.browser
-tools.test.inference ui.private ;
+tools.test.inference ;
 
 { 0 1 } [ <browser-gadget> ] unit-test-effect
 [ ] [ <browser-gadget> [ ] with-grafted-gadget ] unit-test

extra/ui/tools/listener/listener-tests.factor

@@ -1,7 +1,7 @@
 USING: continuations documents ui.tools.interactor
 ui.tools.listener hashtables kernel namespaces parser sequences
 timers tools.test ui.commands ui.gadgets ui.gadgets.editors
-ui.gadgets.panes vocabs words tools.test.ui ui.private ;
+ui.gadgets.panes vocabs words tools.test.ui ;
 IN: temporary
 
 timers [ init-timers ] unless

extra/ui/tools/search/search-tests.factor

@@ -1,6 +1,6 @@
 USING: assocs ui.tools.search help.topics io.files io.styles
 kernel namespaces sequences source-files threads timers
-tools.test ui.gadgets ui.gestures ui.private vocabs
+tools.test ui.gadgets ui.gestures vocabs
 vocabs.loader words tools.test.ui debugger ;
 IN: temporary
 

extra/ui/tools/tools-tests.factor

@@ -2,7 +2,7 @@ USING: ui.tools ui.tools.interactor ui.tools.listener
 ui.tools.search ui.tools.workspace kernel models namespaces
 sequences timers tools.test ui.gadgets ui.gadgets.buttons
 ui.gadgets.labelled ui.gadgets.presentations
-ui.gadgets.scrollers vocabs tools.test.ui ui ui.private ;
+ui.gadgets.scrollers vocabs tools.test.ui ui ;
 IN: temporary
 
 [

extra/ui/tools/walker/walker-tests.factor

@@ -1,6 +1,6 @@
 USING: arrays continuations ui.tools.listener ui.tools.walker
 ui.tools.workspace inspector kernel namespaces sequences threads
-listener tools.test ui ui.gadgets ui.gadgets.worlds ui.private
+listener tools.test ui ui.gadgets ui.gadgets.worlds
 ui.gadgets.packs vectors ui.tools tools.interpreter
 tools.interpreter.debug tools.test.inference tools.test.ui ;
 IN: temporary

extra/ui/ui.factor

@@ -28,8 +28,6 @@ SYMBOL: windows
 : unregister-window ( handle -- )
     windows global [ [ first = not ] curry* subset ] change-at ;
 
-<PRIVATE
-
 : raised-window ( world -- )
     windows get-global [ second eq? ] curry* find drop
     windows get-global [ length 1- ] keep exchange ;
@@ -67,8 +65,6 @@ M: world ungraft*
     dup world-handle (close-window)
     reset-world ;
 
-PRIVATE>
-
 : open-world-window ( world -- )
     dup pref-dim over set-gadget-dim dup relayout graft ;
 
@@ -90,8 +86,6 @@ SYMBOL: ui-hook
     <dlist> \ layout-queue set-global
     V{ } clone windows set-global ;
 
-<PRIVATE
-
 : restore-gadget-later ( gadget -- )
     dup gadget-graft-state {
         { { f f } [ ] }
@@ -133,7 +127,7 @@ SYMBOL: ui-hook
     ] { } make ;
 
 : redraw-worlds ( seq -- )
-    [ dup update-hand draw-world ] each ;
+    [ dup update-hand [ draw-world ] time ] each ;
 
 : notify ( gadget -- )
     dup gadget-graft-state {
@@ -146,8 +140,6 @@ SYMBOL: ui-hook
 : notify-queued ( -- )
     graft-queue [ notify ] dlist-slurp ;
 
-PRIVATE>
-
 : ui-step ( -- )
     [
         do-timers

extra/ui/windows/windows.factor

@@ -397,8 +397,10 @@ M: windows-ui-backend (close-window)
     GetDoubleClickTime double-click-timeout set-global ;
 
 : cleanup-win32-ui ( -- )
-    class-name-ptr get-global f UnregisterClass drop
+    class-name-ptr get-global [
-    class-name-ptr get-global [ free ] when*
+        dup f UnregisterClass drop
+        free
+    ] when*
     f class-name-ptr set-global ;
 
 : setup-pixel-format ( hdc -- )

extra/unix/linux/fs/fs.factor

@@ -0,0 +1,25 @@
+
+USING: alien.syntax ;
+
+IN: unix.linux.fs
+
+: MS_RDONLY		1    ; ! Mount read-only.
+: MS_NOSUID		2    ; ! Ignore suid and sgid bits.
+: MS_NODEV		4    ; ! Disallow access to device special files.
+: MS_NOEXEC		8    ; ! Disallow program execution.
+: MS_SYNCHRONOUS	16   ; ! Writes are synced at once.
+: MS_REMOUNT		32   ; ! Alter flags of a mounted FS.
+: MS_MANDLOCK		64   ; ! Allow mandatory locks on an FS.
+: S_WRITE		128  ; ! Write on file/directory/symlink.
+: S_APPEND		256  ; ! Append-only file.
+: S_IMMUTABLE		512  ; ! Immutable file.
+: MS_NOATIME		1024 ; ! Do not update access times.
+: MS_NODIRATIME		2048 ; ! Do not update directory access times.
+: MS_BIND		4096 ; ! Bind directory at different place.
+
+FUNCTION: int mount
+( char* special_file, char* dir, char* fstype, ulong options, void* data ) ;
+
+! FUNCTION: int umount2 ( char* file, int flags ) ;
+
+FUNCTION: int umount ( char* file ) ;

extra/unix/linux/swap/swap.factor

@@ -0,0 +1,12 @@
+
+USING: alien.syntax ;
+
+IN: unix.linux.swap
+
+: SWAP_FLAG_PREFER	HEX: 8000 ; ! Set if swap priority is specified.
+: SWAP_FLAG_PRIO_MASK	HEX: 7fff ;
+: SWAP_FLAG_PRIO_SHIFT	0 ;
+
+FUNCTION: int swapon ( char* path, int flags ) ;
+
+FUNCTION: int swapoff ( char* path ) ;

extra/unix/process/process.factor

@@ -31,11 +31,23 @@ IN: unix.process
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! This is kludgy. We need a better implementation.
+USING: kernel alien.c-types namespaces continuations threads assocs unix
+       combinators.cleave ;
 
-USE: threads
+SYMBOL: pid-wait
 
-: wait-for-pid ( pid -- )
+! KEY | VALUE
-  dup "int" <c-object> WNOHANG waitpid
+! -----------
-  0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
+! pid | continuation
 
+: init-pid-wait ( -- ) H{ } clone pid-wait set-global ;
+
+: wait-for-pid ( pid -- status ) [ pid-wait get set-at stop ] curry callcc1 ;
+
+: wait-loop ( -- )
+  -1 0 <int> tuck WNOHANG waitpid               ! &status return
+  [ *int ] [ pid-wait get delete-at* drop ] bi* ! status ?
+  dup [ schedule-thread-with ] [ 2drop ] if
+  250 sleep wait-loop ;
+
+: start-wait-loop ( -- ) init-pid-wait [ wait-loop ] in-thread ;

extra/unix/unix.factor

@@ -166,6 +166,10 @@ FUNCTION: time_t time ( time_t* t ) ;
 FUNCTION: int unlink ( char* path ) ;
 FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! wait and waitpid
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 ! Flags for waitpid
 
 : WNOHANG   1 ;
@@ -176,7 +180,27 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 : WCONTINUED 8 ;
 : WNOWAIT    HEX: 1000000 ;
 
+! Examining status
+
+: WTERMSIG ( status -- value ) HEX: 7f bitand ;
+
+: WIFEXITED ( status -- ? ) WTERMSIG zero? ;
+
+: WEXITSTATUS ( status -- value ) HEX: ff00 bitand -8 shift ;
+
+: WIFSIGNALED ( status -- ? ) HEX: 7f bitand 1+ -1 shift 0 > ;
+
+: WCOREFLAG ( -- value ) HEX: 80 ;
+
+: WCOREDUMP ( status -- ? ) WCOREFLAG bitand zero? not ;
+
+: WIFSTOPPED ( status -- ? ) HEX: ff bitand HEX: 7f = ;
+
+: WSTOPSIG ( status -- value ) WEXITSTATUS ;
+
 FUNCTION: pid_t wait ( int* status ) ;
 FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;

extra/webapps/article-manager/furnace/article.furnace

@@ -1,4 +1,4 @@
-<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database ; %>
+<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database html.elements ; %>
     <div id="banner"><h1><% "arg1" get second article-title write %></h1></div>
     <% f "navigation" render-template %>
     <div id="article">

extra/webapps/article-manager/furnace/tag.furnace

@@ -1,4 +1,4 @@
-<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager ; %>
+<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager html.elements ; %>
 
 	<div id="banner"><h1><% "arg1" get second tag-title write %></h1></div>
     <% f "navigation" render-template %>

misc/factor.el

@@ -166,6 +166,9 @@
   (beginning-of-line)
   (insert "! "))
 
+(defun factor-refresh-all ()
+  (interactive)
+  (comint-send-string "*factor*" "refresh-all\n"))
 
 (define-key factor-mode-map "\C-c\C-f" 'factor-run-file)
 (define-key factor-mode-map "\C-c\C-r" 'factor-send-region)