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

core/alien/compiler/compiler.factor

@@ -5,7 +5,8 @@ hashtables kernel math namespaces sequences words
 inference.backend inference.dataflow system
 math.parser classes alien.arrays alien.c-types alien.structs
 alien.syntax cpu.architecture alien inspector quotations assocs
-kernel.private threads continuations.private libc combinators ;
+kernel.private threads continuations.private libc combinators
+init ;
 IN: alien.compiler
 
 ! Common protocol for alien-invoke/alien-callback/alien-indirect
@@ -301,7 +302,7 @@ M: alien-indirect generate-node
 ! this hashtable, they will all be blown away by code GC, beware
 SYMBOL: callbacks
 
-H{ } clone callbacks set-global
+[ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook
 
 : register-callback ( word -- ) dup callbacks get set-at ;
 

core/io/streams/lines/lines-tests.factor

@@ -41,6 +41,14 @@ unit-test
      4 swap stream-read
 ] unit-test
 
+[
+    "1234"
+] [
+     "Hello world\r\n1234" <string-reader>
+     dup stream-readln drop
+     4 swap stream-read-partial
+] unit-test
+
 [
     CHAR: 1
 ] [

core/io/streams/lines/lines.factor

@@ -32,15 +32,26 @@ M: line-reader stream-readln ( stream -- str )
     "\r\n" over delegate stream-read-until handle-readln ;
 
 : fix-read ( stream string -- string )
-    "\n" ?head [ swap stream-read1 [ add ] when* ] [ nip ] if ;
+    over line-reader-cr [
+        over cr-
+        "\n" ?head [
+            swap stream-read1 [ add ] when*
+        ] [ nip ] if
+    ] [ nip ] if ;
 
 M: line-reader stream-read
-    tuck delegate stream-read
+    tuck delegate stream-read fix-read ;
-    over line-reader-cr [ over cr- fix-read ] [ nip ] if ;
+
+M: line-reader stream-read-partial
+    tuck delegate stream-read-partial fix-read ;
 
 : fix-read1 ( stream char -- char )
-    dup CHAR: \n = [ drop stream-read1 ] [ nip ] if ;
+    over line-reader-cr [
+        over cr-
+        dup CHAR: \n = [
+            drop stream-read1
+        ] [ nip ] if
+    ] [ nip ] if ;
 
 M: line-reader stream-read1 ( stream -- char )
-    dup delegate stream-read1
+    dup delegate stream-read1 fix-read1 ;
-    over line-reader-cr [ over cr- fix-read1 ] [ nip ] if ;

core/sequences/sequences.factor

@@ -44,7 +44,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
 TUPLE: bounds-error index seq ;
 
 : bounds-error ( n seq -- * )
-    die \ bounds-error construct-boa throw ;
+    \ bounds-error construct-boa throw ;
 
 : bounds-check ( n seq -- n seq )
     2dup bounds-check? [ bounds-error ] unless ; inline

extra/help/handbook/handbook.factor

@@ -48,6 +48,7 @@ $nl
     { "pathname string"       { "an OS-specific pathname which identifies a file" } }
     { "sequence" { "an object whose class implements the " { $link "sequence-protocol" } } }
     { "slot"                  { "a component of an object which can store a value" } }
+    { "stack effect"          { "a pictorial representation of a word's inputs and outputs, for example " { $snippet "+ ( x y -- z )" } ". See " { $link "effects" } } }
     { "true value"            { "any object not equal to " { $link f } } }
     { "vocabulary" { "a named set of words. See " { $link "vocabularies" } } }
     { "vocabulary specifier"  { "a " { $link vocab } ", " { $link vocab-link } " or a string naming a vocabulary" } }
@@ -71,6 +72,7 @@ $nl
 ARTICLE: "dataflow" "Data and control flow"
 { $subsection "evaluator" }
 { $subsection "words" }
+{ $subsection "effects" }
 { $subsection "shuffle-words" }
 { $subsection "booleans" }
 { $subsection "conditionals" }

extra/io/windows/nt/pipes/pipes.factor

@@ -5,6 +5,9 @@ windows.types math windows.kernel32 windows namespaces kernel
 sequences windows.errors assocs math.parser system random ;
 IN: io.windows.nt.pipes
 
+! This code is based on
+! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
+
 : default-security-attributes ( -- obj )
     "SECURITY_ATTRIBUTES" <c-object>
     "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;

extra/tools/deploy/shaker/shaker.factor

@@ -24,7 +24,6 @@ IN: tools.deploy.shaker
         "Stripping debugger" show
         "resource:extra/tools/deploy/shaker/strip-debugger.factor"
         run-file
-        do-parse-hook
     ] when ;
 
 : strip-libc ( -- )
@@ -32,7 +31,6 @@ IN: tools.deploy.shaker
         "Stripping manual memory management debug code" show
         "resource:extra/tools/deploy/shaker/strip-libc.factor"
         run-file
-        do-parse-hook
     ] when ;
 
 : strip-cocoa ( -- )
@@ -40,7 +38,6 @@ IN: tools.deploy.shaker
         "Stripping unused Cocoa methods" show
         "resource:extra/tools/deploy/shaker/strip-cocoa.factor"
         run-file
-        do-parse-hook
     ] when ;
 
 : strip-assoc ( retained-keys assoc -- newassoc )
@@ -116,7 +113,6 @@ SYMBOL: deploy-vocab
 
         strip-dictionary? [
             {
-                builtins
                 dictionary
                 inspector-hook
                 lexer-factory
@@ -142,6 +138,10 @@ SYMBOL: deploy-vocab
             "c-types" "alien.c-types" lookup ,
         ] when
 
+        native-io? [
+            "default-buffer-size" "io.nonblocking" lookup ,
+        ] when
+
         deploy-ui? get [
             "ui" child-vocabs
             "cocoa" child-vocabs
@@ -152,10 +152,11 @@ SYMBOL: deploy-vocab
         ] when
     ] { } make dup . ;
 
-: strip ( -- )
+: strip ( hook -- )
-    strip-libc
+    >r strip-libc
     strip-cocoa
     strip-debugger
+    r> [ call ] when*
     strip-init-hooks
     deploy-vocab get vocab-main set-boot-quot*
     retained-props >r
@@ -168,10 +169,9 @@ SYMBOL: deploy-vocab
     [
         [
             deploy-vocab set
-            parse-hook get >r
+            parse-hook get
             parse-hook off
             deploy-vocab get require
-            r> [ call ] when*
             strip
             finish-deploy
         ] [

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

@@ -1,7 +1,7 @@
 USING: ui.gadgets.editors tools.test kernel io io.streams.plain
 definitions namespaces ui.gadgets
 ui.gadgets.grids prettyprint documents ui.gestures
-tools.test.inference tools.test.ui ;
+tools.test.inference tools.test.ui models ;
 
 [ "foo bar" ] [
     <editor> "editor" set
@@ -31,3 +31,9 @@ tools.test.inference tools.test.ui ;
 ] unit-test
 
 { 0 1 } [ <editor> ] unit-test-effect
+
+"hello" <model> <field> "field" set
+
+"field" get [
+    [ "hello" ] [ "field" get field-model model-value ] unit-test
+] with-grafted-gadget

extra/ui/gadgets/gadgets.factor

@@ -70,8 +70,12 @@ M: gadget model-changed 2drop ;
     >r <gadget> r> construct-delegate ; inline
 
 : activate-control ( gadget -- )
-    dup gadget-model dup [ 2dup add-connection ] when drop
+    dup gadget-model dup [
-    dup gadget-model swap model-changed ;
+        2dup add-connection
+        swap model-changed
+    ] [
+        2drop
+    ] if ;
 
 : deactivate-control ( gadget -- )
     dup gadget-model dup [ 2dup remove-connection ] when 2drop ;

extra/ui/windows/windows.factor

@@ -280,10 +280,13 @@ SYMBOL: hWnd
     mouse-captured? [ release-capture ] when
     prepare-mouse send-button-up ;
 
+: make-TRACKMOUSEEVENT ( hWnd -- alien )
+    "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
+    "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
+
 : handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
     2nip
-    over "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
+    over make-TRACKMOUSEEVENT
-    "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize
     TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
     0 over set-TRACKMOUSEEVENT-dwHoverTime
     TrackMouseEvent drop
@@ -387,10 +390,10 @@ SYMBOL: hWnd
     dup SetForegroundWindow drop
     SetFocus drop ;
 
-: init-win32-ui
+: init-win32-ui ( -- )
     "MSG" <c-object> msg-obj set
     "Factor-window" malloc-u16-string class-name-ptr set-global
-    register-wndclassex
+    register-wndclassex drop
     GetDoubleClickTime double-click-timeout set-global ;
 
 : cleanup-win32-ui ( -- )