Merge branch 'master' into new_ui

diff --git a/basis/editors/editpadlite/editpadlite.factor b/basis/editors/editpadlite/editpadlite.factor
index d487ca776f81e72d90883c6fc9ec39a38649f1cc..043ef7ef27b1f00f3acbfcd3a58966056334a0df 100644 (file)
--- a/basis/editors/editpadlite/editpadlite.factor
+++ b/basis/editors/editpadlite/editpadlite.factor
@@ -5,7 +5,7 @@ IN: editors.editpadlite
 
 : editpadlite-path ( -- path )
     \ editpadlite-path get-global [
-        "JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files
+        "JGsoft" [ >lower "editpadlite.exe" tail? ] find-in-program-files
         [ "editpadlite.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor
index 09bfd69de8c0809a5764fbc5582737c82a2a1a97..571c20fd6aa0425fc4f3cf0c25ef832771d1b71e 100644 (file)
--- a/basis/editors/editpadpro/editpadpro.factor
+++ b/basis/editors/editpadpro/editpadpro.factor
@@ -5,7 +5,7 @@ IN: editors.editpadpro
 
 : editpadpro-path ( -- path )
     \ editpadpro-path get-global [
-        "JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files
+        "JGsoft" [ >lower "editpadpro.exe" tail? ] find-in-program-files
         [ "editpadpro.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor
index affbcd4eb69152f88d4acf0eb821bb7111c99cd6..a3150dc961f50bd2d0f5169a17d333e1cbd1a86d 100644 (file)
--- a/basis/editors/editplus/editplus.factor
+++ b/basis/editors/editplus/editplus.factor
@@ -5,7 +5,7 @@ IN: editors.editplus
 
 : editplus-path ( -- path )
     \ editplus-path get-global [
-        "EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files
+        "EditPlus 2" [ "editplus.exe" tail? ] find-in-program-files
         [ "editplus.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor
index e18c39ed6059e4c173dc7b543ab6ad551eec2ceb..91d6e878e4958f00dd446b0e81cd2ce876b72694 100755 (executable)
--- a/basis/editors/emacs/windows/windows.factor
+++ b/basis/editors/emacs/windows/windows.factor
@@ -6,7 +6,7 @@ IN: editors.emacs.windows
 
 M: windows default-emacsclient
     {
-        [ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ]
-        [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ]
         [ "emacsclient.exe" ]
     } 0|| ;

diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor
index 52c52bbb8bd554426248254e118ab307ebd76cc2..3380f5c974643e9ecf493ac9aaa63c9a839e198c 100644 (file)
--- a/basis/editors/emeditor/emeditor.factor
+++ b/basis/editors/emeditor/emeditor.factor
@@ -5,7 +5,7 @@ IN: editors.emeditor
 
 : emeditor-path ( -- path )
     \ emeditor-path get-global [
-        "EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files
+        "EmEditor" [ "EmEditor.exe" tail? ] find-in-program-files
         [ "EmEditor.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/etexteditor/etexteditor.factor b/basis/editors/etexteditor/etexteditor.factor
index 37c8d1b57248174f9bfe69c82969c068e00b3042..8b76b3b473f8df9f106af620a6ea8e20b3dbaade 100755 (executable)
--- a/basis/editors/etexteditor/etexteditor.factor
+++ b/basis/editors/etexteditor/etexteditor.factor
@@ -6,7 +6,7 @@ IN: editors.etexteditor
 
 : etexteditor-path ( -- str )
     \ etexteditor-path get-global [
-        "e" t [ "e.exe" tail? ] find-in-program-files
+        "e" [ "e.exe" tail? ] find-in-program-files
         [ "e" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/gvim/windows/windows.factor b/basis/editors/gvim/windows/windows.factor
index 4edc13b90c3cf936573459bfd81b00c58b9613f0..3fe228a403322ac25913d0aa0985223ee3515291 100644 (file)
--- a/basis/editors/gvim/windows/windows.factor
+++ b/basis/editors/gvim/windows/windows.factor
@@ -5,6 +5,6 @@ IN: editors.gvim.windows
 
 M: windows gvim-path
     \ gvim-path get-global [
-        "vim" t [ "gvim.exe" tail? ] find-in-program-files
+        "vim" [ "gvim.exe" tail? ] find-in-program-files
         [ "gvim.exe" ] unless*
     ] unless* ;

diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor
index 1c856bd7615273388c5425a8ccf24c970e5ee741..7b0f2bb72ad87423347acf7aa377d830bc70d8e2 100644 (file)
--- a/basis/editors/notepadpp/notepadpp.factor
+++ b/basis/editors/notepadpp/notepadpp.factor
@@ -4,7 +4,7 @@ IN: editors.notepadpp
 
 : notepadpp-path ( -- path )
     \ notepadpp-path get-global [
-        "notepad++" t [ "notepad++.exe" tail? ] find-in-program-files
+        "notepad++" [ "notepad++.exe" tail? ] find-in-program-files
         [ "notepad++.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor
index fc7e9e319e345c43ce7395fb06e2019326d4e4dc..7e8a540b7331a84eb0135a0660170ef296074093 100644 (file)
--- a/basis/editors/scite/scite.factor
+++ b/basis/editors/scite/scite.factor
@@ -7,11 +7,11 @@ IN: editors.scite
 
 : scite-path ( -- path )
     \ scite-path get-global [
-        "Scintilla Text Editor" t
+        "Scintilla Text Editor"
         [ >lower "scite.exe" tail? ] find-in-program-files
 
         [
-            "SciTE Source Code Editor" t
+            "SciTE Source Code Editor"
             [ >lower "scite.exe" tail? ] find-in-program-files
         ] unless*
         [ "scite.exe" ] unless*

diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor
index 301e82225c7547900316c1a7e290d20f8490c3c7..6f954febe8a4defd4f12cff3d1106e3c3daf0916 100644 (file)
--- a/basis/editors/ted-notepad/ted-notepad.factor
+++ b/basis/editors/ted-notepad/ted-notepad.factor
@@ -4,7 +4,7 @@ IN: editors.ted-notepad
 
 : ted-notepad-path ( -- path )
     \ ted-notepad-path get-global [
-        "TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files
+        "TED Notepad" [ "TedNPad.exe" tail? ] find-in-program-files
         [ "TedNPad.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/textpad/textpad.factor b/basis/editors/textpad/textpad.factor
index ca9d5c486af482558f7fed32ddc0b6964f620fd7..925f75400ff2c1f122b8181f283a74929e5c4022 100644 (file)
--- a/basis/editors/textpad/textpad.factor
+++ b/basis/editors/textpad/textpad.factor
@@ -5,7 +5,7 @@ IN: editors.textpad
 
 : textpad-path ( -- path )
     \ textpad-path get-global [
-        "TextPad 5" t [ "TextPad.exe" tail? ] find-in-program-files
+        "TextPad 5" [ "TextPad.exe" tail? ] find-in-program-files
         [ "TextPad.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor
index b5bc2297437116f1833b8d4f2e8f9aaf5d494a0f..3069d7892521c01586c2318c43b210127ab6192c 100644 (file)
--- a/basis/editors/ultraedit/ultraedit.factor
+++ b/basis/editors/ultraedit/ultraedit.factor
@@ -4,7 +4,7 @@ IN: editors.ultraedit
 
 : ultraedit-path ( -- path )
     \ ultraedit-path get-global [
-        "IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files
+        "IDM Computer Solutions" [ "uedit32.exe" tail? ] find-in-program-files
         [ "uedit32.exe" ] unless*
     ] unless* ;
 

diff --git a/basis/editors/wordpad/wordpad.factor b/basis/editors/wordpad/wordpad.factor
index ef670d5d28f482006db8704c3684001517c13a6d..103b69ba4c253132fcdf6d607cc0829882163f01 100644 (file)
--- a/basis/editors/wordpad/wordpad.factor
+++ b/basis/editors/wordpad/wordpad.factor
@@ -4,7 +4,7 @@ IN: editors.wordpad
 
 : wordpad-path ( -- path )
     \ wordpad-path get [
-        "Windows NT\\Accessories" t
+        "Windows NT\\Accessories"
         [ "wordpad.exe" tail? ] find-in-program-files
     ] unless* ;
 

diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor
index 99135b795344ea28e079854452987b3e51359e94..818899606da745d49dafbe0fae39237fd2a23a13 100644 (file)
--- a/basis/io/directories/search/search-docs.factor
+++ b/basis/io/directories/search/search-docs.factor
@@ -38,7 +38,7 @@ HELP: find-in-directories
 
 HELP: find-all-files
 { $values
-     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "path" "a pathname string" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
 { $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;

diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor
index a8b8bf9215b99570d2eb3f197c5b1279e173e6d2..ba1b9cdbe11c1c0bf21d76d26bc529d0eee52b5d 100644 (file)
--- a/basis/io/directories/search/search-tests.factor
+++ b/basis/io/directories/search/search-tests.factor
@@ -5,6 +5,6 @@ IN: io.directories.search.tests
 [ t ] [
     [
         10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
-        current-temporary-directory get t [ ] find-all-files
+        current-temporary-directory get [ ] find-all-files
     ] with-unique-directory drop [ natural-sort ] bi@ =
 ] unit-test

diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor
index b56fb7b6a3ff2c37fec947c0cad17f4b07cac993..ee8fd129a7313239ce0982d62a89777037b5d6d4 100755 (executable)
--- a/basis/io/directories/search/search.factor
+++ b/basis/io/directories/search/search.factor
@@ -51,7 +51,8 @@ PRIVATE>
         [ keep and ] curry iterate-directory
     ] [ drop f ] recover ; inline
 
-: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f )
+: find-all-files ( path quot: ( obj -- ? ) -- paths/f )
+    f swap
     '[
         _ _ _ [ <directory-iterator> ] dip
         pusher [ [ f ] compose iterate-directory drop ] dip

diff --git a/basis/io/directories/search/windows/windows.factor b/basis/io/directories/search/windows/windows.factor
index 755710befd03d4b5ce3379e4fe8a1c49fe2c6d0c..cda94034179cac43e15e5ebb36aecf02c0456a0e 100644 (file)
--- a/basis/io/directories/search/windows/windows.factor
+++ b/basis/io/directories/search/windows/windows.factor
@@ -7,7 +7,7 @@ IN: io.directories.search.windows
 : program-files-directories ( -- array )
     program-files program-files-x86 2array harvest ; inline
 
-: find-in-program-files ( base-directory bfs? quot -- path )
-    [
+: find-in-program-files ( base-directory quot -- path )
+    t swap [
         [ program-files-directories ] dip '[ _ append-path ] map
     ] 2dip find-in-directories ; inline

diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index 166167a7e7f070c591a4a3ef13c7170121652740..a4d55f3c1e040380c4b6ac1161ae3b3676585f24 100644 (file)
--- a/basis/io/mmap/mmap-tests.factor
+++ b/basis/io/mmap/mmap-tests.factor
@@ -1,6 +1,6 @@
 USING: io io.mmap io.mmap.char io.files io.files.temp
 io.directories kernel tools.test continuations sequences
-io.encodings.ascii accessors ;
+io.encodings.ascii accessors math ;
 IN: io.mmap.tests
 
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
@@ -9,3 +9,13 @@ IN: io.mmap.tests
 [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
+
+
+[ "mmap-empty-file.txt" temp-file delete-file ] ignore-errors
+[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test
+
+[
+    "mmap-empty-file.txt" temp-file [
+        drop
+    ] with-mapped-file
+] [ bad-mmap-size? ] must-fail-with

diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor
index 6f2fabb7098e9ba53ffd8fe1b0fba1c65103e8cd..1a584715144b470606f5e1a48a63c39f7fd767be 100644 (file)
--- a/basis/io/mmap/mmap.factor
+++ b/basis/io/mmap/mmap.factor
@@ -2,15 +2,20 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations destructors io.files io.files.info
 io.backend kernel quotations system alien alien.accessors
-accessors system vocabs.loader combinators alien.c-types ;
+accessors system vocabs.loader combinators alien.c-types
+math ;
 IN: io.mmap
 
 TUPLE: mapped-file address handle length disposed ;
 
 HOOK: (mapped-file) os ( path length -- address handle )
 
+ERROR: bad-mmap-size path size ;
+
 : <mapped-file> ( path -- mmap )
-    [ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep
+    [ normalize-path ] [ file-info size>> ] bi
+    dup 0 <= [ bad-mmap-size ] when
+    [ (mapped-file) ] keep
     f mapped-file boa ;
 
 HOOK: close-mapped-file io-backend ( mmap -- )

diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor
index 9325dcd632048d23ed79d63d4c430d747145f1f8..0fa8e1151f2c9e850578160ab34df811c3174008 100644 (file)
--- a/basis/io/mmap/unix/unix.factor
+++ b/basis/io/mmap/unix/unix.factor
@@ -9,7 +9,7 @@ IN: io.mmap.unix
 :: mmap-open ( path length prot flags -- alien fd )
     [
         f length prot flags
-        path open-r/w |dispose
+        path open-r/w [ <fd> |dispose drop ] keep
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 

diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor
index 6a9a7cb8af05106069a78476f4c053cdd289a31c..7f35ece71473fe7fee5ce7c5ee0f819089587da0 100644 (file)
--- a/basis/stack-checker/errors/errors.factor
+++ b/basis/stack-checker/errors/errors.factor
@@ -80,4 +80,4 @@ TUPLE: inconsistent-recursive-call-error word ;
 TUPLE: unknown-primitive-error ;
 
 : unknown-primitive-error ( -- * )
-    \ unknown-primitive-error inference-error ;
+    \ unknown-primitive-error inference-warning ;

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 0c20c41d99b74754c21a28295808089fd9fe4a70..1b4d9012dbeae56fe64d61c78a402f5103ea7cec 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -141,9 +141,7 @@ M: object infer-call*
     apply-word/effect ;
 
 : infer-exit ( -- )
-    \ exit
-    { integer } { } t >>terminated? <effect>
-    apply-word/effect ;
+    \ exit (( n -- * )) apply-word/effect ;
 
 : infer-load-locals ( -- )
     pop-literal nip
@@ -189,7 +187,7 @@ M: object infer-call*
         { \ load-locals [ infer-load-locals ] }
         { \ get-local [ infer-get-local ] }
         { \ drop-locals [ infer-drop-locals ] }
-        { \ do-primitive [ unknown-primitive-error inference-warning ] }
+        { \ do-primitive [ unknown-primitive-error ] }
         { \ alien-invoke [ infer-alien-invoke ] }
         { \ alien-indirect [ infer-alien-indirect ] }
         { \ alien-callback [ infer-alien-callback ] }
@@ -207,7 +205,7 @@ M: object infer-call*
 {
     declare call (call) slip 2slip 3slip dip 2dip 3dip
     curry compose execute (execute) if dispatch <tuple-boa>
-    (throw) load-local load-locals get-local drop-locals do-primitive
+    (throw) exit load-local load-locals get-local drop-locals do-primitive
     alien-invoke alien-indirect alien-callback
 } [ t "special" set-word-prop ] each
 

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index bc6eb9f09276c1327b010eee299023d8bc331694..fadfadd885e0b2a3c152563e1353edf7ad4faedc 100644 (file)
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -6,7 +6,8 @@ quotations effects tools.test continuations generic.standard
 sorting assocs definitions prettyprint io inspector
 classes.tuple classes.union classes.predicate debugger
 threads.private io.streams.string io.timeouts io.thread
-sequences.private destructors combinators eval locals.backend ;
+sequences.private destructors combinators eval locals.backend
+system ;
 IN: stack-checker.tests
 
 \ infer. must-infer
@@ -581,4 +582,6 @@ DEFER: eee'
 : debugging-curry-folding ( quot -- )
     [ debugging-curry-folding ] curry call ; inline recursive
 
-[ [ ] debugging-curry-folding ] must-infer
\ No newline at end of file
+[ [ ] debugging-curry-folding ] must-infer
+
+[ [ exit ] [ 1 2 3 ] if ] must-infer
\ No newline at end of file

diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor
index 94ff2c1f293121d2886a3de169189b3b9a806af4..101557d0cf80b353186a370e6f42c834a8c5344f 100644 (file)
--- a/core/math/math-docs.factor
+++ b/core/math/math-docs.factor
@@ -308,7 +308,7 @@ HELP: find-last-integer
 
 HELP: byte-array>bignum
 { $values { "byte-array" byte-array } { "n" integer } }
-{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link >le } " or " { $link >be } " instead." } ;
+{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ;
 
 ARTICLE: "division-by-zero" "Division by zero"
 "Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value."

diff --git a/extra/id3/authors.txt b/extra/id3/authors.txt
index ece617b96935408bf7b84a63e9711c77b0e6665a..2bd5c6037ee74b93112015fbd561e216376148f7 100644 (file)
--- a/extra/id3/authors.txt
+++ b/extra/id3/authors.txt
@@ -1,2 +1,2 @@
 Tim Wawrzynczak
-
+Doug Coleman

diff --git a/extra/id3/id3-docs.factor b/extra/id3/id3-docs.factor
index a54bba1629ac0d269b74c96ebefcf828a8803a0f..d171d037984b08f74d49947d6d38252a9238239e 100644 (file)
--- a/extra/id3/id3-docs.factor
+++ b/extra/id3/id3-docs.factor
@@ -6,7 +6,7 @@ IN: id3
 HELP: file-id3-tags
 { $values 
     { "path" "a path string" } 
-    { "object/f" "a tuple storing ID3 metadata or f" } }
+    { "id3v2-info/f" "a tuple storing ID3v2 metadata or f" } }
     { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present.  Currently, the parser supports the following tags: "
       $nl { $link title>> }
       $nl { $link artist>> }

diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor
index bcdc312440e94e496a08ad310f5d9d3c8a46c330..eabbf00ad754b54d828531da5ca868be489ce402 100644 (file)
--- a/extra/id3/id3-tests.factor
+++ b/extra/id3/id3-tests.factor
@@ -1,35 +1,42 @@
 ! Copyright (C) 2009 Tim Wawrzynczak
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test id3 id3.private ;
+USING: tools.test id3 combinators ;
 IN: id3.tests
 
+: id3-params ( id3 -- title artist album year comment genre )
+    {
+        [ id3-title ]
+        [ id3-artist ]
+        [ id3-album ]
+        [ id3-year ]
+        [ id3-comment ]
+        [ id3-genre ]
+    } cleave ;
+
 [
-    T{ id3-info
-       { title "BLAH" }
-       { artist "ARTIST" }
-       { album "ALBUM" }
-       { year "2009" }
-       { comment "COMMENT" }
-       { genre "Bluegrass" }
-    }
-] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test
+   "BLAH"
+   "ARTIST"
+   "ALBUM"
+   "2009"
+   "COMMENT"
+   "Bluegrass"
+] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
 
 [
-    T{ id3-info
-       { title "Anthem of the Trinity" }
-       { artist "Terry Riley" }
-       { album "Shri Camel" }
-       { genre "Classical" }
-    }
-] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test
+    "Anthem of the Trinity"
+    "Terry Riley"
+    "Shri Camel"
+    f
+    f
+    "Classical"
+] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
 
 [    
-    T{ id3-info
-       { title "Stormy Weather" }
-       { artist "Frank Sinatra" }
-       { album "Night and Day Frank Sinatra" }
-       { comment "eng, AG# 08E1C12E" }
-       { genre "Big Band" }
-    }
-] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test
+   "Stormy Weather"
+   "Frank Sinatra"
+   "Night and Day Frank Sinatra"
+    f
+   "eng, AG# 08E1C12E"
+   "Big Band"
+] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
 

diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index f2bbd08996d46bb6a58c03e01b759fd1d252002e..a4adeedaa5a58046ce5a4dd64a9141e272e5e0b5 100644 (file)
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -1,142 +1,144 @@
-! Copyright (C) 2009 Tim Wawrzynczak
+! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays io.encodings.string io.encodings.utf8 assocs math.parser ;
+USING: sequences io io.encodings.binary io.files io.pathnames
+strings kernel math io.mmap io.mmap.uchar accessors syntax
+combinators math.ranges unicode.categories byte-arrays
+io.encodings.string io.encodings.utf16 assocs math.parser
+combinators.short-circuit fry namespaces multiline
+combinators.smart splitting io.encodings.ascii ;
 IN: id3
 
 <PRIVATE
 
-! genres
 CONSTANT: genres
-  H{
-    { 0 "Blues" }
-    { 1 "Classic Rock" }
-    { 2 "Country" }
-    { 3 "Dance" }
-    { 4 "Disco" }
-    { 5 "Funk" }
-    { 6 "Grunge" }
-    { 7 "Hip-Hop" }
-    { 8 "Jazz" }
-    { 9 "Metal" }
-    { 10 "New Age" }
-    { 11 "Oldies" }
-    { 12 "Other" }
-    { 13 "Pop" }
-    { 14 "R&B" }
-    { 15 "Rap" }
-    { 16 "Reggae" }
-    { 17 "Rock" }
-    { 18 "Techno" }
-    { 19 "Industrial" }
-    { 20 "Alternative" }
-    { 21 "Ska" }
-    { 22 "Death Metal" }
-    { 23 "Pranks" }
-    { 24 "Soundtrack" }
-    { 25 "Euro-Techno" }
-    { 26 "Ambient" }
-    { 27 "Trip-Hop" }
-    { 28 "Vocal" }
-    { 29 "Jazz+Funk" }
-    { 30 "Fusion" }
-    { 31 "Trance" }
-    { 32 "Classical" }
-    { 33 "Instrumental" }
-    { 34 "Acid" }
-    { 35 "House" }
-    { 36 "Game" }
-    { 37 "Sound Clip" }
-    { 38 "Gospel" }
-    { 39 "Noise" }
-    { 40 "AlternRock" }
-    { 41 "Bass" }
-    { 42 "Soul" }
-    { 43 "Punk" }
-    { 44 "Space" }
-    { 45 "Meditative" }
-    { 46 "Instrumental Pop" }
-    { 47 "Instrumental Rock" }
-    { 48 "Ethnic" }
-    { 49 "Gothic" }
-    { 50 "Darkwave" }
-    { 51 "Techno-Industrial" }
-    { 52 "Electronic" }
-    { 53 "Pop-Folk" }
-    { 54 "Eurodance" }
-    { 55 "Dream" }
-    { 56 "Southern Rock" }
-    { 57 "Comedy" }
-    { 58 "Cult" }
-    { 59 "Gangsta" }
-    { 60 "Top 40" }
-    { 61 "Christian Rap" }
-    { 62 "Pop/Funk" }
-    { 63 "Jungle" }
-    { 64 "Native American" }
-    { 65 "Cabaret" }
-    { 66 "New Wave" }
-    { 67 "Psychedelic" }
-    { 68 "Rave" }
-    { 69 "Showtunes" }
-    { 70 "Trailer" }
-    { 71 "Lo-Fi" }
-    { 72 "Tribal" }
-    { 73 "Acid Punk" }
-    { 74 "Acid Jazz" }
-    { 75 "Polka" }
-    { 76 "Retro" }
-    { 77 "Musical" }
-    { 78 "Rock & Roll" }
-    { 79 "Hard Rock" }
-    { 80 "Folk" }
-    { 81 "Folk-Rock" }
-    { 82 "National Folk" }
-    { 83 "Swing" }
-    { 84 "Fast Fusion" }
-    { 85 "Bebop" }
-    { 86 "Latin" }
-    { 87 "Revival" }
-    { 88 "Celtic" }
-    { 89 "Bluegrass" }
-    { 90 "Avantgarde" }
-    { 91 "Gothic Rock" }
-    { 92 "Progressive Rock" }
-    { 93 "Psychedelic Rock" }
-    { 94 "Symphonic Rock" }
-    { 95 "Slow Rock" }
-    { 96 "Big Band" }
-    { 97 "Chorus" }
-    { 98 "Easy Listening" }
-    { 99 "Acoustic" }
-    { 100 "Humour" }
-    { 101 "Speech" }
-    { 102 "Chanson" }
-    { 103 "Opera" }
-    { 104 "Chamber Music" }
-    { 105 "Sonata" }
-    { 106 "Symphony" }
-    { 107 "Booty Bass" }
-    { 108 "Primus" }
-    { 109 "Porn Groove" }
-    { 110 "Satire" }
-    { 111 "Slow Jam" }
-    { 112 "Club" }
-    { 113 "Tango" }
-    { 114 "Samba" }
-    { 115 "Folklore" }
-    { 116 "Ballad" }
-    { 117 "Power Ballad" }
-    { 118 "Rhythmic Soul" }
-    { 119 "Freestyle" }
-    { 120 "Duet" }
-    { 121 "Punk Rock" }
-    { 122 "Drum Solo" }
-    { 123 "A capella" }
-    { 124 "Euro-House" }
-    { 125 "Dance Hall" }
-} ! end genre hashtable
-
-! tuples
+    {
+        "Blues" 
+        "Classic Rock" 
+        "Country" 
+        "Dance" 
+        "Disco" 
+        "Funk" 
+        "Grunge" 
+        "Hip-Hop" 
+        "Jazz" 
+        "Metal" 
+        "New Age" 
+        "Oldies" 
+        "Other" 
+        "Pop" 
+        "R&B" 
+        "Rap" 
+        "Reggae" 
+        "Rock" 
+        "Techno" 
+        "Industrial" 
+        "Alternative" 
+        "Ska" 
+        "Death Metal" 
+        "Pranks" 
+        "Soundtrack" 
+        "Euro-Techno" 
+        "Ambient" 
+        "Trip-Hop" 
+        "Vocal" 
+        "Jazz+Funk" 
+        "Fusion" 
+        "Trance" 
+        "Classical" 
+        "Instrumental" 
+        "Acid" 
+        "House" 
+        "Game" 
+        "Sound Clip" 
+        "Gospel" 
+        "Noise" 
+        "AlternRock" 
+        "Bass" 
+        "Soul" 
+        "Punk" 
+        "Space" 
+        "Meditative" 
+        "Instrumental Pop" 
+        "Instrumental Rock" 
+        "Ethnic" 
+        "Gothic" 
+        "Darkwave" 
+        "Techno-Industrial" 
+        "Electronic" 
+        "Pop-Folk" 
+        "Eurodance" 
+        "Dream" 
+        "Southern Rock" 
+        "Comedy" 
+        "Cult" 
+        "Gangsta" 
+        "Top 40" 
+        "Christian Rap" 
+        "Pop/Funk" 
+        "Jungle" 
+        "Native American" 
+        "Cabaret" 
+        "New Wave" 
+        "Psychedelic" 
+        "Rave" 
+        "Showtunes" 
+        "Trailer" 
+        "Lo-Fi" 
+        "Tribal" 
+        "Acid Punk" 
+        "Acid Jazz" 
+        "Polka" 
+        "Retro" 
+        "Musical" 
+        "Rock & Roll" 
+        "Hard Rock" 
+        "Folk" 
+        "Folk-Rock" 
+        "National Folk" 
+        "Swing" 
+        "Fast Fusion" 
+        "Bebop" 
+        "Latin" 
+        "Revival" 
+        "Celtic" 
+        "Bluegrass" 
+        "Avantgarde" 
+        "Gothic Rock" 
+        "Progressive Rock" 
+        "Psychedelic Rock" 
+        "Symphonic Rock" 
+        "Slow Rock" 
+        "Big Band" 
+        "Chorus" 
+        "Easy Listening" 
+        "Acoustic" 
+        "Humour" 
+        "Speech" 
+        "Chanson" 
+        "Opera" 
+        "Chamber Music" 
+        "Sonata" 
+        "Symphony" 
+        "Booty Bass" 
+        "Primus" 
+        "Porn Groove" 
+        "Satire" 
+        "Slow Jam" 
+        "Club" 
+        "Tango" 
+        "Samba" 
+        "Folklore" 
+        "Ballad" 
+        "Power Ballad" 
+        "Rhythmic Soul" 
+        "Freestyle" 
+        "Duet" 
+        "Punk Rock" 
+        "Drum Solo" 
+        "A capella" 
+        "Euro-House"
+        "Dance Hall"
+    }
 
 TUPLE: header version flags size ;
 
@@ -148,59 +150,81 @@ TUPLE: id3-info title artist album year comment genre ;
 
 : <id3-info> ( -- object ) id3-info new ;
 
-: <id3v2-info> ( header frames -- object ) id3v2-info boa ;
+: <id3v2-info> ( header frames -- object )
+    [ [ frame-id>> ] keep ] H{ } map>assoc
+    id3v2-info boa ;
 
 : <header> ( -- object ) header new ;
 
 : <frame> ( -- object ) frame new ;
 
-! utility words
-
-: id3v2? ( mmap -- ? )
-    "ID3" head? ;
+: id3v2? ( mmap -- ? ) "ID3" head? ; inline
 
 : id3v1? ( mmap -- ? )
-    128 tail-slice* "TAG" head? ;
+    { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
+
+: id3v1-frame ( string key -- frame )
+    <frame>
+        swap >>frame-id
+        swap >>data ;
+
+: id3v1>id3v2 ( id3v1 -- id3v2 )
+    [
+        {
+            [ title>> "TIT2" id3v1-frame ]
+            [ artist>> "TPE1" id3v1-frame ]
+            [ album>> "TALB" id3v1-frame ]
+            [ year>> "TYER" id3v1-frame ]
+            [ comment>> "COMM" id3v1-frame ]
+            [ genre>> "TCON" id3v1-frame ]
+        } cleave
+    ] output>array f swap <id3v2-info> ;
 
 : >28bitword ( seq -- int )
-    0 [ swap 7 shift bitor ] reduce ;
+    0 [ [ 7 shift ] dip bitor ] reduce ; inline
 
 : filter-text-data ( data -- filtered )
-    [ printable? ] filter ;
+    [ printable? ] filter ; inline
 
 ! frame details stuff
 
 : valid-frame-id? ( id -- ? )
-    [ [ digit? ] [ LETTER? ] bi or ] all? ;
+    [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
 
 : read-frame-id ( mmap -- id )
-    4 head-slice ;
+    4 head-slice ; inline
 
 : read-frame-size ( mmap -- size )
-    [ 4 8 ] dip subseq ;
+    [ 4 8 ] dip subseq ; inline
 
 : read-frame-flags ( mmap -- flags )
-    [ 8 10 ] dip subseq ;
+    [ 8 10 ] dip subseq ; inline
 
 : read-frame-data ( frame mmap -- frame data )
-    [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
+    [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
 
 ! read whole frames
 
+: decode-text ( string -- string' )
+    dup 2 short head
+    { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
+    utf16 ascii ? decode ; inline
+
 : (read-frame) ( mmap -- frame )
     [ <frame> ] dip
     {
-        [ read-frame-id    utf8 decode  >>frame-id ]
-        [ read-frame-flags >byte-array  >>flags ]
-        [ read-frame-size  >28bitword   >>size ]
-        [ read-frame-data  utf8 decode  >>data ]
+        [ read-frame-id decode-text >>frame-id ]
+        [ read-frame-flags >byte-array >>flags ]
+        [ read-frame-size >28bitword >>size ]
+        [ read-frame-data decode-text >>data ]
     } cleave ;
 
 : read-frame ( mmap -- frame/f )
-    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;
+    dup read-frame-id valid-frame-id?
+    [ (read-frame) ] [ drop f ] if ;
 
 : remove-frame ( mmap frame -- mmap )
-    size>> 10 + tail-slice ;
+    size>> 10 + tail-slice ; inline
 
 : read-frames ( mmap -- frames )
     [ dup read-frame dup ]
@@ -210,88 +234,92 @@ TUPLE: id3-info title artist album year comment genre ;
 ! header stuff
 
 : read-header-supported-version? ( mmap -- ? )
-    3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ;
+    3 tail-slice first { 3 4 } member? ; inline
 
-: read-header-flags ( mmap -- flags )
-    5 swap nth ;
+: read-header-flags ( mmap -- flags ) 5 swap nth ; inline
 
 : read-header-size ( mmap -- size )
-    [ 6 10 ] dip <slice> >28bitword ;
+    [ 6 10 ] dip <slice> >28bitword ; inline
 
 : read-v2-header ( mmap -- id3header )
     [ <header> ] dip
     {
-        [ read-header-supported-version?  >>version ]
+        [ read-header-supported-version? >>version ]
         [ read-header-flags >>flags ]
         [ read-header-size >>size ]
-    } cleave ;
+    } cleave ; inline
 
 : drop-header ( mmap -- seq1 seq2 )
-    dup 10 tail-slice swap ;
-
-: parse-frames ( id3v2-info -- id3-info )
-    [ <id3-info> ] dip frames>>
-    {
-        [ [ frame-id>> "TIT2" = ] find nip [ data>> >>title ] when* ]
-        [ [ frame-id>> "TALB" = ] find nip [ data>> >>album ] when* ]
-        [ [ frame-id>> "TPE1" = ] find nip [ data>> >>artist ] when* ]
-        [ [ frame-id>> "TCON" = ] find nip [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when*
-          >>genre ] when* ]
-        [ [ frame-id>> "COMM" = ] find nip [ data>> >>comment ] when* ]
-        [ [ frame-id>> "TYER" = ] find nip [ data>> >>year ] when* ]
-    } cleave ;
+    [ 10 tail-slice ] [ ] bi ; inline
 
-: read-v2-tag-data ( seq -- id3-info )
-    drop-header read-v2-header swap read-frames <id3v2-info> parse-frames ;
+: read-v2-tag-data ( seq -- id3v2-info )
+    drop-header read-v2-header
+    swap read-frames <id3v2-info> ; inline
     
 ! v1 information
 
-: skip-to-v1-data ( seq -- seq )
-    125 tail-slice* ;
+: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
 
-: read-title ( seq -- title )
-    30 head-slice ;
+: read-title ( seq -- title ) 30 head-slice ; inline
 
-: read-artist ( seq -- title )
-    [ 30 60 ] dip subseq ;
+: read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
 
-: read-album ( seq -- album )
-    [ 60 90 ] dip subseq ;
+: read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
 
-: read-year ( seq -- year )
-    [ 90 94 ] dip subseq ;
+: read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
 
-: read-comment ( seq -- comment )
-    [ 94 124 ] dip subseq ;
+: read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
 
-: read-genre ( seq -- genre )
-    [ 124 ] dip nth ;
+: read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
 
 : (read-v1-tag-data) ( seq -- mp3-file )
     [ <id3-info> ] dip
     {
-        [ read-title   utf8 decode  filter-text-data >>title   ]
-        [ read-artist  utf8 decode  filter-text-data >>artist  ]
-        [ read-album   utf8 decode  filter-text-data >>album   ]
-        [ read-year    utf8 decode  filter-text-data >>year    ]
-        [ read-comment utf8 decode  filter-text-data >>comment ]
-        [ read-genre   >fixnum       genres at       >>genre ]
-    } cleave ;
+        [ read-title   decode-text filter-text-data >>title   ]
+        [ read-artist  decode-text filter-text-data >>artist  ]
+        [ read-album   decode-text filter-text-data >>album   ]
+        [ read-year    decode-text filter-text-data >>year    ]
+        [ read-comment decode-text filter-text-data >>comment ]
+        [ read-genre   number>string                >>genre   ]
+    } cleave ; inline
 
 : read-v1-tag-data ( seq -- mp3-file )
-    skip-to-v1-data (read-v1-tag-data) ;
+    skip-to-v1-data (read-v1-tag-data) ; inline
+
+: parse-genre ( string -- n/f )
+    dup "(" ?head-slice drop ")" ?tail-slice drop
+    string>number dup number? [
+        genres ?nth swap or
+    ] [
+        drop
+    ] if ; inline
 
 PRIVATE>
 
-! public interface
+: frame-named ( id3 name quot -- obj )
+    [ swap frames>> at* ] dip
+    [ data>> ] prepose [ drop f ] if ; inline
+
+: id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
+
+: id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
+
+: id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
 
-: file-id3-tags ( path -- object/f )
+: id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
+
+: id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
+
+: id3-genre ( id3 -- genre/f )
+    "TCON" [ parse-genre ] frame-named ; inline
+
+: id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
+
+: file-id3-tags ( path -- id3v2-info/f )
     [
         {
-            { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- id3v2 )
-            { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info )
-            [ drop f ] ! ( mmap -- f )
+            { [ dup id3v2? ] [ read-v2-tag-data ] }
+            { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
+            [ drop f ]
         } cond
     ] with-mapped-uchar-file ;
-
-! end