aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libid3tag/compat.gperf2
-rw-r--r--scheme/idest/format/pic.scm204
2 files changed, 205 insertions, 1 deletions
diff --git a/libid3tag/compat.gperf b/libid3tag/compat.gperf
index 71e28d0..8b0b696 100644
--- a/libid3tag/compat.gperf
+++ b/libid3tag/compat.gperf
@@ -270,7 +270,7 @@ translate_APIC(struct id3_frame *frame, char const *oldid,
if ((rc = id3_field_parse(&frame->fields[3], &data,
end - data, &encoding)) == -1)
break;
- /* Picture date */
+ /* Picture data */
if ((rc = id3_field_parse(&frame->fields[4], &data,
end - data, &encoding)) == -1)
break;
diff --git a/scheme/idest/format/pic.scm b/scheme/idest/format/pic.scm
new file mode 100644
index 0000000..8f94599
--- /dev/null
+++ b/scheme/idest/format/pic.scm
@@ -0,0 +1,204 @@
+;; This file is part of Idest
+;; Copyright (C) 2011 Sergey Poznyakoff
+;;
+;; Idest is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Idest is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Idest. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (idest format pic))
+
+(use-modules (ice-9 getopt-long)
+ (srfi srfi-1))
+
+(define-public description
+ "show attached picture (APIC frame) or save it on disk")
+
+(define-public idest-main #f)
+
+;; Format specifiers
+;; ~D - Input file directory part
+;; ~N - Input file base name
+;; ~C - Content description
+;; ~T - Mime type without the "image/" prefix
+;; ~P - Picture type
+;; ~I - pid
+(define (format-file-name fmt input-name frame)
+ (let* ((rawdata (assoc-ref (cdr frame) 'rawdata))
+ (fmtlist (string-split fmt #\~))
+ (segments (reverse
+ (fold
+ (lambda (elt prev)
+ (if (string-null? elt)
+ (cons (string-append (car prev) "~") (cdr prev))
+ (let ((ch (string-ref elt 0)))
+ (case ch
+ ((#\D #\N #\C #\T #\P #\I) (cons elt prev))
+ (else
+ (cons (string-append (car prev) elt)
+ (cdr prev)))))))
+ '()
+ (cdr fmtlist)))))
+ (apply
+ string-append
+ (car fmtlist)
+ (map
+ (lambda (seg)
+ (string-append
+ (case (string-ref seg 0)
+ ((#\D) (dirname input-name))
+ ((#\N) (let* ((bname (basename input-name))
+ (pos (string-rindex bname #\.)))
+ (if pos
+ (substring bname 0 pos)
+ bname)))
+ ((#\C) (list-ref (list-ref rawdata 3) 2))
+ ((#\T) (let* ((t (list-ref (list-ref rawdata 1) 2))
+ (pos (string-index t #\/)))
+ (if pos
+ (substring t (+ pos 1))
+ t)))
+ ((#\P) (list-ref (list-ref rawdata 0) 2))
+ ((#\I) (number->string (getpid))))
+ (substring seg 1)))
+ segments))))
+
+(define (save-picture name data)
+ (with-output-to-file
+ name
+ (lambda ()
+ (for-each
+ write-char
+ (let string->bytelist ((str data)
+ (bytelist '()))
+ (cond
+ ((string-null? str)
+ (reverse bytelist))
+ (else
+ (string->bytelist
+ (substring str 2)
+ (cons
+ (integer->char
+ (string->number (substring str 0 2) 16))
+ bytelist)))))))))
+
+(define-public (idest-init)
+ (let* ((cmd (command-line))
+ (progname (car cmd))
+ (description #f)
+ (mime-type #f)
+ (store #f)
+ (file #f)
+ (viewer "xv")
+ (grammar `((description (single-char #\d) (value #t))
+ (mime-type (single-char #\m) (value #t))
+ (store (single-char #\s) (value #f))
+ (file (single-char #\f) (value #t))
+ (viewer (single-char #\v) (value #t))
+ (help (single-char #\h)))))
+ (catch 'misc-error
+ (lambda ()
+ (for-each
+ (lambda (x)
+ (case (car x)
+ ((description)
+ (set! desciption (cdr x)))
+ ((mime-type)
+ (set! mime-type (cdr x)))
+ ((store)
+ (set! store #t))
+ ((file)
+ (set! file (cdr x)))
+ ((viewer)
+ (set! viewer (cdr x)))
+ ((help)
+ (format #t "usage: idest --format=~A [OPTIONS] FILE...\n"
+ progname)
+ (format #t "displays attached picture(s) or stores them on disc\n")
+ (format #t "OPTIONS are:\n")
+ (format #t " -v, --viewer PROG use PROG to view images (default: xv)\n")
+ (format #t " -d, --description STR look for picture with this description\n")
+ (format #t " -m, --mime-type TYPE picture must have this MIME type\n")
+ (format #t " -s, --store store picture on disk, don't show it\n")
+ (format #t " -f, --file FILE save picture to FILE (implies --store)\n")
+ (newline)
+ (format #t "FILE is a format string and can contain the following meta-sequences:\n\n")
+ (format #t "Sequence Expands to\n")
+ (format #t "---------+-----------------------------\n")
+ (for-each
+ (lambda (elt)
+ (display elt)
+ (newline))
+ (list
+ " ~D Input file directory part"
+ " ~N Input file base name"
+ " ~C Content description"
+ " ~T Mime type without the \"image/\" prefix"
+ " ~P Picture type"
+ " ~I PID"))
+ (newline)
+ (exit 0))
+ (else
+ (set-program-arguments (cons progname (cdr x))))))
+ (getopt-long cmd grammar)))
+ (lambda (key . args)
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (format #t "~A: " progname)
+ (apply format #t (list-ref args 1) (list-ref args 2))
+ (newline)
+ (exit 1)))))
+
+ (if file
+ (set! store #t)
+ (set! file "/tmp/~I-~N.~T"))
+ (if (and mime-type (not (string-index mime-type #\/)))
+ (set! mime-type (string-append "image/" mime-type)))
+
+ (set! idest-main
+ (lambda (name frames)
+ (let ((pictures (filter
+ (lambda (frame)
+ (let ((rawdata (assoc-ref (cdr frame) 'rawdata))
+ (id (car frame)))
+ (and (string=? id "APIC")
+ (or (not mime-type)
+ (string-ci=?
+ (list-ref (list-ref rawdata 1) 2)
+ mime-type))
+ (or (not description)
+ (string-ci=?
+ (list-ref (list-ref rawdata 3) 2)
+ description)))))
+ frames)))
+ (force-output (current-output-port))
+ (force-output (current-error-port))
+ (cond
+ ((null? pictures)
+ (format (current-error-port) "~A: no (matching) picture~%"
+ name))
+ (else
+ (for-each
+ (lambda (pic)
+ (let ((data (list-ref (assoc-ref (cdr pic) 'rawdata) 4))
+ (file-name (format-file-name file name pic)))
+ (format #t "Saving ~A~%" file-name)
+ (save-picture file-name (list-ref data 2))
+ (cond
+ ((not store)
+ (let ((res (system* viewer file-name)))
+ (delete-file file-name)
+ (if (= res 256)
+ (exit 1)))))))
+ pictures))))))))
+
+ \ No newline at end of file

Return to:

Send suggestions and report system problems to the System administrator.