diff --git a/core/compiler/test/alien.factor b/core/compiler/test/alien.factor index e737a76e1e..acb9a4a4fa 100755 --- a/core/compiler/test/alien.factor +++ b/core/compiler/test/alien.factor @@ -132,8 +132,8 @@ FUNCTION: int ffi_test_10 int a int b double c int d float e int f int g int h ; [ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test FUNCTION: void ffi_test_20 double x1, double x2, double x3, - double y1, double y2, double y3, - double z1, double z2, double z3 ; + double y1, double y2, double y3, + double z1, double z2, double z3 ; [ ] [ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ffi_test_20 ] unit-test diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index fd15b7da98..ad2bacc789 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -54,6 +54,8 @@ M: pair (bitfield-quot) ( spec -- quot ) \ bitfield [ bitfield-quot ] 1 define-transform +\ flags [ flags [ ] curry ] 1 define-transform + ! Tuple operations : [get-slots] ( slots -- quot ) [ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ; diff --git a/core/math/bitfields/bitfields.factor b/core/math/bitfields/bitfields.factor index f6a3419784..77cc40180e 100644 --- a/core/math/bitfields/bitfields.factor +++ b/core/math/bitfields/bitfields.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math sequences words ; IN: math.bitfields @@ -13,3 +13,6 @@ M: pair (bitfield) ( value accum pair -- newaccum ) : bitfield ( values... bitspec -- n ) 0 [ (bitfield) ] reduce ; + +: flags ( values -- n ) + 0 [ dup word? [ execute ] when bitor ] reduce ; diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor index 7f7d946347..5907c22686 100755 --- a/core/prettyprint/prettyprint-tests.factor +++ b/core/prettyprint/prettyprint-tests.factor @@ -21,9 +21,9 @@ IN: temporary [ "hello\\backslash" unparse ] unit-test -[ "\"\\u123456\"" ] -[ "\u123456" unparse ] -unit-test +! [ "\"\\u123456\"" ] +! [ "\u123456" unparse ] +! unit-test [ "\"\\e\"" ] [ "\e" unparse ] diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 459ec7b153..985c025827 100755 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -88,8 +88,6 @@ unit-test ! Make sure aux vector is not shared [ "\udeadbe" ] [ - "\udeadbe" clone - CHAR: \u123456 over clone set-first + "\udeadbe" clone + CHAR: \u123456 over clone set-first ] unit-test - - diff --git a/extra/cocoa/windows/windows.factor b/extra/cocoa/windows/windows.factor old mode 100644 new mode 100755 index f1c66f5e58..b45acaf852 --- a/extra/cocoa/windows/windows.factor +++ b/extra/cocoa/windows/windows.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math cocoa cocoa.messages cocoa.classes -sequences ; +sequences math.bitfields ; IN: cocoa.windows : NSBorderlessWindowMask 0 ; inline @@ -15,10 +15,12 @@ IN: cocoa.windows : NSBackingStoreBuffered 2 ; inline : standard-window-type - NSTitledWindowMask - NSClosableWindowMask bitor - NSMiniaturizableWindowMask bitor - NSResizableWindowMask bitor ; inline + { + NSTitledWindowMask + NSClosableWindowMask + NSMiniaturizableWindowMask + NSResizableWindowMask + } flags ; inline : ( rect -- window ) NSWindow -> alloc swap diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index f26fe50d79..ef12543d52 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -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 diff --git a/extra/io/monitor/monitor.factor b/extra/io/monitor/monitor.factor index 4dc5081513..11d1b6ecf9 100755 --- a/extra/io/monitor/monitor.factor +++ b/extra/io/monitor/monitor.factor @@ -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 +array ; + +PRIVATE> + HOOK: 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+ diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 1b66c0332e..7112c48551 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -14,9 +14,9 @@ TUPLE: io-task port callbacks ; : io-task-fd io-task-port port-handle ; -: ( port continuation class -- task ) - >r 1vector io-task construct-boa r> construct-delegate ; - inline +: ( 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 ; : ( port -- task ) - f io-task construct-boa mx-task construct-delegate ; + f mx-task ; M: mx-task do-io-task io-task-port mx-port-mx 0 swap wait-for-events f ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index b56e62d3c4..edee598435 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.nonblocking io.unix.backend io.files io -unix kernel math continuations ; +unix kernel math continuations math.bitfields ; IN: io.unix.files : read-flags O_RDONLY ; inline @@ -12,7 +12,7 @@ IN: io.unix.files M: unix-io ( path -- stream ) open-read ; -: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ; inline +: write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline : open-write ( path -- fd ) write-flags file-mode open dup io-error ; @@ -20,7 +20,7 @@ M: unix-io ( path -- stream ) M: unix-io ( path -- stream ) open-write ; -: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ; inline +: append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline : open-append ( path -- fd ) append-flags file-mode open dup io-error diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor index 6d55decb5a..01d6159e45 100755 --- a/extra/io/unix/linux/linux.factor +++ b/extra/io/unix/linux/linux.factor @@ -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 ; + +: ( 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 ; + +: ( -- port ) + H{ } clone + inotify_init dup io-error inotify + { 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 + [ 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 ( 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 ; + +: 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 ; + +: ( port -- task ) + f inotify-task ; + +: init-inotify ( mx -- ) + + dup inotify set-global + swap register-io-task ; + +M: inotify-task do-io-task ( task -- ) + io-task-port read-notifications f ; + M: linux-io init-io ( -- ) - mx set-global ; + mx set-global ; ! init-inotify ; T{ linux-io } set-io-backend diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor index 8e0e63923d..f2cc4ef92a 100755 --- a/extra/io/windows/nt/monitor/monitor.factor +++ b/extra/io/windows/nt/monitor/monitor.factor @@ -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 ; +TUPLE: win32-monitor path recursive? ; + +: ( path recursive? port -- monitor ) + (monitor) { + set-win32-monitor-path + set-win32-monitor-recursive? + set-delegate + } win32-monitor construct ; + M: windows-nt-io ( path recursive? -- monitor ) [ - >r dup open-directory monitor r> { - set-monitor-path - set-delegate - set-monitor-recursive? - } monitor construct + over open-directory 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 (make-overlapped) @@ -49,6 +50,7 @@ M: windows-nt-io ( 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 ( 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 (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 ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 419864b624..ee3f744bb0 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -5,7 +5,7 @@ io.buffers io.files io.nonblocking io.sockets io.binary io.sockets.impl windows.errors strings io.streams.duplex kernel math namespaces sequences windows windows.kernel32 windows.shell32 windows.types windows.winsock splitting -continuations ; +continuations math.bitfields ; IN: io.windows TUPLE: windows-nt-io ; @@ -31,8 +31,11 @@ M: windows-io normalize-directory ( string -- string ) "\\" ?tail drop "\\*" append ; : share-mode ( -- fixnum ) - FILE_SHARE_READ FILE_SHARE_WRITE bitor - FILE_SHARE_DELETE bitor ; foldable + { + FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE + } flags ; foldable : default-security-attributes ( -- obj ) "SECURITY_ATTRIBUTES" diff --git a/extra/macros/zoo/authors.txt b/extra/macros/zoo/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/extra/macros/zoo/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/extra/macros/zoo/zoo.factor b/extra/macros/zoo/zoo.factor deleted file mode 100644 index 21edc39f19..0000000000 --- a/extra/macros/zoo/zoo.factor +++ /dev/null @@ -1,38 +0,0 @@ - -USING: kernel quotations arrays sequences sequences.private macros ; - -IN: macros.zoo - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! MACRO: narray ( n -- quot ) -! dup [ f ] curry -! swap [ -! [ swap [ set-nth-unsafe ] keep ] curry -! ] map concat append ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! MACRO: map-call-with ( quots -- ) -! [ [ [ keep ] curry ] map concat ] keep length [ nip narray ] curry compose ; - -! MACRO: map-call-with2 ( quots -- ) -! dup >r -! [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat -! [ 2drop ] append -! r> length [ narray ] curry append ; - -! MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Conceptual implementation: - -! : pcall ( seq quots -- seq ) [ call ] 2map ; - -! MACRO: pcall ( quots -- ) -! [ [ unclip ] swap append ] map -! [ [ r> swap add >r ] append ] map -! concat -! [ { } >r ] swap append ! pre -! [ drop r> ] append ; ! post diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 4ea91b867b..22bf657637 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! Portions copyright (C) 2007 Eduardo Cavazos. ! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types continuations kernel libc math macros namespaces math.vectors math.constants math.functions math.parser opengl.gl opengl.glu combinators arrays sequences -splitting words byte-arrays ; +splitting words byte-arrays assocs ; IN: opengl : coordinates [ first2 ] 2apply ; @@ -233,7 +233,8 @@ TUPLE: sprite loc dim dim2 dlist texture ; dup sprite-dlist delete-dlist sprite-texture delete-texture ; -: free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ; +: free-sprites ( sprites -- ) + [ nip [ free-sprite ] when* ] assoc-each ; : with-translation ( loc quot -- ) GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline diff --git a/extra/strings/lib/authors.txt b/extra/strings/lib/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/extra/strings/lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/extra/strings/lib/lib.factor b/extra/strings/lib/lib.factor deleted file mode 100644 index d0a34c8d28..0000000000 --- a/extra/strings/lib/lib.factor +++ /dev/null @@ -1,6 +0,0 @@ -USING: math arrays sequences kernel splitting strings ; -IN: strings.lib - -! : char>digit ( c -- i ) 48 - ; - -! : string>digits ( s -- seq ) [ char>digit ] { } map-as ; diff --git a/extra/strings/lib/tags.txt b/extra/strings/lib/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/extra/strings/lib/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index 0d7522332f..2dade0f58e 100755 --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -36,13 +36,13 @@ M: font hashcode* drop font hashcode* ; : close-freetype ( -- ) global [ - open-fonts [ values [ close-font ] each f ] change + open-fonts [ [ drop close-font ] assoc-each f ] change freetype [ FT_Done_FreeType f ] change ] bind ; M: freetype-renderer free-fonts ( world -- ) dup world-handle select-gl-context - world-fonts values [ second free-sprites ] each ; + world-fonts [ nip second free-sprites ] assoc-each ; : ttf-name ( font style -- name ) 2array H{ @@ -100,7 +100,7 @@ SYMBOL: dpi swap set-font-height ; : ( handle -- font ) - V{ } clone + H{ } clone { set-font-handle set-font-widths } font construct dup init-font ; @@ -119,7 +119,7 @@ M: freetype-renderer open-font ( font -- open-font ) : char-width ( open-font char -- w ) over font-widths [ dupd load-glyph glyph-hori-advance ft-ceil - ] cache-nth nip ; + ] cache nip ; M: freetype-renderer string-width ( open-font string -- w ) 0 -rot [ char-width + ] with each ; @@ -175,7 +175,7 @@ M: freetype-renderer string-height ( open-font string -- h ) [ bitmap>texture ] keep [ init-sprite ] keep ; : draw-char ( open-font char sprites -- ) - [ dupd ] cache-nth nip + [ dupd ] cache nip sprite-dlist glCallList ; : (draw-string) ( open-font sprites string loc -- ) @@ -186,7 +186,7 @@ M: freetype-renderer string-height ( open-font string -- h ) ] do-enabled ; : font-sprites ( open-font world -- pair ) - world-fonts [ open-font V{ } clone 2array ] cache ; + world-fonts [ open-font H{ } clone 2array ] cache ; M: freetype-renderer draw-string ( font string loc -- ) >r >r world get font-sprites first2 r> r> (draw-string) ; diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index c3ef328b29..c831a959d0 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -6,7 +6,8 @@ math math.vectors namespaces prettyprint sequences strings vectors words windows.kernel32 windows.gdi32 windows.user32 windows.opengl32 windows.messages windows.types windows.nt windows threads timers libc combinators continuations -command-line shuffle opengl ui.render unicode.case ascii ; +command-line shuffle opengl ui.render unicode.case ascii +math.bitfields ; IN: ui.windows TUPLE: windows-ui-backend ; @@ -370,7 +371,7 @@ M: windows-ui-backend (close-window) class-name-ptr get-global pick GetClassInfoEx zero? [ "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize - CS_HREDRAW CS_VREDRAW bitor CS_OWNDC bitor over set-WNDCLASSEX-style + { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style ui-wndproc over set-WNDCLASSEX-lpfnWndProc 0 over set-WNDCLASSEX-cbClsExtra 0 over set-WNDCLASSEX-cbWndExtra @@ -387,7 +388,7 @@ M: windows-ui-backend (close-window) make-adjusted-RECT >r class-name-ptr get-global f r> >r >r >r ex-style r> r> - WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor + { WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags CW_USEDEFAULT dup r> get-RECT-dimensions f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ; diff --git a/extra/unix/linux/ifreq/ifreq.factor b/extra/unix/linux/ifreq/ifreq.factor old mode 100644 new mode 100755 index c75ee9a5e4..31adc5c237 --- a/extra/unix/linux/ifreq/ifreq.factor +++ b/extra/unix/linux/ifreq/ifreq.factor @@ -58,10 +58,4 @@ IN: unix.linux.ifreq rot string>char-alien over set-struct-ifreq-ifr-ifrn swap over set-struct-ifreq-ifr-ifru - AF_INET SOCK_DGRAM 0 socket SIOCSIFMETRIC rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: words quotations sequences math macros ; - -MACRO: flags ( seq -- ) 0 swap [ execute bitor ] each 1quotation ; \ No newline at end of file + AF_INET SOCK_DGRAM 0 socket SIOCSIFMETRIC rot ioctl drop ; \ No newline at end of file diff --git a/extra/unix/linux/inotify/inotify.factor b/extra/unix/linux/inotify/inotify.factor new file mode 100644 index 0000000000..b7b721efc7 --- /dev/null +++ b/extra/unix/linux/inotify/inotify.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax math math.bitfields ; +IN: unix.linux.inotify + +C-STRUCT: inotify-event + { "int" "wd" } ! watch descriptor + { "uint" "mask" } ! watch mask + { "uint" "cookie" } ! cookie to synchronize two events + { "uint" "len" } ! length (including nulls) of name + { "char[0]" "name" } ! stub for possible name + ; + +: IN_ACCESS HEX: 1 ; inline ! File was accessed +: IN_MODIFY HEX: 2 ; inline ! File was modified +: IN_ATTRIB HEX: 4 ; inline ! Metadata changed +: IN_CLOSE_WRITE HEX: 8 ; inline ! Writtable file was closed +: IN_CLOSE_NOWRITE HEX: 10 ; inline ! Unwrittable file closed +: IN_OPEN HEX: 20 ; inline ! File was opened +: IN_MOVED_FROM HEX: 40 ; inline ! File was moved from X +: IN_MOVED_TO HEX: 80 ; inline ! File was moved to Y +: IN_CREATE HEX: 100 ; inline ! Subfile was created +: IN_DELETE HEX: 200 ; inline ! Subfile was deleted +: IN_DELETE_SELF HEX: 400 ; inline ! Self was deleted +: IN_MOVE_SELF HEX: 800 ; inline ! Self was moved + +: IN_UNMOUNT HEX: 2000 ; inline ! Backing fs was unmounted +: IN_Q_OVERFLOW HEX: 4000 ; inline ! Event queued overflowed +: IN_IGNORED HEX: 8000 ; inline ! File was ignored + +: IN_CLOSE IN_CLOSE_WRITE IN_CLOSE_NOWRITE bitor ; inline ! close +: IN_MOVE IN_MOVED_FROM IN_MOVED_TO bitor ; inline ! moves + +: IN_ONLYDIR HEX: 1000000 ; inline ! only watch the path if it is a directory +: IN_DONT_FOLLOW HEX: 2000000 ; inline ! don't follow a sym link +: IN_MASK_ADD HEX: 20000000 ; inline ! add to the mask of an already existing watch +: 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 + IN_CLOSE_NOWRITE IN_OPEN IN_MOVED_FROM + IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF + IN_MOVE_SELF + } flags ; foldable + +FUNCTION: int inotify_init ( ) ; +FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask ) ; +FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ; diff --git a/extra/windows/advapi32/advapi32.factor b/extra/windows/advapi32/advapi32.factor old mode 100644 new mode 100755 index fd2a9fb8af..d3413b5695 --- a/extra/windows/advapi32/advapi32.factor +++ b/extra/windows/advapi32/advapi32.factor @@ -1,4 +1,4 @@ -USING: alien.syntax kernel math windows.types ; +USING: alien.syntax kernel math windows.types math.bitfields ; IN: windows.advapi32 LIBRARY: advapi32 @@ -483,20 +483,28 @@ FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName, : TOKEN_QUERY_SOURCE HEX: 0010 ; inline : TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline : TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ; -: TOKEN_WRITE STANDARD_RIGHTS_WRITE - TOKEN_ADJUST_PRIVILEGES bitor - TOKEN_ADJUST_GROUPS bitor - TOKEN_ADJUST_DEFAULT bitor ; foldable -: TOKEN_ALL_ACCESS STANDARD_RIGHTS_REQUIRED - TOKEN_ASSIGN_PRIMARY bitor - TOKEN_DUPLICATE bitor - TOKEN_IMPERSONATE bitor - TOKEN_QUERY bitor - TOKEN_QUERY_SOURCE bitor - TOKEN_ADJUST_PRIVILEGES bitor - TOKEN_ADJUST_GROUPS bitor - TOKEN_ADJUST_SESSIONID bitor - TOKEN_ADJUST_DEFAULT bitor ; foldable + +: TOKEN_WRITE + { + STANDARD_RIGHTS_WRITE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_DEFAULT + } flags ; foldable + +: TOKEN_ALL_ACCESS + { + STANDARD_RIGHTS_REQUIRED + TOKEN_ASSIGN_PRIMARY + TOKEN_DUPLICATE + TOKEN_IMPERSONATE + TOKEN_QUERY + TOKEN_QUERY_SOURCE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_SESSIONID + TOKEN_ADJUST_DEFAULT + } flags ; foldable FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle, DWORD DesiredAccess, diff --git a/extra/windows/opengl32/opengl32.factor b/extra/windows/opengl32/opengl32.factor index a8d8ad8153..c38579c95e 100755 --- a/extra/windows/opengl32/opengl32.factor +++ b/extra/windows/opengl32/opengl32.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax parser namespaces kernel -math windows.types windows.types init assocs sequences libc ; +math math.bitfields windows.types windows.types init assocs +sequences libc ; IN: windows.opengl32 ! PIXELFORMATDESCRIPTOR flags @@ -70,10 +71,8 @@ IN: windows.opengl32 : WGL_SWAP_UNDERLAY14 HEX: 20000000 ; inline : WGL_SWAP_UNDERLAY15 HEX: 40000000 ; inline - - : pfd-dwFlags - PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL bitor PFD_DOUBLEBUFFER bitor ; + { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ; ! TODO: compare to http://www.nullterminator.net/opengl32.html : make-pfd ( bits -- pfd ) diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor old mode 100644 new mode 100755 index c8f6a82fb5..39879bf91d --- a/extra/windows/user32/user32.factor +++ b/extra/windows/user32/user32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax parser namespaces kernel math -windows.types shuffle ; +windows.types shuffle math.bitfields ; IN: windows.user32 ! HKL for ActivateKeyboardLayout @@ -32,9 +32,18 @@ IN: windows.user32 : WS_MAXIMIZEBOX HEX: 00010000 ; inline ! Common window styles -: WS_OVERLAPPEDWINDOW WS_OVERLAPPED WS_CAPTION WS_SYSMENU WS_THICKFRAME WS_MINIMIZEBOX WS_MAXIMIZEBOX bitor bitor bitor bitor bitor ; foldable inline +: WS_OVERLAPPEDWINDOW + { + WS_OVERLAPPED + WS_CAPTION + WS_SYSMENU + WS_THICKFRAME + WS_MINIMIZEBOX + WS_MAXIMIZEBOX + } flags ; foldable -: WS_POPUPWINDOW WS_POPUP WS_BORDER WS_SYSMENU bitor bitor ; foldable inline +: WS_POPUPWINDOW + { WS_POPUP WS_BORDER WS_SYSMENU } flags ; foldable : WS_CHILDWINDOW WS_CHILD ; inline @@ -66,10 +75,9 @@ IN: windows.user32 : WS_EX_STATICEDGE HEX: 00020000 ; inline : WS_EX_APPWINDOW HEX: 00040000 ; inline : WS_EX_OVERLAPPEDWINDOW ( -- n ) - WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable inline + WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable : WS_EX_PALETTEWINDOW ( -- n ) - WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW bitor - WS_EX_TOPMOST bitor ; foldable inline + { WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable : CS_VREDRAW HEX: 0001 ; inline : CS_HREDRAW HEX: 0002 ; inline diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor index ffab6786b5..cc19cdc2a3 100755 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. -USING: alien alien.c-types alien.syntax arrays byte-arrays kernel -math sequences windows.types windows.kernel32 windows.errors structs -windows ; +USING: alien alien.c-types alien.syntax arrays byte-arrays +kernel math sequences windows.types windows.kernel32 +windows.errors structs windows math.bitfields ; IN: windows.winsock USE: libc @@ -74,7 +74,7 @@ TYPEDEF: void* SOCKET : AI_PASSIVE 1 ; inline : AI_CANONNAME 2 ; inline : AI_NUMERICHOST 4 ; inline -: AI_MASK AI_PASSIVE AI_CANONNAME bitor AI_NUMERICHOST bitor ; +: AI_MASK { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; : NI_NUMERICHOST 1 ; : NI_NUMERICSERV 2 ; diff --git a/extra/x/widgets/wm/frame/frame.factor b/extra/x/widgets/wm/frame/frame.factor old mode 100644 new mode 100755 index ecf628b9c7..4e3b4e7c93 --- a/extra/x/widgets/wm/frame/frame.factor +++ b/extra/x/widgets/wm/frame/frame.factor @@ -21,14 +21,16 @@ SYMBOL: swap new* >>child new* "white" <-- set-foreground >>gc - SubstructureRedirectMask - ExposureMask bitor - ButtonPressMask bitor - ButtonReleaseMask bitor - ButtonMotionMask bitor - EnterWindowMask bitor - ! experimental masks - SubstructureNotifyMask bitor + { + SubstructureRedirectMask + ExposureMask + ButtonPressMask + ButtonReleaseMask + ButtonMotionMask + EnterWindowMask + ! experimental masks + SubstructureNotifyMask + } flags >>mask <- init-widget diff --git a/extra/x11/windows/windows.factor b/extra/x11/windows/windows.factor old mode 100644 new mode 100755 index 94695720ea..b3220d44bd --- a/extra/x11/windows/windows.factor +++ b/extra/x11/windows/windows.factor @@ -5,14 +5,28 @@ namespaces sequences x11.xlib x11.constants x11.glx ; IN: x11.windows : create-window-mask ( -- n ) - CWBackPixel CWBorderPixel bitor - CWColormap bitor CWEventMask bitor ; + { CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ; : create-colormap ( visinfo -- colormap ) dpy get root get rot XVisualInfo-visual AllocNone XCreateColormap ; : event-mask ( -- n ) +<<<<<<< HEAD:extra/x11/windows/windows.factor + { + ExposureMask + StructureNotifyMask + KeyPressMask + KeyReleaseMask + ButtonPressMask + ButtonReleaseMask + PointerMotionMask + FocusChangeMask + EnterWindowMask + LeaveWindowMask + PropertyChangeMask + } flags ; +======= ExposureMask StructureNotifyMask bitor KeyPressMask bitor @@ -24,6 +38,7 @@ IN: x11.windows EnterWindowMask bitor LeaveWindowMask bitor PropertyChangeMask bitor ; +>>>>>>> a05c18152b59073c49aa313ba685516310ec74a8:extra/x11/windows/windows.factor : window-attributes ( visinfo -- attributes ) "XSetWindowAttributes" diff --git a/extra/x11/xim/xim.factor b/extra/x11/xim/xim.factor old mode 100644 new mode 100755 diff --git a/extra/x11/xlib/xlib.factor b/extra/x11/xlib/xlib.factor old mode 100644 new mode 100755 index 8dd8a55acc..230b24c6d0 --- a/extra/x11/xlib/xlib.factor +++ b/extra/x11/xlib/xlib.factor @@ -1078,18 +1078,18 @@ 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 -: PAllHints [ PPosition PSize PMinSize PMaxSize PResizeInc PAspect ] -0 [ execute bitor ] reduce ; 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 C-STRUCT: XSizeHints { "long" "flags" } diff --git a/vm/os-linux.c b/vm/os-linux.c index 8f3f8408f3..935add6714 100644 --- a/vm/os-linux.c +++ b/vm/os-linux.c @@ -17,3 +17,18 @@ const char *vm_executable_path(void) return safe_strdup(path); } } + +int inotify_init(void) +{ + return syscall(SYS_inotify_init); +} + +int inotify_add_watch(int fd, const char *name, u32 mask) +{ + return syscall(SYS_inotify_add_watch, fd, name, mask); +} + +int inotify_rm_watch(int fd, u32 wd) +{ + return syscall(SYS_inotify_rm_watch, fd, wd); +} diff --git a/vm/os-linux.h b/vm/os-linux.h index 21e34c98f8..1a1e088359 100644 --- a/vm/os-linux.h +++ b/vm/os-linux.h @@ -1,6 +1,12 @@ +#include + #define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) #define DIRECTORY_P(file) ((file)->d_type == DT_DIR) #ifndef environ extern char **environ; #endif + +int inotify_init(void); +int inotify_add_watch(int fd, const char *name, u32 mask); +int inotify_rm_watch(int fd, u32 wd);