removed all logging support, since it was cluttering the code with little benefit. replaced with DBG prints from ASDF/UIOP

audio-streams.lisp

@@ -3,9 +3,6 @@
 
 (in-package #:audio-streams)
 
-(log5:defcategory cat-log-stream)
-(defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
-
 (deftype octet () '(unsigned-byte 8))
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
@@ -148,25 +145,18 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 (defun make-file-stream (filename)
   "Convenience function for creating a file stream. Detects file type and returns proper type stream."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "make-file-stream"
-    (let* ((new-stream (make-mmap-stream filename))
-           (ret-stream))
-
-      (log-stream "Looking at ~a" filename)
-      ;; detect file type and make RET-STREAM.  if we don't recognize stream, RET-STREAM will be NULL
-      (cond ((mp4-atom:is-valid-m4-file new-stream)
-             (log-stream "~a is an MP4 file" filename)
-             (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
-            ((flac-frame:is-valid-flac-file new-stream)
-             (log-stream "~a is a FLAC file" filename)
-             (setf ret-stream (make-instance 'flac-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
-            ((id3-frame:is-valid-mp3-file new-stream)
-             (log-stream "~a is an ID3 file" filename)
-             (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
-            (t
-             (log-stream "Unkown file type")))
-      (stream-close new-stream)
-      ret-stream)))
+  (let* ((new-stream (make-mmap-stream filename))
+         (ret-stream))
+
+    ;; detect file type and make RET-STREAM.  if we don't recognize stream, RET-STREAM will be NULL
+    (cond ((mp4-atom:is-valid-m4-file new-stream)
+           (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+          ((flac-frame:is-valid-flac-file new-stream)
+           (setf ret-stream (make-instance 'flac-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+          ((id3-frame:is-valid-mp3-file new-stream)
+           (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream)))))
+    (stream-close new-stream)
+    ret-stream))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

flac-frame.lisp

@@ -2,9 +2,6 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:flac-frame)
 
-(log5:defcategory cat-log-flac-frame)
-(defmacro log-flac-frame (&rest log-stuff) `(log5:log-for (cat-log-flac-frame) ,@log-stuff))
-
 ;;; FLAC header types
 (defconstant +metadata-streaminfo+  0)
 (defconstant +metadata-padding+     1)
@@ -36,33 +33,28 @@
 (defun is-valid-flac-file (flac-file)
   "Make sure this is a FLAC file. Look for FLAC header at begining"
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "is-valid-flac-file"
-    (stream-seek flac-file 0 :start)
-    (let ((valid nil))
-      (when (> (stream-size flac-file) 4)
-        (unwind-protect
-             (handler-case
-                 (let ((hdr (stream-read-string-with-len flac-file 4)))
-                   (log-flac-frame "got <~a> for flac header" hdr)
-                   (setf valid (string= "fLaC" hdr))
-                   (log-flac-frame "valid = ~a" valid))
-               (condition (c)
-                 (utils:warn-user "is-valid-flac-file: got condition ~a" c)))
-          (stream-seek flac-file 0 :start)))
-        valid)))
+  (stream-seek flac-file 0 :start)
+  (let ((valid nil))
+    (when (> (stream-size flac-file) 4)
+      (unwind-protect
+           (handler-case
+               (let ((hdr (stream-read-string-with-len flac-file 4)))
+                 (setf valid (string= "fLaC" hdr)))
+             (condition (c)
+               (utils:warn-user "is-valid-flac-file: got condition ~a" c)))
+        (stream-seek flac-file 0 :start)))
+    valid))
 
 (defun make-flac-header (stream)
   "Make a flac header from current position in stream"
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "make-flac-header"
-    (let* ((header (stream-read-u32 stream))
-           (flac-header (make-instance 'flac-header
-                                       :pos (- (stream-here stream) 4)
-                                       :last-bit (utils:get-bitfield header 31 1)
-                                       :header-type (utils:get-bitfield header 30 7)
-                                       :header-len (utils:get-bitfield header 23 24))))
-      (log-flac-frame "header = ~a" (vpprint flac-header nil))
-      flac-header)))
+  (let* ((header (stream-read-u32 stream))
+         (flac-header (make-instance 'flac-header
+                                     :pos (- (stream-here stream) 4)
+                                     :last-bit (utils:get-bitfield header 31 1)
+                                     :header-type (utils:get-bitfield header 30 7)
+                                     :header-len (utils:get-bitfield header 23 24))))
+    flac-header))
 
 
 (defparameter *flac-tag-pattern* "(^[a-zA-Z]+)=(.*$)" "used to parse FLAC/ORBIS comments")
@@ -84,46 +76,41 @@
 (defun flac-get-tags (stream)
   "Loop through file and find all comment tags."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "flac-get-tags"
-    (let* ((tags (make-instance 'flac-tags))
-           (vendor-len (stream-read-u32 stream :endian :big-endian))
-           (vendor-str (stream-read-utf-8-string-with-len stream vendor-len))
-           (lst-len (stream-read-u32 stream :endian :big-endian)))
-
-      (setf (vendor-str tags) vendor-str)
-
-      (dotimes (i lst-len)
-        (let* ((comment-len (stream-read-u32 stream :endian :big-endian))
-               (comment (stream-read-utf-8-string-with-len stream comment-len)))
-          (push comment (comments tags))
-          (optima:match comment ((optima.ppcre:ppcre *flac-tag-pattern* tag value)
-                                 (log-flac-frame "got ~a/~a" tag value)
-                                 (flac-add-tag tags tag value)))))
-      (setf (comments tags) (nreverse (comments tags)))
-      tags)))
+  (let* ((tags (make-instance 'flac-tags))
+         (vendor-len (stream-read-u32 stream :endian :big-endian))
+         (vendor-str (stream-read-utf-8-string-with-len stream vendor-len))
+         (lst-len (stream-read-u32 stream :endian :big-endian)))
+
+    (setf (vendor-str tags) vendor-str)
+
+    (dotimes (i lst-len)
+      (let* ((comment-len (stream-read-u32 stream :endian :big-endian))
+             (comment (stream-read-utf-8-string-with-len stream comment-len)))
+        (push comment (comments tags))
+        (optima:match comment ((optima.ppcre:ppcre *flac-tag-pattern* tag value)
+                               (flac-add-tag tags tag value)))))
+    (setf (comments tags) (nreverse (comments tags)))
+    tags))
 
 (defmethod find-flac-frames ((stream flac-file-stream))
   "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*)
-  (log5:with-context "find-flac-frames"
-    (stream-seek stream 4 :start)
-
-    (handler-case
-        (let (headers)
-          (loop for h = (make-flac-header stream) then (make-flac-header stream) do
-            (push h headers)
-            (log-flac-frame "Found flac frame: ~a" (vpprint h nil))
-            (cond
-              ((= +metadata-comment+ (header-type h))
-               (setf (flac-tags stream) (flac-get-tags stream)))
-              ((= +metadata-streaminfo+ (header-type h))
-               (setf (audio-info stream) (get-flac-audio-info stream)))
-              (t (stream-seek stream (header-len h) :current)))
-            (when (not (zerop (last-bit h))) (return)))
-          (setf (flac-headers stream) (nreverse headers)))
-      (condition (c)
-        (utils:warn-user "find-flac-frames got condition ~a" c)
-        (log-flac-frame "got condition ~a when finding flac frames" c)))))
+  (stream-seek stream 4 :start)
+
+  (handler-case
+      (let (headers)
+        (loop for h = (make-flac-header stream) then (make-flac-header stream) do
+          (push h headers)
+          (cond
+            ((= +metadata-comment+ (header-type h))
+             (setf (flac-tags stream) (flac-get-tags stream)))
+            ((= +metadata-streaminfo+ (header-type h))
+             (setf (audio-info stream) (get-flac-audio-info stream)))
+            (t (stream-seek stream (header-len h) :current)))
+          (when (not (zerop (last-bit h))) (return)))
+        (setf (flac-headers stream) (nreverse headers)))
+    (condition (c)
+      (utils:warn-user "find-flac-frames got condition ~a" c))))
 
 (defclass flac-audio-properties ()
   ((min-block-size  :accessor min-block-size  :initarg :min-block-size  :initform 0)

id3-frame.lisp

@@ -3,9 +3,6 @@
 
 (in-package #:id3-frame)
 
-(log5:defcategory cat-log-id3-frame)
-(defmacro log-id3-frame (&rest log-stuff) `(log5:log-for (cat-log-id3-frame) ,@log-stuff))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ID3 header/extended header/v2.1 header ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defclass id3-header ()
   ((version        :accessor version        :initarg :version        :initform 0   :documentation "ID3 version: 2, 3, or 4")
@@ -22,33 +19,30 @@
 Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
   (declare #.utils:*standard-optimize-settings*)
 
-  (log5:with-context "is-valid-mp3-file"
-    (let ((id3)
-          (valid nil)
-          (version)
-          (tag))
-
-      (when (> (stream-size mp3-file) 4)
-        (unwind-protect
-             (handler-case
-                 (progn
-                   (stream-seek mp3-file 0 :start)
-                   (setf id3     (stream-read-string-with-len mp3-file 3)
-                         version (stream-read-u8 mp3-file))
-                   (when (> (stream-size mp3-file) 128)
-                     (stream-seek mp3-file 128 :end)
-                     (setf tag (stream-read-string-with-len mp3-file 3)))
-
-                   (log-id3-frame "id3 = ~a, version = ~d" id3 version)
-
-                   (setf valid (or (and (string= "ID3" id3)
-                                        (or (= 2 version) (= 3 version) (= 4 version)))
-                                   (string= tag "TAG"))))
-               (condition (c)
-                 (utils:warn-user "is-valid-mp3-file got condition ~a" c)
-                 (setf valid nil)))
-          (stream-seek mp3-file 0 :start)))
-      valid)))
+  (let ((id3)
+        (valid nil)
+        (version)
+        (tag))
+
+    (when (> (stream-size mp3-file) 4)
+      (unwind-protect
+           (handler-case
+               (progn
+                 (stream-seek mp3-file 0 :start)
+                 (setf id3     (stream-read-string-with-len mp3-file 3)
+                       version (stream-read-u8 mp3-file))
+                 (when (> (stream-size mp3-file) 128)
+                   (stream-seek mp3-file 128 :end)
+                   (setf tag (stream-read-string-with-len mp3-file 3)))
+
+                 (setf valid (or (and (string= "ID3" id3)
+                                      (or (= 2 version) (= 3 version) (= 4 version)))
+                                 (string= tag "TAG"))))
+             (condition (c)
+               (utils:warn-user "is-valid-mp3-file got condition ~a" c)
+               (setf valid nil)))
+        (stream-seek mp3-file 0 :start)))
+    valid))
 
  (defclass v21-tag-header ()
    ((title    :accessor title    :initarg :title    :initform nil)
@@ -69,32 +63,29 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 (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*)
-  (log5:with-context "v21-frame-initializer"
-    (log-id3-frame "reading v2.1 tag from ~:d" (stream-seek instream 0))
-    (with-slots (title artist album year comment genre track) me
-      (setf title    (upto-null (stream-read-string-with-len instream 30))
-            artist   (upto-null (stream-read-string-with-len instream 30))
-            album    (upto-null (stream-read-string-with-len instream 30))
-            year     (upto-null (stream-read-string-with-len instream 4)))
-
-      ;; In V21, a comment can be split into comment and track #
-      ;; find the first #\Null then check to see if that index < 28.  If so, the check the last two bytes being
-      ;; non-zero---if so, then track can be set to integer value of last two bytes
-
-        (let* ((c (stream-read-sequence instream 30))
-               (first-null (find 0 c))
-               (trck 0))
-          (when (and first-null (<= first-null 28))
-            (setf (ldb (byte 8 8) trck) (aref c 28)
-                  (ldb (byte 8 0) trck) (aref c 29)))
-
-          (setf comment (upto-null (map 'string #'code-char c)))
-          (if (> trck 0)
-              (setf track trck)
-              (setf track nil)))
-
-      (setf genre (stream-read-u8 instream))
-      (log-id3-frame "v21 tag: ~a" (vpprint me nil)))))
+  (with-slots (title artist album year comment genre track) me
+    (setf title    (upto-null (stream-read-string-with-len instream 30))
+          artist   (upto-null (stream-read-string-with-len instream 30))
+          album    (upto-null (stream-read-string-with-len instream 30))
+          year     (upto-null (stream-read-string-with-len instream 4)))
+
+    ;; In V21, a comment can be split into comment and track #
+    ;; find the first #\Null then check to see if that index < 28.  If so, the check the last two bytes being
+    ;; non-zero---if so, then track can be set to integer value of last two bytes
+
+    (let* ((c (stream-read-sequence instream 30))
+           (first-null (find 0 c))
+           (trck 0))
+      (when (and first-null (<= first-null 28))
+        (setf (ldb (byte 8 8) trck) (aref c 28)
+              (ldb (byte 8 0) trck) (aref c 29)))
+
+      (setf comment (upto-null (map 'string #'code-char c)))
+      (if (> trck 0)
+          (setf track trck)
+          (setf track nil)))
+
+    (setf genre (stream-read-u8 instream))))
 
 (defclass id3-ext-header ()
   ((size         :accessor size         :initarg :size         :initform 0)
@@ -113,8 +104,6 @@ NB: 2.3 and 2.4 extended flags are different..."
   (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
-    (log-id3-frame "making id3-ext-header: version = ~d, size = ~d, flags = ~x"
-                   version size flags)
     (ecase version
       (3
        (setf padding (stream-read-u32 instream))
@@ -213,27 +202,21 @@ 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*)
-  (log5:with-context "id3-header-initializer"
-    (with-slots (version revision flags size ext-header frames v21-tag-header) me
-      (stream-seek instream 128 :end)
-      (when (string= "TAG" (stream-read-string-with-len instream 3))
-        (log-id3-frame "looking at last 128 bytes at ~:d to try to read id3v21 header" (stream-here instream))
-        (handler-case
-            (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
-          (condition (c)
-            (utils:warn-user "initialize id3-header got condition ~a" c)
-            (log-id3-frame "reading v21 got condition: ~a" c))))
-
-      (stream-seek instream 0 :start)
-      (when (string= "ID3" (stream-read-string-with-len instream 3))
-        (setf version  (stream-read-u8 instream)
-              revision (stream-read-u8 instream)
-              flags    (stream-read-u8 instream)
-              size     (stream-read-u32 instream :bits-per-byte 7))
-        (when (header-unsynchronized-p flags)
-          (log-id3-frame "header flags indicate unsync"))
-        (assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet")
-        (log-id3-frame "id3 header = ~a" (vpprint me nil))))))
+  (with-slots (version revision flags size ext-header frames v21-tag-header) me
+    (stream-seek instream 128 :end)
+    (when (string= "TAG" (stream-read-string-with-len instream 3))
+      (handler-case
+          (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
+        (condition (c)
+          (utils:warn-user "initialize id3-header got condition ~a" c))))
+
+    (stream-seek instream 0 :start)
+    (when (string= "ID3" (stream-read-string-with-len instream 3))
+      (setf version  (stream-read-u8 instream)
+            revision (stream-read-u8 instream)
+            flags    (stream-read-u8 instream)
+            size     (stream-read-u32 instream :bits-per-byte 7))
+      (assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet"))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -257,19 +240,16 @@ 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*)
-  (log5:with-context  "get-name-value-pair"
-    (log-id3-frame "reading from ~:d, len ~:d, name-encoding = ~d, value-encoding = ~d" (stream-here instream) len name-encoding value-encoding)
-    (let* ((old-pos (stream-here instream))
-           (name (stream-read-string instream :encoding name-encoding))
-           (name-len (- (stream-here instream) old-pos))
-           (value))
+  (let* ((old-pos  (stream-here instream))
+         (name     (stream-read-string instream :encoding name-encoding))
+         (name-len (- (stream-here instream) old-pos))
+         (value))
 
-      (log-id3-frame "name = <~a>, name-len = ~d" name name-len)
-      (setf value (if (>= value-encoding 0)
-                      (stream-read-string-with-len instream (- len name-len) :encoding value-encoding)
-                      (stream-read-sequence instream (- len name-len)))) ; if < 0, then just read as octets
+    (setf value (if (>= value-encoding 0)
+                    (stream-read-string-with-len instream (- len name-len) :encoding value-encoding)
+                    (stream-read-sequence instream (- len name-len)))) ; if < 0, then just read as octets
 
-      (values name value))))
+    (values name value)))
 
 (defclass id3-frame ()
   ((pos     :accessor pos     :initarg :pos                 :documentation "the offset in the buffer were this frame was found")
@@ -344,12 +324,8 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-raw) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-raw"
-    (with-slots (pos len octets) me
-      (log-id3-frame "reading ~:d bytes from position ~:d" len pos)
-      (setf octets (stream-read-sequence instream len))
-      (log-id3-frame "frame: ~a" (vpprint me nil)))))
-
+  (with-slots (pos len octets) me
+    (setf octets (stream-read-sequence instream len))))
 
 (defmethod vpprint ((me frame-raw) stream)
   (with-slots (octets) me
@@ -401,16 +377,14 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-com) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-com"
-    (with-slots (len encoding lang desc val) me
-      (setf encoding (stream-read-u8 instream)
-            lang (stream-read-iso-string-with-len instream 3))
-      (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
-        (setf desc n)
+  (with-slots (len encoding lang desc val) me
+    (setf encoding (stream-read-u8 instream)
+          lang     (stream-read-iso-string-with-len instream 3))
+    (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
+      (setf desc n)
 
-        ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
-        (setf val (upto-null v)))
-      (log-id3-frame "encoding = ~d, lang = <~a>, desc = <~a>, text = <~a>" encoding lang desc val))))
+      ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
+      (setf val (upto-null v)))))
 
 (defmethod vpprint ((me frame-com) stream)
   (with-slots (len encoding lang desc val) me
@@ -441,16 +415,13 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-pic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-pic"
-    (with-slots (id len encoding img-format type desc data) me
-      (setf encoding (stream-read-u8 instream)
-            img-format (stream-read-iso-string-with-len instream 3)
-            type (stream-read-u8 instream))
-      (multiple-value-bind (n v) (get-name-value-pair instream (- len 5) encoding -1)
-        (setf desc n
-              data v)
-        (log-id3-frame "encoding: ~d, img-format = <~a>, type = ~d (~a), desc = <~a>, value = ~a"
-                   encoding img-format type (get-picture-type type) desc (printable-array data))))))
+  (with-slots (id len encoding img-format type desc data) me
+    (setf encoding (stream-read-u8 instream)
+          img-format (stream-read-iso-string-with-len instream 3)
+          type (stream-read-u8 instream))
+    (multiple-value-bind (n v) (get-name-value-pair instream (- len 5) encoding -1)
+      (setf desc n
+            data v))))
 
 (defmethod vpprint ((me frame-pic) stream)
   (with-slots (encoding img-format type desc data) me
@@ -473,25 +444,21 @@ 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*)
-  (log5:with-context "frame-text-info"
-    (with-slots (version flags len encoding info) me
-      (let ((read-len len))
-
-        ;; In version 4 frames, each frame may also have an unsync flag.  since we have unsynced already
-        ;; the only thing we need to do here is check for the optional DATALEN field.  If it is present
-        ;; then it has the actual number of octets to read
-        (when (and (= version 4) (frame-24-unsynch-p flags))
-          (if (frame-24-datalen-p flags)
-              (setf read-len (stream-read-u32 instream :bits-per-byte 7))))
+  (with-slots (version flags len encoding info) me
+    (let ((read-len len))
 
-        (setf encoding (stream-read-u8 instream)
-              info     (stream-read-string-with-len instream (1- read-len) :encoding encoding)))
+      ;; In version 4 frames, each frame may also have an unsync flag.  since we have unsynced already
+      ;; the only thing we need to do here is check for the optional DATALEN field.  If it is present
+      ;; then it has the actual number of octets to read
+      (when (and (= version 4) (frame-24-unsynch-p flags))
+        (if (frame-24-datalen-p flags)
+            (setf read-len (stream-read-u32 instream :bits-per-byte 7))))
 
-      ;; A null is ok, but according to the "spec", you're supposed to ignore anything after a 'Null'
-      (log-id3-frame "made text-info-frame: ~a" (vpprint me nil))
-      (setf info (upto-null info))
+      (setf encoding (stream-read-u8 instream)
+            info     (stream-read-string-with-len instream (1- read-len) :encoding encoding)))
 
-      (log-id3-frame "encoding = ~d, info = <~a>" encoding info))))
+    ;; A null is ok, but according to the "spec", you're supposed to ignore anything after a 'Null'
+    (setf info (upto-null info))))
 
 (defmethod vpprint ((me frame-text-info) stream)
   (with-slots (len encoding info) me
@@ -546,13 +513,11 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-txx) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-txx"
-    (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)
-        (setf desc n
-              val v)
-        (log-id3-frame "encoding = ~d, desc = <~a>, val = <~a>" encoding desc val)))))
+  (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)
+      (setf desc n
+            val v))))
 
 (defmethod vpprint ((me frame-txx) stream)
   (with-slots (len encoding desc val) me
@@ -568,12 +533,10 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-ufi) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-ufi"
-    (with-slots (id len name value) me
-      (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
-        (setf name n
-              value v))
-      (log-id3-frame "name = <~a>, value = ~a" name (printable-array value)))))
+  (with-slots (id len name value) me
+    (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
+      (setf name n
+            value v))))
 
 (defmethod vpprint ((me frame-ufi) stream)
   (with-slots (id len name value) me
@@ -708,15 +671,13 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-apic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-apic"
-    (with-slots (id len encoding mime type desc data) me
-      (setf encoding (stream-read-u8 instream)
-            mime     (stream-read-iso-string instream)
-            type     (stream-read-u8 instream))
-      (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 (length mime) 1 1) encoding -1)
-        (setf desc n
-              data v)
-        (log-id3-frame "enoding = ~d, mime = <~a>, type = ~d (~a), desc = <~a>, data = ~a" encoding mime type (get-picture-type type) desc (printable-array data))))))
+  (with-slots (id len encoding mime type desc data) me
+    (setf encoding (stream-read-u8 instream)
+          mime     (stream-read-iso-string instream)
+          type     (stream-read-u8 instream))
+    (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 (length mime) 1 1) encoding -1)
+      (setf desc n
+            data v))))
 
 (defmethod vpprint ((me frame-apic) stream)
   (with-slots (encoding mime type desc data) me
@@ -743,16 +704,14 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-comm) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-comm"
-    (with-slots (encoding lang len desc val) me
-      (setf encoding (stream-read-u8 instream)
-            lang     (stream-read-iso-string-with-len instream 3))
-      (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
-        (setf desc n)
+  (with-slots (encoding lang len desc val) me
+    (setf encoding (stream-read-u8 instream)
+          lang     (stream-read-iso-string-with-len instream 3))
+    (multiple-value-bind (n v) (get-name-value-pair instream (- len 1 3) encoding encoding)
+      (setf desc n)
 
-        ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
-        (setf val (upto-null v)))
-      (log-id3-frame "encoding = ~d, lang = <~a>, desc = <~a>, val = <~a>" encoding lang desc val))))
+      ;; iTunes broken-ness... for frame-coms, there can be an additional null or two at the end
+      (setf val (upto-null v)))))
 
 (defmethod vpprint ((me frame-comm) stream)
   (with-slots (encoding lang desc val) me
@@ -771,11 +730,9 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-pcnt) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-pcnt"
-    (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...
-      (log-id3-frame "play count = <~d>" play-count))))
+  (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...
 
 (defmethod vpprint ((me frame-pcnt) stream)
   (with-slots (play-count) me
@@ -792,12 +749,10 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-priv) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-priv"
-    (with-slots (id len name value) me
-      (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
-        (setf name n
-              value v)
-        (log-id3-frame "name = <~a>, value = <~a>" name value)))))
+  (with-slots (id len name value) me
+    (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
+      (setf name n
+            value v))))
 
 (defmethod vpprint ((me frame-priv) stream)
   (with-slots (id len name value) me
@@ -816,16 +771,14 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-txxx) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-txxx"
-    (with-slots (encoding len desc val) me
-      (setf encoding (stream-read-u8 instream))
-      (multiple-value-bind (n v) (get-name-value-pair instream
-                                                      (- len 1)
-                                                      encoding
-                                                      encoding)
-        (setf desc n
-              val v))
-      (log-id3-frame "encoding = ~d, desc = <~a>, value = <~a>" encoding desc val))))
+  (with-slots (encoding len desc val) me
+    (setf encoding (stream-read-u8 instream))
+    (multiple-value-bind (n v) (get-name-value-pair instream
+                                                    (- len 1)
+                                                    encoding
+                                                    encoding)
+      (setf desc n
+            val v))))
 
 (defmethod vpprint ((me frame-txxx) stream)
   (format stream "frame-txxx: ~a, <~a/~a>" (vpprint-frame-header me) (desc me) (val me)))
@@ -841,12 +794,10 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me frame-ufid) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "frame-ufid"
-    (with-slots (id len name value) me
-      (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
-        (setf name n
-              value v))
-      (log-id3-frame "name = <~a>, value = ~a" name (printable-array value)))))
+  (with-slots (id len name value) me
+    (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
+      (setf name n
+            value v))))
 
 (defmethod vpprint ((me frame-ufid) stream)
   (with-slots (id len name value) me
@@ -862,9 +813,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
-    (log5:with-context "url"
-      (setf url (stream-read-iso-string-with-len instream len))
-      (log-id3-frame "url = <~a>" url))))
+    (setf url (stream-read-iso-string-with-len instream len))))
 
 (defmethod vpprint ((me frame-url-link) stream)
   (with-slots (url) me
@@ -909,128 +858,102 @@ 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*)
-  (log5:with-context "find-frame-class"
-    (log-id3-frame "looking for class <~a>" id)
-    (let ((found-class-symbol (find-symbol (mk-frame-class-name id) :ID3-FRAME))
-          found-class)
-
-      ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
-      (when found-class-symbol
-        (setf found-class (find-class found-class-symbol))
-        (log-id3-frame "found class: ~a" found-class)
-        (return-from find-frame-class found-class))
-
-      (log-id3-frame "didn't find class, checking general cases")
-
-      ;; if not a "normal" frame-id, look at general cases of
-      ;; starting with a 'T' or a 'W'
-      (setf found-class (case (aref id 0)
-                          (#\T (log-id3-frame "assuming text-info") (find-class (find-symbol "FRAME-TEXT-INFO" :ID3-FRAME)))
-                          (#\W (log-id3-frame "assuming url-link")  (find-class (find-symbol "FRAME-URL-LINK"  :ID3-FRAME)))
-                          (t
-                           ;; we don't recognize the frame name.  if it could possibly be a real frame name,
-                           ;; then just read it raw
-                           (when (possibly-valid-frame-id? id)
-                             (log-id3-frame "just reading raw")
-                             (find-class (find-symbol "FRAME-RAW" :ID3-FRAME))))))
-
-      (log-id3-frame "general case for id <~a> is ~a" id found-class)
-      found-class)))
+  (let ((found-class-symbol (find-symbol (mk-frame-class-name id) :ID3-FRAME))
+        found-class)
+
+    ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
+    (when found-class-symbol
+      (setf found-class (find-class found-class-symbol))
+      (return-from find-frame-class found-class))
+
+    ;; if not a "normal" frame-id, look at general cases of
+    ;; starting with a 'T' or a 'W'
+    (setf found-class (case (aref id 0)
+                        (#\T (find-class (find-symbol "FRAME-TEXT-INFO" :ID3-FRAME)))
+                        (#\W (find-class (find-symbol "FRAME-URL-LINK"  :ID3-FRAME)))
+                        (t
+                         ;; we don't recognize the frame name.  if it could possibly be a real frame name,
+                         ;; then just read it raw
+                         (when (possibly-valid-frame-id? id)
+                           (find-class (find-symbol "FRAME-RAW" :ID3-FRAME))))))
+
+    found-class))
+
 (utils:memoize 'find-frame-class)
 
 (defun make-frame (version instream fn)
   "Create an appropriate mp3 frame by reading data from INSTREAM."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "make-frame"
-    (let* ((pos (stream-here instream))
-           (byte (stream-read-u8 instream))
-           frame-name frame-len frame-flags frame-class)
+  (let* ((pos  (stream-here instream))
+         (byte (stream-read-u8 instream))
+         frame-name frame-len frame-flags frame-class)
 
-      (log-id3-frame "reading from position ~:d (size of stream = ~:d)" pos (stream-size instream))
+    (when (zerop byte) ; XXX should this be correlated to PADDING in the extended header???
+      (return-from make-frame nil))     ; hit padding
 
-      (when (zerop byte)                ; XXX should this be correlated to PADDING in the extended header???
-        (log-id3-frame "hit padding of size ~:d while making a frame" (- (stream-size instream) pos))
-        (return-from make-frame nil))   ; hit padding
+    (setf frame-name
+          (concatenate 'string (string (code-char byte)) (stream-read-string-with-len instream (ecase version (2 2) (3 3) (4 3)))))
 
-      (setf frame-name
-            (concatenate 'string (string (code-char byte)) (stream-read-string-with-len instream (ecase version (2 2) (3 3) (4 3)))))
+    (setf frame-len (ecase version
+                      (2 (stream-read-u24 instream))
+                      (3 (stream-read-u32 instream))
+                      (4 (stream-read-u32 instream :bits-per-byte 7))))
 
-      (setf frame-len (ecase version
-                        (2 (stream-read-u24 instream))
-                        (3 (stream-read-u32 instream))
-                        (4 (stream-read-u32 instream :bits-per-byte 7))))
+    (when (or (= version 3) (= version 4))
+      (setf frame-flags (stream-read-u16 instream))
+      (when (not (valid-frame-flags version frame-flags))
+        (warn-user "Invalid frame flags found in ~a: ~a, will ignore" fn (print-frame-flags version frame-flags nil))))
 
-      (when (or (= version 3) (= version 4))
-        (setf frame-flags (stream-read-u16 instream))
-        (when (not (valid-frame-flags version frame-flags))
-          (log-id3-frame "Invalid frame flags found ~a, will ignore" (print-frame-flags version frame-flags nil))
-          (warn-user "Invalid frame flags found in ~a: ~a, will ignore" fn (print-frame-flags version frame-flags nil))))
+    (setf frame-class (find-frame-class frame-name))
 
-      (log-id3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~a"
-                     frame-name version frame-len
-                     (print-frame-flags version frame-flags nil))
-      (setf frame-class (find-frame-class frame-name))
+    ;; edge case where found a frame name, but it is not valid or where making this frame
+    ;; would blow past the end of the file/buffer
+    (when (or (> (+ (stream-here instream) frame-len) (stream-size instream))
+              (null frame-class))
+      (error "bad frame at position ~d found: ~a" pos frame-name))
 
-      ;; edge case where found a frame name, but it is not valid or where making this frame
-      ;; would blow past the end of the file/buffer
-      (when (or (> (+ (stream-here instream) frame-len) (stream-size instream))
-                (null frame-class))
-        (error "bad frame at position ~d found: ~a" pos frame-name))
-
-      (make-instance frame-class :pos pos :version version :id frame-name :len frame-len :flags frame-flags :instream instream))))
+    (make-instance frame-class :pos pos :version version :id frame-name :len frame-len :flags frame-flags :instream instream)))
 
 (defmethod find-id3-frames ((mp3-file mp3-file-stream))
   "With an open mp3-file, make sure it is in fact an MP3 file, then read its header and frames"
-
   (declare #.utils:*standard-optimize-settings*)
   (labels ((read-loop (version stream)
-             (log5:with-context "read-loop-in-find-id3-frames"
-               (log-id3-frame "Starting loop through ~:d bytes" (stream-size stream))
-               (let (frames this-frame)
-                 (do ()
-                     ((>= (stream-here stream) (stream-size stream)))
-                   (handler-case
-                       (progn
-                         (setf this-frame (make-frame version stream (stream-filename mp3-file)))
-                         (when (null this-frame)
-                           (log-id3-frame "hit padding: returning ~d frames" (length frames))
-                           (return-from read-loop (values t (nreverse frames))))
-
-                         (log-id3-frame "bottom of read-loop: pos = ~:d, size = ~:d" (stream-here stream) (stream-size stream))
-                         (push this-frame frames))
-                     (condition (c)
-                       (utils:warn-user "find-id3-frame got condition ~a" c)
-                       (log-id3-frame "got condition ~a when making frame" c)
-                       (return-from read-loop (values nil (nreverse frames))))))
-
-                 (log-id3-frame "Succesful read: returning ~d frames" (length frames))
-                 (values t (nreverse frames)))))) ; reverse this so we have frames in "file order"
-
-    (log5:with-context "find-id3-frames"
-      (log-id3-frame "~a is a valid mp3 file" (stream-filename mp3-file))
-
-      (setf (id3-header mp3-file) (make-instance 'id3-header :instream mp3-file))
-      (with-slots (size ext-header frames flags version) (id3-header mp3-file)
-
-        ;; At this point, we switch from reading the file stream and create a memory stream
-        ;; rationale: it may need to be unsysnc'ed and it helps prevent run-away reads with
-        ;; mis-formed frames
-        (when (not (zerop size))
-          (let ((mem-stream (make-mem-stream (stream-read-sequence mp3-file size
-                                                                   :bits-per-byte (if (header-unsynchronized-p flags) 7 8)))))
-
-            ;; Must make extended header here since it is subject to unsynchronization.
-            (when (header-extended-p flags)
-              (setf ext-header (make-instance 'id3-ext-header :instream mem-stream :version version)))
-            (log-id3-frame "Complete header: ~a" (vpprint (id3-header mp3-file) nil))
-
-            ;; Start reading frames from memory stream
-            (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
-              (if (not _ok)
-                  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
-              (log-id3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
-              (setf frames _frames)
-              _ok)))))))
+             (let (frames this-frame)
+               (do ()
+                   ((>= (stream-here stream) (stream-size stream)))
+                 (handler-case
+                     (progn
+                       (setf this-frame (make-frame version stream (stream-filename mp3-file)))
+                       (when (null this-frame)
+                         (return-from read-loop (values t (nreverse frames))))
+
+                       (push this-frame frames))
+                   (condition (c)
+                     (utils:warn-user "find-id3-frame got condition ~a" c)
+                     (return-from read-loop (values nil (nreverse frames))))))
+
+               (values t (nreverse frames))))) ; reverse this so we have frames in "file order"
+
+    (setf (id3-header mp3-file) (make-instance 'id3-header :instream mp3-file))
+    (with-slots (size ext-header frames flags version) (id3-header mp3-file)
+
+      ;; At this point, we switch from reading the file stream and create a memory stream
+      ;; rationale: it may need to be unsysnc'ed and it helps prevent run-away reads with
+      ;; mis-formed frames
+      (when (not (zerop size))
+        (let ((mem-stream (make-mem-stream (stream-read-sequence mp3-file size
+                                                                 :bits-per-byte (if (header-unsynchronized-p flags) 7 8)))))
+
+          ;; Must make extended header here since it is subject to unsynchronization.
+          (when (header-extended-p flags)
+            (setf ext-header (make-instance 'id3-ext-header :instream mem-stream :version version)))
+
+          ;; Start reading frames from memory stream
+          (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
+            (if (not _ok)
+                (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
+            (setf frames _frames)
+            _ok))))))
 
 (defun map-id3-frames (mp3-file &key (func (constantly t)))
   "Iterates through the ID3 frames found in an MP3 file"

logging.lisp

@@ -1,37 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: LOGGING; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-
-(in-package #:logging)
-
-(defmacro start-logging ((name spec) &body body)
-  `(unwind-protect
-        (progn
-          (log5:start-sender 'trace-log
-              (log5:stream-sender :location ,name)
-              :category-spec ,spec
-              :output-spec '(log5:message log5:context))
-          ,@body)
-     (log5:stop-sender 'trace-log)))
-
-(defun stop-logging ()
-  (log5:stop-sender 'trace-log))
-
-(defparameter *logging-categories* '(mp4-atom::cat-log-mp4-atom
-                                     audio-streams::cat-log-stream
-                                     mpeg::cat-log-mpeg-frame
-                                     flac-frame::cat-log-flac-frame
-                                     id3-frame::cat-log-id3-frame))
-
-(defmacro with-logging ((&optional file &key (categories *logging-categories*)) &body body)
-  (with-gensyms (output-stream)
-    `(let (,output-stream)
-       (unwind-protect
-            (setf ,output-stream (if ,file
-                                     (open ,file :direction :output :if-exists :supersede :if-does-not-exist :create)
-                                     *standard-output*))
-            (log5:start-sender 'trace-log (log5:stream-sender :location ,output-stream)
-                               :category-spec ',categories
-                               :output-spec '(log5:message log5:context))
-            ,@body)
-       (if ,file (close ,output-stream))
-       (log5:stop-sender 'trace-log))))

mp4-atom.lisp

@@ -2,9 +2,6 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:mp4-atom)
 
-(log5:defcategory cat-log-mp4-atom)
-(defmacro log-mp4-atom (&rest log-stuff) `(log5:log-for (cat-log-mp4-atom) ,@log-stuff))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; A word about atoms (aka "boxes").  There are three kinds of atoms: ones that are containers, ones
@@ -119,16 +116,12 @@ string representation"
 
 (defmethod initialize-instance :around ((me mp4-atom) &key &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "AROUND:mp4-container-atom-initilalizer"
-    (let* ((old *in-progress*)
-           (*in-progress* (tree:make-node me)))
-      ;(log-mp4-atom "AROUND: entering with old: ~a me: ~a" old me)
-      (if old
-          (progn
-            ;(log-mp4-atom "Adding child ~a to ~a" *in-progress* old)
-            (tree:add-child old *in-progress*))
-          (setf *tree* *in-progress*))
-      (call-next-method))))
+  (let* ((old *in-progress*)
+         (*in-progress* (tree:make-node me)))
+    (if old
+        (tree:add-child old *in-progress*)
+        (setf *tree* *in-progress*))
+    (call-next-method)))
 
 (defmacro with-mp4-atom-slots ((instance) &body body)
   `(with-slots (atom-file-pos atom-size atom-type) ,instance
@@ -141,36 +134,28 @@ string representation"
   "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*)
-  (log5:with-context "atom-skip-initilalizer"
-    (with-mp4-atom-slots (me)
-      (log-mp4-atom "skipping atom of type: ~a" (as-string atom-type))
-      (stream-seek mp4-file (- atom-size 8) :current))))
+  (with-mp4-atom-slots (me)
+    (stream-seek mp4-file (- atom-size 8) :current)))
 
 (defclass mp4-container-atom (mp4-atom) ())
 
 (defmethod initialize-instance :after ((me mp4-container-atom) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "mp4-container-atom-initilalizer"
-    (log-mp4-atom "entering with file at pos ~:d, me: ~a"
-                  (stream-here mp4-file) me)
-    (with-mp4-atom-slots (me)
-      (loop for end = (+ atom-file-pos atom-size)
-            for current = (stream-here mp4-file) then (stream-here mp4-file)
-            while (< current end) do
-              (make-mp4-atom mp4-file me)))))
+  (with-mp4-atom-slots (me)
+    (loop for end = (+ atom-file-pos atom-size)
+          for current = (stream-here mp4-file) then (stream-here mp4-file)
+          while (< current end) do
+            (make-mp4-atom mp4-file me))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ILST ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defclass atom-ilst (mp4-container-atom) ())
 
-(defmethod initialize-instance :around ((me atom-ilst) &key mp4-file  &allow-other-keys)
-  "Construct an ilst atom.  ILST atoms are containers that hold data elements related to tagging.
-Loop through this container and construct constituent atoms"
-  (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "atom-ilst-initializer"
-    (with-mp4-atom-slots (me)
-      (log-mp4-atom "atom-ilst-init: found ilst atom <~a> @ ~:d, looping for ~:d bytes"
-                    (as-string atom-type) (stream-here mp4-file) (- atom-size 8)))
-    (call-next-method)))
+;; (defmethod initialize-instance :around ((me atom-ilst) &key mp4-file  &allow-other-keys)
+;;   "Construct an ilst atom.  ILST atoms are containers that hold data elements related to tagging.
+;; Loop through this container and construct constituent atoms"
+;;   (declare #.utils:*standard-optimize-settings*)
+;;   (with-mp4-atom-slots (me)
+;;     (call-next-method)))
 
 (defclass atom-©alb (atom-ilst) ())
 (defclass atom-aART (atom-ilst) ())
@@ -203,39 +188,35 @@ Loop through this container and construct constituent atoms"
 
 (defmethod initialize-instance :after ((me atom-data) &key mp4-file parent &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "atom-data-initializer"
-    (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))
-      (assert (= 0 (stream-read-u32 mp4-file)) ()
-              "a data atom lacks the required null field")
-      (log-mp4-atom "atom-data-init: size = ~:d, name = ~a, version = ~d, flags = ~x"
-                    atom-size (as-string atom-type) atom-version atom-flags)
-      (setf atom-value
-            (cond ((member (atom-type parent)
-                           (list +itunes-album+ +itunes-album-artist+ +itunes-artist+
-                                 +itunes-comment+ +itunes-composer+ +itunes-copyright+
-                                 +itunes-year+ +itunes-encoder+ +itunes-groups+
-                                 +itunes-genre-x+ +itunes-lyrics+ +itunes-purchased-date+
-                                 +itunes-title+ +itunes-tool+ +itunes-writer+))
-                   (stream-read-utf-8-string-with-len mp4-file (- (atom-size me) 16)))
-                  ((member (atom-type parent)
-                           (list +itunes-track+
-                                 +itunes-track-n+
-                                 +itunes-disk+))
-                   (stream-read-u16 mp4-file) ; throw away
-                   (let* ((a (stream-read-u16 mp4-file))
-                          (b (stream-read-u16 mp4-file)))
-                     (stream-seek mp4-file (- (atom-size me) 16 6) :current)
-                     (list a b)))
-                  ((member (atom-type parent)
-                           (list +itunes-tempo+ +itunes-genre+))
-                   (stream-read-u16 mp4-file))
-              ((= (atom-type parent) +itunes-compilation+)
-               (stream-read-u8 mp4-file))
-              ((= (atom-type parent) +itunes-cover-art+)
-               (stream-read-sequence mp4-file (- (atom-size me) 16)))))
-      (log-mp4-atom "atom-data-init: made an ilst atom-data: ~a" (vpprint me nil)))))
+  (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))
+    (assert (= 0 (stream-read-u32 mp4-file)) ()
+            "a data atom lacks the required null field")
+    (setf atom-value
+          (cond ((member (atom-type parent)
+                         (list +itunes-album+ +itunes-album-artist+ +itunes-artist+
+                               +itunes-comment+ +itunes-composer+ +itunes-copyright+
+                               +itunes-year+ +itunes-encoder+ +itunes-groups+
+                               +itunes-genre-x+ +itunes-lyrics+ +itunes-purchased-date+
+                               +itunes-title+ +itunes-tool+ +itunes-writer+))
+                 (stream-read-utf-8-string-with-len mp4-file (- (atom-size me) 16)))
+                ((member (atom-type parent)
+                         (list +itunes-track+
+                               +itunes-track-n+
+                               +itunes-disk+))
+                 (stream-read-u16 mp4-file) ; throw away
+                 (let* ((a (stream-read-u16 mp4-file))
+                        (b (stream-read-u16 mp4-file)))
+                   (stream-seek mp4-file (- (atom-size me) 16 6) :current)
+                   (list a b)))
+                ((member (atom-type parent)
+                         (list +itunes-tempo+ +itunes-genre+))
+                 (stream-read-u16 mp4-file))
+                ((= (atom-type parent) +itunes-compilation+)
+                 (stream-read-u8 mp4-file))
+                ((= (atom-type parent) +itunes-cover-art+)
+                 (stream-read-sequence mp4-file (- (atom-size me) 16)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; AUDIO PROPERTY ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defclass atom-trak (mp4-container-atom) ())
@@ -367,12 +348,10 @@ Loop through this container and construct constituent atoms"
 
 (defmethod initialize-instance :after ((me atom-stsd) &key mp4-file &allow-other-keys)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "atom-stsd"
-    (with-slots (flags version num-entries) me
-      (setf version (stream-read-u8 mp4-file)
-            flags   (stream-read-u24 mp4-file)
-            num-entries (stream-read-u32 mp4-file))
-      (log-mp4-atom "atom-stsd: version = ~d, flags = ~x, num-fields = ~d" version flags num-entries))))
+  (with-slots (flags version num-entries) me
+    (setf version     (stream-read-u8 mp4-file)
+          flags       (stream-read-u24 mp4-file)
+          num-entries (stream-read-u32 mp4-file))))
 
 (defclass atom-mp4a (mp4-container-atom)
   ((reserved    :accessor reserved)    ; 6 bytes
@@ -390,18 +369,17 @@ Loop through this container and construct constituent atoms"
   "Note: this MUST be an AROUND method so that the atom's data can be read in before
 reading the container atoms"
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "atom-mp4a"
-    (with-slots (reserved d-ref-idx version revision vendor num-chans samp-size comp-id packet-size samp-rate) me
-      (setf reserved    (stream-read-sequence mp4-file 6)
-            d-ref-idx   (stream-read-u16 mp4-file)
-            version     (stream-read-u16 mp4-file)
-            revision    (stream-read-u16 mp4-file)
-            vendor      (stream-read-u32 mp4-file)
-            num-chans   (stream-read-u16 mp4-file)
-            samp-size   (stream-read-u16 mp4-file)
-            comp-id     (stream-read-u16 mp4-file)
-            packet-size (stream-read-u16 mp4-file)
-            samp-rate   (stream-read-u32 mp4-file)))) ; fixed 16.16 floating point number
+  (with-slots (reserved d-ref-idx version revision vendor num-chans samp-size comp-id packet-size samp-rate) me
+    (setf reserved    (stream-read-sequence mp4-file 6)
+          d-ref-idx   (stream-read-u16 mp4-file)
+          version     (stream-read-u16 mp4-file)
+          revision    (stream-read-u16 mp4-file)
+          vendor      (stream-read-u32 mp4-file)
+          num-chans   (stream-read-u16 mp4-file)
+          samp-size   (stream-read-u16 mp4-file)
+          comp-id     (stream-read-u16 mp4-file)
+          packet-size (stream-read-u16 mp4-file)
+          samp-rate   (stream-read-u32 mp4-file))) ; fixed 16.16 floating point number
   (call-next-method))
 
 (defclass atom-meta (mp4-container-atom)
@@ -418,45 +396,36 @@ reading the container atoms"
 (defun find-atom-class (id)
   "Search by concatenating 'atom-' with ID and look for that symbol in this package"
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "find-atom-class"
-    (log-mp4-atom "find-atom-class: looking for class <~a>" (as-string id))
-    (let ((found-class-symbol (find-symbol (mk-atom-class-name id) :MP4-ATOM))
-          (found-class))
+  (let ((found-class-symbol (find-symbol (mk-atom-class-name id) :MP4-ATOM)))
 
-      ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
-      (when found-class-symbol
-        (setf found-class (find-class found-class-symbol))
-        (log-mp4-atom "find-atom-class: found class: ~a" found-class)
-        (return-from find-atom-class (find-class found-class-symbol))))
+    ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
+    (when found-class-symbol
+      (return-from find-atom-class (find-class found-class-symbol)))
 
     ;; didn't find a class, so return ATOM-SKIP class
-    (log-mp4-atom "find-atom-class: class not found")
     'atom-skip))
+
 (utils:memoize 'find-atom-class)
 
 (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*)
-  (log5:with-context "make-mp4-atom"
-    (let* ((pos (stream-here mp4-file))
-           (siz (stream-read-u32 mp4-file))
-           (typ (stream-read-u32 mp4-file))
-           (atom))
-      (declare (type fixnum pos siz typ))
-
-      (log-mp4-atom "make-mp4-atom: @ pos = ~:d of size = ~:d and type = ~a" pos siz (as-string typ))
-
-      (when (= 0 siz)
-        (error "trying to make an atom ~a with size of 0 at offset ~:d in file ~a"
-               (as-string typ) pos (stream-filename mp4-file)))
-
-      (setf atom (make-instance (find-atom-class typ) :atom-size siz
-                                                      :atom-type typ
-                                                      :atom-file-pos pos
-                                                      :parent parent
-                                                      :mp4-file mp4-file))
-      (log-mp4-atom "make-mp4-atom: made ~a" (vpprint atom nil))
-      atom)))
+  (let* ((pos (stream-here mp4-file))
+         (siz (stream-read-u32 mp4-file))
+         (typ (stream-read-u32 mp4-file))
+         (atom))
+    (declare (type fixnum pos siz typ))
+
+    (when (= 0 siz)
+      (error "trying to make an atom ~a with size of 0 at offset ~:d in file ~a"
+             (as-string typ) pos (stream-filename mp4-file)))
+
+    (setf atom (make-instance (find-atom-class typ) :atom-size siz
+                                                    :atom-type typ
+                                                    :atom-file-pos pos
+                                                    :parent parent
+                                                    :mp4-file mp4-file))
+    atom))
 
 (defmethod vpprint ((me mp4-atom) stream)
   (declare #.utils:*standard-optimize-settings*)
@@ -496,21 +465,16 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 (defmethod find-mp4-atoms ((mp4-file mp4-file-stream))
   "Given a valid MP4 file MP4-FILE, look for the 'right' atoms and return them."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "find-mp4-atoms"
-
-    (stream-seek mp4-file 0 :start)
-    (setf *in-progress* nil)
-    (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
-                  (stream-filename mp4-file) (stream-here mp4-file) (stream-size mp4-file))
-
-    ;; Construct our fake "root" for our tree, which recursively reads all atoms
-    (tree:make-node (make-instance 'mp4-container-atom
-                                   :atom-type +root+
-                                   :atom-file-pos 0
-                                   :atom-size (stream-size mp4-file)
-                                   :mp4-file mp4-file))
-    (setf (mp4-atoms mp4-file) *tree*)))
-
+  (stream-seek mp4-file 0 :start)
+  (setf *in-progress* nil)
+
+  ;; Construct our fake "root" for our tree, which recursively reads all atoms
+  (tree:make-node (make-instance 'mp4-container-atom
+                                 :atom-type +root+
+                                 :atom-file-pos 0
+                                 :atom-size (stream-size mp4-file)
+                                 :mp4-file mp4-file))
+    (setf (mp4-atoms mp4-file) *tree*))
 
 (defparameter *ilst-data* (list +root+ +mp4-atom-moov+ +mp4-atom-udta+
                                 +mp4-atom-meta+ +mp4-atom-ilst+ nil

mpeg.lisp

@@ -4,9 +4,6 @@
 ;;; Parsing MPEG audio frames.  See http://www.datavoyage.com/mpgscript/mpeghdr.htm for format of a frame.
 (in-package #:mpeg)
 
-(log5:defcategory cat-log-mpeg-frame)
-(defmacro log-mpeg-frame (&rest log-stuff) `(log5:log-for (cat-log-mpeg-frame) ,@log-stuff))
-
 (defconstant +sync-word+  #x7ff "NB: this is 11 bits so as to be able to recognize V2.5")
 
 ;;; the versions
@@ -143,27 +140,22 @@
 
   (defun get-bit-rate (version layer bit-rate-index)
     (declare #.utils:*standard-optimize-settings*)
-    (log5:with-context "get-bit-rate"
-      (log-mpeg-frame "version = ~d, layer = ~d, bit-rate-index = ~d" version layer bit-rate-index)
-      (let ((row (1- bit-rate-index))
-            (col (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
-                        (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 0)
-                              ((= (the fixnum layer) (the fixnum +layer-2+)) 1)
-                              ((= (the fixnum layer) (the fixnum +layer-3+)) 2)
-                              (t nil)))
-                       ((= (the fixnum version) (the fixnum +mpeg-2+))
-                        (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 3)
-                              ((= (the fixnum layer) (the fixnum +layer-2+)) 4)
-                              ((= (the fixnum layer) (the fixnum +layer-3+)) 4)
-                              (t nil)))
-                       (t (error "don't support MPEG 2.5 yet")))))
-
-        (log-mpeg-frame "version = ~d, row = ~d, col = ~d" version row col)
-        (if (or (null col) (< row 0) (> row 14))
-            nil
-            (let ((ret (* 1000 (aref bit-array-table row col))))
-              (log-mpeg-frame "returning ~:d" ret)
-              ret))))))
+    (let ((row (1- bit-rate-index))
+          (col (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
+                      (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 0)
+                            ((= (the fixnum layer) (the fixnum +layer-2+)) 1)
+                            ((= (the fixnum layer) (the fixnum +layer-3+)) 2)
+                            (t nil)))
+                     ((= (the fixnum version) (the fixnum +mpeg-2+))
+                      (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 3)
+                            ((= (the fixnum layer) (the fixnum +layer-2+)) 4)
+                            ((= (the fixnum layer) (the fixnum +layer-3+)) 4)
+                            (t nil)))
+                     (t (error "don't support MPEG 2.5 yet")))))
+
+      (if (or (null col) (< row 0) (> row 14))
+          nil
+          (* 1000 (aref bit-array-table row col))))))
 
 (defun valid-sample-rate-index (sr-index)
   (declare #.utils:*standard-optimize-settings*)
@@ -192,32 +184,24 @@
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
   "Load an MPEG frame from current file position.  If READ-PAYLOAD is set, read in frame's content."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "load-frame"
-    (handler-case
-        (with-frame-slots (me)
-          (log-mpeg-frame "loading frame from pos ~:d" (stream-here instream))
-          (when (null hdr-u32)          ; has header already been read in?
-            (log-mpeg-frame "reading in header")
-            (setf pos (stream-here instream)
-                  hdr-u32 (stream-read-u32 instream))
-            (when (null hdr-u32)
-              (log-mpeg-frame "hit EOF")
-              (return-from load-frame nil)))
-
-          (if (parse-header me)
-              (progn
-                (log-mpeg-frame "header parsed ok")
-                (setf size (get-frame-size version layer bit-rate sample-rate padded))
-                (when read-payload
-                  (setf payload (stream-read-sequence instream (- size 4))))
-                t)
-              (progn
-                (log-mpeg-frame "header didn't parse!")
-                nil)))
-      (end-of-file (c)
-        (declare (ignore c))
-        (log-mpeg-frame "Hit EOF")
-        nil))))
+  (handler-case
+      (with-frame-slots (me)
+        (when (null hdr-u32)            ; has header already been read in?
+          (setf pos     (stream-here instream)
+                hdr-u32 (stream-read-u32 instream))
+          (when (null hdr-u32)
+            (return-from load-frame nil)))
+
+        (if (parse-header me)
+            (progn
+              (setf size (get-frame-size version layer bit-rate sample-rate padded))
+              (when read-payload
+                (setf payload (stream-read-sequence instream (- size 4))))
+              t)
+            nil))
+    (end-of-file (c)
+      (declare (ignore c))
+      nil)))
 
 (defmethod parse-header ((me frame))
   "Given a frame, verify that is a valid MPEG audio frame by examining the header.
@@ -237,60 +221,52 @@ Bit      2 (1  bit ): the original bit
 Bits   1-0 (2  bits): the emphasis"
 
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "parse-header"
-    (with-frame-slots (me)
-      ;; check sync word
-      (setf sync (get-bitfield hdr-u32 31 11))
-      (when (not (= sync +sync-word+))
-        (log-mpeg-frame "bad sync ~x/~x" sync hdr-u32)
+  (with-frame-slots (me)
+    ;; check sync word
+    (setf sync (get-bitfield hdr-u32 31 11))
+    (when (not (= sync +sync-word+))
+      (return-from parse-header nil))
+
+    ;; check version
+    (setf version (get-bitfield hdr-u32 20 2))
+    (when (not (valid-version version))
+      (return-from parse-header nil))
+
+    ;; check layer
+    (setf layer (get-bitfield hdr-u32 18 2))
+    (when (not (valid-layer layer))
+      (return-from parse-header nil))
+
+    (setf protection (get-bitfield hdr-u32 16 1)
+          samples (get-samples-per-frame version layer))
+
+    ;; check bit-rate
+    (let ((br-index (get-bitfield hdr-u32 15 4)))
+      (when (not (valid-bit-rate-index br-index))
         (return-from parse-header nil))
 
-      ;; check version
-      (setf version (get-bitfield hdr-u32 20 2))
-      (when (not (valid-version version))
-        (log-mpeg-frame "bad version ~d" version)
-        (return-from parse-header nil))
+      (setf bit-rate (get-bit-rate version layer br-index)))
 
-      ;; check layer
-      (setf layer (get-bitfield hdr-u32 18 2))
-      (when (not (valid-layer layer))
-        (log-mpeg-frame "bad layer ~d" layer)
+    ;; check sample rate
+    (let ((sr-index (get-bitfield hdr-u32 11 2)))
+      (when (not (valid-sample-rate-index sr-index))
         (return-from parse-header nil))
 
-      (setf protection (get-bitfield hdr-u32 16 1)
-            samples (get-samples-per-frame version layer))
+      (setf sample-rate (get-sample-rate version sr-index)))
 
-      ;; check bit-rate
-      (let ((br-index (get-bitfield hdr-u32 15 4)))
-        (when (not (valid-bit-rate-index br-index))
-          (log-mpeg-frame "bad bit-rate index ~d" br-index)
-          (return-from parse-header nil))
+    (setf padded         (get-bitfield hdr-u32 9 1)
+          private        (get-bitfield hdr-u32 8 1)
+          channel-mode   (get-bitfield hdr-u32 7 2)
+          mode-extension (get-bitfield hdr-u32 5 2)
+          copyright      (get-bitfield hdr-u32 3 1)
+          original       (get-bitfield hdr-u32 2 1)
+          emphasis       (get-bitfield hdr-u32 1 2))
 
-        (setf bit-rate (get-bit-rate version layer br-index)))
+    ;; check emphasis
+    (when (not (valid-emphasis emphasis))
+      (return-from parse-header nil))
 
-      ;; check sample rate
-      (let ((sr-index (get-bitfield hdr-u32 11 2)))
-        (when (not (valid-sample-rate-index sr-index))
-          (log-mpeg-frame "bad sample-rate index ~d" sr-index)
-          (return-from parse-header nil))
-
-        (setf sample-rate (get-sample-rate version sr-index)))
-
-      (setf padded (get-bitfield hdr-u32 9 1)
-            private (get-bitfield hdr-u32 8 1)
-            channel-mode (get-bitfield hdr-u32 7 2)
-            mode-extension (get-bitfield hdr-u32 5 2)
-            copyright (get-bitfield hdr-u32 3 1)
-            original (get-bitfield hdr-u32 2 1)
-            emphasis (get-bitfield hdr-u32 1 2))
-
-      ;; check emphasis
-      (when (not (valid-emphasis emphasis))
-        (log-mpeg-frame "bad emphasis ~d" emphasis)
-        (return-from parse-header nil))
-
-      (log-mpeg-frame "good parse: ~a" me)
-      t)))
+    t))
 
 (defmethod vpprint ((me frame) stream)
   (format stream "~a"
@@ -335,56 +311,42 @@ Bits   1-0 (2  bits): the emphasis"
 
 (defmethod check-vbr ((me frame) fn)
   (declare #.utils:*standard-optimize-settings*)
-  (log5::with-context "check-vbr"
-    (with-frame-slots (me)
-
-      (let ((i (get-side-info-size version channel-mode)))
-        (log-mpeg-frame "array index = ~d, payload size = ~d" i (length payload))
-        (when (>= i (length payload))
-          (return-from check-vbr nil))
-
-        (when (or (and (= (aref payload (+ i 0)) (char-code #\X))
-                       (= (aref payload (+ i 1)) (char-code #\i))
-                       (= (aref payload (+ i 2)) (char-code #\n))
-                       (= (aref payload (+ i 3)) (char-code #\g)))
-                  (and (= (aref payload (+ i 0)) (char-code #\I))
-                       (= (aref payload (+ i 1)) (char-code #\n))
-                       (= (aref payload (+ i 2)) (char-code #\f))
-                       (= (aref payload (+ i 3)) (char-code #\o))))
-
-          (log-mpeg-frame "found xing/info: ~c ~c ~c ~c"
-                      (code-char (aref payload (+ i 0)))
-                      (code-char (aref payload (+ i 1)))
-                      (code-char (aref payload (+ i 2)))
-                      (code-char (aref payload (+ i 3))))
-
-          (setf vbr (make-instance 'vbr-info))
-          (let ((v (make-mem-stream (payload me))))
-            (stream-seek v i :start)            ; seek to Xing/Info offset
-            (setf (tag vbr)   (stream-read-iso-string-with-len v 4)
-                  (flags vbr) (stream-read-u32 v))
-
-            (when (logand (flags vbr) +vbr-frames+)
-              (setf (frames vbr) (stream-read-u32 v))
-              (log-mpeg-frame "Xing frames set: read ~d" (frames vbr))
-
-              ;; some VBR files have the Xing/Info header, but it is not correctly formulated.
-              ;; just warn the user.
-              (when (zerop (frames vbr))
-                (warn-user "file ~a Xing/Info header flags has FRAMES set, but field is zero." fn)))
-
-            (when (logand (flags vbr) +vbr-bytes+)
-              (setf (bytes vbr) (stream-read-u32 v))
-              (log-mpeg-frame "Xing bytes set: read ~d" (bytes vbr)))
-
-            (when (logand (flags vbr) +vbr-tocs+)
-              (setf (tocs vbr) (stream-read-sequence v 100))
-              (log-mpeg-frame "Xing tocs set: read ~a" (tocs vbr)))
-
-            (when (logand (flags vbr) +vbr-scale+)
-              (setf (scale vbr) (stream-read-u32 v))
-              (log-mpeg-frame "Xing scale set: read ~d" (scale vbr)))
-            (log-mpeg-frame "vbr-info = ~a" (vpprint vbr nil))))))))
+  (with-frame-slots (me)
+    (let ((i (get-side-info-size version channel-mode)))
+      (when (>= i (length payload))
+        (return-from check-vbr nil))
+
+      (when (or (and (= (aref payload (+ i 0)) (char-code #\X))
+                     (= (aref payload (+ i 1)) (char-code #\i))
+                     (= (aref payload (+ i 2)) (char-code #\n))
+                     (= (aref payload (+ i 3)) (char-code #\g)))
+                (and (= (aref payload (+ i 0)) (char-code #\I))
+                     (= (aref payload (+ i 1)) (char-code #\n))
+                     (= (aref payload (+ i 2)) (char-code #\f))
+                     (= (aref payload (+ i 3)) (char-code #\o))))
+
+        (setf vbr (make-instance 'vbr-info))
+        (let ((v (make-mem-stream (payload me))))
+          (stream-seek v i :start)      ; seek to Xing/Info offset
+          (setf (tag vbr)   (stream-read-iso-string-with-len v 4)
+                (flags vbr) (stream-read-u32 v))
+
+          (when (logand (flags vbr) +vbr-frames+)
+            (setf (frames vbr) (stream-read-u32 v))
+
+            ;; some VBR files have the Xing/Info header, but it is not correctly formulated.
+            ;; just warn the user.
+            (when (zerop (frames vbr))
+              (warn-user "file ~a Xing/Info header flags has FRAMES set, but field is zero." fn)))
+
+          (when (logand (flags vbr) +vbr-bytes+)
+            (setf (bytes vbr) (stream-read-u32 v)))
+
+          (when (logand (flags vbr) +vbr-tocs+)
+            (setf (tocs vbr) (stream-read-sequence v 100)))
+
+          (when (logand (flags vbr) +vbr-scale+)
+            (setf (scale vbr) (stream-read-u32 v))))))))
 
 (defmethod vpprint ((me vbr-info) stream)
   (with-vbr-info-slots (me)
@@ -393,71 +355,53 @@ Bits   1-0 (2  bits): the emphasis"
 
 (defun find-first-sync (in)
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "find-first-sync"
-
-    (log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-here in))
-    (let ((hdr-u32)
-          (count 0)
-          (pos))
-
-      (handler-case
-          (loop
-            (setf pos (stream-here in)
-                  hdr-u32 (stream-read-u32 in))
-            (when (null hdr-u32)
-              (return-from find-first-sync nil))
-            (incf count)
-
-            (when (= (logand hdr-u32 #xffe00000) #xffe00000) ; magic number is potential sync frame header
-              (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos hdr-u32)
-              (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
-                (if (load-frame hdr :instream in :read-payload t)
-                    (progn
-                      (check-vbr hdr (stream-filename in))
-                      (log-mpeg-frame "Valid header being returned: ~a, searched ~:d times" hdr count)
-                      (return-from find-first-sync hdr))
-                    (progn
-                      (log-mpeg-frame "hdr wasn't valid: ~a" hdr))))))
-        (condition (c) (progn
-                         (warn-user "Condtion <~a> signaled while looking for first sync" c)
-                         (log-mpeg-frame "got a condition while looking for first sync: ~a" c)
-                         (error c))))
-      nil)))
+  (let ((hdr-u32)
+        (count 0)
+        (pos))
 
+    (handler-case
+        (loop
+          (setf pos     (stream-here in)
+                hdr-u32 (stream-read-u32 in))
+          (when (null hdr-u32)
+            (return-from find-first-sync nil))
+          (incf count)
+
+          (when (= (logand hdr-u32 #xffe00000) #xffe00000) ; magic number is potential sync frame header
+            (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
+              (if (load-frame hdr :instream in :read-payload t)
+                  (progn
+                    (check-vbr hdr (stream-filename in))
+                    (return-from find-first-sync hdr))))))
+      (condition (c) (progn
+                       (warn-user "Condtion <~a> signaled while looking for first sync" c)
+                       (error c))))
+    nil))
 (defmethod next-frame ((me frame) &key instream read-payload)
   "Get next frame.  If READ-PAYLOAD is true, read in contents for frame, else, seek to next frame header."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "next-frame"
-    (let ((nxt-frame (make-instance 'frame)))
-      (when (not (payload me))
-        (log-mpeg-frame "no payload load required in current frame, skipping from ~:d forward ~:d bytes"
-                        (stream-here instream)
-                        (- (size me) 4) :current)
-        (stream-seek instream (- (size me) 4) :current))
-
-      (log-mpeg-frame "at pos ~:d, read-payload is ~a" (stream-here instream) read-payload)
-      (if (load-frame nxt-frame :instream instream :read-payload read-payload)
-          nxt-frame
-          nil))))
+  (let ((nxt-frame (make-instance 'frame)))
+    (when (not (payload me))
+      (stream-seek instream (- (size me) 4) :current))
+
+    (if (load-frame nxt-frame :instream instream :read-payload read-payload)
+        nxt-frame
+        nil)))
 
 (defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
 
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
   "Loop through the MPEG audio frames in a file.  If *MAX-FRAMES-TO-READ* is set, return after reading that many frames."
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "map-frames"
-    (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
-
-    (when start-pos
-      (stream-seek in start-pos :start))
+  (when start-pos
+    (stream-seek in start-pos :start))
 
     (loop
       for max-frames = (if max max *max-frames-to-read*)
       for count = 0 then (incf count)
       for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
       while (and frame (< count max-frames)) do
-        (log-mpeg-frame "map-frames: at pos ~:d, dispatching function" (pos frame))
-        (funcall func frame))))
+        (funcall func frame)))
 
 (defclass mpeg-audio-info ()
   ((is-vbr      :accessor is-vbr      :initarg :is-vbr      :initform nil)
@@ -482,72 +426,63 @@ Bits   1-0 (2  bits): the emphasis"
 (defun calc-bit-rate-exhaustive (in start info)
   "Map every MPEG frame in IN and calculate the bit-rate"
   (declare #.utils:*standard-optimize-settings*)
-  (log5:with-context "calc-bit-rate-exhaustive"
-    (let ((total-len 0)
-          (last-bit-rate nil)
-          (bit-rate-total 0)
-          (vbr nil))
-      (log-mpeg-frame "broken Xing/Info header found, reading all frames")
-      (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) info
-        (map-frames in (lambda (f)
-                         (incf n-frames)
-                         (incf total-len (float (/ (samples f) (sample-rate f))))
-                         (incf bit-rate-total (bit-rate f))
-                         (if (null last-bit-rate)
-                             (setf last-bit-rate (bit-rate f))
-                             (progn
-                               (when (not (= last-bit-rate (bit-rate f)))
-                                 (setf vbr t))
-                               (setf last-bit-rate (bit-rate f)))))
-                    :read-payload nil :start-pos start)
-
-        (log-mpeg-frame "finished mapping. read ~:d frames" n-frames)
-
-        (when (or (< n-frames 10) (zerop bit-rate-total))
-          (log-mpeg-frame "couldn't get audio-info: only got ~d frames" n-frames)
-          (return-from calc-bit-rate-exhaustive))
-
-        (setf is-vbr t
-              len total-len
-              bit-rate (float (/ bit-rate-total n-frames)))
-        (log-mpeg-frame "len = ~:d, bit-rate = ~f" len bit-rate)))))
-
- (defun get-mpeg-audio-info (in &key) ;; (max-frames *max-frames-to-read*))
-   "Get MPEG Layer 3 audio information.
+  (let ((total-len      0)
+        (last-bit-rate  nil)
+        (bit-rate-total 0)
+        (vbr            nil))
+    (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) info
+      (map-frames in (lambda (f)
+                       (incf n-frames)
+                       (incf total-len (float (/ (samples f) (sample-rate f))))
+                       (incf bit-rate-total (bit-rate f))
+                       (if (null last-bit-rate)
+                           (setf last-bit-rate (bit-rate f))
+                           (progn
+                             (when (not (= last-bit-rate (bit-rate f)))
+                               (setf vbr t))
+                             (setf last-bit-rate (bit-rate f)))))
+                  :read-payload nil :start-pos start)
+
+      (when (or (< n-frames 10) (zerop bit-rate-total))
+        (return-from calc-bit-rate-exhaustive))
+
+      (setf is-vbr   t
+            len      total-len
+            bit-rate (float (/ bit-rate-total n-frames))))))
+(defun get-mpeg-audio-info (in &key) ;; (max-frames *max-frames-to-read*))
+  "Get MPEG Layer 3 audio information.
  If the first MPEG frame we find is a Xing/Info header, return that as info.
  Else, we assume CBR and calculate the duration, etc."
   (declare #.utils:*standard-optimize-settings*)
-   (log5:with-context "get-mpeg-audio-info"
-     (let ((first-frame (find-first-sync in))
-           (info (make-instance 'mpeg-audio-info)))
-
-       (log-mpeg-frame "search for first frame yielded ~a" (vpprint first-frame nil))
-       (when (null first-frame)
-         (return-from get-mpeg-audio-info nil))
-
-       (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) info
-         (setf version (version first-frame)
-               layer (layer first-frame)
-               sample-rate (sample-rate first-frame))
-
-         (if (vbr first-frame)
-             ;; found a Xing header, now check to see if it is correct
-             (if (zerop (frames (vbr first-frame)))
-                 (calc-bit-rate-exhaustive in (pos first-frame) info) ; Xing header broken, read all frames to calc
-                 ;; Good Xing header, use info in VBR to calc
-                 (setf n-frames 1
-                       is-vbr   t
-                       len      (float (* (frames (vbr first-frame)) (/ (samples first-frame) (sample-rate first-frame))))
-                       bit-rate (float (/ (* 8 (bytes (vbr first-frame))) len))))
-
-             ;; No Xing header found.  Assume CBR and calculate based on first frame
-             (let* ((first (pos first-frame))
-                    (last (- (audio-streams:stream-size in) (if (id3-frame::v21-tag-header (id3-header in)) 128 0)))
-                    (n-fr (round (/ (float (- last first)) (float (size first-frame)))))
-                    (n-sec (round (/ (float (* (size first-frame) n-fr)) (float (* 125 (float (/ (bit-rate first-frame) 1000))))))))
-               (setf is-vbr nil
-                     n-frames 1
-                     len n-sec
-                     bit-rate (float (bit-rate first-frame))))))
-
-             info)))
+  (let ((first-frame (find-first-sync in))
+        (info        (make-instance 'mpeg-audio-info)))
+
+    (when (null first-frame)
+      (return-from get-mpeg-audio-info nil))
+
+    (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) info
+      (setf version     (version first-frame)
+            layer       (layer first-frame)
+            sample-rate (sample-rate first-frame))
+
+      (if (vbr first-frame)
+          ;; found a Xing header, now check to see if it is correct
+          (if (zerop (frames (vbr first-frame)))
+              (calc-bit-rate-exhaustive in (pos first-frame) info) ; Xing header broken, read all frames to calc
+              ;; Good Xing header, use info in VBR to calc
+              (setf n-frames 1
+                    is-vbr   t
+                    len      (float (* (frames (vbr first-frame)) (/ (samples first-frame) (sample-rate first-frame))))
+                    bit-rate (float (/ (* 8 (bytes (vbr first-frame))) len))))
+
+          ;; No Xing header found.  Assume CBR and calculate based on first frame
+          (let* ((first (pos first-frame))
+                 (last (- (audio-streams:stream-size in) (if (id3-frame::v21-tag-header (id3-header in)) 128 0)))
+                 (n-fr (round (/ (float (- last first)) (float (size first-frame)))))
+                 (n-sec (round (/ (float (* (size first-frame) n-fr)) (float (* 125 (float (/ (bit-rate first-frame) 1000))))))))
+            (setf is-vbr   nil
+                  n-frames 1
+                  len      n-sec
+                  bit-rate (float (bit-rate first-frame))))))
+
+    info))

packages.lisp

@@ -9,7 +9,7 @@
   (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null
            #:redirect #:memoize #:it #:*standard-optimize-settings*
            #:get-bitfield #:while #:aif #:awhen #:with-gensyms #:make-keyword
-           #:dump-data #:timings)
+           #:dump-data #:timings #:dbg #:dbg-helper)
   (:use #:common-lisp))
 
 (defpackage #:profile
@@ -95,10 +95,6 @@
   (:use #:common-lisp #:audio-streams #:id3-frame #:utils))
 
 
-(defpackage #:logging
-  (:export #:with-logging #:stop-logging)
-  (:use #:common-lisp #:utils))
-
 (defpackage #:mpeg
   (:export #:get-mpeg-audio-info #:vpprint)
   (:use #:common-lisp #:audio-streams #:utils))

taglib-tests.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:taglib-tests
-  (:use #:common-lisp #:logging #:audio-streams))
+  (:use #:common-lisp #:audio-streams))
 
 (in-package #:taglib-tests)
 
@@ -154,16 +154,3 @@
   "Time parsing of DIR."
   (let ((audio-streams:*get-audio-info* do-audio-processing))
     (time (mp-do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))
-
-
-
-#|
-(defvar foo nil)
-(defun tst ()
-  (let ((*break-on-signals* t))
-    (setf foo (audio-streams:make-file-stream *song-m4a*))
-    (parse-audio-file foo)))
-
-(defun prt ()
-  (tree:traverse mp4-atom::*tree* (lambda (node depth) (format t "~v@tNode: ~a~%" depth (mp4-atom::vpprint node nil))) 1))
-|#

taglib.asd

@@ -16,5 +16,4 @@
                (:file "id3-frame"     :depends-on ("packages" "utils"))
                (:file "flac-frame"    :depends-on ("packages" "utils"))
                (:file "abstract-tag"  :depends-on ("packages" "id3-frame" "audio-streams" "mp4-atom" "utils"))
-               (:file "logging"       :depends-on ("packages" "mp4-atom" "audio-streams" "utils"))
                (:file "mp4-atom"      :depends-on ("packages" "utils"))))

utils.lisp

@@ -115,3 +115,54 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
   (let ((real-base (get-internal-real-time)))
     (funcall function)
     (float (/ (- (get-internal-real-time) real-base) internal-time-units-per-second))))
+
+;;; Taken from ASDF
+(defmacro DBG (tag &rest exprs)
+  "debug macro for print-debugging:
+TAG is typically a constant string or keyword to identify who is printing,
+but can be an arbitrary expression returning a tag to be princ'ed first;
+if the expression returns NIL, nothing is printed.
+EXPRS are expressions, which when the TAG was not NIL are evaluated in order,
+with their source code then their return values being printed each time.
+The last expresion is *always* evaluated and its multiple values are returned,
+but its source and return values are only printed if TAG was not NIL;
+previous expressions are not evaluated at all if TAG returned NIL.
+The macro expansion has relatively low overhead in space or time."
+  (let* ((last-expr (car (last exprs)))
+         (other-exprs (butlast exprs))
+         (tag-var (gensym "TAG"))
+         (thunk-var (gensym "THUNK")))
+    `(let ((,tag-var ,tag))
+       (flet ,(when exprs `((,thunk-var () ,last-expr)))
+         (if ,tag-var
+             (DBG-helper ,tag-var
+                         (list ,@(loop :for x :in other-exprs :collect
+                                       `(cons ',x #'(lambda () ,x))))
+                         ',last-expr ,(if exprs `#',thunk-var nil))
+             ,(if exprs `(,thunk-var) '(values)))))))
+
+(defun DBG-helper (tag expressions-thunks last-expression last-thunk)
+  ;; Helper for the above debugging macro
+  (labels
+      ((f (stream fmt &rest args)
+         (with-standard-io-syntax
+           (let ((*print-readably* nil)
+                 (*package* (find-package :cl)))
+             (apply 'format stream fmt args)
+             (finish-output stream))))
+       (z (stream)
+         (f stream "~&"))
+       (e (fmt arg)
+         (f *error-output* fmt arg))
+       (x (expression thunk)
+         (e "~&  ~S => " expression)
+         (let ((results (multiple-value-list (funcall thunk))))
+           (e "~{~S~^ ~}~%" results)
+           (apply 'values results))))
+    (map () #'z (list *standard-output* *error-output* *trace-output*))
+    (e "~A~%" tag)
+    (loop :for (expression . thunk) :in expressions-thunks
+          :do (x expression thunk))
+    (if last-thunk
+        (x last-expression last-thunk)
+        (values))))