cgit.sxemacs.org Git - sxemacs/blob - lisp/ffi/ffi-taglib.el

   1 ;;; ffi-taglib.el --- SXEmacs interface to taglib
   2 ;;
   3 ;; Copyright (C) 2006 Sebastian Freundt
   4 ;;
   5 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
   6 ;; Keywords: ffi, taglib
   7 ;;
   8 ;; This file is part of SXEmacs.
   9 ;;
  10 ;; This program is free software; you can redistribute it and/or modify it
  11 ;; under a BSD-like licence.
  12 ;;
  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.
  23 ;;
  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.
  35 ;;
  36 ;;
  37 ;;; Commentary:
  38 ;;
  39 ;;; Code:
  40 (eval-when-compile
  41   (autoload #'view-mode "view-less" nil t))
  42
  43 (require 'ffi)
  44 (require 'ffi-libc)
  45
  46 (globally-declare-boundp 'int)
  47
  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.
  52 (ffi-load "libtag")
  53 (ffi-load "libtag_c")
  54
  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)))
  61
  62 \f
  63 (defconst taglib:file_new
  64   (ffi-defun '(function TagLib_File c-string)
  65              "taglib_file_new")
  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))))
  72
  73 (defconst taglib:file_free
  74   (ffi-defun '(function void TagLib_File)
  75              "taglib_file_free")
  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)))
  81
  82 (defconst taglib:file_save
  83   (ffi-defun '(function int TagLib_File)
  84              "taglib_file_save")
  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)
  89     (null
  90      (zerop
  91       (ffi-get
  92        (ffi-call-function taglib:file_save file-object))))))
  93
  94 \f
  95 ;;; constructors/destructors
  96 (defconst taglib:file_tag
  97   (ffi-defun '(function TagLib_Tag TagLib_File)
  98              "taglib_file_tag")
  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)))
 104
 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)
 112   t)
 113
 114 ;;; accessors
 115 ;; char *taglib_tag_title(const TagLib_Tag *tag);
 116 (defconst taglib:tag_title
 117   (ffi-defun '(function c-string TagLib_Tag)
 118              "taglib_tag_title")
 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)
 123     (let* ((raw
 124             (ffi-call-function taglib:tag_title tag-object))
 125            (result
 126             (ffi-get raw)))
 127       (taglib:tag-free-strings)
 128       (unless (zerop (length result))
 129         result))))
 130
 131 ;; char *taglib_tag_artist(const TagLib_Tag *tag);
 132 (defconst taglib:tag_artist
 133   (ffi-defun '(function c-string TagLib_Tag)
 134              "taglib_tag_artist")
 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)
 139     (let* ((raw
 140             (ffi-call-function taglib:tag_artist tag-object))
 141            (result
 142             (ffi-get raw)))
 143       (taglib:tag-free-strings)
 144       (unless (zerop (length result))
 145         result))))
 146
 147 ;; char *taglib_tag_album(const TagLib_Tag *tag);
 148 (defconst taglib:tag_album
 149   (ffi-defun '(function c-string TagLib_Tag)
 150              "taglib_tag_album")
 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)
 155     (let* ((raw
 156             (ffi-call-function taglib:tag_album tag-object))
 157            (result
 158             (ffi-get raw)))
 159       (taglib:tag-free-strings)
 160       (unless (zerop (length result))
 161         result))))
 162
 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)
 171     (let* ((raw
 172             (ffi-call-function taglib:tag_comment tag-object))
 173            (result
 174             (ffi-get raw)))
 175       (taglib:tag-free-strings)
 176       (unless (zerop (length result))
 177         result))))
 178
 179 ;; char *taglib_tag_genre(const TagLib_Tag *tag);
 180 (defconst taglib:tag_genre
 181   (ffi-defun '(function c-string TagLib_Tag)
 182              "taglib_tag_genre")
 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)
 187     (let* ((raw
 188             (ffi-call-function taglib:tag_genre tag-object))
 189            (result
 190             (ffi-get raw)))
 191       (taglib:tag-free-strings)
 192       (unless (zerop (length result))
 193         result))))
 194
 195 ;; unsigned int taglib_tag_year(const TagLib_Tag *tag);
 196 (defconst taglib:tag_year
 197   (ffi-defun '(function int TagLib_Tag)
 198              "taglib_tag_year")
 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)
 203     (let* ((raw
 204             (ffi-call-function taglib:tag_year tag-object))
 205            (result
 206             (ffi-get raw)))
 207       (unless (zerop result)
 208         result))))
 209
 210 ;; unsigned int taglib_tag_track(const TagLib_Tag *tag);
 211 (defconst taglib:tag_track
 212   (ffi-defun '(function int TagLib_Tag)
 213              "taglib_tag_track")
 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)
 218     (let* ((raw
 219             (ffi-call-function taglib:tag_track tag-object))
 220            (result
 221             (ffi-get raw)))
 222       (unless (zerop result)
 223         result))))
 224
 225 ;;; modifiers
 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))
 237     t))
 238
 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))
 250     t))
 251
 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))
 263     t))
 264
 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))
 276     t))
 277
 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))
 289     t))
 290
 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))
 302     t))
 303
 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))
 315     t))
 316
 317 \f
 318 ;;; constructors
 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)))
 327
 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)
 335     (let* ((raw
 336             (ffi-call-function taglib:audioproperties_length audioprops))
 337            (result
 338             (ffi-get raw)))
 339       (unless (zerop result)
 340         result))))
 341
 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)
 349     (let* ((raw
 350             (ffi-call-function taglib:audioproperties_bitrate audioprops))
 351            (result
 352             (ffi-get raw)))
 353       (unless (zerop result)
 354         result))))
 355
 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)
 363     (let* ((raw
 364             (ffi-call-function taglib:audioproperties_samplerate audioprops))
 365            (result
 366             (ffi-get raw)))
 367       (unless (zerop result)
 368         result))))
 369
 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)
 377     (let* ((raw
 378             (ffi-call-function taglib:audioproperties_channels audioprops))
 379            (result
 380             (ffi-get raw)))
 381       (unless (zerop result)
 382         result))))
 383
 384 \f
 385 ;;; higher level API
 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)))
 392       (when (and tlf
 393                  (null (ffi-null-p tlf)))
 394         (let ((tlt (taglib:file-tag tlf))
 395               (tlap (taglib:file-audio-properties tlf))
 396               (tfuns (list
 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)))
 404               (apfuns (list
 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)
 410             (mapc-internal
 411              #'(lambda (fun)
 412                  (let ((res (funcall (cdr fun) tlt)))
 413                    (when res
 414                      (dllist-append result (cons (car fun) res)))))
 415              tfuns))
 416           (unless (ffi-null-p tlap)
 417             (mapc-internal
 418              #'(lambda (fun)
 419                  (let ((res (funcall (cdr fun) tlap)))
 420                    (when res
 421                      (dllist-append result (cons (car fun) res)))))
 422              apfuns)
 423             (dllist-prepend result (cons 'type 'audio))))
 424         (taglib:file-free tlf)
 425
 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)))
 430
 431       (dllist-to-list result))))
 432
 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.")
 437
 438 (defvar taglib:editable-tagnames
 439   '("album" "artist" "comment" "genre" "title" "track" "year")
 440   "List of tagnames whose values may be changed.")
 441
 442 (defvar taglib:readonly-tagnames
 443   '("length" "bitrate" "samplerate" "channels")
 444   "List of the tagnames that the user can't change.")
 445
 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.")
 451
 452 ;;;###autoload
 453 (defun taglib:get-tag (file tag)
 454   "Get ID3 or Vorbis comment TAG from FILE.
 455
 456 With a prefix arg, insert the TAG at point in the current buffer,
 457 otherwise just display it in the echo area."
 458   (interactive
 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))
 466                   taglib:extensions)
 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))
 471          tfun res)
 472     (if (member tag taglib:readonly-tagnames)
 473         (progn
 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)
 480     (if (interactive-p)
 481         (if current-prefix-arg
 482             (insert res)
 483           (message "[%s of %s]: %s" tag (file-basename file) res))
 484       res)))
 485
 486 ;;;###autoload
 487 (defalias #'taglib:show-tag #'taglib:get-tag)
 488
 489 ;;;###autoload
 490 (defun taglib:put-tag (file tag value)
 491   "Set FILE's TAG to VALUE."
 492   (interactive
 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))
 497                                        ""))))
 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)
 503                (stringp value))
 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)))
 509
 510 ;;;###autoload
 511 (defalias #'taglib:set-tag #'taglib:put-tag)
 512
 513 ;;;###autoload
 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
 522       (erase-buffer)
 523       (insert (format "Taglib tags of: %s" (file-basename file)))
 524       (center-line)
 525       (insert "\n\n")
 526       (mapfam
 527        #'(lambda (tag)
 528            (let ((fill-column 15))
 529              (insert (format "%s" (car tag)))
 530              (save-restriction
 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))))
 534        tags))
 535     (push-window-configuration)
 536     (pop-to-buffer buf)
 537     (funcall #'view-mode nil #'(lambda (&rest unused)
 538                                  (pop-window-configuration)))
 539     (goto-char (point-min))))
 540
 541 (provide 'ffi-taglib)
 542
 543 ;;; ffi-taglib.el ends here