Source

cl-taglib / cl-taglib.lisp

Full commit
Walton Hoops c198991 






























Walton Hoops f4d7e25 
Walton Hoops ea7c616 
Walton Hoops c198991 
Walton Hoops e1801e8 
Walton Hoops f4d7e25 
Walton Hoops acb63d2 
Walton Hoops cfc5f23 
Walton Hoops a7bb7a6 
Walton Hoops f4d7e25 



Walton Hoops a7bb7a6 
Walton Hoops f4d7e25 
Walton Hoops ea7c616 


Walton Hoops 9debea0 










Walton Hoops f4d7e25 






Walton Hoops e1801e8 









;;;; cl-taglib.lisp

(in-package #:cl-taglib)

;;; "cl-taglib" goes here. Hacks and glory await!
(define-foreign-library taglib
  (t (:default "libtag_c")))

(use-foreign-library taglib)

(defcfun (set-strings-unicode "taglib_set_strings_unicode") :void
  (unicode :boolean))

(defcfun (set-string-management "taglib_set_string_management_enabled") :void
  (mangement :boolean))

(defcfun (free "taglib_free") :void
  (str :pointer))

(defcfun (file-new "taglib_file_new") :pointer
  (filename :string))

(defcfun (file-free "taglib_file_free") :void
  (file :pointer))

(defcfun (file-is-valid "taglib_file_is_valid") :boolean
  (file :pointer))

(defcfun (file-tag "taglib_file_tag") :pointer
  (file :pointer))

(defcfun (file-audioproperties "taglib_file_audioproperties") :pointer
  (file :pointer))

(defcfun (tagfile-save "taglib_file_save") :boolean
  (file :pointer))

;;; BUG: does not emit error if file can't be opened
(defmacro with-tag-file ((var path) &body body)
  `(let ((,var (file-new ,path)))
     (unwind-protect (progn
		       ,@body)
       (file-free ,var))))

(defmacro tag-accessor-for (slot type)
  (let ((function-name (intern (concatenate 'string "TAG-" (string slot))))
	(foreign-name (string-downcase (concatenate 'string "taglib_tag_" (string slot))))
	(foreign-set-name (string-downcase (concatenate 'string "taglib_tag_set_" (string slot)))))
    (list 'progn
	  (if (eq type :string)
	      `(defun ,function-name (tag)
		(let ((str-ptr (foreign-funcall ,foreign-name :pointer tag :string+ptr)))
		  (foreign-funcall "taglib_free" :pointer (cadr str-ptr) :void)
		  (car str-ptr)))
	      `(defun ,function-name (tag)
		(foreign-funcall ,foreign-name :pointer tag ,type)))
	  `(defun (setf ,function-name) (value tag)
	    (foreign-funcall ,foreign-set-name :pointer tag ,type value :void)))))

(tag-accessor-for :title :string)
(tag-accessor-for :artist :string)
(tag-accessor-for :album :string)
(tag-accessor-for :comment :string)
(tag-accessor-for :genre :string)
(tag-accessor-for :year :uint)
(tag-accessor-for :track :uint)

(defmacro audio-reader-for (slot)
  (let ((function-name (intern (concatenate 'string "AUDIO-" (string slot))))
	(foreign-name (string-downcase (concatenate 'string "taglib_audioproperties_" (string slot)))))
    `(defcfun (,function-name ,foreign-name) :int
       (audio :pointer))))

(audio-reader-for :length)
(audio-reader-for :bitrate)
(audio-reader-for :samplerate)
(audio-reader-for :channels)