From 565f97950a35e5dd001887c12edc32150b220906 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 23:09:38 -0600 Subject: [PATCH 01/18] Fix redundancy in tty-listener --- extra/raptor/raptor.factor | 5 ++--- extra/raptor/readme-0.1.1 | 17 +++++++++++++---- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index b0b9c05895..a3b4cbfd0a 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -40,9 +40,8 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex listener ; : tty-listener ( tty -- ) - [ ] - [ ] - bi [ listener ] with-stream ; + [ ] [ ] bi + [ listener ] with-stream ; : forever ( quot -- ) [ call ] [ forever ] bi ; diff --git a/extra/raptor/readme-0.1.1 b/extra/raptor/readme-0.1.1 index 303fb416c4..bb5d4c0ff8 100644 --- a/extra/raptor/readme-0.1.1 +++ b/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 From f927a01370f3d7d77717f64635c65cd9bc71a534 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 18 Nov 2007 15:19:02 -0600 Subject: [PATCH 02/18] unix: Added words to inspect status from wait/waitpid --- extra/unix/unix.factor | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 0854754dcb..10ff7a9efa 100644 --- a/extra/unix/unix.factor +++ b/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 ) ; From 76146310db62e8f265e078b0f035e4861906ee72 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:57:22 -0600 Subject: [PATCH 03/18] Add `{ parsing word to bake --- extra/bake/bake.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 5e1700c6e2..437a42d546 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,6 +1,6 @@ -USING: kernel parser namespaces quotations vectors strings -sequences assocs tuples math combinators ; +USING: kernel parser namespaces quotations arrays vectors strings + sequences assocs tuples math combinators ; IN: bake @@ -48,4 +48,8 @@ DEFER: bake : bake-items ( seq -- ) [ bake-item ] each ; : bake ( seq -- seq ) - [ reset-building save-exemplar bake-items finish-baking ] with-scope ; \ No newline at end of file + [ reset-building save-exemplar bake-items finish-baking ] with-scope ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing \ No newline at end of file From 350a23e525f10f8041db3c2a02c12f6d71ee219c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:57:44 -0600 Subject: [PATCH 04/18] Add factor-refresh-all function to factor.el --- misc/factor.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/misc/factor.el b/misc/factor.el index 19e29843d6..88af0a6dab 100644 --- a/misc/factor.el +++ b/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) From 1d4d78c2ce404e2827488d2bced2b15710cb5512 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:58:20 -0600 Subject: [PATCH 05/18] Add the new wait-loop system to unix.process --- extra/unix/process/process.factor | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 7f06f903ac..a99611aba6 100644 --- a/extra/unix/process/process.factor +++ b/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 -- ) - dup "int" WNOHANG waitpid - 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; +! KEY | VALUE +! ----------- +! 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 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 ; \ No newline at end of file From bbcd7bc6ea2ab9a5ff7cc5b1c98776aee9de90f0 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:59:04 -0600 Subject: [PATCH 06/18] Modify raptor.cron --- extra/raptor/cron/cron.factor | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/extra/raptor/cron/cron.factor b/extra/raptor/cron/cron.factor index f004ba30d5..8158a03286 100644 --- a/extra/raptor/cron/cron.factor +++ b/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 : 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 [ cron-jobs-hourly get call ] schedule + { 25 } { 6 } f f f [ cron-jobs-daily get call ] schedule + { 47 } { 6 } f f { 7 } [ cron-jobs-weekly get call ] schedule + { 52 } { 6 } { 1 } f f [ cron-jobs-monthly get call ] schedule ; + From bab5554cfe409af70b5cb127e58bd71e186d24de Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:59:37 -0600 Subject: [PATCH 07/18] Refactor raptor a bit --- extra/raptor/raptor.factor | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index a3b4cbfd0a..7e32463ea1 100644 --- a/extra/raptor/raptor.factor +++ b/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 -- ) - 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 ; +: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-wait ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -43,13 +44,6 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex [ ] [ ] bi [ listener ] with-stream ; -: forever ( quot -- ) [ call ] [ forever ] bi ; - -: start-listeners ( -- ) - [ [ "/dev/tty2" tty-listener ] forever ] in-thread - [ [ "/dev/tty3" tty-listener ] forever ] in-thread - [ [ "/dev/tty4" tty-listener ] forever ] in-thread ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : start-networking ( -- ) networking-hook get call ; @@ -59,3 +53,4 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex : shutdown ( -- ) shutdown-hook get call ; MAIN: boot + From a2aea6a4d17353812b9b3c9561ba2297d88e4ea1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 02:03:16 -0600 Subject: [PATCH 08/18] Update raptor config and cronjobs --- extra/raptor/config.factor | 21 +++++++++--- extra/raptor/cronjobs.factor | 63 ++++++++++++++++-------------------- 2 files changed, 45 insertions(+), 39 deletions(-) diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index d06d8e3db0..386ddf7744 100644 --- a/extra/raptor/config.factor +++ b/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,12 @@ IN: raptor configure-route ] networking-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! boot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ + start-wait-loop ! rcS.d @@ -76,11 +81,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 +119,8 @@ IN: raptor "reboot" stop-service ] reboot-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! shutdown-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ diff --git a/extra/raptor/cronjobs.factor b/extra/raptor/cronjobs.factor index 394c213162..894e8e5ce7 100644 --- a/extra/raptor/cronjobs.factor +++ b/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 ; +[ + "/etc/cron.daily/apt" run-script + "/etc/cron.daily/aptitude" run-script + "/etc/cron.daily/bsdmainutils" run-script + "/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 -: 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 ; +[ + "/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 -: 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 [ cron-hourly ] schedule - { 25 } { 6 } f f f [ cron-daily ] schedule - { 47 } { 6 } f f { 7 } [ cron-weekly ] schedule - { 52 } { 6 } { 1 } f f [ cron-monthly ] schedule ; \ No newline at end of file +[ + "/etc/cron.monthly/scrollkeeper" run-script + "/etc/cron.monthly/standard" run-script +] cron-jobs-monthly set-global \ No newline at end of file From 861cfe7dc2f88990d4da9056bf30dff3792c64fa Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:32:32 -0600 Subject: [PATCH 09/18] add unix.linux.fs --- extra/unix/linux/fs/fs.factor | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 extra/unix/linux/fs/fs.factor diff --git a/extra/unix/linux/fs/fs.factor b/extra/unix/linux/fs/fs.factor new file mode 100644 index 0000000000..02fd357ccd --- /dev/null +++ b/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 ) ; \ No newline at end of file From 963ae64952ce375237090e199b3bc24f707c96f1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:32:51 -0600 Subject: [PATCH 10/18] add unix.linux.swap --- extra/unix/linux/swap/swap.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 extra/unix/linux/swap/swap.factor diff --git a/extra/unix/linux/swap/swap.factor b/extra/unix/linux/swap/swap.factor new file mode 100644 index 0000000000..4cafa5723f --- /dev/null +++ b/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 ) ; \ No newline at end of file From 6d64c460c31fcbfb74753c417b91a69b5c9d8208 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:33:39 -0600 Subject: [PATCH 11/18] Add ,u and `{ to bake --- extra/bake/bake.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 437a42d546..d038e81394 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -22,6 +22,10 @@ C: splice-quot ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: ,u ( seq -- seq ) unclip building get push ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SYMBOL: exemplar : reset-building ( -- ) 1024 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? ] [ , ] } @@ -52,4 +57,5 @@ DEFER: bake ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing \ No newline at end of file +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing + From 1143f52f25ac9af286ee4259dc38cdcffec18715 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:34:25 -0600 Subject: [PATCH 12/18] Activate swap and mount root fs in raptor --- extra/raptor/config.factor | 15 ++++++++++++++- extra/raptor/raptor.factor | 13 ++++++++++++- 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index 386ddf7744..ecdbf98f17 100644 --- a/extra/raptor/config.factor +++ b/extra/raptor/config.factor @@ -26,6 +26,14 @@ IN: raptor configure-route ] networking-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Filesystems +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +"/dev/hda1" root-device set-global + +{ "/dev/hda5" } swap-devices set-global + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! boot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -43,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 diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index 7e32463ea1..e6f960cd8d 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -33,7 +33,7 @@ SYMBOL: networking-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-wait ; +: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -46,6 +46,17 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +USING: unix.linux.swap unix.linux.fs ; + +SYMBOL: root-device +SYMBOL: swap-devices + +: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ; + +: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : start-networking ( -- ) networking-hook get call ; : boot ( -- ) boot-hook get call ; From 812277815fd1ac0605d00d1656fbe61d03bf54e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Nov 2007 14:21:32 -0500 Subject: [PATCH 13/18] Improve multi-click detection logic --- extra/ui/gestures/gestures.factor | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) mode change 100644 => 100755 extra/ui/gestures/gestures.factor diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor old mode 100644 new mode 100755 index 0e337c538a..756ddfbf00 --- a/extra/ui/gestures/gestures.factor +++ b/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 ; IN: ui.gestures : set-gestures ( class hash -- ) "gestures" set-word-prop ; @@ -176,9 +176,23 @@ 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? not ] [ f ] } + { [ multi-click-button? not ] [ f ] } + { [ multi-click-position? not ] [ f ] } + { [ multi-click-position? not ] [ f ] } + { [ t ] [ t ] } + } cond nip ; : update-click# ( button -- ) global [ From 687d2aa6a4707afc807a926fc91bc73bfc95b0a3 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 23 Nov 2007 14:32:02 +1300 Subject: [PATCH 14/18] Fix article manager bitrot --- extra/webapps/article-manager/furnace/article.furnace | 2 +- extra/webapps/article-manager/furnace/tag.furnace | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/webapps/article-manager/furnace/article.furnace b/extra/webapps/article-manager/furnace/article.furnace index 41929301a6..f0647aa442 100644 --- a/extra/webapps/article-manager/furnace/article.furnace +++ b/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 ; %> <% f "navigation" render-template %>
diff --git a/extra/webapps/article-manager/furnace/tag.furnace b/extra/webapps/article-manager/furnace/tag.furnace index 493ce2e613..a778deb9be 100644 --- a/extra/webapps/article-manager/furnace/tag.furnace +++ b/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 ; %> <% f "navigation" render-template %> From cd844658959e2203c38d23a1da203da1a17d5426 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Nov 2007 20:47:58 -0500 Subject: [PATCH 15/18] Documentation fix --- core/quotations/quotations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 core/quotations/quotations-docs.factor diff --git a/core/quotations/quotations-docs.factor b/core/quotations/quotations-docs.factor old mode 100644 new mode 100755 index f647bb2a66..3a32b63ae9 --- a/core/quotations/quotations-docs.factor +++ b/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." } ; From a61c0d5f7c1ec5c9c51a24ac4a83c900d9b37da8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Nov 2007 20:48:24 -0500 Subject: [PATCH 16/18] Fix definition of macro predicate class --- extra/macros/macros.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 extra/macros/macros.factor diff --git a/extra/macros/macros.factor b/extra/macros/macros.factor old mode 100644 new mode 100755 index 9c06822463..1c23a1c85e --- a/extra/macros/macros.factor +++ b/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: \ ; ; From 204069e01d8b0768a00850ef500c3dd2754ae39f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Nov 2007 21:00:56 -0500 Subject: [PATCH 17/18] Improve editor gadget selection behavior --- extra/documents/documents.factor | 6 +++ extra/ui/gadgets/editors/editors.factor | 56 +++++++++++++++++-------- extra/ui/gestures/gestures.factor | 13 +++--- extra/ui/windows/windows.factor | 6 ++- 4 files changed, 55 insertions(+), 26 deletions(-) mode change 100644 => 100755 extra/documents/documents.factor diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor old mode 100644 new mode 100755 index bc4dc412fc..01034e0e3f --- a/extra/documents/documents.factor +++ b/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 diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index 65758ab54c..84cc01cdb6 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/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 { - { 1 [ (position-caret) ] } - { 2 [ T{ one-word-elt } select-elt ] } - { 3 [ T{ one-line-elt } select-elt ] } - [ 2drop ] - } case ; + mouse-elt dup T{ one-char-elt } = + [ drop dup extend-selection dup editor-mark click-loc ] + [ select-elt ] if ; : 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 } diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 756ddfbf00..3d1e7baf7f 100755 --- a/extra/ui/gestures/gestures.factor +++ b/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 combinators ; +math.vectors tuples classes ui.gadgets timers combinators.lib ; IN: ui.gestures : set-gestures ( class hash -- ) "gestures" set-word-prop ; @@ -187,12 +187,11 @@ drag-timer construct-empty drag-timer set-global : multi-click? ( button -- ? ) { - { [ multi-click-timeout? not ] [ f ] } - { [ multi-click-button? not ] [ f ] } - { [ multi-click-position? not ] [ f ] } - { [ multi-click-position? not ] [ f ] } - { [ t ] [ t ] } - } cond nip ; + [ multi-click-timeout? ] + [ multi-click-button? ] + [ multi-click-position? ] + [ multi-click-position? ] + } && nip ; : update-click# ( button -- ) global [ diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 3ce745970d..290e4ef311 100755 --- a/extra/ui/windows/windows.factor +++ b/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 [ free ] when* + class-name-ptr get-global [ + dup f UnregisterClass drop + free + ] when* f class-name-ptr set-global ; : setup-pixel-format ( hdc -- ) From 937446c53b96d5faacf84d056d7bac25a0af1d8c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Nov 2007 16:24:57 -0500 Subject: [PATCH 18/18] Editors tweaks --- extra/tools/test/ui/ui.factor | 2 +- extra/ui/gadgets/editors/editors-tests.factor | 2 +- extra/ui/gadgets/gadgets-tests.factor | 2 +- extra/ui/gadgets/scrollers/scrollers-tests.factor | 2 +- extra/ui/tools/browser/browser-tests.factor | 2 +- extra/ui/tools/listener/listener-tests.factor | 2 +- extra/ui/tools/search/search-tests.factor | 2 +- extra/ui/tools/tools-tests.factor | 2 +- extra/ui/tools/walker/walker-tests.factor | 2 +- extra/ui/ui.factor | 10 +--------- 10 files changed, 10 insertions(+), 18 deletions(-) diff --git a/extra/tools/test/ui/ui.factor b/extra/tools/test/ui/ui.factor index 6dcf9da4b5..0376e7f4c7 100755 --- a/extra/tools/test/ui/ui.factor +++ b/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 diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor index 6966e9639f..6be0423e95 100755 --- a/extra/ui/gadgets/editors/editors-tests.factor +++ b/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 ; diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index 6c651fa248..48bb3718cb 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/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 } } ] [ diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/extra/ui/gadgets/scrollers/scrollers-tests.factor index 7d0dd0158f..a53cf1fb0e 100755 --- a/extra/ui/gadgets/scrollers/scrollers-tests.factor +++ b/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 diff --git a/extra/ui/tools/browser/browser-tests.factor b/extra/ui/tools/browser/browser-tests.factor index 00c8e5489c..5a343919e7 100755 --- a/extra/ui/tools/browser/browser-tests.factor +++ b/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 } [ ] unit-test-effect [ ] [ [ ] with-grafted-gadget ] unit-test diff --git a/extra/ui/tools/listener/listener-tests.factor b/extra/ui/tools/listener/listener-tests.factor index 62bd350e71..4e59fd63ee 100755 --- a/extra/ui/tools/listener/listener-tests.factor +++ b/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 diff --git a/extra/ui/tools/search/search-tests.factor b/extra/ui/tools/search/search-tests.factor index ed110e19d6..47ae786f59 100755 --- a/extra/ui/tools/search/search-tests.factor +++ b/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 diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor index eb30b198d6..919d1705af 100755 --- a/extra/ui/tools/tools-tests.factor +++ b/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 [ diff --git a/extra/ui/tools/walker/walker-tests.factor b/extra/ui/tools/walker/walker-tests.factor index b37c38c6ed..eea6d78f22 100755 --- a/extra/ui/tools/walker/walker-tests.factor +++ b/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 diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor index 0e1b82ab9b..0c3b3e7867 100755 --- a/extra/ui/ui.factor +++ b/extra/ui/ui.factor @@ -28,8 +28,6 @@ SYMBOL: windows : unregister-window ( handle -- ) windows global [ [ first = not ] curry* subset ] change-at ; - - : open-world-window ( world -- ) dup pref-dim over set-gadget-dim dup relayout graft ; @@ -90,8 +86,6 @@ SYMBOL: ui-hook \ layout-queue set-global V{ } clone windows set-global ; - - : ui-step ( -- ) [ do-timers