, no longer has the deprecated string append behavior, added stream-write1 generic

diff --git a/CHANGES.txt b/CHANGES.txt
index 01f9428dce03154394aa2117ae81c5b002fc0f6f..dfae17062a23eecb3640bb11f8a71c9f36d3d295 100644 (file)
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -14,17 +14,34 @@ Factor 0.76:
 - Only 2 generations are used by default now, since there seems to be no
   performance benefit to having 3 after running some brief benchmarks.
 
-- Many improvements to the matrices library.
+- The following formely list-specific words are now generic:
+    
+    all? all-with? subset subset-with fiber? prune
+
+- The contains? word for testing membership in a sequence has been
+  renamed to member?.
 
-- String input streams.
+- The some? and some-with? combinators are gone. Their replacements
+  are contains?, contains-with?, find, find*, find-with, and find-with*.
+  See the documentation for details.
 
-  with-string is now string-out ( quot -- string )
+- The nreverse word has been removed.
 
-  new string-in ( string quot -- ) word, calls quot with stdio bound to
+- reversed ( seq -- seq ) outputs a new sequence that shares structure
+  with the given sequence, but presents elements in reverse order.
+
+- Many improvements to the matrices library.
+
+- with-string word renamed to string-out ( quot -- string )
+
+- new string-in ( string quot -- ) word, calls quot with stdio bound to
   a stream that reads from the given string.
 
 - Improved inspector. Call it with inspect ( obj -- ).
 
+- Fixed bug where images saved from the jEdit plugin would fail to
+  start.
+
 - md5 hashing algorithm in contrib/crypto/ (Doug Coleman).
 
 Factor 0.75:

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index c0779f410493bc11ce8f2f101f5ed8bd5f02ff48..ae333cab08d6447cb7776d52233e20b1922fa869 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,49 +1,37 @@
-+ bugs to fix soon\r
+76:\r
+---\r
 \r
-<magnus--> http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS\r
-<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html\r
-<magnus--> not *too* long\r
-<magnus--> but we'd need to longjmp the main thread from the exception handler thread\r
-<magnus--> or cause a signal in the main thread\r
-<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html\r
-<magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
-\r
-- i/o: don't keep creating new sbufs\r
 - set-length should not shorten the underlying sequence\r
-- there is a problem with hashcodes of words and bootstrapping\r
-- http keep alive, and range get\r
-- sleep word\r
-- fix i/o on generic x86/ppc unix\r
-- code walker & exceptions\r
-- if two tasks write to a unix stream, the buffer can overflow\r
-- rename prettyprint* to pprint, prettyprint to pp\r
-- reader syntax for arrays, byte arrays, displaced aliens\r
-- images saved from plugin do not work\r
-- investigate orphans\r
+- i/o: don't keep creating new sbufs\r
+- [ EAX 0 ] --> [ EAX ]\r
+- rollovers broken with menus\r
+- menu dragging\r
+- fix up the min thumb size hack\r
+- bevel borders\r
+- nicer scrollbars with up/down buttons\r
+- gaps in pack layout\r
+- fix listener prompt display after presentation commands invoked\r
+- stack display bugs\r
+- simple tutorial\r
+- parser::skip clean up\r
 \r
-+ plugin:\r
++ misc\r
 \r
-- word preview for parsing words\r
-- plugin: supportsBackspace\r
-- if external factor is down, don't add tons of random shit to the       \r
-  dictionary\r
+Investigate:\r
 \r
-+ ui:\r
+  http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS\r
+  http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html\r
+  http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html\r
+  http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
 \r
-- faster layout\r
+- http keep alive, and range get\r
+- code walker & exceptions\r
 - faster repaint\r
-- ui browser\r
-- mouse enter onto overlapping with interior, but not child, gadget\r
-- rollovers broken in inspector\r
-- menu dragging\r
-- fix up the min thumb size hack\r
 \r
 + ffi:\r
 \r
-- alien primitives need a more general input type\r
 - smarter out parameter handling\r
 - clarify powerpc passing of value struct parameters\r
-- box/unbox_signed/unsigned_8\r
 - ffi unicode strings: null char security hole\r
 - utf16 string boxing\r
 - value type structs\r
@@ -58,7 +46,6 @@
 - simplifier:\r
   - kill replace after a peek\r
   - merge inc-d's across VOPs that don't touch the stack\r
-- [ EAX 0 ] --> [ EAX ]\r
 - intrinsic char-slot set-char-slot integer-slot set-integer-slot\r
 - [ [ dup call ] dup call ] infer hangs\r
 - more accurate types for various words\r
@@ -77,12 +64,13 @@
 - array sort\r
 - nappend: instead of using push, enlarge the sequence with set-length\r
   then add set the elements with set-nth\r
-- faster sequence operations\r
 - specialized arrays\r
 - phase out sbuf-append\r
 \r
 + kernel:\r
 \r
+- sleep word\r
+- there is a problem with hashcodes of words and bootstrapping\r
 - delegating generic words with a non-standard picker\r
 - powerpc has weird callstack residue\r
 - instances: do not use make-list\r
@@ -99,17 +87,18 @@
 \r
 - faster stream-copy\r
 - reading and writing byte arrays\r
-- merge unix and win32 io where appropriate\r
+- clean up line reading code in win32-io\r
 - unix io: handle \n\r and \n\0\r
 - separate words for writing characters and strings\r
-- perhaps:\r
-  GENERIC: set-style ( style stream -- )\r
-  GENERIC: stream-write\r
-  GENERIC: stream-write-char\r
 - stream server can hang because of exception handler limitations\r
 - better i/o scheduler\r
 - unify unparse and prettyprint\r
 - utf16, utf8 encoding\r
+- fix i/o on generic x86/ppc unix\r
+- if two tasks write to a unix stream, the buffer can overflow\r
+- rename prettyprint* to pprint, prettyprint to pp\r
+- reader syntax for arrays, byte arrays, displaced aliens\r
+- print parsing words in bold\r
 \r
 + nice to have libraries:\r
 \r

diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor
index 4684658d4768897d521fbbcba98c6a9883930925..5808e7f3b7543847813ca43f562e6f346dd6d2f7 100644 (file)
--- a/library/alien/aliens.factor
+++ b/library/alien/aliens.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: hashtables kernel lists math namespaces parser io ;
+USING: hashtables io kernel kernel-internals lists math
+namespaces parser ;
 
 DEFER: dll?
 BUILTIN: dll 15 dll? [ 1 "dll-path" f ] ;
@@ -12,6 +13,8 @@ BUILTIN: alien 16 alien? ;
 DEFER: displaced-alien?
 BUILTIN: displaced-alien 20 displaced-alien? ;
 
+UNION: c-ptr byte-array alien displaced-alien ;
+
 : NULL ( -- null )
     #! C null value.
     0 <alien> ;

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 4a3ad8e7417abe782e6d67d4ff00b191dced2aa2..dc60eadb7a4e536299bb6c3671b9907d245b6c0c 100644 (file)
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -161,12 +161,8 @@ M: f ' ( obj -- ptr )
     [ emit ] each ;
 
 : word-error ( word msg -- )
-    [
-        ,
-        dup word-vocabulary ,
-        " " ,
-        word-name ,
-    ] make-string throw ;
+    [ % dup word-vocabulary % " " % word-name % ] make-string
+    throw ;
 
 : transfer-word ( word -- word )
     #! This is a hack. See doc/bootstrap.txt.

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index ba903cee1030d1e4b7c92150d01760dfd4b7164d..9834480f5e1a22255c24cf431d618eebcf7ad51b 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -154,33 +154,33 @@ vocabularies get [
     [ "dlclose" "alien"                       [ [ dll ] [ ] ] ]
     [ "<alien>" "alien"                       [ [ integer ] [ alien ] ] ]
     [ "<byte-array>" "kernel-internals"       [ [ integer ] [ byte-array ] ] ]
-    [ "<displaced-alien>" "alien"             [ [ integer object ] [ displaced-alien ] ] ]
-    [ "alien-signed-cell" "alien"             [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-signed-cell" "alien"         [ [ integer alien integer ] [ ] ] ]
-    [ "alien-unsigned-cell" "alien"           [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-unsigned-cell" "alien"       [ [ integer alien integer ] [ ] ] ]
-    [ "alien-signed-8" "alien"                [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-signed-8" "alien"            [ [ integer alien integer ] [ ] ] ]
-    [ "alien-unsigned-8" "alien"              [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-unsigned-8" "alien"          [ [ integer alien integer ] [ ] ] ]
-    [ "alien-signed-4" "alien"                [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-signed-4" "alien"            [ [ integer alien integer ] [ ] ] ]
-    [ "alien-unsigned-4" "alien"              [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-unsigned-4" "alien"          [ [ integer alien integer ] [ ] ] ]
-    [ "alien-signed-2" "alien"                [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-signed-2" "alien"            [ [ integer alien integer ] [ ] ] ]
-    [ "alien-unsigned-2" "alien"              [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-unsigned-2" "alien"          [ [ integer alien integer ] [ ] ] ]
-    [ "alien-signed-1" "alien"                [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-signed-1" "alien"            [ [ integer alien integer ] [ ] ] ]
-    [ "alien-unsigned-1" "alien"              [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-unsigned-1" "alien"          [ [ integer alien integer ] [ ] ] ]
-    [ "alien-float" "alien"                   [ [ alien integer ] [ float ] ] ]
-    [ "set-alien-float" "alien"               [ [ float alien integer ] [ ] ] ]
-    [ "alien-double" "alien"                  [ [ alien integer ] [ float ] ] ]
-    [ "set-alien-double" "alien"              [ [ float alien integer ] [ ] ] ]
-    [ "alien-c-string" "alien"                [ [ alien integer ] [ string ] ] ]
-    [ "set-alien-c-string" "alien"            [ [ string alien integer ] [ ] ] ]
+    [ "<displaced-alien>" "alien"             [ [ integer c-ptr ] [ displaced-alien ] ] ]
+    [ "alien-signed-cell" "alien"             [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-signed-cell" "alien"         [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-unsigned-cell" "alien"           [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-cell" "alien"       [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-signed-8" "alien"                [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-signed-8" "alien"            [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-unsigned-8" "alien"              [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-8" "alien"          [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-signed-4" "alien"                [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-signed-4" "alien"            [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-unsigned-4" "alien"              [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-4" "alien"          [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-signed-2" "alien"                [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-signed-2" "alien"            [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-unsigned-2" "alien"              [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-2" "alien"          [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-signed-1" "alien"                [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-signed-1" "alien"            [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-unsigned-1" "alien"              [ [ c-ptr integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-1" "alien"          [ [ integer c-ptr integer ] [ ] ] ]
+    [ "alien-float" "alien"                   [ [ c-ptr integer ] [ float ] ] ]
+    [ "set-alien-float" "alien"               [ [ float c-ptr integer ] [ ] ] ]
+    [ "alien-double" "alien"                  [ [ c-ptr integer ] [ float ] ] ]
+    [ "set-alien-double" "alien"              [ [ float c-ptr integer ] [ ] ] ]
+    [ "alien-c-string" "alien"                [ [ c-ptr integer ] [ string ] ] ]
+    [ "set-alien-c-string" "alien"            [ [ string c-ptr integer ] [ ] ] ]
     [ "throw" "errors"                        [ [ object ] [ ] ] ]
     [ "string>memory" "kernel-internals"      [ [ string integer ] [ ] ] ]
     [ "memory>string" "kernel-internals"      [ [ integer integer ] [ string ] ] ]

diff --git a/library/cli.factor b/library/cli.factor
index 6a5406ca521d8fe036a37f67ca6f4c5bb4a91525..ceeb97dccd6e99b0df598c10f4b7afce6226c2af 100644 (file)
--- a/library/cli.factor
+++ b/library/cli.factor
@@ -12,10 +12,8 @@ sequences strings ;
 
 : run-user-init ( -- )
     #! Run user init file if it exists
-    "user-init" get [
-        [ "~" get , "/" , ".factor-" , "rc" , ] make-string
-        ?run-file
-    ] when ;
+    "user-init" get
+    [ "~" get "/.factor-rc" append ?run-file ] when ;
 
 : set-path ( value list -- )
     unswons over [ nest [ set-path ] bind ] [ nip set ] ifte ;
@@ -55,6 +53,7 @@ sequences strings ;
     #! -no-<flag> CLI switch
     "user-init" on
     "compile" on
+    "null-stdio" off
     os "win32" = "ui" "tty" ? "shell" set ;
 
 : parse-command-line ( -- )

diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor
index eda61bb37e8d5ba82e4a8a0ab11679ed072c46e8..fab5d8de1f031f9f8d9a514b3427957780e39f19 100644 (file)
--- a/library/collections/namespaces.factor
+++ b/library/collections/namespaces.factor
@@ -120,7 +120,7 @@ SYMBOL: building
 : unique, ( obj -- )
     #! Add the object to the sequence being built with make-seq
     #! unless an equal object has already been added.
-    building get 2dup index -1 = [ push ] [ 2drop ] ifte ;
+    building get 2dup member? [ 2drop ] [ push ] ifte ;
 
 : % ( seq -- )
     #! Append to the sequence being built with make-seq.

diff --git a/library/collections/strings-epilogue.factor b/library/collections/strings-epilogue.factor
index 9b41a694d98295eb3cb0398207ae7eb0c09e3f79..4bb36a4e359464e8aa36a7435db517c087f99675 100644 (file)
--- a/library/collections/strings-epilogue.factor
+++ b/library/collections/strings-epilogue.factor
@@ -7,9 +7,6 @@ sequences strings ;
 : empty-sbuf ( len -- sbuf )
     dup <sbuf> [ set-length ] keep ;
 
-: sbuf-append ( ch/str sbuf -- )
-    over string? [ swap nappend ] [ push ] ifte ;
-
 : fill ( count char -- string ) <repeated> >string ;
 
 : padding ( string count char -- string )

diff --git a/library/generic/slots.factor b/library/generic/slots.factor
index 388bb3c061abb2f2f5bad957a6635b6c84bd1f63..d5c5aea5aef6b96c05a4f995dc311f254ce30032 100644 (file)
--- a/library/generic/slots.factor
+++ b/library/generic/slots.factor
@@ -49,7 +49,7 @@ sequences strings words ;
     >r word-name "-" r> append3 create-in ;
 
 : writer-word ( class name -- word )
-    [ swap "set-" , word-name , "-" , , ] make-string create-in ;
+    [ swap "set-" % word-name % "-" % % ] make-string create-in ;
 
 : simple-slot ( class name -- [ reader writer ] )
     [ reader-word ] 2keep writer-word 2list ;

diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor
index 7a665b852504cb8a85e3cf6be940db6ed692fa2d..a8e65854e411823bb965dbc079da72b9292f41e9 100644 (file)
--- a/library/httpd/browser-responder.factor
+++ b/library/httpd/browser-responder.factor
@@ -137,9 +137,9 @@ sequences ;
   #! Build a string that can evaluate the string 'to-eval'
   #! by first doing an 'IN: vocab' and a 'USE:' of all
   #! necessary vocabs for existing words in that vocab.
-  [ >r "IN: " , dup , "\n" ,
-     vocabulary-uses [ "USE: " , , "\n" , ] each
-     r> , "\n" , ] make-string ;
+  [ >r "IN: " % dup % "\n" %
+     vocabulary-uses [ "USE: " % % "\n" % ] each
+     r> % "\n" % ] make-string ;
 
 : show-parse-error ( error -- )
   #! Show an error page describing the parse error.
@@ -169,8 +169,8 @@ sequences ;
   #! URL which, when requested, will display the source to that
   #! word.
   [ 
-    ".?word=" , url-encode ,
-    "&vocab=" , url-encode ,
+    ".?word=" % url-encode %
+    "&vocab=" % url-encode %
   ] make-string ;
 
 : browse ( <browser> -- )

diff --git a/library/httpd/cont-responder.factor b/library/httpd/cont-responder.factor
index 746e65364ded433f3dd1c22944fec80374f0882d..c4f2f12145a5ebdc445f94278492478df8296b8f 100644 (file)
--- a/library/httpd/cont-responder.factor
+++ b/library/httpd/cont-responder.factor
@@ -40,7 +40,7 @@ SYMBOL: post-refresh-get?
 
 : get-random-id ( -- id ) 
   #! Generate a random id to use for continuation URL's
-  [ 32 [ 0 9 random-int unparse , ] times ] make-string str>number 36 >base ;
+  [ 32 [ 0 9 random-int unparse % ] times ] make-string str>number 36 >base ;
 
 #! Name of variable holding the table of continuations.
 SYMBOL: table 
@@ -199,8 +199,8 @@ SYMBOL: callback-cc
   #! HTTP 302 to occur to instruct the browser to forward to
   #! the request URL.
   [ 
-    "HTTP/1.1 302 Document Moved\nLocation: " , ,
-    "\nContent-Length: 0\nContent-Type: text/plain\n\n" , 
+    "HTTP/1.1 302 Document Moved\nLocation: " % %
+    "\nContent-Length: 0\nContent-Type: text/plain\n\n" %
   ] make-string call-exit-continuation ;
 
 : redirect-to-here ( -- )

diff --git a/library/httpd/html-tags.factor b/library/httpd/html-tags.factor
index 5f9f55698d4c6f841cfac43093cafaf994bec3e9..a8c263bd7c9ddadd562e9deddc8813222802690f 100644 (file)
--- a/library/httpd/html-tags.factor
+++ b/library/httpd/html-tags.factor
@@ -67,7 +67,7 @@ USE: sequences
 ! <a href= "http://" swap append a> "click" write </a>
 !
 ! (url -- )
-! <a href= [ "http://" , , ] make-string a> "click" write </a>
+! <a href= [ "http://" % % ] make-string a> "click" write </a>
 !
 ! Tags that have no 'closing' equivalent have a trailing tag/> form:
 !
@@ -77,7 +77,7 @@ USE: sequences
     #! Convert the attrs alist to a string
     #! suitable for embedding in an html tag.
     reverse [
-        [ dup car , "='" , cdr , "'" , ] each
+        [ dup car % "='" % cdr % "'" % ] each
     ] make-string ;
 
 : write-attributes ( n: namespace -- )    
@@ -163,13 +163,13 @@ USE: sequences
 : def-for-html-word-</foo> ( name -- name quot )
     #! Return the name and code for the </foo> patterned
     #! word.    
-    [ "</" , , ">" , ] make-string dup [ write ] cons ;
+    [ "</" % % ">" % ] make-string dup [ write ] cons ;
 
 : def-for-html-word-<foo/> ( name -- name quot )
     #! Return the name and code for the <foo/> patterned
     #! word.
-    [ "<" , dup , "/>" , ] make-string swap
-    [ "<" , , ">" , ] make-string
+    [ "<" % dup % "/>" % ] make-string swap
+    [ "<" % % ">" % ] make-string
     [ write ] cons ;
 
 : def-for-html-word-foo/> ( name -- name quot )

diff --git a/library/httpd/html.factor b/library/httpd/html.factor
index 01324480ac5cb6b4584d451f44a061d6aa82d572..92fa603dea396dae8198f339321465e8458b35dd 100644 (file)
--- a/library/httpd/html.factor
+++ b/library/httpd/html.factor
@@ -101,6 +101,11 @@ sequences strings styles unparser words ;
 
 TUPLE: html-stream ;
 
+M: html-stream stream-write1 ( char stream -- )
+    [
+        dup html-entities assoc [ write ] [ write1 ] ?ifte
+    ] with-wrapper ;
+
 M: html-stream stream-write-attr ( str style stream -- )
     [
         [

diff --git a/library/inference/test.factor b/library/inference/test.factor
index c15ddad68fbd43d6c6e0b6214a223d585d7b688f..252e424c6b1289262aeece5f1c89f02c9b9544c9 100644 (file)
--- a/library/inference/test.factor
+++ b/library/inference/test.factor
@@ -9,10 +9,10 @@ io strings unparser ;
 
 : infer-fail ( quot error -- )
     "! " , dup string? [ unparse ] unless , "\n" ,
-    [ [ infer ] cons . \ unit-test-fails . ] string-out , ;
+    [ [ infer ] cons . \ unit-test-fails . ] string-out % ;
 
 : infer-pass ( quot effect -- )
-    [ unit . [ infer ] cons . \ unit-test . ] string-out , ;
+    [ unit . [ infer ] cons . \ unit-test . ] string-out % ;
 
 : infer>test ( quot -- str )
     #! Make a string representing a unit test for the stack

diff --git a/library/inference/values.factor b/library/inference/values.factor
index 004accfcb2b917633ad99dd6f9229b976d76d258..c5e40e9a0ddf1c18c950c6747186c0690e3cab27 100644 (file)
--- a/library/inference/values.factor
+++ b/library/inference/values.factor
@@ -27,8 +27,8 @@ M: computed value= ( literal value -- ? )
 : failing-class-and ( class class -- class )
     2dup class-and dup null = [
         -rot [
-            word-name , " and " , word-name ,
-            " do not intersect" ,
+            word-name % " and " % word-name %
+            " do not intersect" %
         ] make-string inference-warning
     ] [
         2nip

diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor
index 53ad13ad9407e2e624c94825f75b36d096b6ee88..239cd9b1f3a269b1498a695bee83643fb9f9fea2 100644 (file)
--- a/library/io/c-streams.factor
+++ b/library/io/c-streams.factor
@@ -12,6 +12,9 @@ strings threads ;
 
 TUPLE: c-stream in out flush? ;
 
+M: c-stream stream-write1 ( char stream -- )
+    >r ch>string r> c-stream-out fwrite ;
+
 M: c-stream stream-write-attr ( str style stream -- )
     nip >r dup string? [ ch>string ] unless r>
     c-stream-out fwrite ;

diff --git a/library/io/duplex-stream.factor b/library/io/duplex-stream.factor
index 400d1c4537e394d9ff0c4ec27b248c62393a085d..cfcf698db5358f76df2aa4cb9f3ac151ad0bbf27 100644 (file)
--- a/library/io/duplex-stream.factor
+++ b/library/io/duplex-stream.factor
@@ -14,11 +14,14 @@ M: duplex-stream stream-auto-flush
 M: duplex-stream stream-readln
     duplex-stream-in stream-readln ;
 
+M: duplex-stream stream-read1
+    duplex-stream-in stream-read1 ;
+
 M: duplex-stream stream-read
     duplex-stream-in stream-read ;
 
-M: duplex-stream stream-read1
-    duplex-stream-in stream-read1 ;
+M: duplex-stream stream-write1
+    duplex-stream-out stream-write1 ;
 
 M: duplex-stream stream-write-attr
     duplex-stream-out stream-write-attr ;

diff --git a/library/io/stdio.factor b/library/io/stdio.factor
index 414948603fe07c8cf8859206d1a650a260be685f..0493175421de3a50555f3edd91073d2d35ea41f5 100644 (file)
--- a/library/io/stdio.factor
+++ b/library/io/stdio.factor
@@ -8,6 +8,7 @@ USING: errors generic kernel lists namespaces strings styles ;
 : read1      ( -- char )         stdio get stream-read1 ;
 : read       ( count -- string ) stdio get stream-read ;
 : write      ( string -- )       stdio get stream-write ;
+: write1     ( char -- )         stdio get stream-write1 ;
 : write-attr ( string style -- ) stdio get stream-write-attr ;
 : print      ( string -- )       stdio get stream-print ;
 : terpri     ( -- )              "\n" write ;

diff --git a/library/io/stream.factor b/library/io/stream.factor
index d08eff4ca105c8198b027008e1e23760a476c48e..c828b13e11ee49125341185a7929b1a89901d874 100644 (file)
--- a/library/io/stream.factor
+++ b/library/io/stream.factor
@@ -10,8 +10,9 @@ SYMBOL: stdio
 GENERIC: stream-flush      ( stream -- )
 GENERIC: stream-auto-flush ( stream -- )
 GENERIC: stream-readln     ( stream -- string )
-GENERIC: stream-read       ( count stream -- string )
 GENERIC: stream-read1      ( stream -- char/f )
+GENERIC: stream-read       ( count stream -- string )
+GENERIC: stream-write1     ( char stream -- )
 GENERIC: stream-write-attr ( string style stream -- )
 GENERIC: stream-close      ( stream -- )
 GENERIC: set-timeout       ( timeout stream -- )
@@ -42,6 +43,7 @@ M: null-stream stream-auto-flush drop ;
 M: null-stream stream-readln drop f ;
 M: null-stream stream-read 2drop f ;
 M: null-stream stream-read1 drop f ;
+M: null-stream stream-write1 2drop ;
 M: null-stream stream-write-attr 3drop ;
 M: null-stream stream-close drop ;
 
@@ -57,10 +59,3 @@ C: wrapper-stream ( stream -- stream )
 
 : with-wrapper ( stream quot -- )
     >r wrapper-stream-scope r> bind ;
-
-! Standard actions protocol for presentations output to
-! attributed streams.
-: <actions> ( path alist -- alist )
-    #! For each element of the alist, change the value to
-    #! path " " value
-    [ uncons >r swap " " r> append3 cons ] map-with ;

diff --git a/library/io/string-streams.factor b/library/io/string-streams.factor
index 69ac725da90a0fddda6d6ebeca0391db85124daf..dee33b278c3e4f92773229fc1e9fcde0a270c4d0 100644 (file)
--- a/library/io/string-streams.factor
+++ b/library/io/string-streams.factor
@@ -1,7 +1,11 @@
 USING: io kernel math namespaces sequences strings ;
 
 ! String buffers support the stream output protocol.
-M: sbuf stream-write-attr nip sbuf-append ;
+M: sbuf stream-write1 push ;
+
+M: sbuf stream-write-attr
+    nip over string? [ swap nappend ] [ push ] ifte ;
+
 M: sbuf stream-close drop ;
 M: sbuf stream-flush drop ;
 M: sbuf stream-auto-flush drop ;

diff --git a/library/syntax/see.factor b/library/syntax/see.factor
index 59622720ca5c5e9e1ad6a9a01ac727d107b98762..d78c981802f65063bb28a5e954d135b77c8842a2 100644 (file)
--- a/library/syntax/see.factor
+++ b/library/syntax/see.factor
@@ -19,27 +19,21 @@ streams strings styles unparser words ;
     \ parsing prettyprint-prop
     \ inline prettyprint-prop ;
 
-: comment-style
-    #! Feel free to redefine this!
-    [
-        [[ "fg" [ 255 0 0 ] ]]
-        [[ foreground [ 192 0 0 ] ]]
-    ] ;
-
-: comment. ( comment -- ) comment-style write-attr ;
+: comment. ( comment -- )
+    [ [[ font-style italic ]] ] write-attr ;
 
 : infer-effect. ( effect -- )
     [
-        "(" ,
-        2unlist >r [ " " , unparse , ] each r>
-        " --" ,
-        [ " " , unparse , ] each
-        " )" ,
+        "(" %
+        2unlist >r [ " " % unparse % ] each r>
+        " --" %
+        [ " " % unparse % ] each
+        " )" %
     ] make-string comment. ;
 
 : stack-effect. ( word -- )
     dup "stack-effect" word-prop [
-        [ CHAR: ( , , CHAR: ) , ] make-string
+        [ CHAR: ( , % CHAR: ) , ] make-string
         comment.
     ] [
         "infer-effect" word-prop dup [

diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor
index 0eb75e303b4023715a82c298ae2ffb4900142c01..e674ac829277558ffb173327b99c08895a416495 100644 (file)
--- a/library/syntax/unparser.factor
+++ b/library/syntax/unparser.factor
@@ -7,13 +7,7 @@ sequences sequences stdio strings words ;
 GENERIC: unparse ( obj -- str )
 
 M: object unparse ( obj -- str )
-    [
-        "#<" ,
-        dup class unparse ,
-        " @ " , 
-        address unparse ,
-        ">" ,
-    ] make-string ;
+    "( " swap class word-name " )" append3 ;
 
 : >digit ( n -- ch )
     dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
@@ -45,9 +39,9 @@ M: integer unparse ( obj -- str ) >dec ;
 M: ratio unparse ( num -- str )
     [
         dup
-        numerator unparse ,
+        numerator unparse %
         CHAR: / ,
-        denominator unparse ,
+        denominator unparse %
     ] make-string ;
 
 : fix-float ( str -- str )
@@ -60,12 +54,12 @@ M: float unparse ( float -- str )
 
 M: complex unparse ( num -- str )
     [
-        "#{ " ,
+        "#{ " %
         dup
-        real unparse ,
-        " " ,
-        imaginary unparse ,
-        " }#" ,
+        real unparse %
+        " " %
+        imaginary unparse %
+        " }#" %
     ] make-string ;
 
 : ch>ascii-escape ( ch -- esc )
@@ -93,15 +87,15 @@ M: string unparse ( str -- str )
     [ CHAR: " , unparse-string CHAR: " , ] make-string ;
 
 M: sbuf unparse ( str -- str )
-    [ "SBUF\" " , unparse-string CHAR: " , ] make-string ;
+    [ "SBUF\" " % unparse-string CHAR: " , ] make-string ;
 
-M: word unparse ( obj -- str ) word-name dup "#<unnamed>" ? ;
+M: word unparse ( obj -- str ) word-name dup "( unnamed )" ? ;
 
 M: t unparse drop "t" ;
 M: f unparse drop "f" ;
 
 M: dll unparse ( obj -- str )
-    [ "DLL\" " , dll-path unparse-string CHAR: " , ] make-string ;
+    [ "DLL\" " % dll-path unparse-string CHAR: " , ] make-string ;
 
 : hex-string ( str -- str )
     [ [ >hex 2 CHAR: 0 pad-left % ] each ] make-string ;

diff --git a/library/test/benchmark/strings.factor b/library/test/benchmark/strings.factor
index 3a24380dec36bb7eea0273c743e40d3b9e9ac4ba..c9c86e29d4816d48da19438ca1435b0b84db089e 100644 (file)
--- a/library/test/benchmark/strings.factor
+++ b/library/test/benchmark/strings.factor
@@ -4,7 +4,7 @@ USING: compiler kernel math namespaces sequences strings test ;
 
 : string-step ( n str -- )
     2dup length > [
-        dup [ "123" , , "456" , , "789" , ] make-string
+        dup [ "123" % % "456" % % "789" % ] make-string
         dup dup length 2 /i 0 swap rot subseq
         swap dup length 2 /i 1 + 1 swap rot subseq append
         string-step

diff --git a/library/test/test.factor b/library/test/test.factor
index 2a468a38154bebaba8921769f58e59859ef44b9c..cfb9bbd2010ad10f7b0d6a92022392be78f94923 100644 (file)
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -24,7 +24,7 @@ M: assert error.
     #! execute it.
     millis >r gc-time >r call gc-time r> - millis r> -
     [
-        unparse , " ms run / " , unparse , " ms GC time" ,
+        unparse % " ms run / " % unparse % " ms GC time" %
     ] make-string print ;
 
 : unit-test ( output input -- )

diff --git a/library/tools/jedit.factor b/library/tools/jedit.factor
index e7a6c0be04d93724b7addbb6859db0faf05434d5..e97ed998e47928a60359be76610ab35d717910a5 100644 (file)
--- a/library/tools/jedit.factor
+++ b/library/tools/jedit.factor
@@ -17,10 +17,10 @@ unparser words ;
 
 : make-jedit-request ( files params -- code )
     [
-        "EditServer.handleClient(false,false,false,null," ,
-        "new String[] {" ,
-        [ unparse , "," , ] each
-        "null});\n" ,
+        "EditServer.handleClient(false,false,false,null," %
+        "new String[] {" %
+        [ unparse % "," % ] each
+        "null});\n" %
     ] make-string ;
 
 : send-jedit-request ( request -- )

diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index 1f85be22fe09e358ebd23228891622164f36cf39..ac9375d83e508d85ebeb8c8dac74e060edb1a582 100644 (file)
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -34,6 +34,7 @@ sequences io sequences styles ;
 
 : button-gestures ( button quot -- )
     over f reverse-video set-paint-prop
+    over << solid f >> interior set-paint-prop
     dupd [ action ] set-action
     dup [ dup button-update button-clicked ] [ button-up 1 ] set-action
     dup [ button-update ] [ button-down 1 ] set-action

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index c1c7d4fe935c049a953acaf261ee795301aa05a3..891a9848cc6f6dc39a61a7a8afa6fe7a681af8eb 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -94,4 +94,5 @@ M: editor layout* ( editor -- )
     dup editor-caret swap caret-loc swap set-shape-loc ;
 
 M: editor draw-gadget* ( editor -- )
+    dup delegate draw-gadget*
     dup editor-text draw-string ;

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index cf68264d51808b739e57ca264af7eebf1112f680..187eeb9f8e835eacd732d1acb1fa1096a2a1082d 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -17,4 +17,5 @@ M: label pref-dim ( label -- dim )
     dup label-text label-size ;
 
 M: label draw-gadget* ( label -- )
+    dup delegate draw-gadget*
     dup label-text draw-string ;

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index 3f21add508278aa351615ace46b36eccee9c24b7..c3f66dc05e03c6ec02f65a704489555d17f27a0e 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -85,6 +85,9 @@ M: pane stream-auto-flush ( stream -- ) drop ;
 M: pane stream-readln ( stream -- line )
     [ over set-pane-continuation stop ] callcc1 nip ;
 
+M: pane stream-write1 ( string style stream -- )
+    [ rot ch>string unit pane-write ] keep scroll>bottom ;
+
 M: pane stream-write-attr ( string style stream -- )
     [ rot "\n" split pane-write ] keep scroll>bottom ;
 

diff --git a/library/unix/io.factor b/library/unix/io.factor
index 92ac6f6d254744a704b13053f421d495e5f4b5e7..c6065450813ff3c6fbfdce57ddd472dc360c48b2 100644 (file)
--- a/library/unix/io.factor
+++ b/library/unix/io.factor
@@ -271,9 +271,6 @@ M: write-task do-io-task
 
 M: write-task task-container drop write-tasks get ;
 
-: write-fin ( str writer -- )
-    dup pending-error >buffer ;
-
 : add-write-io-task ( callback task -- )
     dup io-task-fd write-tasks get hash [
         dup write-task? [
@@ -294,10 +291,16 @@ M: port stream-flush ( stream -- )
 M: port stream-auto-flush ( stream -- ) drop ;
 
 : wait-to-write ( len port -- )
-    tuck can-write? [ drop ] [ stream-flush ] ifte ;
+    tuck can-write? [ dup stream-flush ] unless pending-error ;
+
+: blocking-write1 ( str writer -- )
+    1 over wait-to-write >buffer ;
+
+M: port stream-write1 ( char writer -- )
+    nip >r dup string? [ ch>string ] unless r> blocking-write ;
 
 : blocking-write ( str writer -- )
-    over length over wait-to-write write-fin ;
+    over length over wait-to-write >buffer ;
 
 M: port stream-write-attr ( string style writer -- )
     nip >r dup string? [ ch>string ] unless r> blocking-write ;

diff --git a/library/win32/win32-stream.factor b/library/win32/win32-stream.factor
index ba2b22846143fbc468fcf251fb97247852879241..cb5a47546eaf9607aa631388627717d711c64ab3 100644 (file)
--- a/library/win32/win32-stream.factor
+++ b/library/win32/win32-stream.factor
@@ -100,13 +100,13 @@ M: string do-write ( str -- )
 
 : do-read-count ( sbuf count -- str )
     dup 0 = [ 
-        drop sbuf>string 
+        drop >string 
     ] [
         dup consume-input
         dup length dup 0 = [
             3drop >string-or-f
         ] [
-            >r swap r> - >r swap [ sbuf-append ] keep r> do-read-count
+            >r swap r> - >r swap [ swap nappend ] keep r> do-read-count
         ] ifte
     ] ifte ;
 
@@ -123,7 +123,7 @@ M: string do-write ( str -- )
                 peek-input "\r" = [ 1 consume-input drop ] when 
                 drop >string
             ] [
-                over sbuf-append do-read-line 
+                dupd nappend do-read-line 
             ] ifte
         ] ifte
     ] ifte ;