Merge branch 'master' of git://factorcode.org/git/factor

basis/grouping/grouping-docs.factor

@@ -29,8 +29,7 @@ ABOUT: "grouping"
 HELP: groups
 { $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
 $nl
-"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
-{ $see-also group } ;
+"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." } ;
 
 HELP: group
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
@@ -48,11 +47,16 @@ HELP: <groups>
         "USING: arrays kernel prettyprint sequences grouping ;"
         "9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
     }
+    { $example
+        "USING: kernel prettyprint sequences grouping ;"
+        "{ 1 2 3 4 5 6 } 3 <groups> 0 swap nth ."
+        "{ 1 2 3 }"
+    }
 } ;
 
 HELP: <sliced-groups>
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
-{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
+{ $description "Outputs a virtual sequence whose elements are slices of disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
 { $examples
     { $example
         "USING: arrays kernel prettyprint sequences grouping ;"
@@ -60,6 +64,11 @@ HELP: <sliced-groups>
         "dup [ reverse-here ] each concat >array ."
         "{ 2 1 0 5 4 3 8 7 6 }"
     }
+    { $example
+        "USING: kernel prettyprint sequences grouping ;"
+        "{ 1 2 3 4 5 6 } 3 <sliced-groups> 1 swap nth ."
+        "T{ slice { from 3 } { to 6 } { seq { 1 2 3 4 5 6 } } }"
+    }
 } ;
 
 HELP: clumps
@@ -89,11 +98,23 @@ HELP: <clumps>
         "share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
         "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
     }
+    { $example
+        "USING: kernel sequences grouping prettyprint ;"
+        "{ 1 2 3 4 5 6 } 3 <clumps> 1 swap nth ."
+        "{ 2 3 4 }"
+    }
 } ;
 
 HELP: <sliced-clumps>
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
-{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
+{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." }
+{ $examples
+    { $example
+        "USING: kernel sequences grouping prettyprint ;"
+        "{ 1 2 3 4 5 6 } 3 <sliced-clumps> 1 swap nth ."
+        "T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }"
+    }
+} ;
 
 { clumps groups } related-words
 

basis/io/directories/search/search-docs.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations ;
+IN: io.directories.search
+
+HELP: each-file
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+}
+{ $description "Performs a directory traversal, breadth-first or depth-first, and calls the quotation on the full pathname of each file." }
+{ $examples
+    { $unchecked-example "USING: sequences io.directories.search ;"
+        "\"resource:misc\" t [ . ] each-file"
+        "! Recursive directory listing prints here"
+    }
+} ;
+
+HELP: recursive-directory
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
+     { "paths" "a sequence of pathname strings" }
+}
+{ $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ;
+
+HELP: find-file
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "path/f" "a pathname string or f" }
+}
+{ $description "Finds the first file in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+
+HELP: find-in-directories
+{ $values
+     { "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "path'" "a pathname string" }
+}
+{ $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+
+HELP: find-all-files
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "paths" "a sequence of pathname strings" }
+}
+{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+
+HELP: find-all-in-directories
+{ $values
+     { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "paths" "a sequence of pathname strings" }
+}
+{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+
+{ find-file find-all-files find-in-directories find-all-in-directories } related-words
+
+ARTICLE: "io.directories.search" "io.directories.search"
+"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
+"Traversing directories:"
+{ $subsection recursive-directory }
+{ $subsection each-file }
+"Finding files:"
+{ $subsection find-file }
+{ $subsection find-all-files }
+{ $subsection find-in-directories }
+{ $subsection find-all-in-directories } ;
+
+ABOUT: "io.directories.search"

basis/io/directories/search/search.factor

@@ -5,10 +5,10 @@ io.directories io.files io.files.info io.pathnames kernel
 sequences system vocabs.loader ;
 IN: io.directories.search
 
-TUPLE: directory-iterator path bfs queue ;
-
 <PRIVATE
 
+TUPLE: directory-iterator path bfs queue ;
+
 : qualified-directory ( path -- seq )
     dup directory-files [ append-path ] with map ;
 
@@ -38,22 +38,25 @@ TUPLE: directory-iterator path bfs queue ;
 
 PRIVATE>
 
+: each-file ( path bfs? quot: ( obj -- ) -- )
+    [ <directory-iterator> ] dip
+    [ f ] compose iterate-directory drop ; inline
+
+: recursive-directory ( path bfs? -- paths )
+    [ ] accumulator [ each-file ] dip ;
+
 : find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
     [ <directory-iterator> ] dip
     [ keep and ] curry iterate-directory ; inline
 
-: each-file ( path bfs? quot: ( obj -- ? ) -- )
-    [ <directory-iterator> ] dip
-    [ f ] compose iterate-directory drop ; inline
-
 : find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
     [ <directory-iterator> ] dip
     pusher [ [ f ] compose iterate-directory drop ] dip ; inline
 
-: recursive-directory ( path bfs? -- paths )
-    [ ] accumulator [ each-file ] dip ;
+: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path' )
+    '[ _ _ find-file ] attempt-all ;
 
-: find-in-directories ( directories bfs? quot -- path' )
-    '[ _ _ find-file ] attempt-all ; inline
+: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths )
+    '[ _ _ find-all-files ] map concat ;
 
 os windows? [ "io.directories.search.windows" require ] when

basis/unix/users/users-docs.factor

@@ -50,7 +50,7 @@ HELP: set-real-user
 HELP: user-passwd
 { $values
      { "obj" object }
-     { "passwd" passwd } }
+     { "passwd/f" "passwd or f" } }
 { $description "Returns the passwd tuple given a username string or user id." } ;
 
 HELP: username

basis/unix/users/users-tests.factor

@@ -24,3 +24,7 @@ IN: unix.users.tests
 [ ] [ effective-user-id [ ] with-effective-user ] unit-test
 
 [ ] [ [ ] with-user-cache ] unit-test
+
+[ "9999999999999999999" ] [ 9999999999999999999 username ] unit-test
+
+[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test

basis/unix/users/users.factor

@@ -47,17 +47,18 @@ SYMBOL: user-cache
 : with-user-cache ( quot -- )
     [ <user-cache> user-cache ] dip with-variable ; inline
 
-GENERIC: user-passwd ( obj -- passwd )
+GENERIC: user-passwd ( obj -- passwd/f )
 
 M: integer user-passwd ( id -- passwd/f )
     user-cache get
-    [ at ] [ getpwuid passwd>new-passwd ] if* ;
+    [ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
 
 M: string user-passwd ( string -- passwd/f )
     getpwnam dup [ passwd>new-passwd ] when ;
 
 : username ( id -- string )
-    user-passwd username>> ;
+    dup user-passwd
+    [ nip username>> ] [ number>string ] if* ;
 
 : user-id ( string -- id )
     user-passwd uid>> ;

extra/html/parser/utils/utils.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs circular combinators continuations hashtables
 hashtables.private io kernel math namespaces prettyprint
-quotations sequences splitting state-parser strings ;
+quotations sequences splitting state-parser strings
+combinators.short-circuit ;
 IN: html.parser.utils
 
 : string-parse-end? ( -- ? ) get-next not ;
@@ -13,26 +14,26 @@ IN: html.parser.utils
     dup length rot length 1- - head next* ;
 
 : trim1 ( seq ch -- newseq )
-    [ ?head drop ] [ ?tail drop ] bi ;
+    [ [ ?head-slice drop ] [ ?tail-slice drop ] bi ] 2keep drop like ;
 
-: single-quote ( str -- newstr )
-    "'" dup surround ;
+: quote? ( ch -- ? ) "'\"" member? ;
 
-: double-quote ( str -- newstr )
-    "\"" dup surround ;
+: single-quote ( str -- newstr ) "'" dup surround ;
+
+: double-quote ( str -- newstr ) "\"" dup surround ;
 
 : quote ( str -- newstr )
     CHAR: ' over member?
     [ double-quote ] [ single-quote ] if ;
 
 : quoted? ( str -- ? )
-    [ f ]
-    [ [ first ] [ peek ] bi [ = ] keep "'\"" member? and ] if-empty ;
+    {
+        [ length 1 > ]
+        [ first quote? ]
+        [ [ first ] [ peek ] bi = ]
+    } 1&& ;
 
-: ?quote ( str -- newstr )
-    dup quoted? [ quote ] unless ;
+: ?quote ( str -- newstr ) dup quoted? [ quote ] unless ;
 
 : unquote ( str -- newstr )
     dup quoted? [ but-last-slice rest-slice >string ] when ;
-
-: quote? ( ch -- ? ) "'\"" member? ;