Implement new formats: framelist & lyrics.

* scheme/format.scm: Set actual format script name as argv[0]
* src/cmdline.opt <format>: Use `stop' to stop
argument processing.
* src/getopt.m4 (GETOPT): New local variable `stop'.

* scheme/idest/format/framelist.scm: New file.
* scheme/idest/format/lyrics.scm: New file.

7 files changed, 206 insertions, 7 deletions

diff --git a/scheme/format.scm b/scheme/format.scm
index 61a98cc..9ce8026 100644
--- a/scheme/format.scm
+++ b/scheme/format.scm
@@ -26,7 +26,7 @@
                      (set! %load-hook saved-load-hook)))
 
   (let ((mod-name (list-ref cmd 1)))
-    (set-program-arguments (cons (car cmd) (list-tail cmd 2)))
+    (set-program-arguments (list-tail cmd 1))
     (set! idest-main
           (module-ref
            (resolve-module (list 'idest 'format (string->symbol mod-name)))
diff --git a/scheme/idest/format/framelist.scm b/scheme/idest/format/framelist.scm
new file mode 100644
index 0000000..2445a59
--- /dev/null
+++ b/scheme/idest/format/framelist.scm
@@ -0,0 +1,97 @@
+;; 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 framelist))
+
+(use-modules (ice-9 getopt-long))
+
+(define-public idest-main #f)
+
+(let* ((cmd (command-line))
+       (progname (car cmd))
+       (delim #\newline)
+       (addinfo #f)
+       (frame-list #f) ; FIXME: Need a way to access filter_list from idest
+       (grammar `((full (single-char #\F))
+                  (qualified (single-char #\Q))
+                  (frames (single-char #\f) (value #t))
+                  (single-line (single-char #\l))
+                  (help (single-char #\h)))))
+  
+  (catch 'misc-error
+         (lambda ()
+           (for-each
+            (lambda (x)
+              (case (car x)
+                ((full)
+                 (set! addinfo
+                       (lambda (attr-list)
+                         (for-each
+                          (lambda (attr)
+                            (if (not (eq? (car attr) 'text))
+                                (format #t " ~A=\"~A\""
+                                        (car attr) (cdr attr))))
+                          attr-list))))
+                ((qualified)
+                 (set! addinfo
+                       (lambda (attr-list)
+                         (for-each
+                          (lambda (attr)
+                            (if (not (or (eq? (car attr) 'text)
+                                         (eq? (car attr) 'descr)))
+                                (format #t ":~A" (cdr attr))))
+                          attr-list))))
+                ((single-line)
+                 (set! delim #\,))
+                ((frames)
+                 (set! frame-list (string-split (cdr x) #\,)))
+                ((help)
+                 (format #t "usage: idest --format=~A [OPTIONS] FILE...\n"
+                         progname)
+                 (format #t "displays the frame list\n")
+                 (format #t "OPTIONS are:\n")
+                 (format #t "  -F, --full         display all qualifiers\n")
+                 (format #t "  -f, --frames FLIST display only frames from FLIST\n")
+                 (format #t "  -Q, --qualified    display frames in qualified form\n")
+                 (format #t "  -l, --single-line  fit output on single-line\n")
+                 (format #t "  -h, --help         show this help summary\n")
+                 (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)))))
+
+  (set! idest-main
+        (lambda (name frames)
+          (do ((tail frames (cdr tail)))
+              ((null? tail))
+            (let ((elt (car tail)))
+              (cond
+               ((or (not frame-list) (member (car elt) frame-list))
+                (display (car elt))
+                (if addinfo (addinfo (cdr elt)))
+                (if (null? (cdr tail))
+                    (newline)
+                    (display delim)))))))))
+
+
diff --git a/scheme/idest/format/lyrics.scm b/scheme/idest/format/lyrics.scm
new file mode 100644
index 0000000..7fb5b1c
--- /dev/null
+++ b/scheme/idest/format/lyrics.scm
@@ -0,0 +1,101 @@
+;; 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 lyrics))
+
+(use-modules (ice-9 getopt-long)
+             (ice-9 popen))
+
+(define-public idest-main #f)
+
+(let* ((cmd (command-line))
+       (progname (car cmd))
+       (lang #f)
+       (condesc #f)
+       (grammar `((lang (single-char #\l) (value #t))
+                  (content (single-char #\c) (value #t))
+                  (help (single-char #\h)))))
+  (catch 'misc-error
+         (lambda ()
+           (for-each
+            (lambda (x)
+              (case (car x)
+                ((file)
+                 (set! file (cdr x)))
+                ((lang)
+                 (set! lang (cdr x)))
+                ((content)
+                 (set! condesc (cdr x)))
+                ((help)
+                 (format #t "usage: idest --format=~A [OPTIONS] FILE...\n"
+                         progname)
+                 (format #t "displays the USLT (unsynchronised lyric text) frame\n")
+                 (format #t "OPTIONS are:\n")
+                 (format #t "  -l, --lang NAME    set language in which the lyrics is writen (default: eng)\n")
+                 (format #t "  -c, --content TEXT set content description\n")
+                 (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)))))
+  (set! idest-main
+        (lambda (name frames)
+          (force-output (current-output-port))
+          (force-output (current-error-port))
+          (letrec ((title #f)
+                   (print-lyrics (lambda (text)
+                                   (display (or title name))
+                                   (newline)
+                                   (newline)
+                                   (display text)
+                                   (newline))))
+            (call-with-current-continuation
+             (lambda (return)
+               (for-each
+                (lambda (elt)
+                  (let ((frame-name (car elt))
+                        (frame-attr (cdr elt)))
+                    (cond
+                     ((string=? frame-name "TIT2")
+                      (set! title (assoc-ref frame-attr 'text)))
+                     ((and (string=? frame-name "USLT")
+                           (or (not lang)
+                               (string=? lang (assoc-ref frame-attr 'lang)))
+                           (or (not condesc)
+                               (string=? condesc
+                                         (assoc-ref frame-attr 'condesc))))
+                      (let ((text (assoc-ref frame-attr 'text)))
+                        (cond
+                         ((getenv "PAGER") =>
+                          (lambda (pag)
+                            (let ((port (open-output-pipe pag)))
+                              (with-output-to-port
+                                  port
+                                (lambda ()
+                                  (print-lyrics text)))
+                              (close-pipe port))))
+                         (else
+                          (print-lyrics text)))
+                        (return))))))