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

core/io/files/files-docs.factor

@@ -89,7 +89,6 @@ ARTICLE: "io.files" "Basic file operations"
 { $subsection "fs-meta" }
 { $subsection "directories" }
 { $subsection "delete-move-copy" }
-{ $subsection "unique" }
 { $see-also "os" } ;
 
 ABOUT: "io.files"

extra/db/types/types.factor

@@ -153,33 +153,6 @@ TUPLE: no-sql-modifier ;
     [ lookup-modifier ] map " " join
     dup empty? [ " " swap append ] unless ;
 
-SYMBOL: building-seq 
-: get-building-seq ( n -- seq )
-    building-seq get nth ;
-
-: n, get-building-seq push ;
-: n% get-building-seq push-all ;
-: n# >r number>string r> n% ;
-
-: 0, 0 n, ;
-: 0% 0 n% ;
-: 0# 0 n# ;
-: 1, 1 n, ;
-: 1% 1 n% ;
-: 1# 1 n# ;
-: 2, 2 n, ;
-: 2% 2 n% ;
-: 2# 2 n# ;
-
-: nmake ( quot exemplars -- seqs )
-    dup length dup zero? [ 1+ ] when
-    [
-        [
-            [ drop 1024 swap new-resizable ] 2map
-            [ building-seq set call ] keep
-        ] 2keep >r [ like ] 2map r> firstn 
-    ] with-scope ;
-
 HOOK: bind% db ( spec -- )
 
 TUPLE: no-slot-named ;

extra/html/parser/analyzer/analyzer.factor

@@ -2,6 +2,42 @@ USING: assocs html.parser kernel math sequences strings ascii
 arrays shuffle unicode.case namespaces splitting http ;
 IN: html.parser.analyzer
 
+: (find-relative)
+    [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ;
+
+: find-relative ( seq quot n -- i elt )
+    >r over [ find drop ] dip r> swap pick
+    (find-relative) ;
+
+: (find-all) ( n seq quot -- )
+    2dup >r >r find* [
+        dupd 2array , 1+ r> r> (find-all)
+    ] [
+        r> r> 3drop
+    ] if* ;
+
+: find-all ( seq quot -- alist )
+    [ 0 -rot (find-all) ] { } make ;
+
+: (find-nth) ( offset seq quot n count -- obj )
+    >r >r [ find* ] 2keep 4 npick [
+        r> r> 1+ 2dup <= [
+            4drop
+        ] [
+            >r >r >r >r drop 1+ r> r> r> r>
+            (find-nth)
+        ] if
+    ] [
+        2drop r> r> 2drop
+    ] if ;
+
+: find-nth ( seq quot n -- i elt )
+    0 -roll 0 (find-nth) ;
+
+: find-nth-relative ( seq quot n offest -- i elt )
+    >r [ find-nth ] 3keep 2drop nip r> swap pick
+    (find-relative) ;
+
 : remove-blank-text ( vector -- vector' )
     [
         dup tag-name text = [
@@ -51,29 +87,33 @@ IN: html.parser.analyzer
     >r >lower r>
     [ tag-attributes at over = ] with find rot drop ;
 
-: find-between ( i/f tag/f vector -- vector )
+: find-between* ( i/f tag/f vector -- vector )
     pick integer? [
-        rot 1+ tail-slice
+        rot tail-slice
         >r tag-name r>
-        [ find-matching-close drop ] keep swap head
+        [ find-matching-close drop 1+ ] keep swap head
     ] [
         3drop V{ } clone
     ] if ;
+    
+: find-between ( i/f tag/f vector -- vector )
+    find-between* dup length 3 >= [
+        [ 1 tail-slice 1 head-slice* ] keep like
+    ] when ;
+
+: find-between-first ( string vector -- vector' )
+    [ find-first-name ] keep find-between ;
+
+: tag-link ( tag -- link/f )
+    tag-attributes [ "href" swap at ] [ f ] if* ;
 
 : find-links ( vector -- vector )
     [ tag-name "a" = ] subset
-    [ tag-attributes "href" swap at ] map
+    [ tag-link ] subset ;
-    [ ] subset ;
 
-: (find-all) ( n seq quot -- )
-    2dup >r >r find* [
-        dupd 2array , 1+ r> r> (find-all)
-    ] [
-        r> r> 3drop
-    ] if* ;
 
-: find-all ( seq quot -- alist )
+: find-by-text ( seq quot -- tag )
-    [ 0 -rot (find-all) ] { } make ;
+    [ dup tag-name text = ] swap compose find drop ;
 
 : find-opening-tags-by-name ( name seq -- seq )
     [ [ tag-name = ] keep tag-closing? not and ] with find-all ;

extra/io/windows/ce/ce.factor

@@ -3,4 +3,5 @@ io.windows.ce.files io.windows.ce.sockets io.windows.ce.launcher
 namespaces io.windows.mmap ;
 IN: io.windows.ce
 
+USE: io.windows.files
 T{ windows-ce-io } set-io-backend

extra/io/windows/files/files.factor

@@ -50,17 +50,20 @@ SYMBOL: +encrypted+
         { +encrypted+ FILE_ATTRIBUTE_ENCRYPTED }
     } get-flags ;
 
+: win32-file-type ( n -- symbol )
+    FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
+
 : WIN32_FIND_DATA>file-info
     {
-        [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
+        [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
         [
             [ WIN32_FIND_DATA-nFileSizeLow ]
             [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit
         ]
         [ WIN32_FIND_DATA-dwFileAttributes ]
-        [
+        ! [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp ]
-            WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp
+        [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ]
-        ]
+        ! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ]
     } cleave
     \ file-info construct-boa ;
 
@@ -73,16 +76,15 @@ SYMBOL: +encrypted+
 
 : BY_HANDLE_FILE_INFORMATION>file-info
     {
-        [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes ]
+        [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type ]
         [
             [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
             [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit
         ]
         [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ]
-        [
+        ! [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp ]
-            BY_HANDLE_FILE_INFORMATION-ftLastWriteTime
+        [ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ]
-            FILETIME>timestamp
+        ! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ]
-        ]
     } cleave
     \ file-info construct-boa ;
 

extra/io/windows/nt/nt.factor

@@ -9,6 +9,7 @@ USE: io.windows.nt.launcher
 USE: io.windows.nt.monitors
 USE: io.windows.nt.sockets
 USE: io.windows.mmap
+USE: io.windows.files
 USE: io.backend
 
 T{ windows-nt-io } set-io-backend

extra/sequences/lib/lib.factor

@@ -140,13 +140,13 @@ PRIVATE>
 : strings ( alphabet length -- seqs )
     >r dup length r> number-strings map-alphabet ;
 
-: nths ( nths seq -- subseq )
+: switches ( seq1 seq -- subseq )
-    ! nths is a sequence of ones and zeroes
+    ! seq1 is a sequence of ones and zeroes
     >r [ length ] keep [ nth 1 = ] curry subset r>
     [ nth ] curry { } map-as ;
 
 : power-set ( seq -- subsets )
-    2 over length exact-number-strings swap [ nths ] curry map ;
+    2 over length exact-number-strings swap [ switches ] curry map ;
 
 : push-either ( elt quot accum1 accum2 -- )
     >r >r keep swap r> r> ? push ; inline
@@ -214,3 +214,9 @@ PRIVATE>
 
 : attempt-each ( seq quot -- result )
     (each) iterate-prep (attempt-each-integer) ; inline
+
+: ?nth* ( n seq -- elt/f ? )
+    2dup bounds-check? [ nth-unsafe t ] [ 2drop f f ] if ; flushable
+
+: nths ( indices seq -- seq' )
+    [ swap nth ] with map ;