]> gitweb.factorcode.org Git - factor.git/commitdiff
duplex-stream stream-close bugfix
authorSlava Pestov <slava@factorcode.org>
Fri, 24 Jun 2005 02:35:41 +0000 (02:35 +0000)
committerSlava Pestov <slava@factorcode.org>
Fri, 24 Jun 2005 02:35:41 +0000 (02:35 +0000)
library/httpd/responder.factor
library/io/duplex-stream.factor
library/math/matrices.factor
library/syntax/parse-syntax.factor
library/syntax/parse-words.factor
library/ui/gadgets.factor
library/ui/splitters.factor
library/ui/tiles.factor

index da53518097396ec2f9b73c00bc0e6d5cbe8e63c7..1fac90f1e0f917b57eb69b1ac31c75eb7a967476 100644 (file)
@@ -47,8 +47,8 @@ SYMBOL: responders
 
 : directory-no/ ( -- )
     [
-        "request" get , CHAR: / ,
-        "raw-query" get [ CHAR: ? , , ] when*
+        "request" get % CHAR: / ,
+        "raw-query" get [ CHAR: ? , % ] when*
     ] make-string redirect ;
 
 : content-length ( alist -- length )
@@ -68,7 +68,7 @@ SYMBOL: responders
 
 : log-user-agent ( alist -- )
     "User-Agent" swap assoc* [
-        unswons [ , ": " , , ] make-string log
+        unswons [ % ": " % % ] make-string log
     ] when* ;
 
 : prepare-url ( url -- url )
index e429eb967d46232dd970d72a2e6d4794b1d77fb7..400d1c4537e394d9ff0c4ec27b248c62393a085d 100644 (file)
@@ -24,9 +24,12 @@ M: duplex-stream stream-write-attr
     duplex-stream-out stream-write-attr ;
 
 M: duplex-stream stream-close
+    #! The output stream is closed first, in case both streams
+    #! are attached to the same file descriptor, the output
+    #! buffer needs to be flushed before we close the fd.
     dup
-    duplex-stream-in stream-close
-    duplex-stream-out stream-close ;
+    duplex-stream-out stream-close
+    duplex-stream-in stream-close ;
 
 M: duplex-stream set-timeout
     2dup
index d9d16f2b5d5c7262898d4f2d9d989b2463f8a19d..6461708ce3bc9fc77ca8a69c7287d28d048c4c10 100644 (file)
@@ -5,6 +5,7 @@ USING: errors generic kernel lists math namespaces sequences
 vectors ;
 
 : n*v ( n vec -- vec ) [ * ] map-with ;
+: v*n ( vec n -- vec ) swap n*v ;
 
 ! Vector operations
 : v+ ( v v -- v ) [ + ] 2map ;
index 9e1feb57cf8c737ee55dbf4ad817716592dfb358..2f355de4bcb98f221e1df7cd60bbe13565922ba1 100644 (file)
@@ -113,20 +113,6 @@ BUILTIN: f 9 not ;
 : CHAR: ( -- ) 0 scan next-char drop swons ; parsing
 
 ! String literal
-: (parse-string) ( n str -- n )
-    2dup nth CHAR: " = [
-        drop 1 +
-    ] [
-        [ next-char swap , ] keep (parse-string)
-    ] ifte ;
-
-: parse-string ( -- str )
-    #! Read a string from the input stream, until it is
-    #! terminated by a ".
-    "col" [
-        [ "line" get (parse-string) ] make-string swap
-    ] change ;
-
 : " parse-string swons ; parsing
 
 : SBUF" skip-blank parse-string >sbuf swons ; parsing
index 651b22fb3fc5c0a75bf5f7da1c1a25e28ef8a044..0a712d3e51db444e470f7c0fd63379626c2b3ddf 100644 (file)
@@ -146,3 +146,17 @@ global [ string-mode off ] bind
     ] [
         drop
     ] ifte ;
+
+: (parse-string) ( n str -- n )
+    2dup nth CHAR: " = [
+        drop 1 +
+    ] [
+        [ next-char swap , ] keep (parse-string)
+    ] ifte ;
+
+: parse-string ( -- str )
+    #! Read a string from the input stream, until it is
+    #! terminated by a ".
+    "col" [
+        [ "line" get (parse-string) ] make-string swap
+    ] change ;
index ef13960c11234c096d9de163e0fcb71c34122b04..18dd30b3a104ff3155aff76ebaa0d1337c59fff6 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic hashtables kernel lists math namespaces sequences
-vectors ;
+USING: generic hashtables kernel lists math matrices namespaces
+sequences vectors ;
 
 ! A gadget is a shape, a paint, a mapping of gestures to
 ! actions, and a reference to the gadget's parent. A gadget
@@ -88,4 +88,13 @@ M: gadget layout*
     gadget-children [ prefer ] each ;
 
 GENERIC: user-input* ( ch gadget -- ? )
+
 M: gadget user-input* 2drop t ;
+
+GENERIC: orientation ( gadget -- vector )
+
+: orient* ( x y axis -- v )
+    2dup v* >r >r drop dup r> v* v- r> v+ ;
+
+: orient ( x y gadget -- vec )
+    orientation orient* ;
index 4cb3e310cc19e6c14463491f83e48f3d8d448d50..574f35f1dafb52dd81c1bcb8396f76b505856fb4 100644 (file)
@@ -12,26 +12,45 @@ C: divider ( splitter -- divider )
 
 M: divider pref-size drop 16 16 ;
 
-TUPLE: splitter vector first divider second ;
+TUPLE: splitter vector first divider second split ;
 
-C: splitter ( first second vector -- )
+M: splitter orientation splitter-vector ;
+
+C: splitter ( first second vector -- splitter )
+    <empty-gadget> over set-delegate
     [ set-splitter-vector ] keep
     [ set-splitter-second ] keep
     [ set-splitter-first ] keep
-    [ dup <divider> swap set-splitter-divider ] keep ;
+    [ dup <divider> swap set-splitter-divider ] keep
+    1/2 over set-splitter-split ;
+
+: <x-splitter> ( first second -- splitter )
+    { 1 0 0 } <splitter> ;
+
+: <y-splitter> ( first second -- splitter )
+    { 0 1 0 } <splitter> ;
 
 : splitter-pref-dims ( splitter -- dim dim dim )
     dup splitter-first pref-dim
     over splitter-divider pref-dim
     rot splitter-second pref-dim ;
 
-: set-axis ( x y axis -- v )
-    2dup v* >r >r drop dup r> v* v- r> v+ ;
-
 M: splitter pref-size ( splitter -- w h )
     [ splitter-pref-dims 3dup vmax vmax >r v+ v+ r> ] keep
-    splitter-vector set-axis 3unseq drop ;
+    orient 3unseq drop ;
+
+: size-divider ( splitter -- )
+    dup shape-dim over splitter-divider
+    [ rot orient ] keep set-gadget-dim ;
+
+: move-divider ( splitter -- )
+    [
+        dup shape-dim dup pick splitter-split v*n { 8 8 8 } v-
+        rot orient
+    ] keep splitter-divider set-gadget-loc ;
+
+: layout-divider ( splitter -- )
+    dup size-divider move-divider ;
 
 M: splitter layout* ( splitter -- )
-    
-    ;
+    ( layout-divider ) drop ;
index ce7a31e85f6559fcbd3504d13ef81addb833e26a..3acd6921d3527444b61a43314ca9e68423acc9e2 100644 (file)
@@ -68,12 +68,14 @@ TUPLE: tile original ;
      [ add-center ] keep ;
 
 C: tile ( child caption -- tile )
-    [ f line-border swap set-delegate ] keep
+    f line-border over set-delegate
     [ >r tile-content r> add-gadget ] keep
-    [ tile-actions ] keep ;
+    dup tile-actions ;
 
 M: tile pref-size shape-size ;
 
 : tile ( gadget title -- )
     #! Show the gadget in a new tile.
-    <tile> [ world get add-gadget ] keep prefer ;
+    <tile> [
+        world get add-gadget { 100 100 0 }
+    ] keep set-gadget-dim ;