checkpointing SBCL coversion---mostly works

audio-streams.lisp

@@ -22,12 +22,13 @@
 (defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
 (defun make-mmap-stream (f) (make-instance 'mem-stream :stream-filename f))
 
+;;; XXX from quickutil/alexandria---should change to qtlc:utilize
 (defmethod initialize-instance :after ((stream mem-stream) &key)
   "Stream initializer. If STREAM-FILENAME is set, MMAP a the file. Else, we assume VECT was set."
   (with-mem-stream-slots (stream)
     (when stream-filename
       #+CCL (setf vect (ccl:map-file-to-octet-vector stream-filename))
-      #-CCL (error "Not Yet!")
+      #-CCL (setf vect (alexandria:read-file-into-byte-vector stream-filename))
       )
     (setf stream-size (length vect))))
 
@@ -37,7 +38,7 @@
   (with-mem-stream-slots (stream)
     (when stream-filename
       #+CCL (ccl:unmap-octet-vector vect)
-      #-CCL (error "Not Yet")
+      #-CCL ; nothing to do here
       )
     (setf vect nil)))
 
@@ -50,7 +51,7 @@
 As a convenience, OFFSET and FROM are optional, so (STREAM-SEEK stream) returns the current read-offset in stream."
   (declare #.utils:*standard-optimize-settings*)
   (declare (fixnum offset))
-(with-mem-stream-slots (stream)
+  (with-mem-stream-slots (stream)
     (ecase from
       (:start                  ; INDEX set to OFFSET from start of stream
        (setf index offset))
@@ -113,17 +114,14 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
         (7
          (let* ((last-byte-was-FF nil)
                 (byte nil)
-                (octets
-                  #-CCL (error "Not yet")
-                  #+CCL  (ccl:with-output-to-vector (out)
-                           (dotimes (i size)
-                             (setf byte (stream-read-u8 stream))
-                             (if last-byte-was-FF
-                                 (if (not (zerop byte))
-                                     (write-byte byte out))
-                                 (write-byte byte out))
-                             (setf last-byte-was-FF (= byte #xFF))))
-                  ))
+                (octets (flexi-streams:with-output-to-sequence (out)
+                          (dotimes (i size)
+                            (setf byte (stream-read-u8 stream))
+                            (if last-byte-was-FF
+                                (if (not (zerop byte))
+                                    (write-byte byte out))
+                                (write-byte byte out))
+                            (setf last-byte-was-FF (= byte #xFF))))))
            (values octets size))))))
 
 (defclass mp3-file-stream (mem-stream)
@@ -164,7 +162,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 (defun stream-decode-iso-string (octets &key (start 0) (end nil))
   (declare #.utils:*standard-optimize-settings*)
   #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :iso-8859-1)
-  #-CCL (error "Not Yet")
+  #-CCL (babel:octets-to-string octets :start start :end end :encoding :iso-8859-1)
   )
 
 ;;;
@@ -191,10 +189,10 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
            (let ((bom (get-byte-order-mark octets)))
              (ecase (the fixnum bom)
                (#xfffe #+CCL (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2le)
-                       #-CCL (error "Not Yet")
+                       #-CCL (babel:octets-to-string octets :start (+ 2 start) :end end :encoding :ucs-2le)
                        )
                (#xfeff #+CCL (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2be)
-                       #-CCL (error "Not Yet")
+                       #-CCL (babel:octets-to-string octets :start (+ 2 start) :end end :encoding :ucs-2be)
                        )
                (0      (make-string 0))))))))
 
@@ -202,14 +200,14 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
   "Decode octets as a UCS-BE string (encoding == 2)"
   (declare #.utils:*standard-optimize-settings*)
   #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :ucs-2be)
-  #-CCL (error "Not Yet")
+  #-CCL (babel:octets-to-string octets :start start :end end :encoding :ucs-2be)
   )
 
 (defun stream-decode-utf-8-string (octets &key (start 0) (end nil))
   "Decode octets as a utf-8 string"
   (declare #.utils:*standard-optimize-settings*)
   #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :utf-8)
-  #-CCL (error "Not Yet")
+  #-CCL (babel:octets-to-string octets :start start :end end :encoding :utf-8)
   )
 
 (defun stream-decode-string (octets &key (start 0) (end nil) (encoding 0))
@@ -253,62 +251,54 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 (defmethod stream-read-iso-string ((instream mem-stream))
   "Read in a null terminated iso-8859-1 string"
   (declare #.utils:*standard-optimize-settings*)
-  (let ((octets #+CCL (ccl:with-output-to-vector (out)
-                        (do ((b (stream-read-u8 instream) (stream-read-u8 instream)))
-                            (nil)
-                          (when (zerop b)
-                            (return))   ; leave loop w/o writing
-                          (write-byte b out)))
-                #-CCL (error "Not Yet")
-        ))
+  (let ((octets (flexi-streams:with-output-to-sequence (out)
+                  (do ((b (stream-read-u8 instream) (stream-read-u8 instream)))
+                      (nil)
+                    (when (zerop b)
+                      (return))         ; leave loop w/o writing
+                    (write-byte b out)))))
     (stream-decode-iso-string octets)))
 
 (defmethod stream-read-ucs-string ((instream mem-stream))
   "Read in a null terminated UCS string."
   (declare #.utils:*standard-optimize-settings*)
-  (let ((octets #+CCL (ccl:with-output-to-vector (out)
-                        (do* ((b0 (stream-read-u8 instream)
-                                  (stream-read-u8 instream))
-                              (b1 (stream-read-u8 instream)
-                                  (stream-read-u8 instream)))
-                             (nil)
-                          (when (and (zerop b0) (zerop b1))
-                            (return))
-                          (write-byte b0 out)
-                          (write-byte b1 out)))
-                #-CCL (error "Not Yet")
-                ))
+  (let ((octets (flexi-streams:with-output-to-sequence (out)
+                  (do* ((b0 (stream-read-u8 instream)
+                            (stream-read-u8 instream))
+                        (b1 (stream-read-u8 instream)
+                            (stream-read-u8 instream)))
+                       (nil)
+                    (when (and (zerop b0) (zerop b1))
+                      (return))
+                    (write-byte b0 out)
+                    (write-byte b1 out)))))
     (stream-decode-ucs-string octets)))
 
 (defmethod stream-read-ucs-be-string ((instream mem-stream))
   "Read in a null terminated UCS-BE string."
   (declare #.utils:*standard-optimize-settings*)
-  (let ((octets #+CCL (ccl:with-output-to-vector (out)
-                        (do* ((b0 (stream-read-u8 instream)
-                                  (stream-read-u8 instream))
-                              (b1 (stream-read-u8 instream)
-                                  (stream-read-u8 instream)))
-                             (nil)
-                          (when (and (zerop b0) (zerop b1))
-                            (return))
-                          (write-byte b0 out)
-                          (write-byte b1 out)))
-                #-CCL (error "Not Yet")
-                ))
+  (let ((octets (flexi-streams:with-output-to-sequence (out)
+                  (do* ((b0 (stream-read-u8 instream)
+                            (stream-read-u8 instream))
+                        (b1 (stream-read-u8 instream)
+                            (stream-read-u8 instream)))
+                       (nil)
+                    (when (and (zerop b0) (zerop b1))
+                      (return))
+                    (write-byte b0 out)
+                    (write-byte b1 out)))))
     (stream-decode-ucs-be-string octets)))
 
 (defmethod stream-read-utf-8-string ((instream mem-stream))
   "Read in a null terminated utf-8 string (encoding == 3)"
   (declare #.utils:*standard-optimize-settings*)
-  (let ((octets #+CCL (ccl:with-output-to-vector (out)
-                        (do ((b (stream-read-u8 instream)
-                                (stream-read-u8 instream)))
-                            (nil)
-                          (when (zerop b)
-                            (return))
-                          (write-byte b out)))
-                #-CCL (error "Not Yet")
-                ))
+  (let ((octets (flexi-streams:with-output-to-sequence (out)
+                  (do ((b (stream-read-u8 instream)
+                          (stream-read-u8 instream)))
+                      (nil)
+                    (when (zerop b)
+                      (return))
+                    (write-byte b out)))))
     (stream-decode-utf-8-string octets)))
 
 (defmethod stream-read-string ((instream mem-stream) &key (encoding 0))

id3-frame.lisp

@@ -409,28 +409,28 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defclass frame-pic (id3-frame)
   ((encoding   :accessor encoding)
    (img-format :accessor img-format)
-   (type       :accessor type)
+   (ptype      :accessor ptype)
    (desc       :accessor desc)
    (data       :accessor data)))
 
 (defmethod initialize-instance :after ((me frame-pic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (with-slots (id len encoding img-format type desc data) me
-    (setf encoding (stream-read-u8 instream)
+  (with-slots (id len encoding img-format ptype desc data) me
+    (setf encoding   (stream-read-u8 instream)
           img-format (stream-read-iso-string-with-len instream 3)
-          type (stream-read-u8 instream))
+          ptype      (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
+  (with-slots (encoding img-format ptype desc data) me
     (format stream "frame-pic: ~a,  encoding ~d, img-format type: <~a>, picture type: ~d (~a), description <~a>, data: ~a"
-            (vpprint-frame-header me) encoding img-format type (get-picture-type type) desc (printable-array data))))
+            (vpprint-frame-header me) encoding img-format ptype (get-picture-type ptype) desc (printable-array data))))
 
 (defmethod picture-info ((me frame-pic))
   "Used by ABSTRACT-TAG interface to report data about V2.2 cover art"
-  (with-slots (encoding img-format type desc data) me
+  (with-slots (encoding img-format ptype desc data) me
     (format nil "Size: ~:d" (length data))))
 
 ;; Version 2, 3, or 4 generic text-info frames
@@ -664,29 +664,29 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defclass frame-apic (id3-frame)
   ((encoding :accessor encoding)
    (mime     :accessor mime)
-   (type     :accessor type)
+   (ptype    :accessor ptype)
    (desc     :accessor desc)
    (data     :accessor data))
   (:documentation "Holds an attached picture (cover art)"))
 
 (defmethod initialize-instance :after ((me frame-apic) &key instream)
   (declare #.utils:*standard-optimize-settings*)
-  (with-slots (id len encoding mime type desc data) me
+  (with-slots (id len encoding mime ptype desc data) me
     (setf encoding (stream-read-u8 instream)
           mime     (stream-read-iso-string instream)
-          type     (stream-read-u8 instream))
+          ptype    (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
+  (with-slots (encoding mime ptype desc data) me
     (format stream "frame-apic: ~a, encoding ~d, mime type: ~a, picture type: ~d (~a), description <~a>, data: ~a"
-            (vpprint-frame-header me) encoding mime type (get-picture-type type) desc (printable-array data))))
+            (vpprint-frame-header me) encoding mime ptype (get-picture-type ptype) desc (printable-array data))))
 
 (defmethod picture-info ((me frame-apic))
   "Used by ABSTRACT-TAG interface to report data about V2.3/4 cover art"
-  (with-slots (encoding mime type desc data) me
+  (with-slots (encoding mime ptype desc data) me
     (format nil "Size: ~:d" (length data))))
 
 ;;; V23/V24 COMM frames

packages.lisp

@@ -3,6 +3,8 @@
 (in-package #:cl-user)
 
 (defpackage #:tree
+  (:export #:make-node #:add-child #:first-child #:next-sibling #:data
+           #:traverse #:print-tree #:find-tree #:at-path)
   (:use #:common-lisp))
 
 (defpackage #:utils

taglib-tests.asd

@@ -2,7 +2,7 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 ;;;
 
-;(pushnew :I-AM-MARKV *features*)
+#+SBCL (declaim (sb-ext:muffle-conditions sb-ext:compiler-note style-warning))
 
 (asdf:defsystem #:taglib-tests
   :description "Simple demo/test code for taglib"

taglib-tests.lisp

@@ -18,7 +18,10 @@
 ;;; A note re filesystem encoding: my music collection is housed on a Mac and shared via SAMBA.
 ;;; In order to make sure we get valid pathnames, we need to set CCL's filesystem encoding to
 ;;; :UTF-8
-(defun set-pathname-encoding (enc)        (setf (ccl:pathname-encoding-name) enc))
+(defun set-pathname-encoding (enc)
+  #+CCL (setf (ccl:pathname-encoding-name) enc)
+  t)
+
 (defun set-pathname-encoding-for-osx ()   (set-pathname-encoding :utf-8))
 (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
 

taglib.asd

@@ -1,11 +1,13 @@
 ;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
+(pushnew :DBG *features*)
+
 (asdf:defsystem #:taglib
   :description "Pure Lisp implementation to read (and write, perhaps, one day) tags"
   :author "Mark VandenBrink"
   :license "Public Domain"
-  :depends-on (#:optima #:optima.ppcre)
+  :depends-on (#:optima #:optima.ppcre #:flexi-streams #:babel #:alexandria)
   :components ((:file "packages")
                (:file "profile"       :depends-on ("packages"))
                (:file "utils"         :depends-on ("packages"))

tree.lisp

@@ -75,6 +75,3 @@
             (utils:aif (at-path node (rest path) cmp)
                        (return-from at-path utils:it))))
   nil)
-
-(let ((pkg (find-package :tree)))
-  (do-all-symbols (sym pkg) (when (eql (symbol-package sym) pkg) (export sym pkg))))

utils.lisp

@@ -4,7 +4,9 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :INSTRUMENT-MEMOIZED *features*)
-  (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
+  #+DBG (defvar *standard-optimize-settings* '(optimize (debug 3)))
+  #-DBG (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0)))
+  )
 
 (defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn-user")