general prettifying of code

abstract-tag.lisp

@@ -47,6 +47,7 @@ Ignores case and returns first complete match"
   "Given N, a supposed ID3 genre, range check it to make sure it
 is > 0 and < (sizeof *ID3V1-GENRES*)"
   (declare #.utils:*standard-optimize-settings*)
+
   (if (or (> n (1- (length *id3v1-genres*)))
             (< n 0))
         "BAD GENRE"
@@ -73,6 +74,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 ;;;; MP3
 (defmethod cover ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((pictures)
         (frames (id3:get-frames me '("PIC" "APIC"))))
     (when frames
@@ -82,6 +84,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod album ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TAL" "TALB"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one album tag")
@@ -92,6 +95,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod artist ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TP1" "TPE1"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one artist tag")
@@ -102,6 +106,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod comment ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("COM" "COMM"))))
     (when frames
       (let ((new-frames))
@@ -117,6 +122,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod year ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TRD" "TDRC"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one year tag")
@@ -127,6 +133,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod title ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TT2" "TIT2"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one title tag")
@@ -137,6 +144,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod genre ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TCO" "TCON"))))
     (when frames
       (when (> (length frames) 1)
@@ -170,6 +178,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 ;;;; No V2.1 tags for any of these
 (defmethod album-artist ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TP2" "TPE2"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one album-artist tag")
@@ -178,6 +187,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod composer ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TCM" "TCOM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one composer tag")
@@ -186,6 +196,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod copyright ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TCR" "TCOP"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one copyright tag")
@@ -194,6 +205,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod encoder ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TEN" "TENC"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one encoder tag")
@@ -202,6 +214,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod groups ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TT1" "TTE1"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one group tag")
@@ -210,6 +223,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod lyrics ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("ULT" "USLT"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one lyrics tag")
@@ -218,6 +232,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod writer ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TCM" "TCOM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one composer tag")
@@ -226,6 +241,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod compilation ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TCMP" "TCP"))))
     (if frames
         (id3:info (first frames))
@@ -233,6 +249,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod disk ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TPA" "TPOS"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one disk number tag")
@@ -241,6 +258,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod tempo ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TBP" "TBPM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one tempo tag")
@@ -250,6 +268,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 (defun mk-lst (str)
   "Transform 'N/M' to (N M)"
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((pos (position #\/ str)))
     (if (null pos)
         (list str)
@@ -257,6 +276,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
 
 (defmethod track ((me id3:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((frames (id3:get-frames me '("TRK" "TRCK"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one track number tag")
@@ -267,6 +287,7 @@ is > 0 and < (sizeof *ID3V1-GENRES*)"
   "Show the tags for an MP3.  If RAW is non-nil, dump all the frames;
 else, print out a subset."
   (declare #.utils:*standard-optimize-settings*)
+
   (if raw
       (format t "~a~%~a~%" (id3:filename me)
               (with-output-to-string (s)
@@ -336,6 +357,7 @@ else, print out a subset."
 
 (defmethod genre        ((me m4a:mp4-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((genre   (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-genre+))
         (genre-x (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-genre-x+)))
     (assert (not (and genre genre-x)))
@@ -346,6 +368,7 @@ else, print out a subset."
 
 (defmethod track ((me m4a:mp4-file))
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((track   (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-track+))
         (track-n (m4a:tag-get-value (m4a:mp4-atoms me) m4a:+itunes-track-n+)))
     (assert (not (and track track-n)))
@@ -422,6 +445,8 @@ else show subset of DATA atoms"
 (defmethod genre        ((me flac:flac-file)) (get-flac-tag-info me "genre"))
 
 (defmethod track        ((me flac:flac-file))
+  (declare #.utils:*standard-optimize-settings*)
+
   (let ((tr (get-flac-tag-info me "tracknumber"))
         (tn (get-flac-tag-info me "tracktotal")))
     (if tn (list tr tn) tr)))

audio-streams.lisp

@@ -6,6 +6,7 @@
 (defun make-audio-stream (arg)
   "Creates a stream for ARG"
   (declare #.utils:*standard-optimize-settings*)
+
   (labels ((make-file-stream (name)
              (let ((fd (open name :direction :input :element-type 'octet)))
                (if fd
@@ -37,6 +38,7 @@
   "Move the FILE-POSITION of a stream"
   (declare #.utils:*standard-optimize-settings*)
   (declare (fixnum offset))
+
   (ecase from
     (:start (file-position stream offset))
     (:current (file-position stream (+ (file-position stream) offset)))
@@ -70,18 +72,28 @@ many bits should be used from each read byte."
            finally (return-from read-n-bytes value)))))
 
 ;;;; Number readers
+(declaim (inline stream-read-u8
+                 stream-read-u16
+                 stream-read-u32
+                 stream-read-u64
+                 stream-read-u128))
+
 (defun stream-read-u8 (stream)
   (declare #.utils:*standard-optimize-settings*)
   (read-byte stream nil nil))
 
 (defun stream-read-u16  (stream &key (bits-per-byte 8) (endian :little-endian))
   (read-n-bytes stream 2  :bits-per-byte bits-per-byte :endian endian))
+
 (defun stream-read-u24  (stream &key (bits-per-byte 8) (endian :little-endian))
   (read-n-bytes stream 3  :bits-per-byte bits-per-byte :endian endian))
+
 (defun stream-read-u32  (stream &key (bits-per-byte 8) (endian :little-endian))
   (read-n-bytes stream 4  :bits-per-byte bits-per-byte :endian endian))
+
 (defun stream-read-u64  (stream &key (bits-per-byte 8) (endian :little-endian))
   (read-n-bytes stream 8  :bits-per-byte bits-per-byte :endian endian))
+
 (defun stream-read-u128 (stream &key (bits-per-byte 8) (endian :little-endian))
   (read-n-bytes stream 16 :bits-per-byte bits-per-byte :endian endian))
 
@@ -89,6 +101,7 @@ many bits should be used from each read byte."
 (defun stream-read-sequence (stream size &key (bits-per-byte 8))
   "Read in a sequence of octets at BITS-PER-BYTE"
   (declare #.utils:*standard-optimize-settings*)
+
   (ecase bits-per-byte
     (8 (let ((octets (make-octets size)))
          (values octets (read-sequence octets stream))))
@@ -205,12 +218,14 @@ byte-order marks, so we have to do that here before calling."
 
 
 ;;;; Files
-(defvar *get-audio-info* t
-  "controls whether the parsing functions parse audio info like bit-rate, etc")
+(defparameter *get-audio-info* t
+  "Controls whether the parsing functions parse audio info like bit-rate, etc")
 
 (defun open-audio-file (filename &optional (get-audio-info *get-audio-info*))
-  "Open and parse FILENAME for tag and optionally audio info"
+  "Open and parse FILENAME for tag and optionally audio info. Closes underlying
+file upon return."
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((stream)
         (info))
 

flac.lisp

@@ -70,16 +70,19 @@
 
 (defmethod flac-add-tag ((me flac-tags) new-tag new-val)
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((l-new-tag (string-downcase new-tag)))
     (setf (gethash l-new-tag (tags me)) new-val)))
 
 (defmethod flac-get-tag ((me flac-tags) key)
   (declare #.utils:*standard-optimize-settings*)
+
   (gethash (string-downcase key) (tags me)))
 
 (defun flac-get-tags (stream)
   "Loop through file and find all comment tags."
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((tags (make-instance 'flac-tags))
          (vendor-len (stream-read-u32 stream :endian :big-endian))
          (vendor-str (stream-read-utf-8-string stream vendor-len))
@@ -111,7 +114,6 @@
   "Loop through file and find all FLAC headers. If we find comment or audio-info
 headers, go ahead and parse them too."
   (declare #.utils:*standard-optimize-settings*)
-
   (declare (ignore get-audio-info)) ; audio info comes for "free"
 
   (stream-seek instream 4 :start)

id3.lisp

@@ -8,6 +8,7 @@
   "Read in a string of a given encoding of length 'len'. Encoding
 is from the ID3 'spec'"
   (declare #.utils:*standard-optimize-settings*)
+
   (if (and len (<= len 0))
       nil
       (ecase encoding
@@ -57,6 +58,7 @@ is from the ID3 'spec'"
 (defmethod initialize-instance ((me v21-tag-header) &key instream)
   "Read in a V2.1 tag.  Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (title artist album year comment genre track) me
     (setf title    (upto-null (stream-read-iso-string instream 30))
           artist   (upto-null (stream-read-iso-string instream 30))
@@ -95,6 +97,7 @@ is from the ID3 'spec'"
 Note: extended headers are subject to unsynchronization, so make sure that INSTREAM has been made sync-safe.
 NB: 2.3 and 2.4 extended flags are different..."
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (size flags padding crc is-update restrictions) me
     (setf size  (stream-read-u32 instream)
           flags (stream-read-u16 instream)) ; reading in flags fields, must discern below 2.3/2.4
@@ -126,6 +129,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun ext-header-restrictions-grok (r)
   "Return a string that shows what restrictions are in an ext-header"
   (declare #.utils:*standard-optimize-settings*)
+
   (if (zerop r)
       "No restrictions"
       (with-output-to-string (s)
@@ -196,6 +200,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defmethod initialize-instance :after ((me id3-header) &key instream &allow-other-keys)
   "Fill in an mp3-header from INSTREAM."
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (version revision flags size ext-header frames v21-tag-header) me
     (stream-seek instream 128 :end)
     (when (string= "TAG" (stream-read-iso-string instream 3))
@@ -234,6 +239,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 ;;; the bytes an raw octets.
 (defun get-name-value-pair (instream len name-encoding value-encoding)
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((old-pos  (stream-seek instream))
          (name     (id3-read-string instream :encoding name-encoding))
          (name-len (- (stream-seek instream) old-pos))
@@ -276,12 +282,14 @@ NB: 2.3 and 2.4 extended flags are different..."
 ;; NB version 2.2 does NOT have FLAGS field in a frame; hence, the ECASE
 (defun valid-frame-flags (header-version frame-flags)
   (declare #.utils:*standard-optimize-settings*)
+
   (ecase header-version
     (3 (zerop (logand #b0001111100011111 frame-flags)))
     (4 (zerop (logand #b1000111110110000 frame-flags)))))
 
 (defun print-frame-flags (version flags stream)
   (declare #.utils:*standard-optimize-settings*)
+
   (ecase version
     (2 (format stream "None, "))
     (3 (format stream
@@ -319,6 +327,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-raw) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (pos len octets) me
     (setf octets (stream-read-sequence instream len))))
 
@@ -372,6 +381,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-com) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (len encoding lang desc val) me
     (setf encoding (stream-read-u8 instream)
           lang     (stream-read-iso-string instream 3))
@@ -410,6 +420,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-pic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len encoding img-format ptype desc data) me
     (setf encoding   (stream-read-u8 instream)
           img-format (stream-read-iso-string instream 3)
@@ -439,6 +450,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-text-info) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (version flags len encoding info) me
     (let ((read-len len))
 
@@ -475,6 +487,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defmethod initialize-instance :after ((me frame-itunes-compilation) &key &allow-other-keys)
   "iTunes compilation weirdness: I have seen this encoded soooo many ways..."
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (len octets info) me
     (setf info
           (cond
@@ -539,6 +552,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-txx) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (len encoding desc val) me
     (setf encoding (stream-read-u8 instream))
     (multiple-value-bind (n v) (get-name-value-pair instream (1- len) encoding encoding)
@@ -559,6 +573,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-ufi) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len name value) me
     (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
       (setf name n
@@ -678,6 +693,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun get-picture-type (n)
   "Function to return picture types for APIC frames"
   (declare #.utils:*standard-optimize-settings*)
+
   (if (and (>= n 0) (< n (length *picture-type*)))
       (nth n *picture-type*)
       "Unknown"))
@@ -699,6 +715,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-apic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len encoding mime ptype desc data) me
     (setf encoding (stream-read-u8 instream)
           mime     (stream-read-iso-string instream)
@@ -732,6 +749,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-comm) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (encoding lang len desc val) me
     (setf encoding (stream-read-u8 instream)
           lang     (stream-read-iso-string instream 3))
@@ -758,6 +776,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-pcnt) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (play-count len) me
     (assert (= 4 len) () "Ran into a play count with ~d bytes" len)
     (setf play-count (stream-read-u32 instream)))) ; probably safe---play count *can* be longer than 4 bytes, but...
@@ -777,6 +796,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-priv) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len name value) me
     (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
       (setf name n
@@ -822,6 +842,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-ufid) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len name value) me
     (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
       (setf name n
@@ -840,6 +861,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-url-link) &key instream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (id len url) me
     (setf url (stream-read-iso-string instream len))))
 
@@ -865,6 +887,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun possibly-valid-frame-id? (frame-id)
   "test to see if a string is a potentially valid frame id"
   (declare #.utils:*standard-optimize-settings*)
+
   (labels ((numeric-char-p (c)
              (let ((code (char-code c)))
                (and (>= code (char-code #\0))
@@ -880,6 +903,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun mk-frame-class-name (id)
   (declare #.utils:*standard-optimize-settings*)
+
   (string-upcase (concatenate 'string "frame-" id)))
 (utils:memoize 'mk-frame-class-name)
 
@@ -899,6 +923,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun find-frame-class (id)
   "Search by concatenating 'frame-' with ID and look for that symbol in this package"
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((found-class-symbol (find-symbol (mk-frame-class-name id) :ID3))
         found-class)
 
@@ -925,6 +950,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun make-frame (version instream fn)
   "Create an appropriate mp3 frame by reading data from INSTREAM."
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((pos  (stream-seek instream))
          (byte (stream-read-u8 instream))
          frame-name frame-len frame-flags frame-class)
@@ -995,6 +1021,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defun parse-audio-file (instream &optional get-audio-info)
   "Parse an MP3 file"
   (declare #.utils:*standard-optimize-settings*)
+
   (labels ((read-loop (version stream)
              (let (frames this-frame)
                (do ()
@@ -1008,7 +1035,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
                        (push this-frame frames))
                    (condition (c)
-                     (utils:warn-user "find-id3-frame got condition ~a" c)
+                     (utils:warn-user "id3 parse-audio-file got condition ~a" c)
                      (return-from read-loop (values nil (nreverse frames))))))
 
                (values t (nreverse frames))))) ; frames in "file order"
@@ -1047,11 +1074,15 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun map-id3-frames (mp3 &key (func (constantly t)))
   "Iterates through the ID3 frames found in an MP3 file"
+  (declare #.utils:*standard-optimize-settings*)
+
   (mapcar func (frames (id3-header mp3))))
 
 (defun get-frames (mp3 names)
   "Given a MP3 file's info, search its frames for NAMES.
 Return file-order list of matching frames"
+  (declare #.utils:*standard-optimize-settings*)
+
   (let (found-frames)
     (map-id3-frames mp3
                     :func (lambda (f)

iso-639-2.lisp

@@ -495,5 +495,6 @@
 (defun get-iso-639-2-language (l)
   "Convert an ISO-639-2 language tag into a readable language."
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((lang (getf *langs* (make-keyword (string-upcase l)))))
     (if lang lang "Bad ISO-639-2 language")))

m4a.lisp

@@ -22,6 +22,7 @@
   (defun as-string (atom-type)
     "Given an integer, return the string representation"
     (declare #.utils:*standard-optimize-settings*)
+
     (with-output-to-string (s nil)
       (write-char (code-char (ldb (byte 8 24) atom-type)) s)
       (write-char (code-char (ldb (byte 8 16) atom-type)) s)
@@ -31,6 +32,7 @@
   (defun as-octet (c)
     "Used below so that we can create atom 'types' from char/ints"
     (declare #.utils:*standard-optimize-settings*)
+
     (cond ((typep c 'standard-char) (coerce (char-code c) '(unsigned-byte 8)))
           ((typep c 'integer) (coerce c '(unsigned-byte 8)))
           (t (error "can only handle characters and integers"))))
@@ -86,8 +88,8 @@
 (defconstant* +mp4-atom-trak+         (mk-mp4-atom-type #\t #\r #\a #\k))
 (defconstant* +mp4-atom-udta+         (mk-mp4-atom-type #\u #\d #\t #\a))
 
-(defvar *in-progress* nil "the node currently being worked upon")
-(defvar *tree*        nil "the root of the atom tree")
+(defparameter *in-progress* nil "the node currently being worked upon")
+(defparameter *tree*        nil "the root of the atom tree")
 
 (defclass mp4-atom ()
   ((atom-file-pos :accessor atom-file-pos :initarg :atom-file-pos :initform nil)
@@ -97,6 +99,7 @@
 
 (defmethod initialize-instance :around ((me mp4-atom) &key &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((old *in-progress*)
          (*in-progress* (tree:make-node me)))
     (if old
@@ -137,6 +140,7 @@ moov.udta.meta.ilst.xid  # space end!
   "The 'skip' atom.  Used when we want to capture the header of atom, but don't want/need
 to read the payload of an atom."
   (declare #.utils:*standard-optimize-settings*)
+
   (with-mp4-atom-slots (me)
     (stream-seek mp4-file (- atom-size 8) :current)))
 
@@ -145,6 +149,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me mp4-container-atom) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-mp4-atom-slots (me)
     (loop for end = (+ atom-file-pos atom-size)
           for current = (stream-seek mp4-file) then (stream-seek mp4-file)
@@ -185,6 +190,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me atom-data) &key mp4-file parent &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (atom-size atom-type atom-version atom-flags atom-value) me
     (setf atom-version (stream-read-u8 mp4-file)
           atom-flags   (stream-read-u24 mp4-file))
@@ -245,6 +251,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me atom-hdlr) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (version flags qtype mtype resv rflag rmask mhdlr atom-size) me
     (setf version  (stream-read-u8 mp4-file)
           flags    (stream-read-u24 mp4-file)
@@ -268,6 +275,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me atom-mdhd) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (version flags c-time m-time scale duration lang quality) me
     (setf version  (stream-read-u8 mp4-file)
           flags    (stream-read-u24 mp4-file)
@@ -297,6 +305,7 @@ to read the payload of an atom."
 (defun read-descriptor-len (instream)
   "Get the ES descriptor's length."
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((tmp (stream-read-u8 instream))
          (len (logand tmp #x7f)))
     (declare (type (unsigned-byte 8) tmp))
@@ -328,6 +337,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me atom-esds) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (version flags esid s-priority obj-id s-type buf-size max-bit-rate avg-bit-rate) me
     (setf version (stream-read-u8 mp4-file)
           flags (stream-read-u24 mp4-file))
@@ -355,6 +365,7 @@ to read the payload of an atom."
 
 (defmethod initialize-instance :after ((me atom-stsd) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (flags version num-entries) me
     (setf version     (stream-read-u8 mp4-file)
           flags       (stream-read-u24 mp4-file)
@@ -395,6 +406,7 @@ reading the container atoms"
 
 (defmethod initialize-instance :around ((me atom-meta) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
+
    (with-slots (version flags) me
      (setf version (stream-read-u8 mp4-file)
            flags   (stream-read-u24 mp4-file)))
@@ -404,6 +416,8 @@ reading the container atoms"
 ;;; This needs to be enhanced by accounting for all atom-types,
 ;;; else we get potential runaways. For now, just brute-force it
 (defun is-valid (str)
+  (declare #.utils:*standard-optimize-settings*)
+
   (assert (= 4 (length str)))
   (loop for c across str do
     (when (not (or (alphanumericp c)
@@ -445,6 +459,7 @@ reading the container atoms"
 
 (defun make-mp4-atom (mp4-file parent)
   "Get current file position, read in size/type, then construct the correct atom."
+
   (declare #.utils:*standard-optimize-settings*)
   (let* ((pos (stream-seek mp4-file))
          (siz (stream-read-u32 mp4-file))
@@ -466,6 +481,7 @@ reading the container atoms"
 
 (defmethod vpprint ((me mp4-atom) stream)
   (declare #.utils:*standard-optimize-settings*)
+
   (format stream "~a"
           (with-output-to-string (s)
             (with-mp4-atom-slots (me)
@@ -482,6 +498,7 @@ reading the container atoms"
   "Make sure this is an MP4 file.  Quick check: is first atom (at file-offset 4) == FSTYP?
 Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((valid)
         (size)
         (header))
@@ -532,6 +549,7 @@ one of the +iTunes- constants")
 (defmethod tag-get-value (atoms atom-type)
   "Helper function to extract text from ILST atom's data atom"
   (declare #.utils:*standard-optimize-settings*)
+
   (setf (nth 5 *ilst-data*) atom-type)
   (aif (tree:at-path atoms *ilst-data*
                      (lambda (x y)
@@ -542,6 +560,7 @@ one of the +iTunes- constants")
 (defun mp4-show-raw-tag-atoms (mp4-file-stream out-stream)
   "Show all the iTunes data atoms"
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((top-node
           (tree:at-path (mp4-atoms mp4-file-stream)
                         (list +root+ +mp4-atom-moov+ +mp4-atom-udta+
@@ -590,6 +609,7 @@ root.moov.trak.mdia.minf.stbl.mp4a, and root.moov.trak.mdia.minf.stbl.mp4a.esds"
 
 (defmethod vpprint ((me audio-info) stream)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-slots (seconds channels bits-per-sample sample-rate max-bit-rate avg-bit-rate) me
     (format stream "sample rate: ~:d Hz, # channels: ~d, bits-per-sample: ~:d, max bit-rate: ~:d Kbps, avg bit-rate: ~:d Kbps, duration: ~:d:~2,'0d"
             (if sample-rate sample-rate 0)
@@ -603,6 +623,7 @@ root.moov.trak.mdia.minf.stbl.mp4a, and root.moov.trak.mdia.minf.stbl.mp4a.esds"
 (defun get-mp4-audio-info (mp4-file)
   "Find and parse the audio information in MP4-FILE"
   (declare #.utils:*standard-optimize-settings*)
+
   (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
@@ -618,3 +639,13 @@ root.moov.trak.mdia.minf.stbl.mp4a, and root.moov.trak.mdia.minf.stbl.mp4a.esds"
           (setf avg-bit-rate (avg-bit-rate esds)
                 max-bit-rate (max-bit-rate esds))))))
     info))
+
+(defun map-mp4-atoms (m4a &key (func (constantly t)))
+  "Visit each atom we found in M4A"
+  (declare #.utils:*standard-optimize-settings*)
+
+  (tree:traverse
+   (m4a:mp4-atoms m4a)
+   (lambda (node depth)
+     (declare (ignore depth))
+     (funcall func (tree:data node)))))

packages.lisp

@@ -54,7 +54,6 @@
            #:open-audio-file
            #:stream-filename
            #:stream-read-iso-string
-           #:stream-read-octets
            #:stream-read-sequence
            #:stream-read-u128
            #:stream-read-u16
@@ -72,7 +71,6 @@
 (defpackage #:flac
   (:export #:audio-info
            #:filename
-           #:find-flac-frames
            #:flac-file
            #:flac-get-tag
            #:flac-headers
@@ -109,17 +107,15 @@
            #:+itunes-track-n+
            #:+itunes-writer+
            #:+itunes-year+
-           #:atom-decoded
            #:atom-file-pos
            #:atom-size
            #:atom-type
            #:audio-info
            #:clear-skipped
            #:filename
-           #:find-mp4-atoms
            #:get-mp4-audio-info
            #:is-valid-m4-file
-           #:map-mp4-atom
+           #:map-mp4-atoms
            #:mp4-atom
            #:mp4-atoms
            #:mp4-file
@@ -139,12 +135,9 @@
            #:desc
            #:encoding
            #:filename
-           #:find-id3-frames
            #:frames
            #:genre
-           #:get-frame-info
            #:get-frames
-           #:header
            #:id
            #:id3-frame
            #:id3-header
@@ -155,15 +148,13 @@
            #:mp3-file
            #:parse-audio-file
            #:picture-info
-           #:skipped-id3-frames*
            #:title
            #:v21-tag-header
            #:val
            #:version
            #:vpprint
            #:year
-           #:year
-           #:year)
+           #:*skipped-id3-frames*)
   (:use #:common-lisp #:audio-streams #:utils #:iso-639-2))
 
 (defpackage #:abstract-tag
@@ -173,14 +164,13 @@
            #:comment
            #:composer
            #:copyright
-           #:created
            #:encoder
            #:get-id3v1-genre
            #:groups
            #:lyrics
+           #:*raw-tags*
            #:title
            #:show-tags
-           #:tool
            #:writer)
   (:use #:common-lisp #:audio-streams #:utils))
 

tree.lisp

@@ -14,32 +14,38 @@
 (defun make-node (data)
   "Creates a new node with DATA as contents"
   (declare #.utils:*standard-optimize-settings*)
+
   (cons (cons data nil) nil))
 
 (defun add-child (node child)
   "Takes two nodes created with MAKE-NODE and adds CHILD"
   (declare #.utils:*standard-optimize-settings*)
+
   (nconc (first node) child)
   node)
 
 (defun first-child (node)
   "Returns a reference to the first child of NODE"
   (declare #.utils:*standard-optimize-settings*)
+
   (rest (first node)))
 
 (defun next-sibling (node)
   "Returns next SIBLING of NODE"
   (declare #.utils:*standard-optimize-settings*)
+
   (rest node))
 
 (defun data (node)
   "Returns the information in NODE"
   (declare #.utils:*standard-optimize-settings*)
+
   (first (first node)))
 
 (defun traverse (tree func &optional (depth 0))
   "Depth-first traversal of TREE calling FUNC for each node"
   (declare #.utils:*standard-optimize-settings*)
+
   (when tree
     (funcall func tree depth)
     (traverse (first-child tree) func (+ 2 depth))
@@ -48,11 +54,13 @@
 (defun print-tree (tree)
   "Print the nodes of TREE"
   (declare #.utils:*standard-optimize-settings*)
+
   (traverse tree (lambda (node depth) (format t "~v@tNode: ~a~%" depth (data node)))))
 
 (defun find-tree (tree test)
   "Find all nodes in TREE where TEST returns T"
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((results))
     (traverse tree (lambda (node depth)
                      (declare (ignore depth))

utils.lisp

@@ -98,10 +98,12 @@ The macro expansion has relatively low overhead in space or time."
 (defun upto-null (string)
   "Trim STRING to end at first NULL found"
   (declare #.utils:*standard-optimize-settings*)
+
   (subseq string 0 (position #\Null string)))
 
 (defun dump-data (file-name data)
   (declare #.utils:*standard-optimize-settings*)
+
   (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
     (write-sequence data f)))
 
@@ -116,6 +118,7 @@ The macro expansion has relatively low overhead in space or time."
   "Create a bit mask that begins at bit START (31 is MSB) and is WIDTH bits wide.
 Example: (get-bitmask 31 11) -->> #xffe00000"
   (declare #.utils:*standard-optimize-settings*)
+
   (ash (- (ash 1 width) 1) (- (1+ start) width)))
 
 (defmacro get-bitfield (int start width)
@@ -173,6 +176,7 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
 (defun mk-memoize (func-name)
   "Takes a normal function object and returns a memoized one"
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((func (symbol-function func-name))
          (the-hash-table (make-locked-hash-table
                           :lock (make-lock)
@@ -192,6 +196,7 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
 
 (defun timings (function)
   (declare #.utils:*standard-optimize-settings*)
+
   (let ((real-base (get-internal-real-time)))
     (funcall function)
     (float (/ (- (get-internal-real-time) real-base) internal-time-units-per-second))))