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

core/flow-chart/flow-chart.factor

@@ -0,0 +1,74 @@
+USING: kernel words math inference.dataflow sequences
+optimizer.def-use combinators.private namespaces arrays
+math.parser assocs prettyprint io strings inference hashtables ;
+IN: flow-chart
+
+GENERIC: flow-chart* ( n word -- value nodes )
+
+M: word flow-chart*
+    2drop f f ;
+
+M: compound flow-chart*
+    word-def swap 1+ [ drop <computed> ] map
+    [ dataflow-with compute-def-use ] keep
+    first dup used-by prune [ t eq? not ] subset ;
+
+GENERIC: node-word ( node -- word )
+
+M: #call node-word node-param ;
+
+M: #if node-word drop \ if ;
+
+M: #dispatch node-word drop \ dispatch ;
+
+DEFER: flow-chart
+
+: flow-chart-node ( value node -- )
+    [ node-in-d <reversed> index ] keep
+    node-word flow-chart , ;
+
+SYMBOL: pruned
+
+SYMBOL: nesting
+
+SYMBOL: max-nesting
+
+2 max-nesting set
+
+: flow-chart ( n word -- seq )
+    [
+        2dup 2array ,
+        nesting dup inc get max-nesting get > [
+            2drop pruned ,
+        ] [
+            flow-chart* dup length 5 > [
+                2drop pruned ,
+            ] [
+                [ flow-chart-node ] curry* each
+            ] if
+        ] if
+    ] { } make ;
+
+: th ( n -- )
+    dup number>string write
+    100 mod dup 20 > [ 10 mod ] when
+    H{ { 1 "st" } { 2 "nd" } { 3 "rd" } } at "th" or write ;
+
+: chart-heading. ( pair -- )
+    first2 >r 1+ th " argument to " write r> . ;
+
+GENERIC# show-chart 1 ( seq n -- )
+
+: indent CHAR: \s <string> write ;
+
+M: sequence show-chart
+    dup indent
+    >r unclip chart-heading. r>
+    2 + [ show-chart ] curry each ;
+
+M: word show-chart
+    dup indent
+    "... pruned" print ;
+
+: flow-chart. ( n word -- )
+    flow-chart 2 show-chart ;

core/io/files/files.factor

@@ -19,17 +19,17 @@ HOOK: make-directory io-backend ( path -- )
 
 HOOK: delete-directory io-backend ( path -- )
 
+: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
+
 HOOK: root-directory? io-backend ( path -- ? )
 
-M: object root-directory? ( path -- ? ) "/" = ;
+M: object root-directory? ( path -- ? ) path-separator? ;
 
-! Words for accessing filesystem meta-data.
+: trim-path-separators ( str -- newstr )
-
+    [ path-separator? ] right-trim ;
-: path-separator? ( ch -- ? )
-    "/\\" member? ;
 
 : path+ ( str1 str2 -- str )
-    >r [ path-separator? ] right-trim "/" r>
+    >r trim-path-separators "/" r>
     [ path-separator? ] left-trim 3append ;
 
 : stat ( path -- directory? permissions length modified )
@@ -39,12 +39,15 @@ M: object root-directory? ( path -- ? ) "/" = ;
 
 : directory? ( path -- ? ) stat 3drop ;
 
+: special-directory? ( name -- ? )
+    { "." ".." } member? ;
+
 : fixup-directory ( path seq -- newseq )
     [
         dup string?
         [ tuck path+ directory? 2array ] [ nip ] if
     ] curry* map
-    [ first { "." ".." } member? not ] subset ;
+    [ first special-directory? not ] subset ;
 
 : directory ( path -- seq )
     normalize-directory dup (directory) fixup-directory ;
@@ -62,17 +65,19 @@ TUPLE: no-parent-directory path ;
     \ no-parent-directory construct-boa throw ;
 
 : parent-directory ( path -- parent )
-    {
+    trim-path-separators
-        { [ dup root-directory? ] [ ] }
+    dup empty? [ drop "/" ] [
-        { [ dup "/\\" split ".." over member? "." rot member? or ]
+        dup root-directory? [ ] [
-            [ no-parent-directory ] }
+            dup last-path-separator drop [
-        { [ t ] [ dup last-path-separator
+                1+ cut
-            [ 1+ head ] [ 2drop "." ] if ] }
+                special-directory?
-    } cond ;
+                [ no-parent-directory ] when
+            ] when*
+        ] if
+    ] if ;
 
 : file-name ( path -- string )
-    dup last-path-separator
+    dup last-path-separator [ 1+ tail ] [ drop ] if ;
-    [ 1+ tail ] [ drop ] if ;
 
 : resource-path ( path -- newpath )
     \ resource-path get [ image parent-directory ] unless*
@@ -82,8 +87,7 @@ TUPLE: no-parent-directory path ;
     "resource:" ?head [ resource-path ] when ;
 
 : make-directories ( path -- )
-    normalize-pathname
+    normalize-pathname trim-path-separators {
-    {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }
@@ -94,19 +98,6 @@ TUPLE: no-parent-directory path ;
         ] }
     } cond drop ;
 
-TUPLE: pathname string ;
-
-C: <pathname> pathname
-
-M: pathname <=> [ pathname-string ] compare ;
-
-: home ( -- dir )
-    {
-        { [ winnt? ] [ "USERPROFILE" os-env ] }
-        { [ wince? ] [ "" resource-path ] }
-        { [ unix? ] [ "HOME" os-env ] }
-    } cond ;
-
 : copy-file ( from to -- )
     dup parent-directory make-directories
     <file-writer> [
@@ -121,3 +112,16 @@ M: pathname <=> [ pathname-string ] compare ;
     >r dup directory swap r> [
         >r >r first r> over path+ r> rot path+ copy-file
     ] 2curry each ;
+
+: home ( -- dir )
+    {
+        { [ winnt? ] [ "USERPROFILE" os-env ] }
+        { [ wince? ] [ "" resource-path ] }
+        { [ unix? ] [ "HOME" os-env ] }
+    } cond ;
+
+TUPLE: pathname string ;
+
+C: <pathname> pathname
+
+M: pathname <=> [ pathname-string ] compare ;

core/vocabs/loader/loader.factor

@@ -145,7 +145,7 @@ SYMBOL: load-help?
 : update-roots ( vocabs -- )
     [ dup find-vocab-root swap vocab set-vocab-root ] each ;
 
-: to-refresh ( prefix -- seq )
+: to-refresh ( prefix -- modified-sources modified-docs )
     child-vocabs
     dup update-roots
     dup modified-sources swap modified-docs ;

extra/io/server/server.factor

@@ -80,7 +80,8 @@ SYMBOL: log-stream
 
 : datagram-loop ( quot datagram -- )
     [
-        [ receive dup log-datagram >r swap call r> ] keep send
+        [ receive dup log-datagram >r swap call r> ] keep
+        pick [ send ] [ 3drop ] keep
     ] 2keep datagram-loop ; inline
 
 : spawn-datagrams ( quot addrspec -- )
@@ -91,4 +92,4 @@ SYMBOL: log-stream
 : with-datagrams ( seq service quot -- )
     [
         [ swap spawn-datagrams ] curry concurrency:parallel-each
-    ] with-logging ; inline
+    ] curry with-logging ; inline

extra/io/unix/files/files.factor

@@ -4,9 +4,6 @@ USING: io.backend io.nonblocking io.unix.backend io.files io
 unix kernel math continuations ;
 IN: io.unix.files
 
-M: unix-io root-directory? ( path -- ? )
-    "/" = ;
-
 : open-read ( path -- fd )
     O_RDONLY file-mode open dup io-error ;
 

extra/io/unix/launcher/launcher.factor

@@ -1,36 +1,13 @@
 
 USING: io io.launcher io.unix.backend io.nonblocking
 sequences kernel namespaces math system alien.c-types
-debugger continuations combinators.lib threads ;
+debugger continuations ;
 
 IN: io.unix.launcher
 
 ! Search unix first
 USE: unix
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Factor friendly versions of the exec functions
-
-: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ;
-
-: execv*  ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ;
-: execvp* ( filename argv -- int ) [ malloc-char-string ] [ >argv ] bi* execvp ;
-
-: execve* ( pathname argv envp -- int )
-  [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Wait for a pid to finish without freezing up all the Factor threads.
-! Need to find a less kludgy way to do this.
-
-: wait-for-pid ( pid -- )
-  dup "int" <c-object> WNOHANG waitpid
-  0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : with-fork ( child parent -- pid )
     fork [ zero? -rot if ] keep ; inline
 

extra/io/windows/ce/sockets/sockets.factor

@@ -8,89 +8,16 @@ IN: io.windows.ce
 
 M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ;
 
-TUPLE: WSAArgs
-    s
-    lpBuffers
-    dwBufferCount
-    lpNumberOfBytesRet
-    lpFlags
-    lpOverlapped
-    lpCompletionRoutine ;
-C: <WSAArgs> WSAArgs
-
-: make-WSAArgs ( port -- <WSARecv> )
-    [ port-handle win32-file-handle ] keep
-    1 "DWORD" <c-object> f f f <WSAArgs> ;
-
-: setup-WSARecv ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
-    [ WSAArgs-s ] keep
-    [
-        WSAArgs-lpBuffers [ buffer-capacity ] keep
-        buffer-end
-        "WSABUF" <c-object>
-        [ windows.winsock:set-WSABUF-buf ] keep
-        [ windows.winsock:set-WSABUF-len ] keep
-    ] keep
-    [ WSAArgs-dwBufferCount ] keep
-    [ WSAArgs-lpNumberOfBytesRet ] keep
-    [ WSAArgs-lpFlags ] keep
-    [ WSAArgs-lpOverlapped ] keep
-    WSAArgs-lpCompletionRoutine ;
-
-! M: win32-socket wince-read ( port port-handle -- )
-    ! drop dup make-WSAArgs dup setup-WSARecv WSARecv zero? [
-        ! drop port-errored
-    ! ] [
-        ! WSAArgs-lpNumberOfBytesRet *uint dup zero? [
-            ! drop
-            ! t swap set-port-eof?
-        ! ] [
-            ! swap n>buffer
-        ! ] if
-    ! ] if ;
-
 M: win32-socket wince-read ( port port-handle -- )
     win32-file-handle over buffer-end pick buffer-capacity 0
     windows.winsock:recv
     dup windows.winsock:SOCKET_ERROR = [
         drop port-errored
     ] [
-        dup zero? [
+        dup zero?
-            drop
+        [ drop t swap set-port-eof? ] [ swap n>buffer ] if
-            t swap set-port-eof?
-        ] [
-            swap n>buffer
-        ] if
     ] if ;
 
-: setup-WSASend ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
-    [ WSAArgs-s ] keep
-    [
-        WSAArgs-lpBuffers [ buffer-length ] keep
-        buffer@
-        "WSABUF" <c-object>
-        [ windows.winsock:set-WSABUF-buf ] keep
-        [ windows.winsock:set-WSABUF-len ] keep
-    ] keep
-    [ WSAArgs-dwBufferCount ] keep
-    [ WSAArgs-lpNumberOfBytesRet ] keep
-    [ WSAArgs-lpFlags ] keep
-    [ WSAArgs-lpOverlapped ] keep
-    WSAArgs-lpCompletionRoutine ;
-
-! M: win32-socket wince-write ( port port-handle -- )
-    ! drop dup make-WSAArgs dup setup-WSASend WSASend zero? [
-        ! drop port-errored
-    ! ] [
-        ! FileArgs-lpNumberOfBytesRet *uint ! *DWORD
-        ! over delegate [ buffer-consume ] keep
-        ! buffer-length 0 > [
-            ! flush-output
-        ! ] [
-            ! drop
-        ! ] if
-    ! ] if ;
-
 M: win32-socket wince-write ( port port-handle -- )
     win32-file-handle over buffer@ pick buffer-length 0
     windows.winsock:send
@@ -100,8 +27,9 @@ M: win32-socket wince-write ( port port-handle -- )
 : do-connect ( addrspec -- socket )
     [ tcp-socket dup ] keep
     make-sockaddr/size
-    f f f f windows.winsock:WSAConnect zero?
+    f f f f
-    [ windows.winsock:winsock-error ] unless ;
+    windows.winsock:WSAConnect
+    windows.winsock:winsock-error!=0/f ;
 
 M: windows-ce-io (client) ( addrspec -- duplex-stream )
     do-connect <win32-socket> dup handle>duplex-stream ;
@@ -121,7 +49,8 @@ M: windows-ce-io accept ( server -- client )
         swap server-port-addr sockaddr-type heap-size
         dup <byte-array> [
             swap <int> f 0
-            windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET =
+            windows.winsock:WSAAccept
+            dup windows.winsock:INVALID_SOCKET =
             [ windows.winsock:winsock-error ] when
         ] keep
     ] keep server-port-addr parse-sockaddr swap
@@ -132,14 +61,32 @@ M: windows-ce-io <datagram> ( addrspec -- datagram )
         windows.winsock:SOCK_DGRAM server-fd <win32-socket> f <port>
     ] keep <datagram-port> ;
 
+: packet-size 65536 ; inline
+
+: receive-buffer ( -- buf )
+    \ receive-buffer get-global expired? [
+        packet-size malloc \ receive-buffer set-global
+    ] when
+    \ receive-buffer get-global ;
+
+: make-WSABUF ( len buf -- ptr )
+    "WSABUF" <c-object>
+    [ windows.winsock:set-WSABUF-buf ] keep
+    [ windows.winsock:set-WSABUF-len ] keep ;
+
+: receive-WSABUF ( -- buf )
+    packet-size receive-buffer make-WSABUF ;
+
+: packet-data ( len -- byte-array )
+    receive-buffer swap memory>string >byte-array ;
+
+packet-size <byte-array> receive-buffer set-global
+
 M: windows-ce-io receive ( datagram -- packet addrspec )
     dup check-datagram-port
     [
         port-handle win32-file-handle
-        "WSABUF" <c-object>
+        receive-WSABUF
-        default-buffer-size get over windows.winsock:set-WSABUF-len
-        default-buffer-size get <byte-array> over windows.winsock:set-WSABUF-buf
-        [
         1
         0 <uint> [
             0 <uint>
@@ -147,24 +94,22 @@ M: windows-ce-io receive ( datagram -- packet addrspec )
                 64 <int>
                 f
                 f
-                    windows.winsock:WSARecvFrom zero?
+                windows.winsock:WSARecvFrom
-                    [ windows.winsock:winsock-error ] unless
+                windows.winsock:winsock-error!=0/f
             ] keep
-            ] keep *uint
+        ] keep *uint packet-data swap
-        ] keep
+    ] keep datagram-port-addr parse-sockaddr ;
-    ] keep
+
-    ! sockaddr count buf datagram
+: send-WSABUF ( byte-array -- ptr )
-    >r windows.winsock:WSABUF-buf swap memory>string swap r>
+    dup length packet-size > [ "UDP packet too long" throw ] when
-    datagram-port-addr parse-sockaddr ;
+    dup length receive-buffer rot pick memcpy
+    receive-buffer make-WSABUF ;
 
 M: windows-ce-io send ( packet addrspec datagram -- )
     3dup check-datagram-send
     port-handle win32-file-handle
-    rot dup length "WSABUF" <c-object>
+    rot send-WSABUF
-    [ windows.winsock:set-WSABUF-len ] keep
-    [ windows.winsock:set-WSABUF-buf ] keep
-
     rot make-sockaddr/size
     >r >r 1 0 <uint> 0 r> r> f f
-    windows.winsock:WSASendTo zero?
+    windows.winsock:WSASendTo
-    [ windows.winsock:winsock-error ] unless ;
+    windows.winsock:winsock-error!=0/f ;

extra/io/windows/nt/backend/backend.factor

@@ -8,6 +8,14 @@ IN: io.windows.nt.backend
 : unicode-prefix ( -- seq )
     "\\\\?\\" ; inline
 
+M: windows-nt-io root-directory? ( path -- ? )
+    dup length 2 = [
+        dup first Letter?
+        swap second CHAR: : = and
+    ] [
+        drop f
+    ] if ;
+
 M: windows-nt-io normalize-pathname ( string -- string )
     dup string? [ "pathname must be a string" throw ] unless
     "/" split "\\" join

extra/io/windows/nt/nt-tests.factor

@@ -5,12 +5,12 @@ IN: temporary
 [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
 [ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
 ! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
-[ "c:\\" ] [ "c:\\" parent-directory ] unit-test
+[ "c:" ] [ "c:\\" parent-directory ] unit-test
-[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test
+[ "Z:" ] [ "Z:\\" parent-directory ] unit-test
 [ "c:" ] [ "c:" parent-directory ] unit-test
 [ "Z:" ] [ "Z:" parent-directory ] unit-test
-[ t ] [ "c:\\" root-directory? ] unit-test
+[ t ] [ "c:\\" trim-path-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" root-directory? ] unit-test
+[ t ] [ "Z:\\" trim-path-separators root-directory? ] unit-test
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test

extra/io/windows/windows.factor

@@ -1,9 +1,8 @@
-USING: alien alien.c-types arrays destructors io
+USING: alien alien.c-types arrays destructors io io.backend
-io.backend io.buffers io.files io.nonblocking io.sockets
+io.buffers io.files io.nonblocking io.sockets io.binary
-io.sockets.impl windows.errors strings io.streams.duplex
+io.sockets.impl windows.errors strings io.streams.duplex kernel
-kernel math namespaces sequences windows
+math namespaces sequences windows windows.kernel32
-windows.kernel32 windows.winsock windows.winsock.private ;
+windows.winsock windows.winsock.private ;
-USE: prettyprint
 IN: io.windows
 
 TUPLE: windows-nt-io ;
@@ -16,15 +15,6 @@ M: windows-io (handle-destructor) ( obj -- )
 M: windows-io (socket-destructor) ( obj -- )
     destructor-obj closesocket drop ;
 
-M: windows-io root-directory? ( path -- ? )
-    [ path-separator? ] right-trim
-    dup length 2 = [
-        dup first Letter?
-        swap second CHAR: : = and
-    ] [
-        drop f
-    ] if ;
-
 TUPLE: win32-file handle ptr overlapped ;
 
 : <win32-file>  ( handle ptr -- obj )
@@ -67,9 +57,18 @@ M: win32-file close-handle ( handle -- )
 : (open-append) ( path -- handle )
     normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ;
 
+: set-file-pointer ( handle length -- )
+    dupd d>w/w <uint> FILE_BEGIN SetFilePointer
+    INVALID_SET_FILE_POINTER = [
+        CloseHandle "SetFilePointer failed" throw
+    ] when drop ;
+
 : open-append ( path -- handle length )
-    dup file-length dup
+    dup file-length dup [
-    [ >r (open-append) r> ] [ drop open-write ] if ;
+        >r (open-append) r> 2dup set-file-pointer
+    ] [
+        drop open-write
+    ] if ;
 
 TUPLE: FileArgs
     hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRet lpOverlapped ;
@@ -160,13 +159,13 @@ USE: namespaces
 : listen-backlog ( -- n ) HEX: 7fffffff ; inline
 
 : listen-on-socket ( socket -- )
-    listen-backlog listen winsock-error!=0/f ;
+    listen-backlog listen winsock-return-check ;
 
 M: win32-socket stream-close ( stream -- )
     win32-file-handle closesocket drop ;
 
 M: windows-io addrinfo-error ( n -- )
-    winsock-error!=0/f ;
+    winsock-return-check ;
 
 : tcp-socket ( addrspec -- socket )
     protocol-family SOCK_STREAM open-socket ;

extra/network-clipboard/network-clipboard.factor

@@ -0,0 +1,99 @@
+! Copyright (C) 2007 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.server io.sockets io strings parser byte-arrays
+namespaces ui.clipboards ui.gadgets.panes ui.gadgets.scrollers
+ui.gadgets.buttons ui.gadgets.tracks ui.gadgets ui.operations
+ui.commands ui kernel splitting combinators continuations
+sequences io.streams.duplex models ;
+IN: network-clipboard
+
+: clipboard-port 4444 ;
+
+: get-request
+    clipboard get clipboard-contents write ;
+
+: contents ( -- str )
+    [ 1024 read dup ] [ ] [ drop ] unfold concat ;
+
+: set-request
+    contents clipboard get set-clipboard-contents ;
+    
+: clipboard-server ( -- )
+    clipboard-port internet-server "clip-server" [
+        readln {
+            { "GET" [ get-request ] }
+            { "SET" [ set-request ] }
+        } case
+    ] with-server ;
+
+\ clipboard-server H{
+    { +nullary+ t }
+    { +listener+ t }
+} define-command
+
+: <client-datagram> ( -- datagram )
+    "0.0.0.0" 0 <inet4> <datagram> ;
+
+: with-client ( addrspec quot -- )
+    >r <client> r> with-stream ; inline
+
+: send-text ( text host -- )
+    clipboard-port <inet4> [ write ] with-client ;
+
+TUPLE: host name ;
+
+C: <host> host
+    
+M: string host-name ;
+
+: send-clipboard ( host -- )
+    host-name
+    "SET\n" clipboard get clipboard-contents append swap send-text ;
+
+[ host? ] \ send-clipboard H{ } define-operation
+
+: ask-text ( text host -- )
+    clipboard-port <inet4>
+    [ write flush contents ] with-client ;
+
+: receive-clipboard ( host -- )
+    host-name
+    "GET\n" swap ask-text
+    clipboard get set-clipboard-contents ;
+
+[ host? ] \ receive-clipboard H{ } define-operation
+
+: hosts. ( seq -- )
+    "Hosts:" print
+    [ dup <host> write-object nl ] each ;
+
+TUPLE: network-clipboard-tool ;
+
+\ network-clipboard-tool "toolbar" f {
+    { f clipboard-server }
+} define-command-map
+
+: <network-clipboard-tool> ( model -- gadget )
+    \ network-clipboard-tool construct-empty [
+        toolbar,
+        [ hosts. ] <pane-control> <scroller> 1 track,
+    ] { 0 1 } build-track ;
+
+SYMBOL: network-clipboards
+
+{ } <model> network-clipboards set-global
+
+: set-network-clipboards ( seq -- )
+    network-clipboards get set-model ;
+
+: add-network-clipboard ( host -- )
+    network-clipboards get [ swap add ] change-model ;
+
+: network-clipboard-tool ( -- )
+    [
+        network-clipboards get
+        <network-clipboard-tool>
+        "Network clipboard" open-window
+    ] with-ui ;
+
+MAIN: network-clipboard-tool

extra/webapps/planet/planet.factor

@@ -1,7 +1,7 @@
 USING: sequences rss arrays concurrency kernel sorting
 html.elements io assocs namespaces math threads vocabs html
 furnace http.server.templating calendar math.parser splitting
-continuations debugger system ;
+continuations debugger system http.server.responders ;
 IN: webapps.planet
 
 TUPLE: posting author title date link body ;
@@ -92,7 +92,7 @@ SYMBOL: cached-postings
     cached-postings get 4 head print-posting-summaries ;
 
 : planet-factor ( -- )
-    [
+    serving-html [
         "resource:extra/webapps/planet/planet.fhtml"
         run-template-file
     ] with-html-stream ;

extra/windows/kernel32/kernel32.factor

@@ -96,6 +96,7 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 
 : INVALID_HANDLE_VALUE -1 <alien> ; inline
 : INVALID_FILE_SIZE HEX: FFFFFFFF ; inline
+: INVALID_SET_FILE_POINTER HEX: ffffffff ; inline
 
 : FILE_BEGIN 0 ; inline
 : FILE_CURRENT 1 ; inline

extra/windows/winsock/winsock.factor

@@ -413,6 +413,11 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
     ] when ;
 
 : winsock-error!=0/f ( n/f -- )
+    { 0 f } member? [
+        winsock-error-string throw
+    ] unless ;
+
+: winsock-return-check ( n/f -- )
     dup { 0 f } member? [
         drop
     ] [
@@ -433,5 +438,5 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
     SOCKET_ERROR = [ winsock-error ] when ;
 
 : init-winsock ( -- )
-    HEX: 0202 <wsadata> WSAStartup winsock-error!=0/f ;
+    HEX: 0202 <wsadata> WSAStartup winsock-return-check ;