Improve batch/format interface.

* scheme/batch.scm: Rewrite using idest-load-module
* scheme/format.scm: Likewise.
* scheme/idest/batch/setlyrics.scm: New file.
* scheme/idest/format/framelist.scm: Define idest-init
* scheme/idest/format/help.scm: Likewise.
* scheme/idest/format/lyrics.scm: Likewise.
* scheme/idest/load-module.scm: New file.

5 files changed, 323 insertions, 155 deletions

diff --git a/scheme/idest/batch/setlyrics.scm b/scheme/idest/batch/setlyrics.scm
new file mode 100644
index 0000000..bd137a5
--- /dev/null
+++ b/scheme/idest/batch/setlyrics.scm
@@ -0,0 +1,106 @@
+;; 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 batch setlyrics))
+
+(use-modules (ice-9 getopt-long)
+	     (ice-9 rdelim))
+
+(define (show-help progname)
+  (format #t "usage: idest --batch=~A [OPTIONS] FILE...\n" progname)
+  (format #t "sets the USLT (unsynchronised lyric text) frame from a file\n")
+  (format #t "OPTIONS are:\n")
+  (format #t "  -f, --file FILE    read text from FILE (default: stdin)\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))
+	  
+(define-public description
+  "set song lyrics (USLT frame) from a file")
+
+(define-public idest-main #f)
+
+(define-public (idest-init)
+  (let* ((cmd (command-line))
+	 (progname (car cmd))
+	 (file #f)
+	 (lang "eng")
+	 (condesc "")
+	 (grammar `((file (single-char #\f) (value #t))
+		    (lang (single-char #\l) (value #t))
+		    (content (single-char #\c) (value #t))
+		    (help))))
+    (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)
+		   (show-help progname))
+		  (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
+     ((< (length (command-line)) 2)
+      (format (current-error-port)
+	      "usage: idest -S ~A [OPTIONS] FILE...\n\
+ry `idest -S ~A --help', for more info.\n"
+	      progname progname)
+      (exit 1)))
+    
+    (let ((text
+	   (with-input-from-port
+	       (if file (open file O_RDONLY) (current-input-port))
+	     (lambda ()
+	       (do ((line-list '())
+		    (line (read-line) (read-line)))
+		   ((eof-object? line)
+		    (apply string-append (reverse line-list)))
+		 (set! line-list (cons line (cons "\n" line-list))))))))
+      (letrec ((mainfunc
+		(lambda (name frames)
+		  (append
+		   (filter
+		    (lambda (elt)
+		      (not (and (string=? (car elt) "USLT")
+				(let ((v (assoc-ref (cdr elt) 'lang)))
+				  (or (not v) (string=? lang)))
+				(let ((v (assoc-ref (cdr elt) 'condesc)))
+				  (or (not v) (string=? condesc))))))
+		    frames)
+		   (list
+		    (cons
+		     "USLT"
+		     (list (cons 'lang lang)
+			   (cons 'condesc condesc)
+			   (cons 'text text))))))))
+	(set! idest-main mainfunc)))))
+
+
diff --git a/scheme/idest/format/framelist.scm b/scheme/idest/format/framelist.scm
index 693742e..daf2efd 100644
--- a/scheme/idest/format/framelist.scm
+++ b/scheme/idest/format/framelist.scm
@@ -23,78 +23,77 @@
 
 (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)))))))))
-
-
+(define-public (idest-init)
+  (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/help.scm b/scheme/idest/format/help.scm
index e55dda1..57e954b 100644
--- a/scheme/idest/format/help.scm
+++ b/scheme/idest/format/help.scm
@@ -18,8 +18,10 @@
 
 (use-modules (idest list-modules))
 
-(idest-list-modules 'format)
-(exit 0)
+(define-public (idest-init)
+  (idest-list-modules 'format)
+  (exit 0))
+
 
 
 
diff --git a/scheme/idest/format/lyrics.scm b/scheme/idest/format/lyrics.scm
index 1ad1f03..3e366fd 100644
--- a/scheme/idest/format/lyrics.scm
+++ b/scheme/idest/format/lyrics.scm
@@ -24,81 +24,82 @@
 
 (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
+(define-public (idest-init)
+  (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
diff --git a/scheme/idest/load-module.scm b/scheme/idest/load-module.scm
new file mode 100644
index 0000000..1460709
--- /dev/null
+++ b/scheme/idest/load-module.scm
@@ -0,0 +1,60 @@
+;; 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 load-module))
+
+(use-modules (guile-user))
+
+(define-public (idest-load-module type)
+  (let* ((cmd (command-line))
+	 (mod-pathname #f)
+	 (mod-name (list-ref cmd 1)))
+       
+    (set-program-arguments (list-tail cmd 1))
+    
+    (letrec ((module (resolve-module
+		      (list 'idest type (string->symbol mod-name))))
+	     (get-proc (lambda (sym)
+			 (if (module-defined? module sym)
+			     (let ((proc (module-ref module sym)))
+			       (cond
+				((procedure? proc)
+				 proc)
+				(else
+				 (format (current-error-port)
+					 "idest: ~A is defined in ~A, but is not a procedure~%"
+					 sym mod-name)
+				 (exit 1))))
+			     #f))))
+
+      (cond
+       ((not (and module (module-public-interface module)))
+	(error "no code for module" mod-name))
+       ((get-proc 'idest-init) =>
+	(lambda (proc)
+	  (proc))))
+      
+      (cond
+;;        ((and (eq? type 'format) (not idest-readonly))
+;; 	(format (current-error-port) "idest: ~A wants to modify files!~%"
+;; 		mod-pathname)
+;; 	(exit 1))
+       ((get-proc 'idest-main) =>
+	(lambda (proc)
+	  (set! idest-main proc)))
+       (else
+	(format (current-error-port)
+		"idest: ~A does not define ~A~%" mod-name 'idest-main)
+	(exit 1))))))