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

basis/tools/scaffold/scaffold.factor

@@ -6,7 +6,7 @@ vocabs.loader io combinators calendar accessors math.parser
 io.streams.string ui.tools.operations quotations strings arrays
 prettyprint words vocabs sorting sets classes math alien urls
 splitting ascii combinators.short-circuit alarms words.symbol
-system ;
+system summary ;
 IN: tools.scaffold
 
 SYMBOL: developer-name
@@ -16,6 +16,10 @@ ERROR: not-a-vocab-root string ;
 ERROR: vocab-name-contains-separator path ;
 ERROR: vocab-name-contains-dot path ;
 ERROR: no-vocab vocab ;
+ERROR: bad-developer-name name ;
+
+M: bad-developer-name summary
+    drop "Developer name must be a string." ;
 
 <PRIVATE
 
@@ -101,11 +105,16 @@ ERROR: no-vocab vocab ;
     ] if ;
 
 : scaffold-authors ( vocab-root vocab -- )
+    developer-name get [
+        dup string? [ bad-developer-name ] unless
         "authors.txt" vocab-root/vocab/file>path scaffolding? [
-        [ developer-name get ] dip utf8 set-file-contents
+            utf8 set-file-contents
         ] [
-        drop
+            2drop
-    ] if ;
+        ] if
+    ] [
+        2drop
+    ] if* ;
 
 : lookup-type ( string -- object/string ? )
     "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
@@ -298,9 +307,12 @@ SYMBOL: examples-flag
         "}" print
     ] with-variable ;
 
+: touch. ( path -- )
+    [ touch-file ]
+    [ "Click to edit: " write <pathname> . ] bi ;
+
 : scaffold-rc ( path -- )
-    [ home ] dip append-path
+    [ home ] dip append-path touch. ;
-    [ touch-file ] [ "Click to edit: " write <pathname> . ] bi ;
 
 : scaffold-factor-boot-rc ( -- )
     os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ;
@@ -308,4 +320,7 @@ SYMBOL: examples-flag
 : scaffold-factor-rc ( -- )
     os windows? "factor-rc" ".factor-rc" ? scaffold-rc ;
 
-: scaffold-emacs ( -- ) ".emacs" scaffold-rc ;
+
+HOOK: scaffold-emacs os ( -- )
+
+M: unix scaffold-emacs ( -- ) ".emacs" scaffold-rc ;

basis/tools/scaffold/windows/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/tools/scaffold/windows/windows.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.pathnames system tools.scaffold windows.shell32 ;
+IN: tools.scaffold.windows
+
+M: windows scaffold-emacs ( -- )
+    application-data ".emacs" append-path touch. ;

extra/audio/wav/wav.factor

@@ -1,6 +1,7 @@
 USING: alien.c-types alien.syntax audio combinators
 combinators.short-circuit io io.binary io.encodings.binary
-io.files io.streams.memory kernel locals sequences ;
+io.files io.streams.byte-array kernel locals math
+sequences ;
 IN: audio.wav
 
 CONSTANT: RIFF-MAGIC "RIFF"
@@ -16,7 +17,6 @@ C-STRUCT: riff-chunk-header
 C-STRUCT: riff-chunk
     { "riff-chunk-header" "header" }
     { "char[4]" "format" }
-    { "uchar[0]" "body" }
     ;
 
 C-STRUCT: wav-fmt-chunk
@@ -34,25 +34,38 @@ C-STRUCT: wav-data-chunk
     { "uchar[0]" "body" }
     ;
 
+ERROR: invalid-wav-file ;
+
+: ensured-read ( count -- output/f )
+    [ read ] keep over length = [ drop f ] unless ;
+: ensured-read* ( count -- output )
+    ensured-read [ invalid-wav-file ] unless* ;
+
 : read-chunk ( -- byte-array/f )
-    4 read [ 4 read le> [ <uint> ] [ read ] bi 3append ] [ f ] if* ;
+    4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ;
+: read-riff-chunk ( -- byte-array/f )
+    "riff-chunk" heap-size ensured-read* ;
 
 : id= ( chunk id -- ? )
-    [ 4 memory>byte-array ] dip sequence= ;
+    [ 4 head ] dip sequence= ;
+
+: check-chunk ( chunk id min-size -- ? )
+    [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
 
 :: read-wav-chunks ( -- fmt data )
     f :> fmt! f :> data!
     [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
     [ {
-        { [ dup FMT-MAGIC  id= ] [ fmt!  ] }
+        { [ dup FMT-MAGIC  "wav-fmt-chunk"  heap-size check-chunk ] [ fmt!  ] }
-        { [ dup DATA-MAGIC id= ] [ data! ] }
+        { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] }
     } cond ] while drop
-    fmt data ;
+    fmt data 2dup and [ invalid-wav-file ] unless ;
-
-ERROR: invalid-wav-file ;
 
 : verify-wav ( chunk -- )
-    { [ RIFF-MAGIC id= ] [ riff-chunk-format WAVE-MAGIC id= ] } 1&&
+    {
+        [ RIFF-MAGIC id= ]
+        [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ]
+    } 1&&
     [ invalid-wav-file ] unless ;
 
 : (read-wav) ( -- audio )
@@ -68,7 +81,5 @@ ERROR: invalid-wav-file ;
 
 : read-wav ( filename -- audio )
     binary [
-        read-chunk
+        read-riff-chunk verify-wav (read-wav)
-        [ verify-wav ]
-        [ riff-chunk-body <memory-stream> [ (read-wav) ] with-input-stream* ] bi
     ] with-file-reader ;