new 'file' collection to house file-format libraries

svn: r8156

collects/file/doc/common.ss

@@ -0,0 +1,9 @@
+#lang scheme/base
+
+(require scribble/manual
+         (for-label scheme/base
+                    scheme/contract))
+
+(provide (all-from-out scribble/manual)
+         (for-label (all-from-out scheme/base
+                                  scheme/contract)))

collects/file/doc/file.scrbl

@@ -0,0 +1,15 @@
+#lang scribble/doc
+@(require "common.ss")
+
+@title{@bold{File}: PLT File Format Libraries}
+
+@table-of-contents[]
+
+@include-section["gzip.scrbl"]
+@include-section["gunzip.scrbl"]
+@include-section["zip.scrbl"]
+@include-section["tar.scrbl"]
+@include-section["md5.scrbl"]
+@include-section["gif.scrbl"]
+
+@index-section[]

collects/file/doc/gif.scrbl

@@ -0,0 +1,234 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/gif
+                     (only-in scheme/gui bitmap%)))
+
+@title{GIF File Writing}
+
+@defmodule[file/gif]{The @schememodname[file/gif] library provides
+functions for writing GIF files to a stream, including GIF files with
+multiple images and controls (such as animated GIFs).}
+
+This library does not rely on @schememodname[scheme/gui]. See
+@scheme[bitmap%] (which is part of @schememodname[scheme/gui]) to read
+a GIF file. Also @xmethod[bitmap% save-file] can write a GIF file
+without animations or other controls, but with typically better
+quantization.
+
+@defproc[(gif-start [out output-port?]
+                    [width (integer-in 0 #xFFFFFFFF)]
+                    [height (integer-in 0 #xFFFFFFFF)]
+                    [bg-color byte?]
+                    [colormap (or/c false/c gif-colormap?)])
+         gif-stream?]{
+
+Writes the start of a GIF file to the given output port, and returns a
+GIF stream that adds to the output port.
+
+The width and height determine a virtual space for the overall GIF
+image. Individual images added to the GIF stream must fit within this
+virtual space. The space is initialized by the given background color.
+
+The default meaning of color numbers (such as the background color) is
+determined by the given colormap, but individual images within the GIF
+file can have their own colormaps.
+
+A global colormap need not be supplied, in which case a colormap must
+be supplied for each image. Beware that the @scheme[bg-color]'s
+meaning is ill-defined if a global colormap is not provided.}
+
+@defproc[(gif-stream? [v any/c]) boolean?]{
+
+Returns @scheme[#t] if @scheme[v] is a GIF stream created by
+@scheme[gif-start].
+
+A stream can be in any of several states, some of which are recognized
+by more specific predicates:
+
+@itemize{
+ 
+ @item{@scheme[empty-gif-stream?] : no images or controls have been added to the stream}
+
+ @item{@scheme[image-or-control-ready-gif-stream?] : another image or control can be written now}
+
+ @item{@scheme[image-ready-gif-stream?] : another image can be written
+               now (since a control was written).}
+
+ @item{done : nothing more can be added}
+
+}}
+
+@defproc[(empty-gif-stream? [v any/c]) boolean?]{
+
+See @scheme[gif-stream?].}
+
+
+@defproc[(image-or-control-ready-gif-stream? [v any/c]) boolean?]{
+
+See @scheme[gif-stream?].}
+
+
+@defproc[(image-ready-gif-stream? [v any/c]) boolean?]{
+
+See @scheme[gif-stream?].}
+
+
+@defproc[(gif-colormap? [v any/c]) boolean?]{
+
+Returns @scheme[#t] if @scheme[v] is a list of vectors where each
+vector must contain three bytes---one for red, one for blue, and one
+for green---and the list length must be 2, 4, 8, 16, 32, 64, 128, or
+256. The colors are indexed (starting from 0) by their order in the
+list.}
+
+@defproc[(gif-end [gs image-or-control-ready-gif-stream?]) void?]{
+
+Finishes writing a GIF file. The GIF stream's output port is not
+automatically closed.}
+
+
+@defproc[(gif-add-image [gs image-or-control-ready-gif-stream?]
+                        [left (integer-in 0 #xFFFFFFFF)]
+                        [top (integer-in 0 #xFFFFFFFF)]
+                        [width (integer-in 0 #xFFFFFFFF)]
+                        [height (integer-in 0 #xFFFFFFFF)]
+                        [interlaced? any/c]
+                        [colormap (or/c gif-colormap? false/c)]
+                        [bstr bytes?])
+         void?]{
+
+Writes an image to the given GIF stream @scheme[gs]. The
+@scheme[left], @scheme[top], @scheme[width], and @scheme[height]
+values specify the location and size of the image within the overall
+GIF image's virtual space.
+
+If @scheme[interlaced?] is true, then @scheme[bytes] should provide
+bytes in interlaced order instead of top-to-bottom order. Interlaced
+order is:
+
+@itemize{
+
+ @item{every 8th row, starting with 0}
+ @item{every 8th row, starting with 4}
+ @item{every 4th row, starting with 2}
+ @item{every 2nd row, starting with 1}
+
+}
+
+If a global color is provided with @scheme[gif-start], a @scheme[#f]
+value can be provided for @scheme[colormap].
+
+The @scheme[bstr] argument specifies the pixel content of the
+image. Each byte specifies a color (i.e., an index in the
+colormap). Each row is provided left-to-right, and the rows provided
+either top-to-bottom or in interlaced order (see above). If the image
+is prefixed with a control that specifies an transparent index (see
+@scheme[gif-add-control]), then the corresponding ``color'' doesn't
+draw into the overall GIF image.
+
+An exception is raised if any byte value in @scheme[bstr] is larger
+than the colormap's length, if the @scheme[bstr] length is not
+@scheme[width] times @scheme[height], or if the @scheme[top],
+@scheme[left], @scheme[width], and @scheme[height] dimensions specify
+a region beyond the overall GIF image's virtual space.}
+
+
+@defproc[(gif-add-control [gs image-or-control-ready-gif-stream?]
+                          [disposal (one-of/c 'any 'keep 'restore-bg 'restore-prev)]
+                          [wait-for-input? any/c]
+                          [delay-csec (integer-in 0 #xFFFFFFFF)]
+                          [transparent (or/c byte? false/c)])
+         void?]{
+
+Writes an image-control command to a GIF stream. Such a control must
+appear just before an image, and it applies to the following image.
+
+The GIF image model involves processing images one by one, placing
+each image into the specified position within the overall image's
+virtual space. An image-control command can specify a delay before an
+image is added (to create animated GIFs), and it also specifies how
+the image should be kept or removed from the overall image before
+proceeding to the next one (also for GIF animation).
+
+The @scheme[disposal] argument specifies how to proceed:
+
+@itemize{
+
+ @item{@scheme['any] : doesn't matter (perhaps because the next image
+       completely overwrites the current one)}
+
+ @item{@scheme['keep] : leave the image in place}
+
+ @item{@scheme['restore-bg] : replace the image with the background
+       color}
+
+ @item{@scheme['restore-prev] : restore the overall image content to the
+       content before the image is added}
+
+}
+       
+If @scheme[wait-for-input?] is true, then the display program may wait
+for some cue from the user (perhaps a mouse click) before adding the
+image.
+
+The @scheme[delay-csec] argument specifies a delay in @math{1/100}s of
+a second.
+
+If the @scheme[transparent] argument is a byte, then it determines an
+index that is used to represent transparent pixels in the follow image
+(as opposed to the color specified by the colormap for the index).}
+
+
+@defproc[(gif-add-loop-control [gs image-or-control-ready-gif-stream?]
+                               [iteration (integer-in 0 #xFFFFFFFF)])
+         void?]{
+
+Writes an control command to a GIF stream for which no images or other
+commands have already been written. The command causes the animating
+sequence of images in the GIF to be repeated @scheme[iteration]
+times, where 0 can be used to mean ``infinity.''}
+
+
+@defproc[(gif-add-comment [gs image-or-control-ready-gif-stream?])
+         void?]{
+
+Adds a generic comment to the GIF stream.}
+
+
+@defproc[(quantize [argb-bstr bytes?])
+         (values bytes?
+                 gif-colormap?
+                 (or/c byte? false/c))]{
+
+Each image in a GIF stream is limited to 256 colors, including the
+transparent ``color,'' if any. The @scheme[quantize] function helps
+converts a 24-bit image (plus alpha channel) into an indexed-color
+image, reducing the number of colors if necessary.
+
+Given a set of pixels expressed in ARGB format (i.e., each four bytes
+is a set of values for one pixel: alpha, red, blue, and green),
+@scheme[quantize] produces produces
+
+@itemize{
+
+ @item{bytes for the image (i.e., a array of colors, expressed as a byte
+       string),}
+
+ @item{a colormap, and}
+
+ @item{either @scheme[#f] or a color index for the transparent ``color.''}
+
+}
+
+The conversion treats alpha values less than 128 as transparent
+pixels, and other alpha values as solid.
+
+The quantization process first attempts to use all (non-transparent)
+colors in the image. If that fails, it reduces the image to 12-bit
+color (3 bits per each of red, green, and blue) by rounding up pixel
+values, and tries again. If that fails, it reduces the image to 6-bit
+color (2 bits per each of red, green, and blue).
+
+To convert a collection of images all with the same quantization,
+append them for the input of a single call of @scheme[quantize], and
+then break apart the result bytes.}

collects/file/doc/gunzip.scrbl

@@ -0,0 +1,64 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/gunzip
+                     file/gzip))
+
+@title{@exec{gzip} Decompression}
+
+@defmodule[file/gunzip]{The @schememodname[file/gunzip] library provides
+utilities to decompress archive files in @exec{gzip} format, or simply
+to deccompress data using the @exec{pkzip} ``inflate'' method.}
+
+
+@defproc[(gunzip [file path-string?]
+                 [output-name-filter (string? boolean? . -> . path-string?)
+                                     (lambda (file archive-supplied?) file)])
+         void?]{ 
+
+Extracts data that was compressed using the @exec{gzip} utility (or
+@scheme[gzip] function), writing the uncompressed data directly to a
+file. The @scheme[file] argument is the name of the file containing
+compressed data. The default output file name is the original name of
+the compressed file as stored in @scheme[file]. If a file by this name
+exists, it will be overwritten. If no original name is stored in the
+source file, @scheme["unzipped"] is used as the default output file
+name.
+
+The @scheme[output-name-filter] procedure is applied to two
+arguments---the default destination file name and a boolean that is
+@scheme[#t] if this name was read from @scheme[file]---before the
+destination file is created. The return value of the file is used as
+the actual destination file name (to be opened with the
+@scheme['truncate] flag of @scheme[open-output-file]).
+
+If the compressed data turns out to be corrupted, the
+@scheme[exn:fail] exception is raised.}
+
+
+@defproc[(gunzip-through-ports [in input-port?]
+                               [out output-port?])
+         void?]{
+
+Reads the port @scheme[in] for compressed data that was created using
+the @exec{gzip} utility, writing the uncompressed data to the port
+@scheme[out].
+
+If the compressed data turns out to be corrupted, the
+@scheme[exn:fail] exception is raised. The unzipping process may peek
+further into @scheme[in] than needed to decompress the data, but it
+will not consume the unneeded bytes.}
+
+
+@defproc[(inflate [in input-port?]
+                  [out output-port?])
+         void?]{
+
+Reads @exec{pkzip}-format ``deflated'' data from the port @scheme[in]
+and writes the uncompressed (``inflated'') data to the port
+@scheme[out].  The data in a file created by @exec{gzip} uses this
+format (preceded with some header information).
+
+If the compressed data turns out to be corrupted, the
+@scheme[exn:fail] exception is raised. The inflate process may peek
+further into @scheme[in] than needed to decompress the data, but it
+will not consume the unneeded bytes.}

collects/file/doc/gzip.scrbl

@@ -0,0 +1,50 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/gzip))
+
+@title{@exec{gzip} Compression and File Creation}
+
+@defmodule[file/gzip]{The @schememodname[file/gzip] library provides
+utilities to create archive files in @exec{gzip} format, or simply to
+compress data using the @exec{pkzip} ``deflate'' method.}
+
+@defproc[(gzip [in-file path-string?]
+               [out-file path-string? (string-append in-file ".gz")])
+         void?]{
+
+Compresses data to the same format as the @exec{gzip} utility, writing
+the compressed data directly to a file. The @scheme[in-file] argument
+is the name of the file to compress. If the file named by
+@scheme[out-file] exists, it will be overwritten.}
+
+
+@defproc[(gzip-through-ports [in input-port?]
+                             [out output-port?]
+                             [orig-filename (or/c string? false/c)]
+                             [timestamp exact-integer?])
+         void?]{
+
+Reads the port @scheme[in] for data and compresses it to @scheme[out],
+outputting the same format as the @exec{gzip} utility. The
+@scheme[orig-filename] string is embedded in this output;
+@scheme[orig-filename] can be @scheme[#f] to omit the filename from
+the compressed stream. The @scheme[timestamp] number is also embedded
+in the output stream, as the modification date of the original file
+(in Unix seconds, as @scheme[file-or-directory-modify-seconds] would
+report under Unix).}
+
+
+@defproc[(deflate [in input-port?]
+                  [out output-port?])
+         (values exact-nonnegative-integer?
+                 exact-nonnegative-integer?
+                 exact-nonnegative-integer?)]{
+
+Writes @exec{pkzip}-format ``deflated'' data to the port @scheme[out],
+compressing data from the port @scheme[in].  The data in a file
+created by @exec{gzip} uses this format (preceded with header
+information).
+
+The result is three values: the number of bytes read from @scheme[in],
+the number of bytes written to @scheme[out], and a cyclic redundancy
+check (CRC) value for the input.}

collects/file/doc/info.ss

@@ -0,0 +1,3 @@
+(module info setup/infotab
+  (define name "File documentation")
+  (define scribblings '(("file.scrbl" (multi-page main-doc)))))

collects/file/doc/md5.scrbl

@@ -0,0 +1,18 @@
+#lang scribble/doc
+@(require "common.ss"
+          scribble/eval
+          file/md5
+          (for-label file/md5))
+
+@title{MD5 Message Digest}
+
+@defmodule[file/md5]
+
+@defproc[(md5 [in (or/c input-port? bytes?)]) bytes?]{
+
+Produces a byte string containing 32 hexadecimal digits (lowercase)
+that is the MD5 hash of the given input stream or byte string.
+
+@examples[
+(md5 #"abc")
+]}

collects/file/doc/tar.scrbl

@@ -0,0 +1,34 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/tar))
+
+@title{@exec{tar} File Creation}
+
+@defmodule[file/tar]{The @schememodname[file/tar] library provides
+utilities to create archive files in USTAR format, like the archive
+that the Unix utility @exec{pax} generates.  The USTAR format imposes
+limits on path lengths.  The resulting archives contain only
+directories and files (symbolic links are followed), and owner
+information is not preserved; the owner that is stored in the archive
+is always ``root.''}
+
+@defproc[(tar [tar-file path-string?][path path-string?] ...) 
+         void?]{
+
+Creates @scheme[tar-file], which holds the complete content of all
+@scheme[path]s.  The given @scheme[path]s are all expected to be
+relative path names of existing directories and files (i.e., relative
+to the current directory).  If a nested path is provided as a
+@scheme[path], its ancestor directories are also added to the
+resulting tar file, up to the current directory (using
+@scheme[pathlist-closure]).}
+
+@defproc[(tar->output [paths (listof path-string?)]
+                      [out output-port? (current-output-port)])
+         void?]{
+
+Packages each of the given @scheme[paths] in a @exec{tar} format
+archive that is written directly to the @scheme[out].  The specified
+@scheme[paths] are included as-is; if a directory is specified, its
+content is not automatically added, and nested directories are added
+without parent directories.}

collects/file/doc/zip.scrbl

@@ -0,0 +1,47 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/zip
+                     file/gunzip
+                     scheme/file))
+
+@title{@exec{zip} File Creation}
+
+@defmodule[file/zip]{The @schememodname[file/zip] library provides
+utilities to create @exec{zip} archive files, which are compatible
+with both Windows and Unix (including Mac OS X) unpacking. The actual
+compression is implemented by @scheme[deflate].}
+
+@defproc[(zip [zip-file path-string?][path path-string?] ...) 
+         void?]{
+
+Creates @scheme[zip-file], which holds the complete content of all
+@scheme[path]s.  The given @scheme[path]s are all expected to be
+relative path names of existing directories and files (i.e., relative
+to the current directory).  If a nested path is provided as a
+@scheme[path], its ancestor directories are also added to the
+resulting zip file, up to the current directory (using
+@scheme[pathlist-closure]).  Files are packaged as usual for
+@exec{zip} files, including permission bits for both Windows and Unix
+(including Mac OS X).  The permission bits are determined by
+@scheme[file-or-directory-permissions], which does not preserve the
+distinction between owner/group/other permissions. Also, symbolic
+links are always followed.}
+
+
+@defproc[(zip->output [paths (listof path-string?)]
+                      [out output-port? (current-output-port)])
+         void?]{
+
+Zips each of the given @scheme[paths], and packages it as a zip
+``file'' that is written directly to @scheme[out].  Unlike
+@scheme[zip], the specified @scheme[paths] are included as-is; if a
+directory is specified, its content is not automatically added, and
+nested directories are added without parent directories.}
+
+
+@defboolparam[zip-verbose on?]{
+
+A parameter that controls output during a @scheme[zip]
+operation. Setting this parameter to a true value causes @scheme[zip]
+to display to @scheme[(current-error-port)] the filename that is
+currently being compressed.}

collects/file/gif.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require net/gifwrite)
+(provide (all-from-out net/gifwrite))

collects/file/gunzip.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mzlib/inflate)
+(provide (all-from-out mzlib/inflate))

collects/file/gzip.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mzlib/deflate)
+(provide (all-from-out mzlib/deflate))

collects/file/info.ss

@@ -0,0 +1,2 @@
+(module info setup/infotab
+  (define name "File"))

collects/file/md5.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mzlib/md5)
+(provide (all-from-out mzlib/md5))

collects/file/tar.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mzlib/tar)
+(provide (all-from-out mzlib/tar))

collects/file/zip.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mzlib/zip)
+(provide (all-from-out mzlib/zip))

collects/net/gifwrite.ss

@@ -21,6 +21,12 @@
 
   (define GifVersionPrefix #"GIF89a")
 
+  (provide gif-stream?
+           image-ready-gif-stream?
+           image-or-control-ready-gif-stream?
+           empty-gif-stream?
+           (rename color-map? gif-colormap?))
+
   (define-struct gif-stream (port 
                              SWidth
                              SHeight

collects/scribble/manual.ss

@@ -531,6 +531,16 @@
       [else
        #'#f]))
 
+  (define-syntax (result-contract stx)
+    (syntax-case stx ()
+      [(_ c)
+       (if (string? (syntax-e #'c))
+           (raise-syntax-error
+            'defproc
+            "expected a result contract, found a string"
+            #'c)
+           #'(schemeblock0 c))]))
+
   (define-syntax defproc 
     (syntax-rules ()
       [(_ (id arg ...) result desc ...)
@@ -545,7 +555,7 @@
                  '[(id arg ...) ...] 
                  (list (list (lambda () (arg-contract arg)) ...) ...)
                  (list (list (lambda () (arg-default arg)) ...) ...)
-                 (list (lambda () (schemeblock0 result)) ...)
+                 (list (lambda () (result-contract result)) ...)
                  (lambda () (list desc ...)))]))
   (define-syntax defstruct
     (syntax-rules ()

collects/scribblings/quick/quick.scrbl

@@ -109,15 +109,16 @@ it looks like this:
 @mr-interaction[(hc-append (circle 10) (rectangle 10 20))]
 
 The hyphen in the name @scheme[hc-append] is just a part of the
-identifier; it's not @scheme[hc] minus @scheme[append]. The function
-name starts with @scheme[h] because it combines pictures horizontally,
-and the next letter is @scheme[c] because the pictures are centered
-vertically. If you wonder what other functions exist (perhaps a way to
-stack pictures vertically and left-aligned), move the text caret to
-the name @scheme[hc-append] and press the F1 key in DrScheme. A Help
-Desk window will appear, and it will give you a link to the
-documentation for @scheme[hc-append]. Click the link, and you'll see
-lots of other functions.
+identifier; it's not @schemeidfont{hc} minus
+@schemeidfont{append}. The function name starts with @scheme[h]
+because it combines pictures horizontally, and the next letter is
+@scheme[c] because the pictures are centered vertically. If you wonder
+what other functions exist (perhaps a way to stack pictures vertically
+and left-aligned), move the text caret to the name @scheme[hc-append]
+and press the F1 key in DrScheme. A Help Desk window will appear, and
+it will give you a link to the documentation for
+@scheme[hc-append]. Click the link, and you'll see lots of other
+functions.
 
 @; ----------------------------------------------------------------------
 @section{Definitions}

collects/scribblings/reference/runtime.scrbl

@@ -121,7 +121,7 @@ Scheme starts (not including any command-line arguments that were
 treated as flags for the system).}
 
 
-@defparam[current-thread-initial-stack-size exact-positive-integer?]{
+@defparam[current-thread-initial-stack-size size exact-positive-integer?]{
 
 A parameter that provides a hint about how much space to reserve for a
 newly created thread's local variables. The actual space used by a

collects/scribblings/slideshow/picts.scrbl

@@ -621,7 +621,8 @@ Creates a fluffy cloud.}
 @defproc[(file-icon [w real?]
                     [h real?] 
                     [color (or/c string? (is-a?/c color%) any/c)]
-                    [shaded? any/c #f])]{
+                    [shaded? any/c #f])
+         pict?]{
 
 Creates a Mac-like file icon, optionally shaded. If @scheme[color] is
 not a string or @scheme[color%] object, it is treated as a boolean, in

collects/scribblings/slideshow/slides.scrbl

@@ -226,7 +226,8 @@ Cancels the most recently created slide, and also returns a slide
 structure that be supplied to @scheme[re-slide] to restore the slide
 (usually in a later position).}
 
-@defproc[(re-slide [slide slide?] [pict pict? (blank)])]{
+@defproc[(re-slide [slide slide?] [pict pict? (blank)])
+         void?]{
 
 Re-inserts a slide, @scheme[lt-superimpose]ing the given additional
 @scheme[pict].}
@@ -240,7 +241,7 @@ Returns @scheme[#t] if @scheme[v] is a slide produced by
 
 @section{Viewer Control}
 
-@defproc[(start-at-recent-slide)]{
+@defproc[(start-at-recent-slide) void?]{
 
 Sets the starting slide for the talk to the most recently created
 slide. If this function is used multiple times, the last use overrides