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.

2 files changed, 198 insertions, 0 deletions

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))))))
+		frames)
+	       (format (current-error-port)  "~A: no lyrics~%" name)))))))
\ No newline at end of file