1. Walton Hoops
  2. cl-taglib


cl-taglib / cl-taglib.lisp

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