Merge branch 'master' of http://dharmatech.onigirihouse.com/factor
commit
4af437cc78
|
@ -14,7 +14,7 @@ TUPLE: buffer size ptr fill pos ;
|
|||
dup buffer-ptr free f swap set-buffer-ptr ;
|
||||
|
||||
: buffer-reset ( n buffer -- )
|
||||
[ set-buffer-fill ] keep 0 swap set-buffer-pos ;
|
||||
0 swap { set-buffer-fill set-buffer-pos } set-slots ;
|
||||
|
||||
: buffer-consume ( n buffer -- )
|
||||
[ buffer-pos + ] keep
|
||||
|
|
|
@ -1,11 +1,39 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend kernel continuations ;
|
||||
USING: io.backend kernel continuations namespaces sequences
|
||||
assocs hashtables sorting arrays ;
|
||||
IN: io.monitor
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: monitor queue closed? ;
|
||||
|
||||
: check-monitor ( monitor -- )
|
||||
monitor-closed? [ "Monitor closed" throw ] when ;
|
||||
|
||||
: (monitor) ( delegate -- monitor )
|
||||
H{ } clone {
|
||||
set-delegate
|
||||
set-monitor-queue
|
||||
} monitor construct ;
|
||||
|
||||
HOOK: fill-queue io-backend ( monitor -- assoc )
|
||||
|
||||
: changed-file ( changed path -- )
|
||||
namespace [ append ] change-at ;
|
||||
|
||||
: dequeue-change ( assoc -- path changes )
|
||||
delete-any prune natural-sort >array ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
||||
|
||||
HOOK: next-change io-backend ( monitor -- path changes )
|
||||
: next-change ( monitor -- path changed )
|
||||
dup check-monitor
|
||||
dup monitor-queue dup assoc-empty? [
|
||||
drop dup fill-queue over set-monitor-queue next-change
|
||||
] [ nip dequeue-change ] if ;
|
||||
|
||||
SYMBOL: +add-file+
|
||||
SYMBOL: +remove-file+
|
||||
|
|
|
@ -14,9 +14,9 @@ TUPLE: io-task port callbacks ;
|
|||
|
||||
: io-task-fd io-task-port port-handle ;
|
||||
|
||||
: <io-task> ( port continuation class -- task )
|
||||
>r 1vector io-task construct-boa r> construct-delegate ;
|
||||
inline
|
||||
: <io-task> ( port continuation/f class -- task )
|
||||
>r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
|
||||
r> construct-delegate ; inline
|
||||
|
||||
TUPLE: input-task ;
|
||||
|
||||
|
@ -194,7 +194,7 @@ TUPLE: mx-port mx ;
|
|||
TUPLE: mx-task ;
|
||||
|
||||
: <mx-task> ( port -- task )
|
||||
f io-task construct-boa mx-task construct-delegate ;
|
||||
f mx-task <io-task> ;
|
||||
|
||||
M: mx-task do-io-task
|
||||
io-task-port mx-port-mx 0 swap wait-for-events f ;
|
||||
|
|
|
@ -1,15 +1,136 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io.backend io.monitor io.monitor.private io.files
|
||||
io.buffers io.nonblocking io.unix.backend io.unix.select
|
||||
io.unix.launcher unix.linux.inotify assocs namespaces threads
|
||||
continuations init math alien.c-types alien ;
|
||||
IN: io.unix.linux
|
||||
USING: io.backend io.unix.backend io.unix.launcher io.unix.select
|
||||
namespaces kernel assocs unix.process init ;
|
||||
|
||||
TUPLE: linux-io ;
|
||||
|
||||
INSTANCE: linux-io unix-io
|
||||
|
||||
TUPLE: linux-monitor path wd callback ;
|
||||
|
||||
: <linux-monitor> ( path wd -- monitor )
|
||||
f (monitor) {
|
||||
set-linux-monitor-path
|
||||
set-linux-monitor-wd
|
||||
set-delegate
|
||||
} linux-monitor construct ;
|
||||
|
||||
TUPLE: inotify watches ;
|
||||
|
||||
: wd>path ( wd -- path )
|
||||
inotify get-global inotify-watches at linux-monitor-path ;
|
||||
|
||||
: <inotify> ( -- port )
|
||||
H{ } clone
|
||||
inotify_init dup io-error inotify <buffered-port>
|
||||
{ set-inotify-watches set-delegate } inotify construct ;
|
||||
|
||||
: inotify-fd inotify get-global port-handle ;
|
||||
|
||||
: watches inotify get-global inotify-watches ;
|
||||
|
||||
: (add-watch) ( path mask -- wd )
|
||||
inotify-fd -rot inotify_add_watch dup io-error ;
|
||||
|
||||
: check-existing ( wd -- )
|
||||
watches key? [
|
||||
"Cannot open multiple monitors for the same file" throw
|
||||
] when ;
|
||||
|
||||
: add-watch ( path mask -- monitor )
|
||||
dupd (add-watch)
|
||||
dup check-existing
|
||||
[ <linux-monitor> dup ] keep watches set-at ;
|
||||
|
||||
: remove-watch ( monitor -- )
|
||||
dup linux-monitor-wd watches delete-at
|
||||
linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
|
||||
|
||||
M: linux-io <monitor> ( path recursive? -- monitor )
|
||||
drop IN_CHANGE_EVENTS add-watch ;
|
||||
|
||||
: notify-callback ( assoc monitor -- )
|
||||
linux-monitor-callback dup
|
||||
[ schedule-thread-with ] [ 2drop ] if ;
|
||||
|
||||
M: linux-io fill-queue ( monitor -- assoc )
|
||||
dup linux-monitor-callback [
|
||||
"Cannot wait for changes on the same file from multiple threads" throw
|
||||
] when
|
||||
[ swap set-linux-monitor-callback stop ] callcc1
|
||||
swap check-monitor ;
|
||||
|
||||
M: linux-monitor dispose ( monitor -- )
|
||||
dup check-monitor
|
||||
t over set-monitor-closed?
|
||||
H{ } over notify-callback
|
||||
remove-watch ;
|
||||
|
||||
: ?flag ( n mask symbol -- n )
|
||||
pick rot bitand 0 > [ , ] [ drop ] if ;
|
||||
|
||||
: parse-action ( mask -- changed )
|
||||
[
|
||||
IN_CREATE +add-file+ ?flag
|
||||
IN_DELETE +remove-file+ ?flag
|
||||
IN_DELETE_SELF +remove-file+ ?flag
|
||||
IN_MODIFY +modify-file+ ?flag
|
||||
IN_ATTRIB +modify-file+ ?flag
|
||||
IN_MOVED_FROM +rename-file+ ?flag
|
||||
IN_MOVED_TO +rename-file+ ?flag
|
||||
IN_MOVE_SELF +rename-file+ ?flag
|
||||
drop
|
||||
] { } make ;
|
||||
|
||||
: parse-file-notify ( buffer -- changed path )
|
||||
{
|
||||
inotify-event-wd
|
||||
inotify-event-name
|
||||
inotify-event-mask
|
||||
} get-slots
|
||||
parse-action -rot alien>char-string >r wd>path r> path+ ;
|
||||
|
||||
: events-exhausted? ( i buffer -- ? )
|
||||
buffer-fill >= ;
|
||||
|
||||
: inotify-event@ ( i buffer -- alien )
|
||||
buffer-ptr <displaced-alien> ;
|
||||
|
||||
: next-event ( i buffer -- i buffer )
|
||||
2dup inotify-event@
|
||||
inotify-event-len "inotify-event" heap-size +
|
||||
swap >r + r> ;
|
||||
|
||||
: parse-file-notifications ( i buffer -- )
|
||||
2dup events-exhausted? [ 2drop ] [
|
||||
2dup inotify-event@ parse-file-notify changed-file
|
||||
next-event parse-file-notifications
|
||||
] if ;
|
||||
|
||||
: read-notifications ( port -- )
|
||||
dup refill drop
|
||||
0 over parse-file-notifications
|
||||
0 swap buffer-reset ;
|
||||
|
||||
TUPLE: inotify-task ;
|
||||
|
||||
: <inotify-task> ( port -- task )
|
||||
f inotify-task <input-task> ;
|
||||
|
||||
: init-inotify ( mx -- )
|
||||
<inotify>
|
||||
dup inotify set-global
|
||||
<inotify-task> swap register-io-task ;
|
||||
|
||||
M: inotify-task do-io-task ( task -- )
|
||||
io-task-port read-notifications f ;
|
||||
|
||||
M: linux-io init-io ( -- )
|
||||
<select-mx> mx set-global ;
|
||||
<select-mx> mx set-global ; ! init-inotify ;
|
||||
|
||||
T{ linux-io } set-io-backend
|
||||
|
||||
|
|
|
@ -3,12 +3,10 @@
|
|||
USING: alien.c-types destructors io.windows
|
||||
io.windows.nt.backend kernel math windows windows.kernel32
|
||||
windows.types libc assocs alien namespaces continuations
|
||||
io.monitor io.nonblocking io.buffers io.files io sequences
|
||||
hashtables sorting arrays combinators ;
|
||||
io.monitor io.monitor.private io.nonblocking io.buffers io.files
|
||||
io sequences hashtables sorting arrays combinators ;
|
||||
IN: io.windows.nt.monitor
|
||||
|
||||
TUPLE: monitor path recursive? queue closed? ;
|
||||
|
||||
: open-directory ( path -- handle )
|
||||
FILE_LIST_DIRECTORY
|
||||
share-mode
|
||||
|
@ -22,23 +20,26 @@ TUPLE: monitor path recursive? queue closed? ;
|
|||
dup add-completion
|
||||
f <win32-file> ;
|
||||
|
||||
TUPLE: win32-monitor path recursive? ;
|
||||
|
||||
: <win32-monitor> ( path recursive? port -- monitor )
|
||||
(monitor) {
|
||||
set-win32-monitor-path
|
||||
set-win32-monitor-recursive?
|
||||
set-delegate
|
||||
} win32-monitor construct ;
|
||||
|
||||
M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
||||
[
|
||||
>r dup open-directory monitor <buffered-port> r> {
|
||||
set-monitor-path
|
||||
set-delegate
|
||||
set-monitor-recursive?
|
||||
} monitor construct
|
||||
over open-directory win32-monitor <buffered-port>
|
||||
<win32-monitor>
|
||||
] with-destructors ;
|
||||
|
||||
: check-closed ( monitor -- )
|
||||
port-type closed eq? [ "Monitor closed" throw ] when ;
|
||||
|
||||
: begin-reading-changes ( monitor -- overlapped )
|
||||
dup port-handle win32-file-handle
|
||||
over buffer-ptr
|
||||
pick buffer-size
|
||||
roll monitor-recursive? 1 0 ?
|
||||
roll win32-monitor-recursive? 1 0 ?
|
||||
FILE_NOTIFY_CHANGE_ALL
|
||||
0 <uint>
|
||||
(make-overlapped)
|
||||
|
@ -49,6 +50,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
[
|
||||
dup begin-reading-changes
|
||||
swap [ save-callback ] 2keep
|
||||
dup check-monitor ! we may have closed it...
|
||||
get-overlapped-result
|
||||
] with-port-timeout
|
||||
] with-destructors ;
|
||||
|
@ -63,30 +65,19 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
{ [ t ] [ +modify-file+ ] }
|
||||
} cond nip ;
|
||||
|
||||
: changed-file ( directory buffer -- changed path )
|
||||
: parse-file-notify ( directory buffer -- changed path )
|
||||
{
|
||||
FILE_NOTIFY_INFORMATION-FileName
|
||||
FILE_NOTIFY_INFORMATION-FileNameLength
|
||||
FILE_NOTIFY_INFORMATION-Action
|
||||
} get-slots >r memory>u16-string path+ r> parse-action swap ;
|
||||
} get-slots parse-action 1array -rot
|
||||
memory>u16-string path+ ;
|
||||
|
||||
: (changed-files) ( directory buffer -- )
|
||||
2dup changed-file namespace [ swap add ] change-at
|
||||
2dup parse-file-notify changed-file
|
||||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
: changed-files ( directory buffer len -- assoc )
|
||||
M: windows-nt-io fill-queue ( monitor -- assoc )
|
||||
dup win32-monitor-path over buffer-ptr rot read-changes
|
||||
[ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ;
|
||||
|
||||
: fill-queue ( monitor -- )
|
||||
dup monitor-path over buffer-ptr pick read-changes
|
||||
changed-files
|
||||
swap set-monitor-queue ;
|
||||
|
||||
M: windows-nt-io next-change ( monitor -- path changes )
|
||||
dup check-closed
|
||||
dup monitor-queue dup assoc-empty? [
|
||||
drop dup fill-queue next-change
|
||||
] [
|
||||
nip delete-any prune natural-sort >array
|
||||
] if ;
|
||||
|
|
|
@ -0,0 +1,26 @@
|
|||
|
||||
USING: kernel sequences quotations math parser
|
||||
shuffle combinators.cleave combinators.lib sequences.lib ;
|
||||
|
||||
IN: partial-apply
|
||||
|
||||
! Basic conceptual implementation. Todo: get it to compile.
|
||||
|
||||
: apply-n ( obj quot i -- quot ) 1+ [ -nrot ] curry swap compose curry ;
|
||||
|
||||
SYMBOL: _
|
||||
|
||||
SYMBOL: ~
|
||||
|
||||
: blank-positions ( quot -- seq )
|
||||
[ length 2 - ] [ _ indices ] bi [ - ] map-with ;
|
||||
|
||||
: partial-apply ( pattern -- quot )
|
||||
[ blank-positions length nrev ]
|
||||
[ peek 1quotation ]
|
||||
[ blank-positions ]
|
||||
tri
|
||||
[ apply-n ] each ;
|
||||
|
||||
: $[ \ ] [ >quotation ] parse-literal \ partial-apply parsed ; parsing
|
||||
|
|
@ -140,3 +140,13 @@ PRIVATE>
|
|||
: ?second ( seq -- second/f ) 1 swap ?nth ; inline
|
||||
: ?third ( seq -- third/f ) 2 swap ?nth ; inline
|
||||
: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! List the positions of obj in seq
|
||||
|
||||
: indices ( seq obj -- seq )
|
||||
>r dup length swap r>
|
||||
[ = [ ] [ drop f ] if ] curry
|
||||
2map
|
||||
[ ] subset ;
|
||||
|
|
|
@ -30,3 +30,8 @@ MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
|
|||
: 4drop ( a b c d -- ) 3drop drop ; inline
|
||||
|
||||
: tuckd ( x y z -- z x y z ) 2 ntuck ; inline
|
||||
|
||||
MACRO: nrev ( n -- quot )
|
||||
[ 1+ ] map
|
||||
reverse
|
||||
[ [ -nrot ] curry ] map concat ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax ;
|
||||
USING: alien.syntax math math.bitfields ;
|
||||
IN: unix.linux.inotify
|
||||
|
||||
C-STRUCT: inotify-event
|
||||
|
@ -8,7 +8,7 @@ C-STRUCT: inotify-event
|
|||
{ "uint" "mask" } ! watch mask
|
||||
{ "uint" "cookie" } ! cookie to synchronize two events
|
||||
{ "uint" "len" } ! length (including nulls) of name
|
||||
{ "char[1]" "name" } ! stub for possible name
|
||||
{ "char[0]" "name" } ! stub for possible name
|
||||
;
|
||||
|
||||
: IN_ACCESS HEX: 1 ; inline ! File was accessed
|
||||
|
@ -37,6 +37,13 @@ C-STRUCT: inotify-event
|
|||
: IN_ISDIR HEX: 40000000 ; inline ! event occurred against dir
|
||||
: IN_ONESHOT HEX: 80000000 ; inline ! only send event once
|
||||
|
||||
: IN_CHANGE_EVENTS
|
||||
{
|
||||
IN_MODIFY IN_ATTRIB IN_MOVED_FROM
|
||||
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
|
||||
: IN_ALL_EVENTS
|
||||
{
|
||||
IN_ACCESS IN_MODIFY IN_ATTRIB IN_CLOSE_WRITE
|
||||
|
@ -45,6 +52,6 @@ C-STRUCT: inotify-event
|
|||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
|
||||
FUNCTION: int inotify_init ( void ) ;
|
||||
FUNCTION: int inotify_add_watch ( int fd, char* name, u32 mask ) ;
|
||||
FUNCTION: int inotify_rm_watch ( int fd, u32 wd ) ;
|
||||
FUNCTION: int inotify_init ( ) ;
|
||||
FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask ) ;
|
||||
FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types hashtables kernel math math.vectors
|
||||
USING: alien alien.c-types hashtables kernel math math.vectors math.bitfields
|
||||
namespaces sequences x11.xlib x11.constants x11.glx ;
|
||||
IN: x11.windows
|
||||
|
||||
|
@ -12,7 +12,6 @@ IN: x11.windows
|
|||
XCreateColormap ;
|
||||
|
||||
: event-mask ( -- n )
|
||||
<<<<<<< HEAD:extra/x11/windows/windows.factor
|
||||
{
|
||||
ExposureMask
|
||||
StructureNotifyMask
|
||||
|
@ -26,19 +25,6 @@ IN: x11.windows
|
|||
LeaveWindowMask
|
||||
PropertyChangeMask
|
||||
} flags ;
|
||||
=======
|
||||
ExposureMask
|
||||
StructureNotifyMask bitor
|
||||
KeyPressMask bitor
|
||||
KeyReleaseMask bitor
|
||||
ButtonPressMask bitor
|
||||
ButtonReleaseMask bitor
|
||||
PointerMotionMask bitor
|
||||
FocusChangeMask bitor
|
||||
EnterWindowMask bitor
|
||||
LeaveWindowMask bitor
|
||||
PropertyChangeMask bitor ;
|
||||
>>>>>>> a05c18152b59073c49aa313ba685516310ec74a8:extra/x11/windows/windows.factor
|
||||
|
||||
: window-attributes ( visinfo -- attributes )
|
||||
"XSetWindowAttributes" <c-object>
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
! and note the section.
|
||||
|
||||
USING: kernel arrays alien alien.c-types alien.syntax
|
||||
math words sequences namespaces continuations ;
|
||||
math math.bitfields words sequences namespaces continuations ;
|
||||
IN: x11.xlib
|
||||
|
||||
LIBRARY: xlib
|
||||
|
@ -1078,16 +1078,16 @@ FUNCTION: Status XWithdrawWindow (
|
|||
|
||||
! 17.1.7 - Setting and Reading the WM_NORMAL_HINTS Property
|
||||
|
||||
: USPosition 1 0 shift ; inline
|
||||
: USSize 1 1 shift ; inline
|
||||
: PPosition 1 2 shift ; inline
|
||||
: PSize 1 3 shift ; inline
|
||||
: PMinSize 1 4 shift ; inline
|
||||
: PMaxSize 1 5 shift ; inline
|
||||
: PResizeInc 1 6 shift ; inline
|
||||
: PAspect 1 7 shift ; inline
|
||||
: PBaseSize 1 8 shift ; inline
|
||||
: PWinGravity 1 9 shift ; inline
|
||||
: USPosition 1 0 shift ; inline
|
||||
: USSize 1 1 shift ; inline
|
||||
: PPosition 1 2 shift ; inline
|
||||
: PSize 1 3 shift ; inline
|
||||
: PMinSize 1 4 shift ; inline
|
||||
: PMaxSize 1 5 shift ; inline
|
||||
: PResizeInc 1 6 shift ; inline
|
||||
: PAspect 1 7 shift ; inline
|
||||
: PBaseSize 1 8 shift ; inline
|
||||
: PWinGravity 1 9 shift ; inline
|
||||
: PAllHints
|
||||
{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable
|
||||
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
#include <sys/syscall.h>
|
||||
|
||||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
||||
|
||||
|
|
Loading…
Reference in New Issue