Source

cl-taglib / cl-taglib.lisp

Full commit
Walton Hoops c198991 
























Walton Hoops 9f00ef7 
Walton Hoops a467bd8 
Walton Hoops 9f00ef7 



Walton Hoops c198991 


Walton Hoops f4d7e25 
Walton Hoops ea7c616 
Walton Hoops c198991 
Walton Hoops 9d77eee 
Walton Hoops f4d7e25 
Walton Hoops acb63d2 
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-free "taglib_file_free") :void
  (file :pointer))

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

(defun file-new (file)
  (let ((ptr (foreign-funcall "taglib_file_new" :string (namestring file) :pointer)))
    (cond ((null-pointer-p ptr) (error (format nil "Invalid tagfile: ~s" file)))
	  ((not (file-is-valid ptr)) (error (format nil "Invalid tagfile: ~s" file)))
	  (t ptr))))

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

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

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

(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)