Merge branch 'master' into new_ui

basis/csv/csv-docs.factor

@@ -1,28 +1,52 @@
-USING: help.syntax help.markup kernel prettyprint sequences ;
+USING: help.syntax help.markup kernel prettyprint sequences
+io.pathnames ;
 IN: csv
 
 HELP: csv
 { $values { "stream" "an input stream" }
           { "rows" "an array of arrays of fields" } } 
-{ $description "parses a csv stream into an array of row arrays"
+{ $description "Parses a csv stream into an array of row arrays." } ;
-} ;
+
+HELP: file>csv
+{ $values
+    { "path" pathname } { "encoding" "an encoding descriptor" }
+    { "csv" "csv" }
+}
+{ $description "Opens a file and parses it into a sequence of comma-separated-value fields." } ;
+
+HELP: csv>file
+{ $values
+    { "rows" "a sequence of sequences of strings" }
+    { "path" pathname } { "encoding" "an encoding descriptor" }
+}
+{ $description "Writes a comma-separated-value structure to a file." } ;
 
 HELP: csv-row
 { $values { "stream" "an input stream" }
           { "row" "an array of fields" } } 
-{ $description "parses a row from a csv stream"
+{ $description "parses a row from a csv stream" } ;
-} ;
 
 HELP: write-csv
-{ $values { "rows" "an sequence of sequences of strings" }
+{ $values { "rows" "a sequence of sequences of strings" }
           { "stream" "an output stream" } } 
-{ $description "writes csv to the output stream, escaping where necessary"
+{ $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ;
-} ;
-
 
 HELP: with-delimiter
-{ $values { "char" "field delimiter (e.g. CHAR: \t)" }
+{ $values { "ch" "field delimiter (e.g. CHAR: \t)" }
           { "quot" "a quotation" } }
-{ $description "Sets the field delimiter for csv or csv-row words "
+{ $description "Sets the field delimiter for csv or csv-row words." } ;
-} ;
 
+ARTICLE: "csv" "Comma-separated-values parsing and writing"
+"The " { $vocab-link "csv" } " vocabulary can read and write CSV (comma-separated-value) files." $nl
+"Reading a csv file:"
+{ $subsection file>csv }
+"Writing a csv file:"
+{ $subsection csv>file }
+"Changing the delimiter from a comma:"
+{ $subsection with-delimiter }
+"Reading from a stream:"
+{ $subsection csv }
+"Writing to a stream:"
+{ $subsection write-csv } ;
+
+ABOUT: "csv"

basis/csv/csv-tests.factor

@@ -1,5 +1,7 @@
+USING: io.streams.string csv tools.test shuffle kernel strings
+io.pathnames io.files.unique io.encodings.utf8 io.files
+io.directories ;
 IN: csv.tests
-USING: io.streams.string csv tools.test shuffle kernel strings ;
 
 ! I like to name my unit tests
 : named-unit-test ( name output input -- ) 
@@ -76,3 +78,15 @@ USING: io.streams.string csv tools.test shuffle kernel strings ;
 "escapes quotes commas and newlines when writing"
 [ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ]
 [ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } <string-writer> tuck write-csv >string ] named-unit-test ! "
+
+[ { { "writing" "some" "csv" "tests" } } ]
+[
+    "writing,some,csv,tests"
+    "csv-test1-" unique-file utf8
+    [ set-file-contents ] [ file>csv ] [ drop delete-file ] 2tri
+] unit-test
+
+[ t ] [
+    { { "writing,some,csv,tests" } } dup "csv-test2-"
+    unique-file utf8 [ csv>file ] [ file>csv ] 2bi =
+] unit-test

basis/csv/csv.factor

@@ -1,22 +1,19 @@
 ! Copyright (C) 2007, 2008 Phil Dawes
 ! See http://factorcode.org/license.txt for BSD license.
-
+USING: kernel sequences io namespaces make combinators
-! Simple CSV Parser
+unicode.categories io.files combinators.short-circuit ;
-! Phil Dawes phil@phildawes.net
-
-USING: kernel sequences io namespaces make
-combinators unicode.categories ;
 IN: csv
 
 SYMBOL: delimiter
 
 CHAR: , delimiter set-global
 
+<PRIVATE
+
 : delimiter> ( -- delimiter ) delimiter get ; inline
     
 DEFER: quoted-field ( -- endchar )
     
-! trims whitespace from either end of string
 : trim-whitespace ( str -- str )
     [ blank? ] trim ; inline
 
@@ -24,28 +21,28 @@ DEFER: quoted-field ( -- endchar )
   "\n" delimiter> suffix read-until nip ; inline
   
 : not-quoted-field ( -- endchar )
-  "\"\n" delimiter> suffix read-until   ! "
+    "\"\n" delimiter> suffix read-until
-  dup
+    dup {
-  { { CHAR: "     [ drop drop quoted-field ] }  ! " 
+        { CHAR: "    [ 2drop quoted-field ] }
         { delimiter> [ swap trim-whitespace % ] }
         { CHAR: \n   [ swap trim-whitespace % ] }
-    { f           [ swap trim-whitespace % ] }       ! eof
+        { f          [ swap trim-whitespace % ] }
     } case ;
   
 : maybe-escaped-quote ( -- endchar )
-  read1 dup 
+    read1 dup {
-  { { CHAR: "    [ , quoted-field ] }  ! " is an escaped quote
+        { CHAR: "    [ , quoted-field ] }
-    { delimiter> [ ] }                 ! end of quoted field 
+        { delimiter> [ ] }
         { CHAR: \n   [ ] }
-    [ 2drop skip-to-field-end ]       ! end of quoted field + padding
+        [ 2drop skip-to-field-end ]
     } case ;
   
 : quoted-field ( -- endchar )
-  "\"" read-until                                 ! "
+    "\"" read-until
     drop % maybe-escaped-quote ;
 
 : field ( -- sep string )
-  [ not-quoted-field ] "" make  ; ! trim-whitespace
+    [ not-quoted-field ] "" make  ;
 
 : (row) ( -- sep )
     field , 
@@ -54,12 +51,10 @@ DEFER: quoted-field ( -- endchar )
 : row ( -- eof? array[string] )
     [ (row) ] { } make ;
 
-: append-if-row-not-empty ( row -- )
-  dup { "" } = [ drop ] [ , ] if ;
-
 : (csv) ( -- )
-  row append-if-row-not-empty
+    row harvest [ , ] unless-empty [ (csv) ] when ;
-  [ (csv) ] when ;
+  
+PRIVATE>
 
 : csv-row ( stream -- row )
     [ row nip ] with-input-stream ;
@@ -67,23 +62,39 @@ DEFER: quoted-field ( -- endchar )
 : csv ( stream -- rows )
     [ [ (csv) ] { } make ] with-input-stream ;
 
-: with-delimiter ( char quot -- )
+: file>csv ( path encoding -- csv )
-  delimiter swap with-variable ; inline
+    <file-reader> csv ;
+
+: with-delimiter ( ch quot -- )
+    [ delimiter ] dip with-variable ; inline
+
+<PRIVATE
 
 : needs-escaping? ( cell -- ? )
-  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] any? ; inline
+    [ { [ "\n\"" member? ] [ delimiter get = ] } 1|| ] any? ; inline
 
 : escape-quotes ( cell -- cell' )
-  [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline
+    [
+        [
+            [ , ]
+            [ dup CHAR: " = [ , ] [ drop ] if ] bi
+        ] each
+    ] "" make ; inline
 
 : enclose-in-quotes ( cell -- cell' )
-  CHAR: " [ prefix ] [ suffix ] bi ; inline ! "
+    "\"" dup surround ; inline
     
 : escape-if-required ( cell -- cell' )
-  dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline
+    dup needs-escaping?
+    [ escape-quotes enclose-in-quotes ] when ; inline
+
+PRIVATE>
     
 : write-row ( row -- )
-  [ delimiter get write1 ] [ escape-if-required write ] interleave nl ; inline
+    [ delimiter get write1 ]
+    [ escape-if-required write ] interleave nl ; inline
     
 : write-csv ( rows stream -- )
     [ [ write-row ] each ] with-output-stream ;
+
+: csv>file ( rows path encoding -- ) <file-writer> write-csv ;

basis/db/db-docs.factor

@@ -173,7 +173,7 @@ HELP: with-db
 HELP: with-transaction
 { $values
      { "quot" quotation } }
-{ $description "" } ;
+{ $description "Calls the quotation inside a database transaction and commits the result to the database after the quotation finishes. If the quotation throws an error, the transaction is aborted." } ;
 
 ARTICLE: "db" "Database library"
 "Accessing a database:"

basis/db/types/types-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes hashtables help.markup help.syntax io.streams.string
-kernel sequences strings math ;
+kernel sequences strings math db.tuples db.tuples.private ;
 IN: db.types
 
 HELP: +db-assigned-id+
@@ -27,15 +27,11 @@ HELP: +user-assigned-id+
 
 HELP: <generator-bind>
 { $values { "slot-name" object } { "key" object } { "generator-singleton" object } { "type" object } { "generator-bind" generator-bind } }
-{ $description "" } ;
+{ $description "An internal constructor for creating objects containing parameters used for binding generated values to a tuple query." } ;
 
 HELP: <literal-bind>
 { $values { "key" object } { "type" object } { "value" object } { "literal-bind" literal-bind } }
-{ $description "" } ;
+{ $description "An internal constructor for creating objects containing parameters used for binding literal values to a tuple query." } ;
-
-HELP: <low-level-binding>
-{ $values { "value" object } { "low-level-binding" low-level-binding } }
-{ $description "" } ;
 
 HELP: BIG-INTEGER
 { $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ;
@@ -100,18 +96,12 @@ HELP: user-assigned-id-spec?
 HELP: bind#
 { $values
      { "spec" "a sql spec" } { "obj" object } }
-{ $description "" } ;
+{ $description "A generic word that lets a database construct a literal binding." } ;
 
 HELP: bind%
 { $values
      { "spec" "a sql spec" } }
-{ $description "" } ;
+{ $description "A generic word that lets a database output a binding." } ;
-
-HELP: compound
-{ $values
-     { "string" string } { "obj" object }
-     { "hash" hashtable } }
-{ $description "" } ;
 
 HELP: db-assigned-id-spec?
 { $values
@@ -126,45 +116,12 @@ HELP: find-primary-key
 { $description "Returns the rows from the sql-specs array that are part of the primary key. Composite primary keys are supported, so this word must return a sequence." }
 { $notes "This is a low-level word." } ;
 
-HELP: generator-bind
-{ $description "" } ;
-
 HELP: get-slot-named
 { $values
      { "name" "a slot name" } { "tuple" tuple }
      { "value" "the value stored in the slot" } }
 { $description "Returns the value stored in a tuple slot, where the tuple slot is a string." } ;
 
-HELP: literal-bind
-{ $description "" } ;
-
-HELP: lookup-create-type
-{ $values
-     { "obj" object }
-     { "string" string } }
-{ $description "" } ;
-
-HELP: lookup-modifier
-{ $values
-     { "obj" object }
-     { "string" string } }
-{ $description "" } ;
-
-HELP: lookup-type
-{ $values
-     { "obj" object }
-     { "string" string } }
-{ $description "" } ;
-
-HELP: low-level-binding
-{ $description "" } ;
-
-HELP: modifiers
-{ $values
-     { "spec" "a sql spec" }
-     { "string" string } }
-{ $description "" } ;
-
 HELP: no-sql-type
 { $values
      { "type" "a sql type" } }
@@ -173,7 +130,7 @@ HELP: no-sql-type
 HELP: normalize-spec
 { $values
      { "spec" "a sql spec" } }
-{ $description "" } ;
+{ $description "Normalizes a sql spec." } ;
 
 HELP: offset-of-slot
 { $values
@@ -181,52 +138,20 @@ HELP: offset-of-slot
      { "n" integer } }
 { $description "Returns the offset of a tuple slot accessed by name." } ;
 
-HELP: persistent-table
-{ $values
-    
-     { "hash" hashtable } }
-{ $description "" } ;
-
 HELP: primary-key?
 { $values
      { "spec" "a sql spec" }
      { "?" "a boolean" } }
-{ $description "" } ;
+{ $description "Returns true if a sql spec is a primary key." } ;
 
 HELP: random-id-generator
-{ $description "" } ;
+{ $description "Used to tell " { $link eval-generator } " to generate a random number for use as a key." } ;
 
 HELP: relation?
 { $values
      { "spec" "a sql spec" }
      { "?" "a boolean" } }
-{ $description "" } ;
+{ $description "Returns true if a sql spec is a relation." } ;
-
-HELP: remove-db-assigned-id
-{ $values
-     { "specs" "a sequence of sql specs" }
-     { "obj" object } }
-{ $description "" } ;
-
-HELP: remove-id
-{ $values
-     { "specs" "a sequence of sql specs" }
-     { "obj" object } }
-{ $description "" } ;
-
-HELP: set-slot-named
-{ $values
-     { "value" object } { "name" string } { "obj" object } }
-{ $description "" } ;
-
-HELP: spec>tuple
-{ $values
-     { "class" class } { "spec" "a sql spec" }
-     { "tuple" tuple } }
-{ $description "" } ;
-
-HELP: sql-spec
-{ $description "" } ;
 
 HELP: unknown-modifier
 { $values { "modifier" string } }

basis/environment/environment-docs.factor

@@ -7,12 +7,14 @@ HELP: (os-envs)
 { $values
     
      { "seq" sequence } }
-{ $description "" } ;
+{ $description "Returns a sequence of key/value pairs from the operating system." }
+{ $notes "In most cases, use " { $link os-envs } " instead." } ;
 
 HELP: (set-os-envs)
 { $values
      { "seq" sequence } }
-{ $description "" } ;
+{ $description "Low-level word for replacing the current set of environment variables." }
+{ $notes "In most cases, use " { $link set-os-envs } " instead." } ;
 
 
 HELP: os-env ( key -- value )

basis/formatting/formatting-docs.factor

@@ -23,6 +23,8 @@ HELP: printf
         { "%+P.Df"      "Fixed format"               "fixnum, float" }
         { "%+Px"        "Hexadecimal"                "hex" }
         { "%+PX"        "Hexadecimal uppercase"      "hex" }
+        { "%[%?, %]"    "Sequence format"            "sequence" }
+        { "%[%?: %? %]" "Assocs format"              "assocs" }
     }
     $nl
     "A plus sign ('+') is used to optionally specify that the number should be "
@@ -72,6 +74,14 @@ HELP: printf
         "USING: formatting ;"
         "1234 \"%+d\" printf"
         "+1234" }
+    { $example
+        "USING: formatting ;"
+        "{ 1 2 3 } \"%[%d, %]\" printf"
+        "{ 1, 2, 3 }" }
+    { $example
+        "USING: formatting ;"
+        "H{ { 1 2 } { 3 4 } } \"%[%d: %d %]\" printf"
+        "{ 1:2, 3:4 }" }
 } ;
 
 HELP: sprintf

basis/formatting/formatting.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: accessors arrays ascii calendar combinators fry kernel 
+USING: accessors arrays ascii assocs calendar combinators fry kernel 
 generalizations io io.encodings.ascii io.files io.streams.string
 macros math math.functions math.parser peg.ebnf quotations
 sequences splitting strings unicode.case vectors ;
@@ -75,8 +75,8 @@ digits    = (digits_)?           => [[ 6 or ]]
 fmt-%     = "%"                  => [[ [ "%" ] ]] 
 fmt-c     = "c"                  => [[ [ 1string ] ]]
 fmt-C     = "C"                  => [[ [ 1string >upper ] ]]
-fmt-s     = "s"                  => [[ [ ] ]]
+fmt-s     = "s"                  => [[ [ dup number? [ number>string ] when ] ]]
-fmt-S     = "S"                  => [[ [ >upper ] ]]
+fmt-S     = "S"                  => [[ [ dup number? [ number>string ] when >upper ] ]]
 fmt-d     = "d"                  => [[ [ >fixnum number>string ] ]]
 fmt-e     = digits "e"           => [[ first '[ >exp _ exp>string ] ]]
 fmt-E     = digits "E"           => [[ first '[ >exp _ exp>string >upper ] ]]
@@ -91,7 +91,13 @@ strings   = pad width strings_   => [[ reverse compose-all ]]
 numbers_  = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X
 numbers   = sign pad numbers_    => [[ unclip-last prefix compose-all [ fix-sign ] append ]]
 
-formats   = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
+types     = strings|numbers 
+
+lists     = "[%" types ", %]"    => [[ second '[ _ map ", " join "{ " prepend " }" append ] ]] 
+
+assocs    = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ unzip [ _ map ] dip _ map zip [ ":" join ] map ", " join "{ " prepend " }" append ] ]]
+
+formats   = "%" (types|fmt-%|lists|assocs|unknown) => [[ second '[ _ dip ] ]]
 
 plain-text = (!("%").)+          => [[ >string '[ _ swap ] ]]
 

basis/furnace/utilities/utilities-docs.factor

@@ -57,7 +57,7 @@ HELP: modify-redirect-query
 
 HELP: nested-responders
 { $values { "seq" "a sequence of responders" } }
-{ $description "" } ;
+{ $description "Outputs a sequence of responders which participated in the processing of the current request, with the main responder first and the innermost responder last." } ;
 
 HELP: referrer
 { $values { "referrer/f" { $maybe string } } }
@@ -69,11 +69,11 @@ HELP: request-params
 
 HELP: resolve-base-path
 { $values { "string" string } { "string'" string } }
-{ $description "" } ;
+{ $description "Resolves a responder-relative URL." } ;
 
 HELP: resolve-template-path
 { $values { "pair" "a pair with shape " { $snippet "{ class string }" } } { "path" "a pathname string" } }
-{ $description "" } ;
+{ $description "Resolves a responder-relative template path." } ;
 
 HELP: same-host?
 { $values { "url" url } { "?" "a boolean" } }
@@ -85,7 +85,7 @@ HELP: user-agent
 
 HELP: vocab-path
 { $values { "vocab" "a vocabulary specifier" } { "path" "a pathname string" } }
-{ $description "" } ;
+{ $description "Outputs the full pathname of the vocabulary's source directory." } ;
 
 HELP: exit-with
 { $values { "value" object } }

basis/math/bitwise/bitwise-docs.factor

@@ -242,7 +242,7 @@ HELP: shift-mod
      { "n" integer } { "s" integer } { "w" integer }
      { "n" integer }
 }
-{ $description "" } ;
+{ $description "Calls " { $link shift } " on " { $snippet "n" } " and " { $snippet "s" } ", wrapping the result to " { $snippet "w" } " bits." } ;
 
 HELP: unmask
 { $values

basis/math/blas/cblas/cblas.factor

@@ -1,36 +1,51 @@
-USING: alien alien.c-types alien.syntax kernel system combinators ;
+USING: alien alien.c-types alien.syntax kernel system
+combinators ;
 IN: math.blas.cblas
 
-<< "cblas" {
+<<
+: load-atlas ( -- )
+    "atlas" "libatlas.so" "cdecl" add-library ;
+: load-fortran ( -- )
+    "I77" "libI77.so" "cdecl" add-library
+    "F77" "libF77.so" "cdecl" add-library ;
+: load-blas ( -- )
+    "blas" "libblas.so" "cdecl" add-library ;
+
+"cblas" {
     { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] }
     { [ os windows? ] [ "blas.dll" "cdecl" add-library ] }
-    { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] }
+    { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library load-blas ] }
-    { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] }
+    { [ os netbsd? ] [ 
+        load-fortran load-blas
+        "/usr/local/lib/libcblas.so" "cdecl" add-library
+    ] }
+    { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library load-atlas ] }
     [ "libblas.so" "cdecl" add-library ]
-} cond >>
+} cond
+>>
 
 LIBRARY: cblas
 
 TYPEDEF: int CBLAS_ORDER
-: CblasRowMajor 101 ; inline
+CONSTANT: CblasRowMajor 101
-: CblasColMajor 102 ; inline
+CONSTANT: CblasColMajor 102
 
 TYPEDEF: int CBLAS_TRANSPOSE
-: CblasNoTrans   111 ; inline
+CONSTANT: CblasNoTrans   111
-: CblasTrans     112 ; inline
+CONSTANT: CblasTrans     112
-: CblasConjTrans 113 ; inline
+CONSTANT: CblasConjTrans 113
 
 TYPEDEF: int CBLAS_UPLO
-: CblasUpper 121 ; inline
+CONSTANT: CblasUpper 121
-: CblasLower 122 ; inline
+CONSTANT: CblasLower 122
 
 TYPEDEF: int CBLAS_DIAG
-: CblasNonUnit 131 ; inline
+CONSTANT: CblasNonUnit 131
-: CblasUnit    132 ; inline
+CONSTANT: CblasUnit    132
 
 TYPEDEF: int CBLAS_SIDE
-: CblasLeft  141 ; inline
+CONSTANT: CblasLeft  141
-: CblasRight 142 ; inline
+CONSTANT: CblasRight 142
 
 TYPEDEF: int CBLAS_INDEX
 

basis/unix/stat/netbsd/netbsd.factor

@@ -5,3 +5,34 @@ cell-bits {
     { 32 [ "unix.stat.netbsd.32" require ] }
     { 64 [ "unix.stat.netbsd.64" require ] }
 } case
+
+: _VFS_NAMELEN    32   ; inline
+: _VFS_MNAMELEN   1024 ; inline
+
+C-STRUCT: statvfs
+    { "ulong"   "f_flag" }   
+    { "ulong"   "f_bsize" }
+    { "ulong"   "f_frsize" }  
+    { "ulong"   "f_iosize" }  
+    { "fsblkcnt_t" "f_blocks" }       
+    { "fsblkcnt_t" "f_bfree" } 
+    { "fsblkcnt_t" "f_bavail" }       
+    { "fsblkcnt_t" "f_bresvd" }       
+    { "fsfilcnt_t" "f_files" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_favail" }       
+    { "fsfilcnt_t" "f_fresvd" }       
+    { "uint64_t"   "f_syncreads" }    
+    { "uint64_t"   "f_syncwrites" }   
+    { "uint64_t"   "f_asyncreads" }   
+    { "uint64_t"   "f_asyncwrites" }  
+    { "fsid_t"    "f_fsidx" }
+    { "ulong"   "f_fsid" }
+    { "ulong"   "f_namemax" }      
+    { "uid_t"   "f_owner" }
+    { { "uint32_t" 4 } "f_spare" }     
+    { { "char" _VFS_NAMELEN } "f_fstypename" }
+    { { "char" _VFS_NAMELEN } "f_mntonname" }
+    { { "char" _VFS_NAMELEN } "f_mntfromname" } ;
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/uuid/uuid.factor

@@ -52,13 +52,10 @@ IN: uuid
 : string>uuid ( string -- n )
     [ CHAR: - = not ] filter 16 base> ;
 
-: uuid>byte-array ( n -- byte-array ) 
-    16 >be ;
-
 PRIVATE>
 
 : uuid-parse ( string -- byte-array ) 
-    string>uuid uuid>byte-array ;
+    string>uuid 16 >be ;
 
 : uuid-unparse ( byte-array -- string ) 
     be> uuid>string ;

basis/xmode/catalog/catalog.factor

@@ -52,9 +52,15 @@ SYMBOL: rule-sets
     dup "::" split1 [ swap (load-mode) ] [ rule-sets get ] if*
     dup -roll at* [ nip ] [ drop no-such-rule-set ] if ;
 
+DEFER: finalize-rule-set
+
 : resolve-delegate ( rule -- )
-    dup delegate>> dup string?
+    dup delegate>> dup string? [
-    [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ;
+        get-rule-set
+        dup rule-set? [ "not a rule set" throw ] unless
+        swap rule-sets [ dup finalize-rule-set ] with-variable
+        >>delegate drop
+    ] [ 2drop ] if ;
 
 : each-rule ( rule-set quot -- )
     [ rules>> values concat ] dip each ; inline
@@ -74,26 +80,22 @@ SYMBOL: rule-sets
 : resolve-imports ( ruleset -- )
     dup imports>> [
         get-rule-set swap rule-sets [
-            dup resolve-delegates
+            [ nip resolve-delegates ]
-            2dup import-keywords
+            [ import-keywords ]
-            import-rules
+            [ import-rules ]
+            2tri
         ] with-variable
     ] with each ;
 
 ERROR: mutually-recursive-rulesets ruleset ;
+
 : finalize-rule-set ( ruleset -- )
-    dup finalized?>> {
+    dup finalized?>> [ drop ] [
-        { f [
+        t >>finalized?
-            {
-                [ 1 >>finalized? drop ]
         [ resolve-imports ]
         [ resolve-delegates ]
-                [ t >>finalized? drop ]
+        bi
-            } cleave
+    ] if ;
-        ] }
-        { t [ drop ] }
-        { 1 [ mutually-recursive-rulesets ] }
-    } case ;
 
 : finalize-mode ( rulesets -- )
     rule-sets [

basis/xmode/code2html/code2html-tests.factor

@@ -1,7 +1,7 @@
 IN: xmode.code2html.tests
 USING: xmode.code2html xmode.catalog
 tools.test multiline splitting memoize
-kernel ;
+kernel io.streams.string xml.writer ;
 
 [ ] [ \ (load-mode) reset-memoized ] unit-test
 
@@ -10,3 +10,10 @@ kernel ;
     *        {margin:0; padding:0; border:0;} ">
     string-lines "html" htmlize-lines drop
 ] unit-test
+
+[ ] [
+    "test.c"
+    <" int x = "hi";
+/* a comment */ "> <string-reader> htmlize-stream
+    write-xml
+] unit-test

basis/xmode/code2html/code2html.factor

@@ -8,14 +8,14 @@ IN: xmode.code2html
         [ str>> ] [ id>> ] bi [
             name>> swap
             [XML <span class=<->><-></span> XML]
-        ] [ ] if*
+        ] when*
     ] map ;
 
 : htmlize-line ( line-context line rules -- line-context' xml )
     tokenize-line htmlize-tokens ;
 
 : htmlize-lines ( lines mode -- xml )
-    [ f ] 2dip load-mode [ htmlize-line ] curry map nip ;
+    [ f ] 2dip load-mode [ htmlize-line "\n" suffix ] curry map nip ;
 
 : default-stylesheet ( -- xml )
     "resource:basis/xmode/code2html/stylesheet.css"
@@ -24,7 +24,7 @@ IN: xmode.code2html
 
 :: htmlize-stream ( path stream -- xml )
     stream lines
-    [ "" ] [ first find-mode path swap htmlize-lines ]
+    [ "" ] [ path over first find-mode htmlize-lines ]
     if-empty :> input
     default-stylesheet :> stylesheet
     <XML <html>

basis/xmode/loader/loader.factor

@@ -43,17 +43,17 @@ RULE: MARK_PREVIOUS mark-previous-rule
     shared-tag-attrs match-type-attr literal-start ;
 
 TAG: KEYWORDS ( rule-set tag -- key value )
-    ignore-case? get <keyword-map>
+    rule-set get ignore-case?>> <keyword-map>
     swap child-tags [ over parse-keyword-tag ] each
     swap (>>keywords) ;
 
 TAGS>
 
 : ?<regexp> ( string/f -- regexp/f )
-    dup [ ignore-case? get <regexp> ] when ;
+    dup [ rule-set get ignore-case?>> <regexp> ] when ;
 
 : (parse-rules-tag) ( tag -- rule-set )
-    <rule-set>
+    <rule-set> dup rule-set set
     {
         { "SET" string>rule-set-name (>>name) }
         { "IGNORE_CASE" string>boolean (>>ignore-case?) }
@@ -65,11 +65,11 @@ TAGS>
     } init-from-tag ;
 
 : parse-rules-tag ( tag -- rule-set )
-    dup (parse-rules-tag) [
+    [
-        dup ignore-case?>> ignore-case? [
+        [ (parse-rules-tag) ] [ child-tags ] bi
-            swap child-tags [ parse-rule-tag ] with each
+        [ parse-rule-tag ] with each
-        ] with-variable
+        rule-set get
-    ] keep ;
+    ] with-scope ;
 
 : merge-rule-set-props ( props rule-set -- )
     [ assoc-union ] change-props drop ;

basis/xmode/loader/syntax/syntax.factor

@@ -1,13 +1,11 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors xmode.tokens xmode.rules xmode.keyword-map
 xml.data xml.utilities xml assocs kernel combinators sequences
 math.parser namespaces make parser lexer xmode.utilities
-parser-combinators.regexp io.files ;
+parser-combinators.regexp io.files splitting arrays ;
 IN: xmode.loader.syntax
 
-SYMBOL: ignore-case?
-
 ! Rule tag parsing utilities
 : (parse-rule-tag) ( rule-set tag specs class -- )
     new swap init-from-tag swap add-rule ; inline
@@ -44,16 +42,19 @@ SYMBOL: ignore-case?
 
 : parse-literal-matcher ( tag -- matcher )
     dup children>string
-    ignore-case? get <string-matcher>
+    rule-set get ignore-case?>> <string-matcher>
     swap position-attrs <matcher> ;
 
 : parse-regexp-matcher ( tag -- matcher )
-    dup children>string ignore-case? get <regexp>
+    dup children>string rule-set get ignore-case?>> <regexp>
     swap position-attrs <matcher> ;
 
 : shared-tag-attrs ( -- )
     { "TYPE" string>token (>>body-token) } , ; inline
 
+: parse-delegate ( string -- pair )
+    "::" split1 [ rule-set get swap ] unless* 2array ;
+
 : delegate-attr ( -- )
     { "DELEGATE" f (>>delegate) } , ;
 

basis/xmode/marker/context/context.factor

@@ -1,4 +1,4 @@
-USING: accessors kernel ;
+USING: accessors kernel xmode.rules ;
 IN: xmode.marker.context
 
 ! Based on org.gjt.sp.jedit.syntax.TokenMarker.LineContext
@@ -10,7 +10,7 @@ end
 ;
 
 : <line-context> ( ruleset parent -- line-context )
-    over [ "no context" throw ] unless
+    over rule-set? [ "not a rule-set" throw ] unless
     line-context new
         swap >>parent
         swap >>in-rule-set ;

core/strings/strings-docs.factor

@@ -4,7 +4,7 @@ sbufs math ;
 IN: strings
 
 ARTICLE: "strings" "Strings"
-"A string is a fixed-size mutable sequence of Unicode 5.0 code points."
+"A string is a fixed-size mutable sequence of Unicode 5.1 code points."
 $nl
 "Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode."
 $nl

extra/svg/svg.factor

@@ -1,3 +1,4 @@
+! (c)2009 Joe Groff, see BSD license
 USING: accessors arrays assocs fry kernel math math.affine-transforms math.constants
 math.functions math.parser math.vectors memoize peg.ebnf sequences sequences.squish
 splitting strings xml.data xml.utilities ;

misc/fuel/fuel-markup.el

@@ -323,7 +323,7 @@
         (sort-lines nil start (point))))))
 
 (defun fuel-markup--vocab-link (e)
-  (fuel-markup--insert-button (cadr e) (car (cddr e)) 'vocab))
+  (fuel-markup--insert-button (cadr e) (or (car (cddr e)) (cadr e)) 'vocab))
 
 (defun fuel-markup--vocab-links (e)
   (dolist (link (cdr e))

vm/os-unix.c

@@ -36,7 +36,7 @@ void init_ffi(void)
 
 void ffi_dlopen(F_DLL *dll)
 {
-	dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY);
+	dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY|RTLD_GLOBAL);
 }
 
 void *ffi_dlsym(F_DLL *dll, F_SYMBOL *symbol)