#!/usr/bin/guile \					-*-scheme-*-
-e main --debug -s
!#
;; make-prototype.  Generated from make-prototype.in by configure.

;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.

;; This file is part of GNUnited Nations.

;; GNUnited Nations 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 of the
;; License, or (at your option) any later version.

;; GNUnited Nations 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 GNUnited Nations.  If not, see
;; <http://www.gnu.org/licenses/>.

(define version-message
  (string-append
   "make-prototype (GNUnited Nations) 0.2\n"
   "Copyright (C) 2009 Free Software Foundation, Inc.\n"
   "You may redistribute copies of GNUnited Nations\n"
   "under the terms of the GNU General Public License.\n"
   "For more information about these matters, see the file named COPYING.\n"))

; FIXME: Use AC_INIT's 5th argument and AC_PACKAGE_URL once Autoconf
; 2.64 is released.
(define help-message
  (string-append
   "Usage: make-prototype OPTION...\n"
   "\n"
   "Input format specification:\n"
   "      --article              Process input file as an article (default)\n"
   "      --home                 Process input file as a home page\n"
   "\n"
   "Input specification:\n"
   "  -i, --input=FILE           Input file (article or home page)\n"
   "  -g, --generic=FILE         Generic notes for a language team\n"
   "\n"
   "Output options:\n"
   "  -o, --output=FILE          Output prototype\n"
   "  -t, --translinks=FILE      Translations links (meaningful for articles only)\n"
   "\n"
   "      --version              Just print version info and return\n"
   "      --help                 Print this usage information message\n"
   "\n"
   "Report bugs to bug-gnun@gnu.org\n"
   "GNUnited Nations home page: <http://www.gnu.org/software/gnun/>\n"
   "General help using GNU software: <http://www.gnu.org/gethelp/>\n"))

(define option-grammar
  '((article (value #f))
    (home (value #f))
    (input (single-char #\i) (value #t))
    (generic (single-char #\g) (value #t))
    (output (single-char #\o) (value #t))
    (translinks (single-char #\t) (value #t))
    (version (value #f))
    (help (value #f))))

(define article-page-regexp
  "^(.*)(<title>.*)(</div>.*<div id=\"footer\">.*)(<p>.*?[$]Date:.*)(<ul class=\"translations-list\">.*</ul>)(.*)$")

(define home-page-regexp
  "^(.*?)(<title>.*)(</div>.*<div id=\"footer\">.*)(<p>.*?[$]Date:.*)$")

(define skip-tag
  "gnun")

(define slot-translators-notes
  (string-append
   "\n"
   "<div style=\"font-size: small;\">\n"
   "<!--TRANSLATORS: Use space (SPC) as msgstr if you don't have notes.-->\n"
   "*GNUN-SLOT: TRANSLATOR'S NOTES*</div>\n"))

(define slot-translators-credits
  (string-append
  "\n"
  "<div class=\"translators-credits\">\n"
  "<!--TRANSLATORS: Use space (SPC) as msgstr if you don't want credits.-->\n"
  "*GNUN-SLOT: TRANSLATOR'S CREDITS*</div>\n"))

(define autogenerated-warning
  "This file is automatically generated by GNUnited Nations!")

(define <skip-tag>
  (string-append "<" skip-tag ">"))

(define </skip-tag>
  (string-append "</" skip-tag ">"))

(define <autogenerated-warning>
  (string-append
   <skip-tag> </skip-tag> "<!-- " autogenerated-warning " -->" "\n"))


(use-modules (ice-9 regex)
	     (ice-9 rdelim)
	     (ice-9 getopt-long))

(define (main args)
  (let* ((options (catch 'misc-error
			 (lambda () (getopt-long args option-grammar))
			 (lambda (key subr message args data)
			   (die (apply format #f message args)))))
	 (opt (lambda args (apply option-ref options args))))
    (cond ((opt 'version #f) (version))
	  ((opt 'help #f) (help))
	  ((and (opt 'article #f)
		(opt 'home #f))
	   (die "conflicting options: `--article' and `--home'"))
	  ((not (opt 'input #f))
	   (die "no input file"))
	  ((not (opt 'generic #f))
	   (die "no generic file"))
	  ((not (opt 'output #f))
	   (die "no output file"))
	  ((opt 'home #f)
	   (and (opt 'translinks #f)
		(die "`--translinks' makes no sense for home pages"))
	   (make-home (opt 'input #f)
		      (opt 'generic #f)
		      (opt 'output #f)))
	  ((opt 'article #t)
	   (or (opt 'translinks #f)
	       (die "no translinks file"))
	   (make-article (opt 'input #f)
			 (opt 'generic #f)
			 (opt 'output #f)
			 (opt 'translinks #f))))))

(define (die message)
  (display "make-prototype: " (current-error-port))
  (display message (current-error-port))
  (newline (current-error-port))
  (exit 2))

(define (version)
  (display version-message))

(define (help)
  (display help-message))

(define (make-article input generic output translinks)
  (with-input-from-file input
    (lambda ()
      (let ((m (string-match article-page-regexp (read-delimited ""))))
	(with-output-to-file output
	  (lambda ()
	    (display
	     (string-append (match:substring m 1)
			    <autogenerated-warning>
			    (match:substring m 2)
			    slot-translators-notes
			    (match:substring m 3)
			    slot-translators-credits
			    "<" skip-tag ">include(`" generic "')</" skip-tag "> "
			    (match:substring m 4)
			    "<" skip-tag ">include(`" translinks "')</" skip-tag ">"
			    (match:substring m 6)))))
	(with-output-to-file translinks
	  (lambda ()
	    (display (match:substring m 5))))))))

(define (make-home input generic output)
  (with-input-from-file input
    (lambda ()
      (let ((m (string-match home-page-regexp (read-delimited ""))))
	(with-output-to-file output
	  (lambda ()
	    (display
	     (string-append (match:substring m 1)
			    <autogenerated-warning>
			    (match:substring m 2)
			    slot-translators-notes
			    (match:substring m 3)
			    slot-translators-credits
			    "<" skip-tag ">include(`" generic "')</" skip-tag "> "
			    (match:substring m 4)))))))))
