cleaning up stuff...

abstract-tag.lisp

@@ -5,154 +5,29 @@
 (defparameter *raw-tags* nil)
 
 (defparameter *id3v1-genres*
-  #("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"
-    "Alternative Rock"
-    "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"
-    "Fusion"
-    "Bebob"
-    "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 Cappella"
-    "Euro-House"
-    "Dance Hall"
-    "Goa"
-    "Drum & Bass"
-    "Club-House"
-    "Hardcore"
-    "Terror"
-    "Indie"
-    "BritPop"
-    "Negerpunk"
-    "Polsk Punk"
-    "Beat"
-    "Christian Gangsta Rap"
-    "Heavy Metal"
-    "Black Metal"
-    "Crossover"
-    "Contemporary Christian"
-    "Christian Rock"
-    "Merengue"
-    "Salsa"
-    "Thrash Metal"
-    "Anime"
-    "Jpop"
-    "Synthpop"))
+  #("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" "Alternative Rock" "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" "Fusion" "Bebob" "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 Cappella" "Euro-House" "Dance Hall"
+    "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie"
+    "BritPop" "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
+    "Black Metal" "Crossover" "Contemporary Christian" "Christian Rock"
+    "Merengue" "Salsa" "Thrash Metal" "Anime" "Jpop" "Synthpop"))
 
 (defun find-genre (name)
   "For debug purpose only: test function to return index of genre, given a name. ignores case and returns first complete match"
@@ -171,7 +46,6 @@
         (aref *id3v1-genres* n)))
 
 ;;;;;;;;;;;;;;;;;;;; MP3 ;;;;;;;;;;;;;;;;;;;;
-
 (defun get-frames (stream names)
   "Given a MP3-STREAM, search its frames for NAMES.  Return file-order list of matching frames"
   (let (found-frames)
@@ -390,26 +264,23 @@
         (when writer (format t "~4twriter: ~a~%" writer))
         (when year (format t "~4tyear: ~a~%" year)))))
 
-
-
 ;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;
-;;; Abstract TAG interface
-(defmethod album ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album+))
-(defmethod album-artist ((me mp4-file-stream))   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album-artist+))
-(defmethod artist ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-artist+))
-(defmethod comment ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-comment+))
-(defmethod composer ((me mp4-file-stream))       (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-composer+))
-(defmethod copyright ((me mp4-file-stream))      (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-copyright+))
-(defmethod year ((me mp4-file-stream))           (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-year+))
-(defmethod encoder ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-encoder+))
-(defmethod groups ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-groups+))
-(defmethod lyrics ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-lyrics+))
-(defmethod title ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-title+))
-(defmethod writer ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-writer+))
-(defmethod compilation ((me mp4-file-stream))    (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-compilation+))
-(defmethod disk  ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-disk+))
-(defmethod tempo ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tempo+))
-(defmethod genre ((me mp4-file-stream))
+(defmethod album        ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album+))
+(defmethod album-artist ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album-artist+))
+(defmethod artist       ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-artist+))
+(defmethod comment      ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-comment+))
+(defmethod composer     ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-composer+))
+(defmethod copyright    ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-copyright+))
+(defmethod year         ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-year+))
+(defmethod encoder      ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-encoder+))
+(defmethod groups       ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-groups+))
+(defmethod lyrics       ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-lyrics+))
+(defmethod title        ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-title+))
+(defmethod writer       ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-writer+))
+(defmethod compilation  ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-compilation+))
+(defmethod disk         ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-disk+))
+(defmethod tempo        ((me mp4-file-stream)) (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tempo+))
+(defmethod genre        ((me mp4-file-stream))
   (let ((genre   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre+))
         (genre-x (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre-x+)))
     (assert (not (and genre genre-x)))
@@ -472,7 +343,6 @@
         (when year (format t "~4tyear: ~a~%" year)))))
 
 ;;;;;;;;;;;;;;;;;;;; FLAC ;;;;;;;;;;;;;;;;;;;;
-;;; Abstract TAG interface
 (defmacro get-flac-tag-info (stream name)
   `(flac-frame:flac-get-tag (flac-tags ,stream) ,name))
 
@@ -492,7 +362,7 @@
                                                   (if tn (list tr tn) tr)))
 
 (defmethod show-tags ((me flac-file-stream) &key (raw *raw-tags*))
-  "Show the tags for a FLAC-FILE. If RAW is non-nil ... XXX"
+  "Show the tags for a FLAC-FILE."
   (format t "~a~%" (stream-filename me))
   (if raw
       (flac-frame:flac-show-raw-tag me t)

audio-streams.lisp

@@ -151,6 +151,13 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;; We need to be able to decode many types of string formats, so we borrow and extend
+;;; the constants embedded in the ID3 "spec."
+(defconstant +enc-iso-8859+ 0 "normal 8-bit Latin encoding")
+(defconstant +enc-ucs+      1 "universal character set, 16-bit, uses initial Byte Order Mark (BOM) to determine endianess")
+(defconstant +enc-ucs-be+   2 "universal character set, 16-bit, big-endian, no BOM")
+(defconstant +enc-utf-8+    3 "UCS transformation format, 8-bit as neeed")
+
 ;;; Decode octets as an iso-8859-1 string (encoding == 0)
 (defun stream-decode-iso-string (octets &key (start 0) (end nil))
   (ccl:decode-string-from-octets octets :start start :end end :external-format :iso-8859-1))
@@ -202,31 +209,27 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 (defmethod stream-read-iso-string-with-len ((instream mem-stream) len)
   "Read an iso-8859-1 string of length 'len' (encoding = 0)"
-  (let ((octets (stream-read-sequence instream len)))
-    (stream-decode-iso-string octets)))
+  (stream-decode-iso-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-ucs-string-with-len ((instream mem-stream) len)
   "Read an ucs-2 string of length 'len' (encoding = 1)"
-  (let ((octets (stream-read-sequence instream len)))
-      (stream-decode-ucs-string octets)))
+  (stream-decode-ucs-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-ucs-be-string-with-len ((instream mem-stream) len)
   "Read an ucs-2-be string of length 'len' (encoding = 2)"
-  (let ((octets (stream-read-sequence instream len)))
-    (stream-decode-ucs-be-string octets)))
+  (stream-decode-ucs-be-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-utf-8-string-with-len ((instream mem-stream) len)
   "Read an utf-8 string of length 'len' (encoding = 3)"
-  (let ((octets (stream-read-sequence instream len)))
-    (stream-decode-utf-8-string octets)))
+  (stream-decode-utf-8-string  (stream-read-sequence instream len)))
 
 (defmethod stream-read-string-with-len ((instream mem-stream) len &key (encoding 0))
   "Read in a string of a given encoding of length 'len'"
   (ecase encoding
-    (0 (stream-read-iso-string-with-len instream len))
-    (1 (stream-read-ucs-string-with-len instream len))
-    (2 (stream-read-ucs-be-string-with-len instream len))
-    (3 (stream-read-utf-8-string-with-len instream len))))
+    (+enc-iso-8859+ (stream-read-iso-string-with-len instream len))
+    (+enc-ucs+      (stream-read-ucs-string-with-len instream len))
+    (+enc-ucs-be+   (stream-read-ucs-be-string-with-len instream len))
+    (+enc-utf-8+    (stream-read-utf-8-string-with-len instream len))))
 
 (defmethod stream-read-iso-string ((instream mem-stream))
   "Read in a null terminated iso-8859-1 string"
@@ -280,10 +283,10 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 (defmethod stream-read-string ((instream mem-stream) &key (encoding 0))
   "Read in a null terminated string of a given encoding."
   (ecase encoding
-    (0 (stream-read-iso-string    instream))
-    (1 (stream-read-ucs-string    instream))
-    (2 (stream-read-ucs-be-string instream))
-    (3 (stream-read-utf-8-string  instream))))
+    (+enc-iso-8859+ (stream-read-iso-string    instream))
+    (+enc-ucs+      (stream-read-ucs-string    instream))
+    (+enc-ucs-be+   (stream-read-ucs-be-string instream))
+    (+enc-utf-8+    (stream-read-utf-8-string  instream))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar *get-audio-info* t "controls whether the parsing functions also parse audio info like bit-rate, etc")

mp4-atom.lisp

@@ -203,7 +203,6 @@ Loop through this container and construct constituent atoms"
 
 ;;; the ILST atom decoders.  First, a lot of the decoders do the same thing, so we define a macros
 ;;; and use those for the relevants atoms.
-;;; XXX rewrite all this to be defclass based (specialize on parent-type)
 (defgeneric decode-ilst-data-atom (type atom atom-parent-type mp4-file))
 
 ;;; Quicktime spec says strings are stored as UTF-8...
@@ -331,7 +330,7 @@ Loop through this container and construct constituent atoms"
    (buf-size     :accessor buf-size)      ; 3 bytes
    (max-bit-rate :accessor max-bit-rate)  ; 4 bytes
    (avg-bit-rate :accessor avg-bit-rate)) ; 4 bytes
-  (:documentation "XXX-partial definition for Elementary Stream DescriptorS"))
+  (:documentation "XXX-partial definition for Elementary Stream Descriptors (ESDs)"))
 
 ;;; 3 bytes extended descriptor type tag string = 3 * 8-bit hex value
 ;;; types are Start = 0x80 ; End = 0xFE
@@ -348,25 +347,25 @@ Loop through this container and construct constituent atoms"
     len))
 
 ;;; one-byte descriptor tags
-(defconstant +MP4-ODescrTag+               #x01)
-(defconstant +MP4-IODescrTag+              #x02)
-(defconstant +MP4-ESDescrTag+              #x03)
-(defconstant +MP4-DecConfigDescrTag+       #x04)
-(defconstant +MP4-DecSpecificDescrTag+     #x05)
-(defconstant +MP4-SLConfigDescrTag+        #x06)
-(defconstant +MP4-ContentIdDescrTag+       #x07)
-(defconstant +MP4-SupplContentIdDescrTag+  #x08)
-(defconstant +MP4-IPIPtrDescrTag+          #x09)
-(defconstant +MP4-IPMPPtrDescrTag+         #x0A)
-(defconstant +MP4-IPMPDescrTag+            #x0B)
-(defconstant +MP4-RegistrationDescrTag+    #x0D)
-(defconstant +MP4-ESIDIncDescrTag+         #x0E)
-(defconstant +MP4-ESIDRefDescrTag+         #x0F)
-(defconstant +MP4-FileIODescrTag+          #x10)
-(defconstant +MP4-FileODescrTag+           #x11)
-(defconstant +MP4-ExtProfileLevelDescrTag+ #x13)
-(defconstant +MP4-ExtDescrTagsStart+       #x80)
-(defconstant +MP4-ExtDescrTagsEnd+         #xFE)
+(defconstant +mp4-odescrtag+               #x01)
+(defconstant +mp4-iodescrtag+              #x02)
+(defconstant +mp4-esdescrtag+              #x03)
+(defconstant +mp4-decconfigdescrtag+       #x04)
+(defconstant +mp4-decspecificdescrtag+     #x05)
+(defconstant +mp4-slconfigdescrtag+        #x06)
+(defconstant +mp4-contentiddescrtag+       #x07)
+(defconstant +mp4-supplcontentiddescrtag+  #x08)
+(defconstant +mp4-ipiptrdescrtag+          #x09)
+(defconstant +mp4-ipmpptrdescrtag+         #x0a)
+(defconstant +mp4-ipmpdescrtag+            #x0b)
+(defconstant +mp4-registrationdescrtag+    #x0d)
+(defconstant +mp4-esidincdescrtag+         #x0e)
+(defconstant +mp4-esidrefdescrtag+         #x0f)
+(defconstant +mp4-fileiodescrtag+          #x10)
+(defconstant +mp4-fileodescrtag+           #x11)
+(defconstant +mp4-extprofileleveldescrtag+ #x13)
+(defconstant +mp4-extdescrtagsstart+       #x80)
+(defconstant +mp4-extdescrtagsend+         #xfe)
 
 (defmethod initialize-instance :after ((me atom-esds) &key (mp4-file nil) &allow-other-keys)
   (with-slots (version flags esid s-priority obj-id s-type buf-size max-bit-rate avg-bit-rate) me
@@ -516,7 +515,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
     valid))
 
 (defmethod find-mp4-atoms ((mp4-file mp4-file-stream))
-  "Given a valid MP4 file mp4-file, look for the 'right' atoms and return them."
+  "Given a valid MP4 file MP4-FILE, look for the 'right' atoms and return them."
   (log5:with-context "find-mp4-atoms"
 
     (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
@@ -539,7 +538,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
       (map-mp4-atom a :func func :depth depth))))
 
 (defmethod map-mp4-atom ((me mp4-atom) &key (func nil) (depth nil))
-  "traverse all atoms under a given atom"
+  "Traverse all atoms under a given atom"
   (log5:with-context "map-mp4-atom(single)"
     (labels ((_indented-atom (atom depth)
                (format t "~vt~a~%"  (if (null depth) 0 depth) (vpprint atom nil))))
@@ -620,7 +619,8 @@ return trak.mdia.mdhd and trak.mdia.minf.stbl.stsd"
    (bits-per-sample :accessor bits-per-sample :initform nil)
    (sample-rate     :accessor sample-rate     :initform nil)
    (max-bit-rate    :accessor max-bit-rate    :initform nil)
-   (avg-bit-rate    :accessor avg-bit-rate    :initform nil)))
+   (avg-bit-rate    :accessor avg-bit-rate    :initform nil))
+  (:documentation "Holds extracted audio information about an MP4 file."))
 
 (defmethod vpprint ((me audio-info) stream)
   (with-slots (seconds channels bits-per-sample sample-rate max-bit-rate avg-bit-rate) me
@@ -634,7 +634,7 @@ return trak.mdia.mdhd and trak.mdia.minf.stbl.stsd"
             (if seconds (round (mod seconds 60)) 0))))
 
 (defun get-mp4-audio-info (mp4-file)
-  "MP4a audio info is held in under the trak.mdia.mdhd/trak.mdia.minf.stbl/trak.mdia.minf.stbl.mp4a atoms."
+  "MP4A audio info is held in under the trak.mdia.mdhd/trak.mdia.minf.stbl/trak.mdia.minf.stbl.mp4a atoms."
   (let ((info (make-instance 'audio-info)))
     (multiple-value-bind (mdhd mp4a esds) (get-audio-properties-atoms mp4-file)
       (with-slots (seconds channels bits-per-sample sample-rate max-bit-rate avg-bit-rate) info

packages.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:has-extension #:redirect
+  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:redirect
            #:it #:fastest #:get-bitfield #:while #:aif #:awhen #:with-gensyms #:make-keyword #:dump-data)
   (:use #:common-lisp))
 

utils.lisp

@@ -30,19 +30,6 @@
   (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
     (write-sequence data f)))
 
-(defmethod has-extension ((n string) ext)
-  "Probably should use CL's PATHNAME methods, but simply looking at the .XXX portion of a filename
-to see if it matches. This is the string version that makes a PATHNAME and calls the PATHNAME version."
-  (has-extension (parse-namestring n) ext))
-
-(defmethod has-extension ((p pathname) ext)
-  "Probably should use CL's PATHNAME methods , but simply looking at the .XXX portion of a filename
-to see if it matches. PATHNAME version."
-  (let ((e (pathname-type p)))
-    (if e
-      (string= (string-downcase e) (string-downcase ext))
-      nil)))
-
 (defmacro redirect (filename &rest body)
   "Temporarily set *STANDARD-OUTPUT* to FILENAME and execute BODY."
   `(let ((*standard-output* (open ,filename :direction :output :if-does-not-exist :create :if-exists :supersede)))