;; This file is part of Idest ;; Copyright (C) 2011, 2015 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 . (define-module (idest batch setpic)) (use-modules (ice-9 getopt-long) (rnrs io ports)) (define-public description "set attached picture from a file") (define-public idest-main #f) (define (read-picture file) (with-output-to-string (lambda () (let ((port (open-file-input-port file))) (let ((get-byte (lambda () (get-u8 port)))) (let loop ((n (get-byte))) (cond ((not (eof-object? n)) (if (< n 16) (display "0")) (display (number->string n 16)) (loop (get-byte)))))) (close-port port))))) (define-public (idest-init) (let* ((cmd (command-line)) (progname (car cmd)) (description "") (mime-type #f) (pic-type "0") (file #f) (grammar `((description (single-char #\d) (value #t)) (mime-type (single-char #\m) (value #t)) (pic-type (single-char #\p) (value #t)) (file (single-char #\f) (value #t)) (help (single-char #\h))))) (catch 'misc-error (lambda () (for-each (lambda (x) (case (car x) ((description) (set! description (cdr x))) ((mime-type) (set! mime-type (cdr x))) ((pic-type) (set! pic-type (cdr x))) ((file) (set! file (cdr x))) ((help) (format #t "usage: idest --format=~A [OPTIONS] FILE...\n" progname) (format #t "OPTIONS are:\n") (format #t " -d, --description STR set description\n") (format #t " -m, --mime-type TYPE set MIME type\n") (format #t " -p, --pic-type NUM set picture type\n") (format #t " -f, --file FILE read picture from FILE\n") (format #t " -h, --help show this help summary\n") (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))))) (cond ((not file) (format #t "~A: missing --file option\n" progname) (exit 1)) ((not mime-type) (let ((i (string-rindex file #\.))) (cond ((= i -1) (format #t "~A: cannot deduce MIME type for ~A: use --mime-type option\n" progname file) (exit 1))) (set! mime-type (string-append "image/" (substring file (1+ i))))))) (cond ((= -1 (string-rindex mime-type #\/)) (set! mime-type (string-append "image/" mime-type))) ((not (string-prefix? "image/" mime-type)) (format #t "~A: invalid MIME type" progname))) (set! idest-main (lambda (name frames) (append (filter (lambda (elt) (not (and (string=? (car elt) "APIC") (string-ci=? (or (assoc-ref (cdr elt) 'mime-type) "image/png") mime-type) (string=? (or (assoc-ref (cdr elt) 'pic-type) "0") pic-type) (string-ci=? (or (assoc-ref (cdr elt) 'condesc) "") description)))) frames) (list (cons "APIC" (list (cons 'mime-type (string-downcase mime-type)) (cons 'pic-type pic-type) (cons 'condesc description) (cons 'text (read-picture file))))))))))