Commit 38bc5019 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Implemented html-unwrap-document.

parent 72c642b4
......@@ -78,8 +78,8 @@ index.html.in:init.lisp index.lisp Makefile
html:index.html.in
find . -name \*.html.in -print \
| while read file ; do \
echo bin/html-wrap-document.lisp \< "$$file" \> "$$(echo $$file | sed -e 's/\.in$$//')" ;\
bin/html-wrap-document.lisp < "$$file" > "$$(echo $$file | sed -e 's/\.in$$//')" ;\
echo ../tools/html-wrap-document.lisp \< "$$file" \> "$$(echo $$file | sed -e 's/\.in$$//')" ;\
../tools/html-wrap-document.lisp < "$$file" > "$$(echo $$file | sed -e 's/\.in$$//')" ;\
done
.PHONY::html
......
......@@ -15,6 +15,7 @@ botihn: com.informatimago.small-cl-pgms.botihn.asd botihn.lisp generate-applica
doc::
pandoc -f rst -t asciidoc < botihn.txt >botihn-fr.asc
rst2html $(RSTHTMLOPT) < botihn.txt | ../bin/html-unwrap-document.lisp > botihn-fr.html
rst2html $(RSTHTMLOPT) < botihn.txt | ../../tools/html-unwrap-document.lisp > botihn-fr.html.in
#### THE END ####
#!/usr/local/bin/clisp -ansi -q -E utf-8
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: html-unwrap-document
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; This script takes a HTML page containing a <div class="document"> entity
;;;; and produces file containing only this element.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-10-20 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; 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/>.
;;;;**************************************************************************
(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*)
#-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")
(com.informatimago.common-lisp.cesarum.package:add-nickname
"COM.INFORMATIMAGO.COMMON-LISP.HTML-GENERATOR.HTML" "<")
(defun unwrap (output class id title description author keywords language document)
(unparse-html `(:div (:class ,class
:id ,id
:title ,(or title "")
:description ,(or description "")
:author ,(or author "")
:language ,(or language "en"))
,@(element-children document))
output)
(values))
(defun main (&optional arguments)
(declare (ignore arguments))
(let* ((html (child-tagged (parse-html-stream *standard-input*) :html))
(head (child-tagged html :head))
(title (element-child (child-tagged head :title)))
(author (value-of-attribute-named (child-tagged-and-valued head :meta :name "author") :content))
(description (value-of-attribute-named (child-tagged-and-valued head :meta :name "description") :content))
(keywords (value-of-attribute-named (child-tagged-and-valued head :meta :name "keywords") :content))
(language (or (value-of-attribute-named html :lang)
(value-of-attribute-named html :xml\:lang)
"en"))
(class "document")
(document (first (grandchildren-tagged-and-valued html :div :class class)))
(id (value-of-attribute-named document :id)))
(unwrap *standard-output* class id title description author keywords language document)))
#-testing-script
(progn
(main ext:*args*)
(ext:exit 0))
(pushnew :testing-script *features*)
;;;; THE END ;;;;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment