1 ;;; ffi-taglib.el --- SXEmacs interface to taglib
3 ;; Copyright (C) 2006 Sebastian Freundt
5 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
6 ;; Keywords: ffi, taglib
8 ;; This file is part of SXEmacs.
10 ;; This program is free software; you can redistribute it and/or modify it
11 ;; under a BSD-like licence.
13 ;; Redistribution and use in source and binary forms, with or without
14 ;; modification, are permitted provided that the following conditions are met:
15 ;; Redistributions of source code must retain the above copyright notice, this
16 ;; list of conditions and the following disclaimer.
17 ;; Redistributions in binary form must reproduce the above copyright notice,
18 ;; this list of conditions and the following disclaimer in the documentation
19 ;; and/or other materials provided with the distribution.
20 ;; Neither the name of the Technical University of Berlin nor the names of its
21 ;; contributors may be used to endorse or promote products derived from this
22 ;; software without specific prior written permission.
24 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25 ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
26 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27 ;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
28 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31 ;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32 ;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 ;; POSSIBILITY OF SUCH DAMAGE.
41 (autoload #'view-mode "view-less" nil t))
46 (globally-declare-boundp 'int)
48 ;; this is our spine, barf if it does not exist.
49 ;; But it won't load everywhere unless you first load the C++ libtag.so
50 ;; first. Not sure why, but I suspect there is some crazy magic voodoo
51 ;; redirection going on between the C++ lib and the C lib. --SY.
55 (unless (ffi-find-named-type 'TagLib_File)
56 (define-ffi-type TagLib_File (pointer void)))
57 (unless (ffi-find-named-type 'TagLib_Tag)
58 (define-ffi-type TagLib_Tag (pointer void)))
59 (unless (ffi-find-named-type 'TagLib_AudioProperties)
60 (define-ffi-type TagLib_AudioProperties (pointer void)))
63 (defconst taglib:file_new
64 (ffi-defun '(function TagLib_File c-string)
66 "Create and return File object.")
67 (defun taglib:file-new (file)
68 "Create and return File object."
69 (when (file-readable-p file)
70 (let ((f (ffi-create-fo 'c-string file)))
71 (ffi-call-function taglib:file_new f))))
73 (defconst taglib:file_free
74 (ffi-defun '(function void TagLib_File)
76 "Destruct File object.")
77 (defun taglib:file-free (file-object)
78 "Destruct File object."
79 (when (ffi-object-p file-object)
80 (ffi-call-function taglib:file_free file-object)))
82 (defconst taglib:file_save
83 (ffi-defun '(function int TagLib_File)
85 "Save tags back to File object.")
86 (defun taglib:file-save (file-object)
87 "Save tags back to File object."
88 (when (ffi-object-p file-object)
92 (ffi-call-function taglib:file_save file-object))))))
95 ;;; constructors/destructors
96 (defconst taglib:file_tag
97 (ffi-defun '(function TagLib_Tag TagLib_File)
99 "Return the tag object associated with the file object.")
100 (defun taglib:file-tag (file-object)
101 "Return the tag object associated with FILE-OBJECT."
102 (when (ffi-object-p file-object)
103 (ffi-call-function taglib:file_tag file-object)))
105 (defconst taglib:tag_free_strings
106 (ffi-defun '(function void)
107 "taglib_tag_free_strings")
108 "Free strings allocated by tag lookup functions.")
109 (defun taglib:tag-free-strings ()
110 "Free strings allocated by tag lookup functions."
111 (ffi-call-function taglib:tag_free_strings)
115 ;; char *taglib_tag_title(const TagLib_Tag *tag);
116 (defconst taglib:tag_title
117 (ffi-defun '(function c-string TagLib_Tag)
119 "Return the title associated with tag.")
120 (defun taglib:tag-title (tag-object)
121 "Return the title associated with TAG-OBJECT."
122 (when (ffi-object-p tag-object)
124 (ffi-call-function taglib:tag_title tag-object))
127 (taglib:tag-free-strings)
128 (unless (zerop (length result))
131 ;; char *taglib_tag_artist(const TagLib_Tag *tag);
132 (defconst taglib:tag_artist
133 (ffi-defun '(function c-string TagLib_Tag)
135 "Return the artist associated with tag.")
136 (defun taglib:tag-artist (tag-object)
137 "Return the artist associated with TAG-OBJECT."
138 (when (ffi-object-p tag-object)
140 (ffi-call-function taglib:tag_artist tag-object))
143 (taglib:tag-free-strings)
144 (unless (zerop (length result))
147 ;; char *taglib_tag_album(const TagLib_Tag *tag);
148 (defconst taglib:tag_album
149 (ffi-defun '(function c-string TagLib_Tag)
151 "Return the album associated with tag.")
152 (defun taglib:tag-album (tag-object)
153 "Return the album associated with TAG-OBJECT."
154 (when (ffi-object-p tag-object)
156 (ffi-call-function taglib:tag_album tag-object))
159 (taglib:tag-free-strings)
160 (unless (zerop (length result))
163 ;; char *taglib_tag_comment(const TagLib_Tag *tag);
164 (defconst taglib:tag_comment
165 (ffi-defun '(function c-string TagLib_Tag)
166 "taglib_tag_comment")
167 "Return the comment associated with tag.")
168 (defun taglib:tag-comment (tag-object)
169 "Return the comment associated with TAG-OBJECT."
170 (when (ffi-object-p tag-object)
172 (ffi-call-function taglib:tag_comment tag-object))
175 (taglib:tag-free-strings)
176 (unless (zerop (length result))
179 ;; char *taglib_tag_genre(const TagLib_Tag *tag);
180 (defconst taglib:tag_genre
181 (ffi-defun '(function c-string TagLib_Tag)
183 "Return the genre associated with tag.")
184 (defun taglib:tag-genre (tag-object)
185 "Return the genre associated with TAG-OBJECT."
186 (when (ffi-object-p tag-object)
188 (ffi-call-function taglib:tag_genre tag-object))
191 (taglib:tag-free-strings)
192 (unless (zerop (length result))
195 ;; unsigned int taglib_tag_year(const TagLib_Tag *tag);
196 (defconst taglib:tag_year
197 (ffi-defun '(function int TagLib_Tag)
199 "Return the year associated with tag.")
200 (defun taglib:tag-year (tag-object)
201 "Return the year associated with TAG-OBJECT."
202 (when (ffi-object-p tag-object)
204 (ffi-call-function taglib:tag_year tag-object))
207 (unless (zerop result)
210 ;; unsigned int taglib_tag_track(const TagLib_Tag *tag);
211 (defconst taglib:tag_track
212 (ffi-defun '(function int TagLib_Tag)
214 "Return the track number associated with tag.")
215 (defun taglib:tag-track (tag-object)
216 "Return the track number associated with TAG-OBJECT."
217 (when (ffi-object-p tag-object)
219 (ffi-call-function taglib:tag_track tag-object))
222 (unless (zerop result)
226 ;; void taglib_tag_set_title(TagLib_Tag *tag, const char *title);
227 (defconst taglib:tag_set_title
228 (ffi-defun '(function void TagLib_Tag c-string)
229 "taglib_tag_set_title")
230 "Set the title and associate it with tag.")
231 (defun taglib:tag-set-title (tag-object title)
232 "Set the title to TITLE and associate it with TAG-OBJECT."
233 (when (and (stringp title)
234 (ffi-object-p tag-object))
235 (let ((tit (ffi-create-fo 'c-string title)))
236 (ffi-call-function taglib:tag_set_title tag-object tit))
239 ;; void taglib_tag_set_artist(TagLib_Tag *tag, const char *artist);
240 (defconst taglib:tag_set_artist
241 (ffi-defun '(function void TagLib_Tag c-string)
242 "taglib_tag_set_artist")
243 "Set the artist and associate it with tag.")
244 (defun taglib:tag-set-artist (tag-object artist)
245 "Set the artist to ARTIST and associate it with TAG-OBJECT."
246 (when (and (stringp artist)
247 (ffi-object-p tag-object))
248 (let ((art (ffi-create-fo 'c-string artist)))
249 (ffi-call-function taglib:tag_set_artist tag-object art))
252 ;; void taglib_tag_set_album(TagLib_Tag *tag, const char *album);
253 (defconst taglib:tag_set_album
254 (ffi-defun '(function void TagLib_Tag c-string)
255 "taglib_tag_set_album")
256 "Set the album and associate it with tag.")
257 (defun taglib:tag-set-album (tag-object album)
258 "Set the album to ALBUM and associate it with TAG-OBJECT."
259 (when (and (stringp album)
260 (ffi-object-p tag-object))
261 (let ((alb (ffi-create-fo 'c-string album)))
262 (ffi-call-function taglib:tag_set_album tag-object alb))
265 ;; void taglib_tag_set_comment(TagLib_Tag *tag, const char *comment);
266 (defconst taglib:tag_set_comment
267 (ffi-defun '(function void TagLib_Tag c-string)
268 "taglib_tag_set_comment")
269 "Set the comment and associate it with tag.")
270 (defun taglib:tag-set-comment (tag-object comment)
271 "Set the comment to COMMENT and associate it with TAG-OBJECT."
272 (when (and (stringp comment)
273 (ffi-object-p tag-object))
274 (let ((com (ffi-create-fo 'c-string comment)))
275 (ffi-call-function taglib:tag_set_comment tag-object com))
278 ;; void taglib_tag_set_genre(TagLib_Tag *tag, const char *genre);
279 (defconst taglib:tag_set_genre
280 (ffi-defun '(function void TagLib_Tag c-string)
281 "taglib_tag_set_genre")
282 "Set the genre and associate it with tag.")
283 (defun taglib:tag-set-genre (tag-object genre)
284 "Set the genre to GENRE and associate it with TAG-OBJECT."
285 (when (and (stringp genre)
286 (ffi-object-p tag-object))
287 (let ((gen (ffi-create-fo 'c-string genre)))
288 (ffi-call-function taglib:tag_set_genre tag-object gen))
291 ;; void taglib_tag_set_year(TagLib_Tag *tag, unsigned int year);
292 (defconst taglib:tag_set_year
293 (ffi-defun '(function void TagLib_Tag int)
294 "taglib_tag_set_year")
295 "Set the year and associate it with tag.")
296 (defun taglib:tag-set-year (tag-object year)
297 "Set the year to YEAR and associate it with TAG-OBJECT."
298 (when (and (natnump year)
299 (ffi-object-p tag-object))
300 (let ((yea (ffi-create-fo 'int year)))
301 (ffi-call-function taglib:tag_set_year tag-object yea))
304 ;; void taglib_tag_set_track(TagLib_Tag *tag, unsigned int track);
305 (defconst taglib:tag_set_track
306 (ffi-defun '(function void TagLib_Tag int)
307 "taglib_tag_set_track")
308 "Set the track number and associate it with tag.")
309 (defun taglib:tag-set-track (tag-object track)
310 "Set the track number to TRACK and associate it with TAG-OBJECT."
311 (when (and (natnump track)
312 (ffi-object-p tag-object))
313 (let ((tra (ffi-create-fo 'int track)))
314 (ffi-call-function taglib:tag_set_track tag-object tra))
319 (defconst taglib:file_audioproperties
320 (ffi-defun '(function TagLib_AudioProperties TagLib_File)
321 "taglib_file_audioproperties")
322 "Return the AudioProperties object associated with the file object.")
323 (defun taglib:file-audio-properties (file-object)
324 "Return the audio properties object associated with FILE-OBJECT."
325 (when (ffi-object-p file-object)
326 (ffi-call-function taglib:file_audioproperties file-object)))
328 (defconst taglib:audioproperties_length
329 (ffi-defun '(function int TagLib_AudioProperties)
330 "taglib_audioproperties_length")
331 "Return the length of the audioproperties object in seconds.")
332 (defun taglib:audioproperties-length (audioprops)
333 "Return the length of AUDIOPROPS in seconds."
334 (when (ffi-object-p audioprops)
336 (ffi-call-function taglib:audioproperties_length audioprops))
339 (unless (zerop result)
342 (defconst taglib:audioproperties_bitrate
343 (ffi-defun '(function int TagLib_AudioProperties)
344 "taglib_audioproperties_bitrate")
345 "Return the bitrate of the audioproperties object in kb/s.")
346 (defun taglib:audioproperties-bitrate (audioprops)
347 "Return the bitrate of AUDIOPROPS in kb/s (kilobit per second)."
348 (when (ffi-object-p audioprops)
350 (ffi-call-function taglib:audioproperties_bitrate audioprops))
353 (unless (zerop result)
356 (defconst taglib:audioproperties_samplerate
357 (ffi-defun '(function int TagLib_AudioProperties)
358 "taglib_audioproperties_samplerate")
359 "Return the samplerate of the audioproperties object in Hz.")
360 (defun taglib:audioproperties-samplerate (audioprops)
361 "Return the samplerate of AUDIOPROPS in Hz."
362 (when (ffi-object-p audioprops)
364 (ffi-call-function taglib:audioproperties_samplerate audioprops))
367 (unless (zerop result)
370 (defconst taglib:audioproperties_channels
371 (ffi-defun '(function int TagLib_AudioProperties)
372 "taglib_audioproperties_channels")
373 "Return the number of channels of the audioproperties object.")
374 (defun taglib:audioproperties-channels (audioprops)
375 "Return the number of channels of AUDIOPROPS."
376 (when (ffi-object-p audioprops)
378 (ffi-call-function taglib:audioproperties_channels audioprops))
381 (unless (zerop result)
386 (defun taglib:properties (file)
387 "Return an alist of available properties of FILE."
388 (when (file-readable-p file)
389 (let* ((result (dllist))
390 (exp-file (expand-file-name file))
391 (tlf (taglib:file-new exp-file)))
393 (null (ffi-null-p tlf)))
394 (let ((tlt (taglib:file-tag tlf))
395 (tlap (taglib:file-audio-properties tlf))
397 (cons 'title #'taglib:tag-title)
398 (cons 'artist #'taglib:tag-artist)
399 (cons 'album #'taglib:tag-album)
400 (cons 'comment #'taglib:tag-comment)
401 (cons 'genre #'taglib:tag-genre)
402 (cons 'year #'taglib:tag-year)
403 (cons 'track #'taglib:tag-track)))
405 (cons 'length #'taglib:audioproperties-length)
406 (cons 'bitrate #'taglib:audioproperties-bitrate)
407 (cons 'samplerate #'taglib:audioproperties-samplerate)
408 (cons 'channels #'taglib:audioproperties-channels))))
409 (unless (ffi-null-p tlt)
412 (let ((res (funcall (cdr fun) tlt)))
414 (dllist-append result (cons (car fun) res)))))
416 (unless (ffi-null-p tlap)
419 (let ((res (funcall (cdr fun) tlap)))
421 (dllist-append result (cons (car fun) res)))))
423 (dllist-prepend result (cons 'type 'audio))))
424 (taglib:file-free tlf)
426 ;; prepend some generic information
427 (dllist-prepend result (cons 'driver 'taglib))
428 (dllist-prepend result (cons 'file exp-file))
429 (dllist-prepend result (cons 'kind 'file)))
431 (dllist-to-list result))))
433 ;;; FIXME: this isn't failsafe, use #'magic:file-type instead.
434 (defvar taglib:extensions
435 '("mp3" "mpc" "ogg" "flac" "spx" "wv" "tta")
436 "List of file types that taglib supports.")
438 (defvar taglib:editable-tagnames
439 '("album" "artist" "comment" "genre" "title" "track" "year")
440 "List of tagnames whose values may be changed.")
442 (defvar taglib:readonly-tagnames
443 '("length" "bitrate" "samplerate" "channels")
444 "List of the tagnames that the user can't change.")
446 (defvar taglib:tagnames
447 (let ((l1 (copy-sequence taglib:editable-tagnames))
448 (l2 (copy-sequence taglib:readonly-tagnames)))
449 (sort (append l1 l2) #'string<))
450 "List of all taglib tagnames.")
453 (defun taglib:get-tag (file tag)
454 "Get ID3 or Vorbis comment TAG from FILE.
456 With a prefix arg, insert the TAG at point in the current buffer,
457 otherwise just display it in the echo area."
459 (list (read-file-name "Get tag from file: " nil "" t)
460 (completing-read "Tag: "
461 (mapfam #'list taglib:tagnames) nil t)))
462 (when (string= tag "")
463 (error 'invalid-argument tag))
464 ;; better done with #'magic:file-type
465 (unless (member (file-name-extension (file-basename file))
467 (error "Unsupported file type: %s" (file-name-extension
468 (file-basename file))))
469 (let* ((fo (taglib:file-new (expand-file-name file)))
470 (to (taglib:file-tag fo))
472 (if (member tag taglib:readonly-tagnames)
474 (setq tfun (intern-soft (format "taglib:audioproperties-%s" tag)))
475 (setq res (funcall tfun (taglib:file-audio-properties fo))))
476 (setq tfun (intern-soft (format "taglib:tag-%s" tag)))
477 (setq res (funcall tfun to)))
478 (taglib:tag-free-strings)
479 (taglib:file-free fo)
481 (if current-prefix-arg
483 (message "[%s of %s]: %s" tag (file-basename file) res))
487 (defalias #'taglib:show-tag #'taglib:get-tag)
490 (defun taglib:put-tag (file tag value)
491 "Set FILE's TAG to VALUE."
493 (list (setq file (read-file-name "File: " nil "" t))
494 (setq tag (completing-read "Tagnam: "
495 (mapfam #'list taglib:editable-tagnames)))
496 (read-string "Tagvalue: " (or (format "%s" (taglib:get-tag file tag))
498 (let* ((fo (taglib:file-new (expand-file-name file)))
499 (to (taglib:file-tag fo))
500 (tfun (intern-soft (format "taglib:tag-set-%s" tag))))
501 ;; year and track are numbers
502 (when (and (string-match #r"^\(track\|year\)$" tag)
504 (setq value (string-to-number value)))
505 (funcall tfun to value)
506 (taglib:file-save fo)
507 (taglib:file-free fo)
508 (taglib:tag-free-strings)))
511 (defalias #'taglib:set-tag #'taglib:put-tag)
514 (defun taglib:list-all-tags (file)
515 "Display a buffer showing all the tags of FILE."
516 (interactive "fFilename: ")
517 (unless (interactive-p)
518 (error 'invalid-operation "Interactive only function"))
519 (let ((buf (get-buffer-create "*taglib:tags*"))
520 (tags (taglib:properties file)))
521 (with-current-buffer buf
523 (insert (format "Taglib tags of: %s" (file-basename file)))
528 (let ((fill-column 15))
529 (insert (format "%s" (car tag)))
531 (narrow-to-region (point-at-bol) (point-at-eol))
532 (set-justification-right (point-min) (point-max))))
533 (insert (format ": %s\n" (cdr tag))))
535 (push-window-configuration)
537 (funcall #'view-mode nil #'(lambda (&rest unused)
538 (pop-window-configuration)))
539 (goto-char (point-min))))
541 (provide 'ffi-taglib)
543 ;;; ffi-taglib.el ends here