#!/usr/local/bin/clisp -ansi -q -E utf-8
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               html-wrap-document
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    This script takes a file containing a <div class="document"> entity
;;;;    and produces a HTML page containing it, with site header and footer.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2015-10-20 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal J. Bourguignon 2015 - 2016
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero General Public License as published by
;;;;    the Free Software Foundation, either version 3 of the License, or
;;;;    (at your option) any later version.
;;;;
;;;;    This program 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 Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *readtable* (copy-readtable nil)))
(in-package "COMMON-LISP-USER")

(defmacro redirecting-stdout-to-stderr (&body body)
  (let ((verror  (gensym))
        (voutput (gensym)))
    `(let* ((,verror  nil)
            (,voutput (with-output-to-string (stream)
                        (let ((*standard-output* stream)
                              (*error-output*    stream)
                              (*trace-output*    stream))
                          (handler-case (progn ,@body)
                            (error (err) (setf ,verror err)))))))
       (when ,verror
         (terpri *error-output*)
         (princ ,voutput *error-output*)
         (terpri *error-output*)
         (princ ,verror *error-output*)
         (terpri *error-output*)
         (terpri *error-output*)
         #+(and clisp (not testing-script)) (ext:exit 1)))))

(redirecting-stdout-to-stderr
  (load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))

(redirecting-stdout-to-stderr
  (ql:quickload :com.informatimago.common-lisp))

(use-package "COM.INFORMATIMAGO.COMMON-LISP.HTML-PARSER.PARSE-HTML")
(use-package "COM.INFORMATIMAGO.COMMON-LISP.HTML-BASE.ML-SEXP")


(defun wrap (input output)
  (let ((document (child-tagged-and-valued (parse-html-stream input) :div "class" "document")))
    (unless document
      (error "Not a <div class=\"document\">…</div> input file."))
    (let ((class       (value-of-attribute-named document :class       ))
          (id          (value-of-attribute-named document :id          ))
          (title       (value-of-attribute-named document :title       ))
          (author      (value-of-attribute-named document :author      ))
          (description (value-of-attribute-named document :description ))
          (keywords    (value-of-attribute-named document :keywords    ))
          (language    (value-of-attribute-named document :language    )))
      (write-line "<?xml version=\"1.0\" encoding=\"utf-8\" ?>" output)
      (write-line "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" output)
      (write-line "<!-- THIS FILE IS GENERATED BY html-wrap-document -->" output)
      (write-line "<!-- PLEASE DO NOT EDIT THIS FILE! -->" output)
      (format output "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"~A\"~:* lang=\"~A\">~%" language)
      (unparse-html `(:head ()
                       (:title () ,title)
                       (:link (:rel "stylesheet"    :href "/default.css" :type "text/css"))
                       (:link (:rel "icon"          :href "/favicon.ico" :type "image/x-icon"))
                       (:link (:rel "shortcut icon" :href "/favicon.ico" :type "image/x-icon"))
                       (:meta (                     :content "text/html; charset=utf-8" :http-equiv "Content-Type" ))
                       (:meta (:name "author"       :content ,author))
                       (:meta (:name "description"  :content ,description               :http-equiv "Description"))
                       (:meta (:name "keywords"     :content ,keywords)))
                    output)
      (write-string "<body>
<!-- TOP-BEGIN -->
<!-- TOP-END -->
<!-- MENU-BEGIN -->
<!-- MENU-END -->
" output)
      (unparse-html  `(:div (:class ,class :id ,id)
                        ,@(element-children document))
                     output)
      (write-string "
<!-- MENU-BEGIN -->
<!-- MENU-END -->
<!-- BOTTOM-BEGIN -->
<!-- BOTTOM-END -->
</body></html>
" output)))
  (values))


(defun main (&optional arguments)
  (declare (ignore arguments))
  (wrap *standard-input* *standard-output*))


#+(and clisp (not testing-script))
(progn
  (main ext:*args*)
  (ext:exit 0))


(pushnew :testing-script *features*)
#-(and) (progn
         (with-open-file (*standard-input* #P"/Users/pjb/public_html/sites/com.informatimago.www/develop/lisp/com/informatimago/small-cl-pgms/botihn/botihn-fr.html.in")
           (parse-html-stream *standard-input*))


         (with-open-file (*standard-input* #P"/Users/pjb/public_html/sites/com.informatimago.www/develop/lisp/com/informatimago/small-cl-pgms/aim-8/aim-8.html.in")
           (parse-html-stream *standard-input*)))


;;;; THE END ;;;;
ViewGit