From 55655a18d5997bb376311f808fdb8883821eade3 Mon Sep 17 00:00:00 2001 From: Luis Oliveira Date: Thu, 19 Jul 2007 00:28:21 +0100 Subject: [PATCH] Very ad-hoc initial version --- .gitignore | 27 - Makefile | 41 + README | 1 + colorize.lisp | 1051 +++++++++++++++++ docstrings.lisp | 48 +- frontend.lisp | 85 ++ gendocs.sh | 300 +++++ gendocs_template | 234 ++++ generate-doc-dir.sh | 25 + licenses/LLGPL.texinfo | 0 licenses/MIT.texinfo | 20 + licenses/PUBLIC-DOMAIN.texinfo | 38 + styles/edi-style.css | 0 styles/style.css | 48 + template.makefile | 31 + template.texinfo | 71 ++ texinfo-docstrings | 1271 +++++++++++++++++++++ texinfo-docstrings.asd | 7 + docstrings.lisp => trunk/docstrings.lisp.original | 0 trunk/gendocs.sh.original | 300 +++++ 20 files changed, 3554 insertions(+), 44 deletions(-) delete mode 100644 .gitignore create mode 100644 Makefile create mode 100644 README create mode 100644 colorize.lisp create mode 100644 frontend.lisp create mode 100644 gendocs.sh create mode 100644 gendocs_template create mode 100644 generate-doc-dir.sh create mode 100644 licenses/LLGPL.texinfo create mode 100644 licenses/MIT.texinfo create mode 100644 licenses/PUBLIC-DOMAIN.texinfo create mode 100644 styles/edi-style.css create mode 100644 styles/style.css create mode 100644 template.makefile create mode 100644 template.texinfo create mode 100644 texinfo-docstrings create mode 100644 texinfo-docstrings.asd copy docstrings.lisp => trunk/docstrings.lisp.original (100%) create mode 100644 trunk/gendocs.sh.original diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 2320edf..0000000 --- a/.gitignore +++ /dev/null @@ -1,27 +0,0 @@ -*.aux -*.cp -*.cps -*.fn -*.fns -*.ky -*.log -*.pg -*.texi-temp -*.toc -*.tp -*.tps -*.vr -*.vrs -asdf.info* -asdf.pdf -asdf.ps -asdf.texinfo -asdf/ -docstrings/ -html-stamp -sbcl.info* -sbcl.pdf -sbcl.ps -sbcl/ -tempfiles-stamp -variables.texinfo diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..71046b2 --- /dev/null +++ b/Makefile @@ -0,0 +1,41 @@ +# -*- Mode: Makefile; tab-width: 4; indent-tabs-mode: t -*- +# +# Makefile --- Make targets for texinfo-docstrings. +# +# Copyright (C) 2007, Luis Oliveira +# +# Permission is hereby granted, free of charge, to any person +# obtaining a copy of this software and associated documentation +# files (the "Software"), to deal in the Software without +# restriction, including without limitation the rights to use, copy, +# modify, merge, publish, distribute, sublicense, and/or sell copies +# of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +.PHONY = all + +all: texinfo-docstrings + +gendocs.sh: + wget -O gendocs.sh http://cvs.savannah.gnu.org/viewvc/*checkout*/texinfo/texinfo/util/gendocs.sh + +cl-launch.sh: + wget -O cl-launch.sh http://fare.tunes.org/files/cl-launch/cl-launch.sh + chmod a+x cl-launch.sh + +texinfo-docstrings: cl-launch.sh frontend.lisp + ./cl-launch.sh --output texinfo-docstrings --file frontend.lisp + +# vim: ft=make ts=4 noet diff --git a/README b/README new file mode 100644 index 0000000..4a6bb31 --- /dev/null +++ b/README @@ -0,0 +1 @@ +Very preliminary stuff built upon SB-TEXINFO. Still very ad-hoc. Document later. diff --git a/colorize.lisp b/colorize.lisp new file mode 100644 index 0000000..420ff42 --- /dev/null +++ b/colorize.lisp @@ -0,0 +1,1051 @@ +;;; This is code was taken from lisppaste2 and is a quick hack +;;; to colorize lisp examples in the html generated by Texinfo. +;;; It is not general-purpose utility, though it could easily be +;;; turned into one. + +;;;; colorize-package.lisp + +(defpackage :colorize + (:use :common-lisp) + (:export :scan-string :format-scan :html-colorization + :find-coloring-type :autodetect-coloring-type + :coloring-types :scan :scan-any :advance :call-parent-formatter + :*coloring-css* :make-background-css :*css-background-class* + :colorize-file :colorize-file-to-stream :*version-token*)) + +;;;; coloring-css.lisp + +(in-package :colorize) + +(defparameter *coloring-css* + ".symbol { color: #770055; background-color: transparent; border: 0px; margin: 0px;} +a.symbol:link { color: #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:active { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:visited { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:hover { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +.special { color : #FF5000; background-color : inherit; } +.keyword { color : #770000; background-color : inherit; } +.comment { color : #007777; background-color : inherit; } +.string { color : #777777; background-color : inherit; } +.character { color : #0055AA; background-color : inherit; } +.syntaxerror { color : #FF0000; background-color : inherit; } +span.paren1:hover { color : inherit; background-color : #BAFFFF; } +span.paren2:hover { color : inherit; background-color : #FFCACA; } +span.paren3:hover { color : inherit; background-color : #FFFFBA; } +span.paren4:hover { color : inherit; background-color : #CACAFF; } +span.paren5:hover { color : inherit; background-color : #CAFFCA; } +span.paren6:hover { color : inherit; background-color : #FFBAFF; } +") + +(defvar *css-background-class* "lisp-bg") + +(defun for-css (thing) + (if (symbolp thing) (string-downcase (symbol-name thing)) + thing)) + +(defun make-background-css (color &key (class *css-background-class*) (extra nil)) + (format nil ".~A { background-color: ~A; color: black; ~{~A; ~}}~:*~:*~:* +.~A:hover { background-color: ~A; color: black; ~{~A; ~}}~%" + class color + (mapcar #'(lambda (extra) + (format nil "~A : ~{~A ~}" + (for-css (first extra)) + (mapcar #'for-css (cdr extra)))) + extra))) + +;;;; colorize.lisp + +;(in-package :colorize) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *coloring-types* nil) + (defparameter *version-token* (gensym))) + +(defclass coloring-type () + ((modes :initarg :modes :accessor coloring-type-modes) + (default-mode :initarg :default-mode :accessor coloring-type-default-mode) + (transition-functions :initarg :transition-functions :accessor coloring-type-transition-functions) + (fancy-name :initarg :fancy-name :accessor coloring-type-fancy-name) + (term-formatter :initarg :term-formatter :accessor coloring-type-term-formatter) + (formatter-initial-values :initarg :formatter-initial-values :accessor coloring-type-formatter-initial-values :initform nil) + (formatter-after-hook :initarg :formatter-after-hook :accessor coloring-type-formatter-after-hook :initform (constantly "")) + (autodetect-function :initarg :autodetect-function :accessor coloring-type-autodetect-function + :initform (constantly nil)) + (parent-type :initarg :parent-type :accessor coloring-type-parent-type + :initform nil) + (visible :initarg :visible :accessor coloring-type-visible + :initform t))) + +(defun find-coloring-type (type) + (if (typep type 'coloring-type) + type + (cdr (assoc (symbol-name type) *coloring-types* :test #'string-equal :key #'symbol-name)))) + +(defun autodetect-coloring-type (name) + (car + (find name *coloring-types* + :key #'cdr + :test #'(lambda (name type) + (and (coloring-type-visible type) + (funcall (coloring-type-autodetect-function type) name)))))) + +(defun coloring-types () + (loop for type-pair in *coloring-types* + if (coloring-type-visible (cdr type-pair)) + collect (cons (car type-pair) + (coloring-type-fancy-name (cdr type-pair))))) + +(defun (setf find-coloring-type) (new-value type) + (if new-value + (let ((found (assoc type *coloring-types*))) + (if found + (setf (cdr found) new-value) + (setf *coloring-types* + (nconc *coloring-types* + (list (cons type new-value)))))) + (setf *coloring-types* (remove type *coloring-types* :key #'car)))) + +(defvar *scan-calls* 0) + +(defvar *reset-position* nil) + +(defmacro with-gensyms ((&rest names) &body body) + `(let ,(mapcar #'(lambda (name) + (list name `(make-symbol ,(symbol-name name)))) names) + ,@body)) + +(defmacro with-scanning-functions (string-param position-place mode-place mode-wait-place &body body) + (with-gensyms (num items position not-preceded-by string item new-mode until advancing) + `(labels ((advance (,num) + (setf ,position-place (+ ,position-place ,num)) + t) + (peek-any (,items &key ,not-preceded-by) + (incf *scan-calls*) + (let* ((,items (if (stringp ,items) + (coerce ,items 'list) ,items)) + (,not-preceded-by (if (characterp ,not-preceded-by) + (string ,not-preceded-by) ,not-preceded-by)) + (,position ,position-place) + (,string ,string-param)) + (let ((,item (and + (< ,position (length ,string)) + (find ,string ,items + :test #'(lambda (,string ,item) + #+nil + (format t "looking for ~S in ~S starting at ~S~%" + ,item ,string ,position) + (if (characterp ,item) + (char= (elt ,string ,position) + ,item) + (search ,item ,string :start2 ,position + :end2 (min (length ,string) + (+ ,position (length ,item)))))))))) + (if (characterp ,item) + (setf ,item (string ,item))) + (if + (if ,item + (if ,not-preceded-by + (if (>= (- ,position (length ,not-preceded-by)) 0) + (not (string= (subseq ,string + (- ,position (length ,not-preceded-by)) + ,position) + ,not-preceded-by)) + t) + t) + nil) + ,item + (progn + (and *reset-position* + (setf ,position-place *reset-position*)) + nil))))) + (scan-any (,items &key ,not-preceded-by) + (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by))) + (and ,item (advance (length ,item))))) + (peek (,item &key ,not-preceded-by) + (peek-any (list ,item) :not-preceded-by ,not-preceded-by)) + (scan (,item &key ,not-preceded-by) + (scan-any (list ,item) :not-preceded-by ,not-preceded-by))) + (macrolet ((set-mode (,new-mode &key ,until (,advancing t)) + (list 'progn + (list 'setf ',mode-place ,new-mode) + (list 'setf ',mode-wait-place + (list 'lambda (list ',position) + (list 'let (list (list '*reset-position* ',position)) + (list 'values ,until ,advancing))))))) + ,@body)))) + +(defvar *formatter-local-variables*) + +(defmacro define-coloring-type (name fancy-name &key modes default-mode transitions formatters + autodetect parent formatter-variables (formatter-after-hook '(constantly "")) + invisible) + (with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) + `(let ((,parent-type (or (find-coloring-type ,parent) + (and ,parent + (error "No such coloring type: ~S" ,parent))))) + (setf (find-coloring-type ,name) + (make-instance 'coloring-type + :fancy-name ',fancy-name + :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) + :default-mode (or ',default-mode + (if ,parent-type (coloring-type-default-mode ,parent-type))) + ,@(if autodetect + `(:autodetect-function ,autodetect)) + :parent-type ,parent-type + :visible (not ,invisible) + :formatter-initial-values (lambda nil + (list* ,@(mapcar #'(lambda (e) + `(cons ',(car e) ,(second e))) + formatter-variables) + (if ,parent-type + (funcall (coloring-type-formatter-initial-values ,parent-type)) + nil))) + :formatter-after-hook (lambda nil + (symbol-macrolet ,(mapcar #'(lambda (e) + `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) + formatter-variables) + (concatenate 'string + (funcall ,formatter-after-hook) + (if ,parent-type + (funcall (coloring-type-formatter-after-hook ,parent-type)) + "")))) + :term-formatter + (symbol-macrolet ,(mapcar #'(lambda (e) + `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) + formatter-variables) + (lambda (,term) + (labels ((call-parent-formatter (&optional (,type (car ,term)) + (,string (cdr ,term))) + (if ,parent-type + (funcall (coloring-type-term-formatter ,parent-type) + (cons ,type ,string)))) + (call-formatter (&optional (,type (car ,term)) + (,string (cdr ,term))) + (funcall + (case (first ,type) + ,@formatters + (t (lambda (,type text) + (call-parent-formatter ,type text)))) + ,type ,string))) + (call-formatter)))) + :transition-functions + (list + ,@(loop for transition in transitions + collect (destructuring-bind (mode &rest table) transition + `(cons ',mode + (lambda (,current-mode ,string ,position) + (let ((,mode-wait (constantly nil)) + (,position-foobage ,position)) + (with-scanning-functions ,string ,position-foobage + ,current-mode ,mode-wait + (let ((*reset-position* ,position)) + (cond ,@table)) + (values ,position-foobage ,current-mode + (lambda (,new-position) + (setf ,position-foobage ,new-position) + (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) + (values ,position-foobage ,advance))))) + ))))))))))) + +(defun full-transition-table (coloring-type-object) + (let ((parent (coloring-type-parent-type coloring-type-object))) + (if parent + (append (coloring-type-transition-functions coloring-type-object) + (full-transition-table parent)) + (coloring-type-transition-functions coloring-type-object)))) + +(defun scan-string (coloring-type string) + (let* ((coloring-type-object (or (find-coloring-type coloring-type) + (error "No such coloring type: ~S" coloring-type))) + (transitions (full-transition-table coloring-type-object)) + (result nil) + (low-bound 0) + (current-mode (coloring-type-default-mode coloring-type-object)) + (mode-stack nil) + (current-wait (constantly nil)) + (wait-stack nil) + (current-position 0) + (*scan-calls* 0)) + (flet ((finish-current (new-position new-mode new-wait &key (extend t) push pop) + (let ((to (if extend new-position current-position))) + (if (> to low-bound) + (setf result (nconc result + (list (cons (cons current-mode mode-stack) + (subseq string low-bound + to)))))) + (setf low-bound to) + (when pop + (pop mode-stack) + (pop wait-stack)) + (when push + (push current-mode mode-stack) + (push current-wait wait-stack)) + (setf current-mode new-mode + current-position new-position + current-wait new-wait)))) + (loop + (if (> current-position (length string)) + (return-from scan-string + (progn + (format *trace-output* "Scan was called ~S times.~%" + *scan-calls*) + (finish-current (length string) nil (constantly nil)) + result)) + (or + (loop for transition in + (mapcar #'cdr + (remove current-mode transitions + :key #'car + :test-not #'(lambda (a b) + (or (eql a b) + (if (listp b) + (member a b)))))) + if + (and transition + (multiple-value-bind + (new-position new-mode new-wait) + (funcall transition current-mode string current-position) + (when (> new-position current-position) + (finish-current new-position new-mode new-wait :extend nil :push t) + t))) + return t) + (multiple-value-bind + (pos advance) + (funcall current-wait current-position) + #+nil + (format t "current-wait returns ~S ~S (mode is ~S, pos is ~S)~%" pos advance current-mode current-position) + (and pos + (when (> pos current-position) + (finish-current (if advance + pos + current-position) + (car mode-stack) + (car wait-stack) + :extend advance + :pop t) + t))) + (progn + (incf current-position))) + ))))) + +(defun format-scan (coloring-type scan) + (let* ((coloring-type-object (or (find-coloring-type coloring-type) + (error "No such coloring type: ~S" coloring-type))) + (color-formatter (coloring-type-term-formatter coloring-type-object)) + (*formatter-local-variables* (funcall (coloring-type-formatter-initial-values coloring-type-object)))) + (format nil "~{~A~}~A" + (mapcar color-formatter scan) + (funcall (coloring-type-formatter-after-hook coloring-type-object))))) + +(defun encode-for-pre (string) + (declare (simple-string string)) + (let ((output (make-array (truncate (length string) 2/3) + :element-type 'character + :adjustable t + :fill-pointer 0))) + (with-output-to-string (out output) + (loop for char across string + do (case char + ((#\&) (write-string "&" out)) + ((#\<) (write-string "<" out)) + ((#\>) (write-string ">" out)) + (t (write-char char out))))) + (coerce output 'simple-string))) + +(defun string-substitute (string substring replacement-string) + "String substitute by Larry Hunter. Obtained from Google" + (let ((substring-length (length substring)) + (last-end 0) + (new-string "")) + (do ((next-start + (search substring string) + (search substring string :start2 last-end))) + ((null next-start) + (concatenate 'string new-string (subseq string last-end))) + (setq new-string + (concatenate 'string + new-string + (subseq string last-end next-start) + replacement-string)) + (setq last-end (+ next-start substring-length))))) + +(defun decode-from-tt (string) + (string-substitute (string-substitute (string-substitute string "&" "&") + "<" "<") + ">" ">")) + +(defun html-colorization (coloring-type string) + (format-scan coloring-type + (mapcar #'(lambda (p) + (cons (car p) + (let ((tt (encode-for-pre (cdr p)))) + (if (and (> (length tt) 0) + (char= (elt tt (1- (length tt))) #\>)) + (format nil "~A~%" tt) tt)))) + (scan-string coloring-type string)))) + +(defun colorize-file-to-stream (coloring-type input-file-name s2 &key (wrap t) (css-background "default")) + (let* ((input-file (if (pathname-type (merge-pathnames input-file-name)) + (merge-pathnames input-file-name) + (make-pathname :type "lisp" + :defaults (merge-pathnames input-file-name)))) + (*css-background-class* css-background)) + (with-open-file (s input-file :direction :input) + (let ((lines nil) + (string nil)) + (block done + (loop (let ((line (read-line s nil nil))) + (if line + (push line lines) + (return-from done))))) + (setf string (format nil "~{~A~%~}" + (nreverse lines))) + (if wrap + (format s2 + " + +
+~A +
" + *coloring-css* + (make-background-css "white") + *css-background-class* + (html-colorization coloring-type string)) + (write-string (html-colorization coloring-type string) s2)))))) + +(defun colorize-file (coloring-type input-file-name &optional output-file-name) + (let* ((input-file (if (pathname-type (merge-pathnames input-file-name)) + (merge-pathnames input-file-name) + (make-pathname :type "lisp" + :defaults (merge-pathnames input-file-name)))) + (output-file (or output-file-name + (make-pathname :type "html" + :defaults input-file)))) + (with-open-file (s2 output-file :direction :output :if-exists :supersede) + (colorize-file-to-stream coloring-type input-file-name s2)))) + +;; coloring-types.lisp + +;(in-package :colorize) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *version-token* (gensym))) + +(defparameter *symbol-characters* + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ*!%$&+-1234567890") + +(defparameter *non-constituent* + '(#\space #\tab #\newline #\linefeed #\page #\return + #\" #\' #\( #\) #\, #\; #\` #\[ #\])) + +(defparameter *special-forms* + '("let" "load-time-value" "quote" "macrolet" "progn" "progv" "go" "flet" "the" + "if" "throw" "eval-when" "multiple-value-prog1" "unwind-protect" "let*" + "labels" "function" "symbol-macrolet" "block" "tagbody" "catch" "locally" + "return-from" "setq" "multiple-value-call")) + +(defparameter *common-macros* + '("loop" "cond" "lambda")) + +(defparameter *open-parens* '(#\()) +(defparameter *close-parens* '(#\))) + +(define-coloring-type :lisp "Basic Lisp" + :modes (:first-char-on-line :normal :symbol :escaped-symbol :keyword :string :comment + :multiline :character + :single-escaped :in-list :syntax-error) + :default-mode :first-char-on-line + :transitions + (((:in-list) + ((or + (scan-any *symbol-characters*) + (and (scan #\.) (scan-any *symbol-characters*)) + (and (scan #\\) (advance 1))) + (set-mode :symbol + :until (scan-any *non-constituent*) + :advancing nil)) + ((or (scan #\:) (scan "#:")) + (set-mode :keyword + :until (scan-any *non-constituent*) + :advancing nil)) + ((scan "#\\") + (let ((count 0)) + (set-mode :character + :until (progn + (incf count) + (if (> count 1) + (scan-any *non-constituent*))) + :advancing nil))) + ((scan #\") + (set-mode :string + :until (scan #\"))) + ((scan #\;) + (set-mode :comment + :until (scan #\newline))) + ((scan "#|") + (set-mode :multiline + :until (scan "|#"))) + ((scan #\() + (set-mode :in-list + :until (scan #\))))) + ((:normal :first-char-on-line) + ((scan #\() + (set-mode :in-list + :until (scan #\))))) + (:first-char-on-line + ((scan #\;) + (set-mode :comment + :until (scan #\newline))) + ((scan "#|") + (set-mode :multiline + :until (scan "|#"))) + ((advance 1) + (set-mode :normal + :until (scan #\newline)))) + (:multiline + ((scan "#|") + (set-mode :multiline + :until (scan "|#")))) + ((:symbol :keyword :escaped-symbol :string) + ((scan #\\) + (let ((count 0)) + (set-mode :single-escaped + :until (progn + (incf count) + (if (< count 2) + (advance 1)))))))) + :formatter-variables ((paren-counter 0)) + :formatter-after-hook (lambda nil + (format nil "~{~A~}" + (loop for i from paren-counter downto 1 + collect ""))) + :formatters + (((:normal :first-char-on-line) + (lambda (type s) + (declare (ignore type)) + s)) + ((:in-list) + (lambda (type s) + (declare (ignore type)) + (labels ((color-parens (s) + (let ((paren-pos (find-if-not #'null + (mapcar #'(lambda (c) + (position c s)) + (append *open-parens* + *close-parens*))))) + (if paren-pos + (let ((before-paren (subseq s 0 paren-pos)) + (after-paren (subseq s (1+ paren-pos))) + (paren (elt s paren-pos)) + (open nil) + (count 0)) + (when (member paren *open-parens* :test #'char=) + (setf count (mod paren-counter 6)) + (incf paren-counter) + (setf open t)) + (when (member paren *close-parens* :test #'char=) + (decf paren-counter)) + (if open + (format nil "~A~C~A" + before-paren + (1+ count) + paren *css-background-class* + (color-parens after-paren)) + (format nil "~A~C~A" + before-paren + paren (color-parens after-paren)))) + s)))) + (color-parens s)))) + ((:symbol :escaped-symbol) + (lambda (type s) + (declare (ignore type)) + (let* ((colon (position #\: s :from-end t)) + (new-s (or (and colon (subseq s (1+ colon))) s))) + (cond + ((or + (member new-s *common-macros* :test #'string-equal) + (member new-s *special-forms* :test #'string-equal) + (some #'(lambda (e) + (and (> (length new-s) (length e)) + (string-equal e (subseq new-s 0 (length e))))) + '("WITH-" "DEF"))) + (format nil "~A" s)) + ((and (> (length new-s) 2) + (char= (elt new-s 0) #\*) + (char= (elt new-s (1- (length new-s))) #\*)) + (format nil "~A" s)) + (t s))))) + (:keyword (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + ((:comment :multiline) + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + ((:character) + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + ((:string) + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + ((:single-escaped) + (lambda (type s) + (call-formatter (cdr type) s))) + ((:syntax-error) + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))))) + +(define-coloring-type :scheme "Scheme" + :autodetect (lambda (text) + (or + (search "scheme" text :test #'char-equal) + (search "chicken" text :test #'char-equal))) + :parent :lisp + :transitions + (((:normal :in-list) + ((scan "...") + (set-mode :symbol + :until (scan-any *non-constituent*) + :advancing nil)) + ((scan #\[) + (set-mode :in-list + :until (scan #\]))))) + :formatters + (((:in-list) + (lambda (type s) + (declare (ignore type s)) + (let ((*open-parens* (cons #\[ *open-parens*)) + (*close-parens* (cons #\] *close-parens*))) + (call-parent-formatter)))) + ((:symbol :escaped-symbol) + (lambda (type s) + (declare (ignore type)) + (let ((result (if (find-package :r5rs-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :r5rs-lookup)) + s)))) + (if result + (format nil "~A" + result (call-parent-formatter)) + (call-parent-formatter))))))) + +(define-coloring-type :elisp "Emacs Lisp" + :autodetect (lambda (name) + (member name '("emacs") + :test #'(lambda (name ext) + (search ext name :test #'char-equal)))) + :parent :lisp + :formatters + (((:symbol :escaped-symbol) + (lambda (type s) + (declare (ignore type)) + (let ((result (if (find-package :elisp-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :elisp-lookup)) + s)))) + (if result + (format nil "~A" + result (call-parent-formatter)) + (call-parent-formatter))))))) + +(define-coloring-type :common-lisp "Common Lisp" + :autodetect (lambda (text) + (search "lisp" text :test #'char-equal)) + :parent :lisp + :transitions + (((:normal :in-list) + ((scan #\|) + (set-mode :escaped-symbol + :until (scan #\|))))) + :formatters + (((:symbol :escaped-symbol) + (lambda (type s) + (declare (ignore type)) + (let* ((colon (position #\: s :from-end t :test #'char=)) + (to-lookup (if colon (subseq s (1+ colon)) s)) + (result (if (find-package :clhs-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :clhs-lookup)) + to-lookup)))) + (if result + (format nil "~A" + result (call-parent-formatter)) + (call-parent-formatter))))))) + +(define-coloring-type :common-lisp-file "Common Lisp File" + :parent :common-lisp + :default-mode :in-list + :invisible t) + +(defvar *c-open-parens* "([{") +(defvar *c-close-parens* ")]}") + +(defvar *c-reserved-words* + '("auto" "break" "case" "char" "const" + "continue" "default" "do" "double" "else" + "enum" "extern" "float" "for" "goto" + "if" "int" "long" "register" "return" + "short" "signed" "sizeof" "static" "struct" + "switch" "typedef" "union" "unsigned" "void" + "volatile" "while" "__restrict" "_Bool")) + +(defparameter *c-begin-word* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") +(defparameter *c-terminators* '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #\( #\) #\' #\" #\[ #\] #\< #\> #\#)) + +(define-coloring-type :basic-c "Basic C" + :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor) + :default-mode :normal + :invisible t + :transitions + ((:normal + ((scan-any *c-begin-word*) + (set-mode :word-ish + :until (scan-any *c-terminators*) + :advancing nil)) + ((scan "/*") + (set-mode :comment + :until (scan "*/"))) + + ((or + (scan-any *c-open-parens*) + (scan-any *c-close-parens*)) + (set-mode :paren-ish + :until (advance 1) + :advancing nil)) + ((scan #\") + (set-mode :string + :until (scan #\"))) + ((or (scan "'\\") + (scan #\')) + (set-mode :character + :until (advance 2)))) + (:string + ((scan #\\) + (set-mode :single-escape + :until (advance 1))))) + :formatter-variables + ((paren-counter 0)) + :formatter-after-hook (lambda nil + (format nil "~{~A~}" + (loop for i from paren-counter downto 1 + collect ""))) + :formatters + ((:normal + (lambda (type s) + (declare (ignore type)) + s)) + (:comment + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + (:string + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + (:character + (lambda (type s) + (declare (ignore type)) + (format nil "~A" + s))) + (:single-escape + (lambda (type s) + (call-formatter (cdr type) s))) + (:paren-ish + (lambda (type s) + (declare (ignore type)) + (let ((open nil) + (count 0)) + (if (eql (length s) 1) + (progn + (when (member (elt s 0) (coerce *c-open-parens* 'list)) + (setf open t) + (setf count (mod paren-counter 6)) + (incf paren-counter)) + (when (member (elt s 0) (coerce *c-close-parens* 'list)) + (setf open nil) + (decf paren-counter) + (setf count (mod paren-counter 6))) + (if open + (format nil "~A" + (1+ count) s *css-background-class*) + (format nil "~A" + s))) + s)))) + (:word-ish + (lambda (type s) + (declare (ignore type)) + (if (member s *c-reserved-words* :test #'string=) + (format nil "~A" s) + s))) + )) + +(define-coloring-type :c "C" + :parent :basic-c + :transitions + ((:normal + ((scan #\#) + (set-mode :preprocessor + :until (scan-any '(#\return #\newline)))))) + :formatters + ((:preprocessor + (lambda (type s) + (declare (ignore type)) + (format nil "~A" s))))) + +(defvar *c++-reserved-words* + '("asm" "auto" "bool" "break" "case" + "catch" "char" "class" "const" "const_cast" + "continue" "default" "delete" "do" "double" + "dynamic_cast" "else" "enum" "explicit" "export" + "extern" "false" "float" "for" "friend" + "goto" "if" "inline" "int" "long" + "mutable" "namespace" "new" "operator" "private" + "protected" "public" "register" "reinterpret_cast" "return" + "short" "signed" "sizeof" "static" "static_cast" + "struct" "switch" "template" "this" "throw" + "true" "try" "typedef" "typeid" "typename" + "union" "unsigned" "using" "virtual" "void" + "volatile" "wchar_t" "while")) + +(define-coloring-type :c++ "C++" + :parent :c + :transitions + ((:normal + ((scan "//") + (set-mode :comment + :until (scan-any '(#\return #\newline)))))) + :formatters + ((:word-ish + (lambda (type s) + (declare (ignore type)) + (if (member s *c++-reserved-words* :test #'string=) + (format nil "~A" + s) + s))))) + +(defvar *java-reserved-words* + '("abstract" "boolean" "break" "byte" "case" + "catch" "char" "class" "const" "continue" + "default" "do" "double" "else" "extends" + "final" "finally" "float" "for" "goto" + "if" "implements" "import" "instanceof" "int" + "interface" "long" "native" "new" "package" + "private" "protected" "public" "return" "short" + "static" "strictfp" "super" "switch" "synchronized" + "this" "throw" "throws" "transient" "try" + "void" "volatile" "while")) + +(define-coloring-type :java "Java" + :parent :c++ + :formatters + ((:word-ish + (lambda (type s) + (declare (ignore type)) + (if (member s *java-reserved-words* :test #'string=) + (format nil "~A" + s) + s))))) + +(let ((terminate-next nil)) + (define-coloring-type :objective-c "Objective C" + :autodetect (lambda (text) (search "mac" text :test #'char=)) + :modes (:begin-message-send :end-message-send) + :transitions + ((:normal + ((scan #\[) + (set-mode :begin-message-send + :until (advance 1) + :advancing nil)) + ((scan #\]) + (set-mode :end-message-send + :until (advance 1) + :advancing nil)) + ((scan-any *c-begin-word*) + (set-mode :word-ish + :until (or + (and (peek-any '(#\:)) + (setf terminate-next t)) + (and terminate-next (progn + (setf terminate-next nil) + (advance 1))) + (scan-any *c-terminators*)) + :advancing nil))) + (:word-ish + #+nil + ((scan #\:) + (format t "hi~%") + (set-mode :word-ish :until (advance 1) :advancing nil) + (setf terminate-next t)))) + :parent :c++ + :formatter-variables ((is-keyword nil) (in-message-send nil)) + :formatters + ((:begin-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send t) + (call-formatter (cons :paren-ish type) s))) + (:end-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send nil) + (call-formatter (cons :paren-ish type) s))) + (:word-ish + (lambda (type s) + (declare (ignore type)) + (prog1 + (let ((result (if (find-package :cocoa-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) + s)))) + (if result + (format nil "~A" + result s) + (if (member s *c-reserved-words* :test #'string=) + (format nil "~A" s) + (if in-message-send + (if is-keyword + (format nil "~A" s) + s) + s)))) + (setf is-keyword (not is-keyword)))))))) + + +;#!/usr/bin/clisp +;#+sbcl +;(require :asdf) +;(asdf:oos 'asdf:load-op :colorize) + +(defmacro with-each-stream-line ((var stream) &body body) + (let ((eof (gensym)) + (eof-value (gensym)) + (strm (gensym))) + `(let ((,strm ,stream) + (,eof ',eof-value)) + (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof))) + ((eql ,var ,eof)) + ,@body)))) + +(defun system (control-string &rest args) + "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and +synchronously execute the result using a Bourne-compatible shell, with +output to *verbose-out*. Returns the shell's exit code." + (let ((command (apply #'format nil control-string args))) + (format t "; $ ~A~%" command) + #+sbcl + (sb-impl::process-exit-code + (sb-ext:run-program + "/bin/sh" + (list "-c" command) + :input nil :output *standard-output*)) + #+(or cmu scl) + (ext:process-exit-code + (ext:run-program + "/bin/sh" + (list "-c" command) + :input nil :output *verbose-out*)) + #+clisp ;XXX not exactly *verbose-out*, I know + (ext:run-shell-command command :output :terminal :wait t) + )) + +(defun strcat (&rest strings) + (apply #'concatenate 'string strings)) + +(defun string-starts-with (start str) + (and (>= (length str) (length start)) + (string-equal start str :end2 (length start)))) + +(defmacro string-append (outputstr &rest args) + `(setq ,outputstr (concatenate 'string ,outputstr ,@args))) + +(defconstant +indent+ 2 + "Indentation used in the examples.") + +(defun texinfo->raw-lisp (code) + "Answer CODE with spurious Texinfo output removed. For use in +preprocessing output in a @lisp block before passing to colorize." + (decode-from-tt + (with-output-to-string (output) + (do* ((last-position 0) + (next-position + #0=(search #1="" code + :start2 last-position :test #'char-equal) + #0#)) + ((eq nil next-position) + (write-string code output :start last-position)) + (write-string code output :start last-position :end next-position) + (let ((end (search #2="" code + :start2 (+ next-position (length #1#)) + :test #'char-equal))) + (assert (integerp end) () + "Missing ~A tag in HTML for @lisp block~%~ + HTML contents of block:~%~A" #2# code) + (write-string code output + :start (+ next-position (length #1#)) + :end end) + (setf last-position (+ end (length #2#)))))))) + +(defun process-file (from to) + (with-open-file (output to :direction :output :if-exists :error) + (with-open-file (input from :direction :input) + (let ((line-processor nil) + (piece-of-code '())) + (labels + ((process-line-inside-pre (line) + (cond ((string-starts-with "" line) + (with-input-from-string + (stream (colorize:html-colorization + :common-lisp + (texinfo->raw-lisp + (apply #'concatenate 'string + (nreverse piece-of-code))))) + (with-each-stream-line (cline stream) + (format output " ~A~%" cline))) + (write-line line output) + (setq piece-of-code '() + line-processor #'process-regular-line)) + (t (let ((to-append (subseq line +indent+))) + (push (if (string= "" to-append) + " " + to-append) piece-of-code) + (push (string #\Newline) piece-of-code))))) + (process-regular-line (line) + (let ((len (some (lambda (test-string) + (when (string-starts-with test-string line) + (length test-string))) + '("
"
+                                 "
"))))
+                 (cond (len
+                         (setq line-processor #'process-line-inside-pre)
+                         (write-string "
" output)
+                         (push (subseq line (+ len +indent+)) piece-of-code)
+                         (push (string #\Newline) piece-of-code))
+                       (t (write-line line output))))))
+          (setf line-processor #'process-regular-line)
+          (with-each-stream-line (line input)
+            (funcall line-processor line)))))))
+
+(defun process-dir (dir)
+  (dolist (html-file (directory dir))
+    (let* ((name (namestring html-file))
+           (temp-name (strcat name ".temp")))
+      (process-file name temp-name)
+      (system "mv ~A ~A" temp-name name))))
+
+;; (go "/tmp/doc/manual/html_node/*.html")
+
+#+clisp
+(progn
+  (assert (first ext:*args*))
+  (process-dir (first ext:*args*)))
+
+#+sbcl
+(progn
+  (assert (second sb-ext:*posix-argv*))
+  (process-dir (second sb-ext:*posix-argv*))
+  (sb-ext:quit))
diff --git a/docstrings.lisp b/docstrings.lisp
index 1177d3d..c01eb93 100644
--- a/docstrings.lisp
+++ b/docstrings.lisp
@@ -36,17 +36,22 @@
 ;;;; Lines containing only a SYMBOL that are followed by indented
 ;;;; lines are marked up as @table @code, with the SYMBOL as the item.
 
+#+sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require 'sb-introspect))
 
-(defpackage :sb-texinfo
-  (:use :cl :sb-mop)
+(defpackage #:texinfo-docstrings
+  (:use #:cl #-sbcl #:c2mop #+sbcl #:sb-mop)
   (:shadow #:documentation)
   (:export #:generate-includes #:document-package)
   (:documentation
    "Tools to generate TexInfo documentation from docstrings."))
 
-(in-package :sb-texinfo)
+(in-package #:texinfo-docstrings)
+
+(defun function-arglist (function)
+  #+sbcl (sb-introspect:function-arglist function)
+  #-sbcl (error "function-arglist unimplemented"))
 
 ;;;; various specials and parameters
 
@@ -54,7 +59,9 @@
 (defvar *texinfo-variables*)
 (defvar *documentation-package*)
 
-(defparameter *undocumented-packages* '(sb-pcl sb-int sb-kernel sb-sys sb-c))
+(defparameter *undocumented-packages*
+  #+sbcl '(sb-pcl sb-int sb-kernel sb-sys sb-c)
+  #-sbcl nil)
 
 (defparameter *documentation-types*
   '(compiler-macro
@@ -224,7 +231,8 @@ symbols or lists of symbols."))
 (defun node-name (doc)
   "Returns TexInfo node name as a string for a DOCUMENTATION instance."
   (let ((kind (get-kind doc)))
-    (format nil "~:(~A~) ~(~A~)" kind (name-using-kind/name kind (get-name doc) doc))))
+    (format nil "~:(~A~) ~(~A~)"
+            kind (name-using-kind/name kind (get-name doc) doc))))
 
 ;;; Definition titles for DOCUMENTATION instances
 
@@ -388,7 +396,7 @@ there is no corresponding docstring."
                       (cond ((or key optional) (car x))
                             (t (clean (car x))))
                       (clean (cdr x) :key key :optional optional))))))
-         (clean (sb-introspect:function-arglist (get-name doc))))))))
+         (clean (function-arglist (get-name doc))))))))
 
 (defun documentation< (x y)
   (let ((p1 (position (get-kind x) *ordered-documentation-kinds*))
@@ -480,7 +488,8 @@ semicolon, and the previous line is empty"
 
 (defun collect-lisp-section (lines line-number)
   (let ((lisp (loop for index = line-number then (1+ index)
-                    for line = (and (< index (length lines)) (svref lines index))
+                    for line = (and (< index (length lines))
+                                    (svref lines index))
                     while (indentation line)
                     collect line)))
     (values (length lisp) `("@lisp" ,@lisp "@end lisp"))))
@@ -650,7 +659,8 @@ followed another tabulation label or a tabulation body."
      ;; KLUDGE: We assume that we don't want to advertise internal
      ;; classes in CP-lists, unless the symbol we're documenting is
      ;; internal as well.
-     (and (member super-package #.'(mapcar #'find-package *undocumented-packages*))
+     (and (member super-package
+                  #.'(mapcar #'find-package *undocumented-packages*))
           (not (eq super-package (symbol-package class-name))))
      ;; KLUDGE: We don't generally want to advertise SIMPLE-ERROR or
      ;; SIMPLE-CONDITION in the CPLs of conditions that inherit them
@@ -684,7 +694,8 @@ followed another tabulation label or a tabulation body."
                "deftp")
               (t
                "deffn"))
-            (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
+            (map 'string (lambda (char) (if (eql char #\-) #\Space char))
+                 (string kind))
             (title-name doc)
             (lambda-list doc))))
 
@@ -702,9 +713,11 @@ followed another tabulation label or a tabulation body."
   (when (member (get-kind doc) '(class structure condition))
     (let ((name (get-name doc)))
       ;; class precedence list
-      (format *texinfo-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
+      (format *texinfo-output*
+              "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
               (remove-if (lambda (class)  (hide-superclass-p name class))
-                         (mapcar #'class-name (ensure-class-precedence-list (find-class name)))))
+                         (mapcar #'class-name (ensure-class-precedence-list
+                                               (find-class name)))))
       ;; slots
       (let ((slots (remove-if (lambda (slot) (hide-slot-p name slot))
                               (class-direct-slots (find-class name)))))
@@ -788,9 +801,9 @@ package, as well as for the package itself."
 
 (defmacro with-texinfo-file (pathname &body forms)
   `(with-open-file (*texinfo-output* ,pathname
-                                    :direction :output
-                                    :if-does-not-exist :create
-                                    :if-exists :supersede)
+                                     :direction :output
+                                     :if-does-not-exist :create
+                                     :if-exists :supersede)
     ,@forms))
 
 (defun generate-includes (directory &rest packages)
@@ -822,9 +835,10 @@ syntax-significant characters are escaped in symbol names, but if a
 docstring contains invalid Texinfo markup, you lose."
   (handler-bind ((warning #'muffle-warning))
     (let* ((package (find-package package))
-           (filename (or filename (make-pathname
-                                   :name (string-downcase (package-name package))
-                                   :type "texinfo")))
+           (filename (or filename
+                         (make-pathname
+                          :name (string-downcase (package-name package))
+                          :type "texinfo")))
            (docs (sort (collect-documentation package) #'documentation<)))
       (with-texinfo-file filename
         (dolist (doc docs)
diff --git a/frontend.lisp b/frontend.lisp
new file mode 100644
index 0000000..cbb8458
--- /dev/null
+++ b/frontend.lisp
@@ -0,0 +1,85 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; texinfo-docstrings.lisp --- Front-end script.
+;;;
+;;; Copyright (C) 2007, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+
+(in-package #:cl-launch)
+
+(defun print-help-and-quit ()
+  (write-line "Usage: texinfo-docstrings [html|pdf|all]    <css style> packages...")
+  (quit 1))
+
+(when (< (length *arguments*) 6)
+  (write-line "Not enough arguments.")
+  (print-help-and-quit))
+
+(defparameter *output*
+  (let ((arg1 (first *arguments*)))
+    (cond
+      ((string-equal arg1 "html") 'html)
+      ((string-equal arg1 "pdf") 'pdf)
+      ((string-equal arg1 "all") 'all)
+      (t (print-help-and-quit)))))
+
+(defparameter *system* (second *arguments*))
+(defparameter *filename* (third *arguments*))
+(defparameter *title* (fourth *arguments*))
+(defparameter *css-style* (fifth *arguments*))
+(defparameter *packages* (mapcar #'string-upcase (nthcdr 5 *arguments*)))
+
+(load-system *system*)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (asdf:oos 'asdf:load-op :texinfo-docstrings))
+
+(apply #'texinfo-docstrings:generate-includes "include/" *packages*)
+
+(defparameter *sysdir*
+  (namestring
+   (make-pathname :directory
+                  (pathname-directory
+                   (asdf:system-definition-pathname
+                    (asdf:find-system :texinfo-docstrings))))))
+
+(defparameter *gendocs-template-dir*
+  (or (getenv "GENDOCS_TEMPLATE_DIR") *sysdir*))
+
+(when (string-equal *css-style* "default")
+  (setq *css-style*
+        (format nil "~Astyles/~A"
+                *sysdir*
+                (case *output*
+                  (html "edi-style.css")
+                  (t "style.css")))))
+
+(let ((asdf::*verbose-out* *terminal-io*))
+  (ecase *output*
+    (html
+     (asdf:run-shell-command "echo not yet"))
+    (pdf
+     (asdf:run-shell-command "echo not yet"))
+    (all
+     (asdf:run-shell-command
+      "GENDOCS_TEMPLATE_DIR=~A sh ~Agendocs.sh --html \"--css-include=~A\" ~A \"~A\""
+      *gendocs-template-dir* *sysdir* *css-style* *filename* *title*))))
diff --git a/gendocs.sh b/gendocs.sh
new file mode 100644
index 0000000..c775c99
--- /dev/null
+++ b/gendocs.sh
@@ -0,0 +1,300 @@
+#!/bin/sh
+# gendocs.sh -- generate a GNU manual in many formats.  This script is
+#   mentioned in maintain.texi.  See the help message below for usage details.
+
+scriptversion=2007-07-01.15
+
+# Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+#
+# This program 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# 
+# Original author: Mohit Agarwal.
+# Send bug reports and any other correspondence to bug-texinfo@gnu.org.
+
+prog=`basename "$0"`
+srcdir=`pwd`
+
+scripturl="http://savannah.gnu.org/cgi-bin/viewcvs/~checkout~/texinfo/texinfo/util/gendocs.sh"
+templateurl="http://savannah.gnu.org/cgi-bin/viewcvs/~checkout~/texinfo/texinfo/util/gendocs_template"
+
+: ${SETLANG="env LANG= LC_MESSAGES= LC_ALL= LANGUAGE="}
+: ${MAKEINFO="makeinfo"}
+: ${TEXI2DVI="texi2dvi -t @finalout"}
+: ${DVIPS="dvips"}
+: ${DOCBOOK2HTML="docbook2html"}
+: ${DOCBOOK2PDF="docbook2pdf"}
+: ${DOCBOOK2PS="docbook2ps"}
+: ${DOCBOOK2TXT="docbook2txt"}
+: ${GENDOCS_TEMPLATE_DIR="."}
+unset CDPATH
+
+version="gendocs.sh $scriptversion
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+There is NO warranty.  You may redistribute this software
+under the terms of the GNU General Public License.
+For more information about these matters, see the files named COPYING."
+
+usage="Usage: $prog [OPTION]... PACKAGE MANUAL-TITLE
+
+Generate various output formats from PACKAGE.texinfo (or .texi or .txi) source.
+See the GNU Maintainers document for a more extensive discussion:
+  http://www.gnu.org/prep/maintain_toc.html
+
+Options:
+  -o OUTDIR   write files into OUTDIR, instead of manual/.
+  --docbook   convert to DocBook too (xml, txt, html, pdf and ps).
+  --html ARG  pass indicated ARG to makeinfo for HTML targets.
+  --help      display this help and exit successfully.
+  --version   display version information and exit successfully.
+
+Simple example: $prog emacs \"GNU Emacs Manual\"
+
+Typical sequence:
+  cd YOURPACKAGESOURCE/doc
+  wget \"$scripturl\"
+  wget \"$templateurl\"
+  $prog YOURMANUAL \"GNU YOURMANUAL - One-line description\"
+
+Output will be in a new subdirectory \"manual\" (by default, use -o OUTDIR
+to override).  Move all the new files into your web CVS tree, as
+explained in the Web Pages node of maintain.texi.
+
+MANUAL-TITLE is included as part of the HTML <title> of the overall
+manual/index.html file.  It should include the name of the package being
+documented.  manual/index.html is created by substitution from the file
+$GENDOCS_TEMPLATE_DIR/gendocs_template.  (Feel free to modify the
+generic template for your own purposes.)
+
+If you have several manuals, you'll need to run this script several
+times with different YOURMANUAL values, specifying a different output
+directory with -o each time.  Then write (by hand) an overall index.html
+with links to them all.
+
+If a manual's texinfo sources are spread across several directories,
+first copy or symlink all Texinfo sources into a single directory.
+(Part of the script's work is to make a tar.gz of the sources.)
+
+You can set the environment variables MAKEINFO, TEXI2DVI, and DVIPS to
+control the programs that get executed, and GENDOCS_TEMPLATE_DIR to
+control where the gendocs_template file is looked for.  (With --docbook,
+the environment variables DOCBOOK2HTML, DOCBOOK2PDF, DOCBOOK2PS, and
+DOCBOOK2TXT are also respected.) 
+
+By default, makeinfo is run in the default (English) locale, since
+that's the language of most Texinfo manuals.  If you happen to have a
+non-English manual and non-English web site, check the SETLANG setting
+in the source.
+
+Email bug reports or enhancement requests to bug-texinfo@gnu.org.
+"
+
+calcsize()
+{
+  size=`ls -ksl $1 | awk '{print $1}'`
+  echo $size
+}
+
+outdir=manual
+html=
+PACKAGE=
+MANUAL_TITLE=
+
+while test $# -gt 0; do
+  case $1 in
+    --help) echo "$usage"; exit 0;;
+    --version) echo "$version"; exit 0;;
+    -o) shift; outdir=$1;;
+    --docbook) docbook=yes;;
+    --html) shift; html=$1;;
+    -*)
+      echo "$0: Unknown or ambiguous option \`$1'." >&2
+      echo "$0: Try \`--help' for more information." >&2
+      exit 1;;
+    *)
+      if test -z "$PACKAGE"; then
+        PACKAGE=$1
+      elif test -z "$MANUAL_TITLE"; then
+        MANUAL_TITLE=$1
+      else
+        echo "$0: extra non-option argument \`$1'." >&2
+        exit 1
+      fi;;
+  esac
+  shift
+done
+
+if test -s "$srcdir/$PACKAGE.texinfo"; then
+  srcfile=$srcdir/$PACKAGE.texinfo
+elif test -s "$srcdir/$PACKAGE.texi"; then
+  srcfile=$srcdir/$PACKAGE.texi
+elif test -s "$srcdir/$PACKAGE.txi"; then
+  srcfile=$srcdir/$PACKAGE.txi
+else
+  echo "$0: cannot find .texinfo or .texi or .txi for $PACKAGE in $srcdir." >&2
+  exit 1
+fi
+
+if test ! -r $GENDOCS_TEMPLATE_DIR/gendocs_template; then
+  echo "$0: cannot read $GENDOCS_TEMPLATE_DIR/gendocs_template." >&2
+  echo "$0: it is available from $templateurl." >&2
+  exit 1
+fi
+
+echo Generating output formats for $srcfile
+
+cmd="$SETLANG $MAKEINFO -o $PACKAGE.info \"$srcfile\""
+echo "Generating info files... ($cmd)"
+eval "$cmd"
+mkdir -p $outdir/
+tar czf $outdir/$PACKAGE.info.tar.gz $PACKAGE.info*
+info_tgz_size=`calcsize $outdir/$PACKAGE.info.tar.gz`
+# do not mv the info files, there's no point in having them available
+# separately on the web.
+
+cmd="${TEXI2DVI} \"$srcfile\""
+echo "Generating dvi ... ($cmd)"
+eval "$cmd"
+
+# now, before we compress dvi:
+echo Generating postscript...
+${DVIPS} $PACKAGE -o
+gzip -f -9 $PACKAGE.ps
+ps_gz_size=`calcsize $PACKAGE.ps.gz`
+mv $PACKAGE.ps.gz $outdir/
+
+# compress/finish dvi:
+gzip -f -9 $PACKAGE.dvi
+dvi_gz_size=`calcsize $PACKAGE.dvi.gz`
+mv $PACKAGE.dvi.gz $outdir/
+
+cmd="${TEXI2DVI} --pdf \"$srcfile\""
+echo "Generating pdf ... ($cmd)"
+eval "$cmd"
+pdf_size=`calcsize $PACKAGE.pdf`
+mv $PACKAGE.pdf $outdir/
+
+cmd="$SETLANG $MAKEINFO -o $PACKAGE.txt --no-split --no-headers \"$srcfile\""
+echo "Generating ASCII... ($cmd)"
+eval "$cmd"
+ascii_size=`calcsize $PACKAGE.txt`
+gzip -f -9 -c $PACKAGE.txt >$outdir/$PACKAGE.txt.gz
+ascii_gz_size=`calcsize $outdir/$PACKAGE.txt.gz`
+mv $PACKAGE.txt $outdir/
+
+cmd="$SETLANG $MAKEINFO --no-split --html -o $PACKAGE.html $html \"$srcfile\""
+echo "Generating monolithic html... ($cmd)"
+rm -rf $PACKAGE.html  # in case a directory is left over
+eval "$cmd"
+html_mono_size=`calcsize $PACKAGE.html`
+gzip -f -9 -c $PACKAGE.html >$outdir/$PACKAGE.html.gz
+html_mono_gz_size=`calcsize $outdir/$PACKAGE.html.gz`
+mv $PACKAGE.html $outdir/
+
+cmd="$SETLANG $MAKEINFO --html -o $PACKAGE.html $html \"$srcfile\""
+echo "Generating html by node... ($cmd)"
+eval "$cmd"
+split_html_dir=$PACKAGE.html
+(
+  cd ${split_html_dir} || exit 1
+  tar -czf ../$outdir/${PACKAGE}.html_node.tar.gz -- *.html
+)
+html_node_tgz_size=`calcsize $outdir/${PACKAGE}.html_node.tar.gz`
+rm -f $outdir/html_node/*.html
+mkdir -p $outdir/html_node/
+mv ${split_html_dir}/*.html $outdir/html_node/
+rmdir ${split_html_dir}
+
+echo Making .tar.gz for sources...
+srcfiles=`ls *.texinfo *.texi *.txi *.eps 2>/dev/null`
+tar cvzfh $outdir/$PACKAGE.texi.tar.gz $srcfiles
+texi_tgz_size=`calcsize $outdir/$PACKAGE.texi.tar.gz`
+
+if test -n "$docbook"; then
+  cmd="$SETLANG $MAKEINFO -o - --docbook \"$srcfile\" > ${srcdir}/$PACKAGE-db.xml"
+  echo "Generating docbook XML... $(cmd)"
+  eval "$cmd"
+  docbook_xml_size=`calcsize $PACKAGE-db.xml`
+  gzip -f -9 -c $PACKAGE-db.xml >$outdir/$PACKAGE-db.xml.gz
+  docbook_xml_gz_size=`calcsize $outdir/$PACKAGE-db.xml.gz`
+  mv $PACKAGE-db.xml $outdir/
+
+  cmd="${DOCBOOK2HTML} -o $split_html_db_dir ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook HTML... ($cmd)"
+  eval "$cmd"
+  split_html_db_dir=html_node_db
+  (
+    cd ${split_html_db_dir} || exit 1
+    tar -czf ../$outdir/${PACKAGE}.html_node_db.tar.gz -- *.html
+  )
+  html_node_db_tgz_size=`calcsize $outdir/${PACKAGE}.html_node_db.tar.gz`
+  rm -f $outdir/html_node_db/*.html
+  mkdir -p $outdir/html_node_db
+  mv ${split_html_db_dir}/*.html $outdir/html_node_db/
+  rmdir ${split_html_db_dir}
+
+  cmd="${DOCBOOK2TXT} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook ASCII... ($cmd)"
+  eval "$cmd"
+  docbook_ascii_size=`calcsize $PACKAGE-db.txt`
+  mv $PACKAGE-db.txt $outdir/
+
+  cmd="${DOCBOOK2PS} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PS... $(cmd)"
+  eval "$cmd"
+  gzip -f -9 -c $PACKAGE-db.ps >$outdir/$PACKAGE-db.ps.gz
+  docbook_ps_gz_size=`calcsize $outdir/$PACKAGE-db.ps.gz`
+  mv $PACKAGE-db.ps $outdir/
+
+  cmd="${DOCBOOK2PDF} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PDF... ($cmd)"
+  eval "$cmd"
+  docbook_pdf_size=`calcsize $PACKAGE-db.pdf`
+  mv $PACKAGE-db.pdf $outdir/
+fi
+
+echo Writing index file...
+curdate=`date '+%B %d, %Y'`
+sed \
+   -e "s!%%TITLE%%!$MANUAL_TITLE!g" \
+   -e "s!%%DATE%%!$curdate!g" \
+   -e "s!%%PACKAGE%%!$PACKAGE!g" \
+   -e "s!%%HTML_MONO_SIZE%%!$html_mono_size!g" \
+   -e "s!%%HTML_MONO_GZ_SIZE%%!$html_mono_gz_size!g" \
+   -e "s!%%HTML_NODE_TGZ_SIZE%%!$html_node_tgz_size!g" \
+   -e "s!%%INFO_TGZ_SIZE%%!$info_tgz_size!g" \
+   -e "s!%%DVI_GZ_SIZE%%!$dvi_gz_size!g" \
+   -e "s!%%PDF_SIZE%%!$pdf_size!g" \
+   -e "s!%%PS_GZ_SIZE%%!$ps_gz_size!g" \
+   -e "s!%%ASCII_SIZE%%!$ascii_size!g" \
+   -e "s!%%ASCII_GZ_SIZE%%!$ascii_gz_size!g" \
+   -e "s!%%TEXI_TGZ_SIZE%%!$texi_tgz_size!g" \
+   -e "s!%%DOCBOOK_HTML_NODE_TGZ_SIZE%%!$html_node_db_tgz_size!g" \
+   -e "s!%%DOCBOOK_ASCII_SIZE%%!$docbook_ascii_size!g" \
+   -e "s!%%DOCBOOK_PS_GZ_SIZE%%!$docbook_ps_gz_size!g" \
+   -e "s!%%DOCBOOK_PDF_SIZE%%!$docbook_pdf_size!g" \
+   -e "s!%%DOCBOOK_XML_SIZE%%!$docbook_xml_size!g" \
+   -e "s!%%DOCBOOK_XML_GZ_SIZE%%!$docbook_xml_gz_size!g" \
+   -e "s,%%SCRIPTURL%%,$scripturl,g" \
+   -e "s!%%SCRIPTNAME%%!$prog!g" \
+$GENDOCS_TEMPLATE_DIR/gendocs_template >$outdir/index.html
+
+echo "Done!  See $outdir/ subdirectory for new files."
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-end: "$"
+# End:
diff --git a/gendocs_template b/gendocs_template
new file mode 100644
index 0000000..dc10c04
--- /dev/null
+++ b/gendocs_template
@@ -0,0 +1,234 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<!-- $Id: gendocs_template,v 1.7 2005/05/15 00:00:08 karl Exp $ -->
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+
+<!--
+ This template was adapted from Texinfo:
+ http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_template
+-->
+
+<head>
+<title>%%TITLE%%
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
%%TITLE%%

+
+
+
last updated %%DATE%%

+
+
+
+

+
+
This document  is available in the following formats:

+
+
+
+
(This page was generated by the %%SCRIPTNAME%%
+script.)

+
+
+
+
+

+
+-->
+
+
+
diff --git a/generate-doc-dir.sh b/generate-doc-dir.sh
new file mode 100644
index 0000000..e43a589
--- /dev/null
+++ b/generate-doc-dir.sh
@@ -0,0 +1,25 @@
+#!/bin/sh
+
+mkdir doc
+cp licenses/MIT.texinfo doc/license.texinfo
+
+manual_filename='babel'
+system='babel'
+title='Babel Manual'
+subtitle='draft version'
+packages='babel babel-encodings'
+
+sed \
+   -e "s!%%MANUAL-FILENAME%%!$manual_filename!g" \
+   -e "s!%%SYSTEM%%!$system!g" \
+   -e "s!%%PACKAGES%%!$packages!g" \
+   -e "s!%%MANUAL-TITLE%%!$title!g" \
+template.makefile > doc/Makefile
+
+sed \
+   -e "s!%%MANUAL-FILENAME%%!$manual_filename!g" \
+   -e "s!%%MANUAL-TITLE%%!$title!g" \
+   -e "s!%%MANUAL-SUBTITLE%%!$subtitle!g" \
+template.texinfo > doc/${manual_filename}.texinfo
+
+echo "Done!  See doc/ subdirectory for new files."
diff --git a/licenses/LLGPL.texinfo b/licenses/LLGPL.texinfo
new file mode 100644
index 0000000..e69de29
diff --git a/licenses/MIT.texinfo b/licenses/MIT.texinfo
new file mode 100644
index 0000000..2835843
--- /dev/null
+++ b/licenses/MIT.texinfo
@@ -0,0 +1,20 @@
+@quotation
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+``Software''), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+@sc{The software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall the authors or copyright holders be liable for any
+claim, damages or other liability, whether in an action of contract,
+tort or otherwise, arising from, out of or in connection with the
+software or the use or other dealings in the software.}
+@end quotation
diff --git a/licenses/PUBLIC-DOMAIN.texinfo b/licenses/PUBLIC-DOMAIN.texinfo
new file mode 100644
index 0000000..18ab6d1
--- /dev/null
+++ b/licenses/PUBLIC-DOMAIN.texinfo
@@ -0,0 +1,38 @@
+@quotation
+Authors dedicate this work to public domain, for the benefit of the
+public at large and to the detriment of the authors' heirs and
+successors. Authors intends this dedication to be an overt act of
+relinquishment in perpetuity of all present and future rights under
+copyright law, whether vested or contingent, in the work. Authors
+understands that such relinquishment of all rights includes the
+relinquishment of all rights to enforce (by lawsuit or otherwise)
+those copyrights in the work.
+
+Authors recognize that, once placed in the public domain, the work may
+be freely reproduced, distributed, transmitted, used, modified, built
+upon, or otherwise exploited by anyone for any purpose, commercial or
+non-commercial, and in any way, including by methods that have not yet
+been invented or conceived.
+
+In those legislations where public domain dedications are not
+recognized or possible, this work is distributed under the following
+terms and conditions:
+
+@quotation
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+``Software''), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+@sc{The software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall the authors or copyright holders be liable for any
+claim, damages or other liability, whether in an action of contract,
+tort or otherwise, arising from, out of or in connection with the
+software or the use or other dealings in the software.}
+@end quotation
+@end quotation
diff --git a/styles/edi-style.css b/styles/edi-style.css
new file mode 100644
index 0000000..e69de29
diff --git a/styles/style.css b/styles/style.css
new file mode 100644
index 0000000..4618956
--- /dev/null
+++ b/styles/style.css
@@ -0,0 +1,48 @@
+body {font-family: century schoolbook, serif;
+      line-height: 1.3;
+      padding-left: 5em; padding-right: 1em;
+      padding-bottom: 1em; max-width: 60em;}
+table {border-collapse: collapse}
+span.roman { font-family: century schoolbook, serif; font-weight: normal; }
+h1, h2, h3, h4, h5, h6 {font-family:  Helvetica, sans-serif}
+h4 { margin-top: 2.5em; }
+dfn {font-family: inherit; font-variant: italic; font-weight: bolder }
+kbd {font-family: monospace; text-decoration: underline}
+/*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/
+var {font-variant: slanted;}
+td  {padding-right: 1em; padding-left: 1em}
+sub {font-size: smaller}
+.node {padding: 0; margin: 0}
+
+.lisp { font-family: monospace;
+        background-color: #F4F4F4; border: 1px solid #AAA;
+        padding-top: 0.5em; padding-bottom: 0.5em; }
+
+/* coloring */
+
+.lisp-bg { background-color: #F4F4F4 ; color: black; }
+.lisp-bg:hover { background-color: #F4F4F4 ; color: black; }
+
+.symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;}
+a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+.special { font-weight: bold; color: #FF5000; background-color: inherit; }
+.keyword { font-weight: bold; color: #770000; background-color: inherit; }
+.comment { font-weight: normal; color: #007777; background-color: inherit; }
+.string  { font-weight: bold; color: #777777; background-color: inherit; }
+.character   { font-weight: bold; color: #0055AA; background-color: inherit; }
+.syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; }
+span.paren1 { font-weight: bold; color: #777777; }
+span.paren1:hover { color: #777777; background-color: #BAFFFF; }
+span.paren2 { color: #777777; }
+span.paren2:hover { color: #777777; background-color: #FFCACA; }
+span.paren3 { color: #777777; }
+span.paren3:hover { color: #777777; background-color: #FFFFBA; }
+span.paren4 { color: #777777; }
+span.paren4:hover { color: #777777; background-color: #CACAFF; }
+span.paren5 { color: #777777; }
+span.paren5:hover { color: #777777; background-color: #CAFFCA; }
+span.paren6 { color: #777777; }
+span.paren6:hover { color: #777777; background-color: #FFBAFF; }
diff --git a/template.makefile b/template.makefile
new file mode 100644
index 0000000..e60970f
--- /dev/null
+++ b/template.makefile
@@ -0,0 +1,31 @@
+# -*- Mode: Makefile; tab-width: 4; indent-tabs-mode: t -*-
+
+MANUAL := "%%MANUAL-FILENAME%%"
+SYSTEM := "%%SYSTEM%%"
+PACKAGES := %%PACKAGES%%
+TITLE := "%%MANUAL-TITLE%%"
+CSS := "default"
+
+export LISP ?= sbcl
+export SBCL_OPTIONS ?= --noinform
+
+.PHONY: all clean html pdf upload
+
+all:
+	texinfo-docstrings all $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
+
+pdf:
+	texinfo-docstrings pdf $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
+
+html:
+	texinfo-docstrings html $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
+
+upload:
+#	rsync -av --delete -e ssh manual common-lisp.net:/project/FOO/public_html/
+#	scp -r manual common-lisp.net:/project/cffi/public_html/
+
+clean:
+	find . \( -name "*.pdf" -name "*.html" -name "*.info" -o -name "*.aux" -o -name "*.cp" -o -name "*.fn" -o -name "*.fns" -o -name "*.ky" -o -name "*.log" -o -name "*.pg" -o -name "*.toc" -o -name "*.tp" -o -name "*.vr" -o -name "*.dvi" -o -name "*.cps" -o -name "*.vrs" \) -exec rm {} \;
+	rm -rf include manual
+
+# vim: ft=make ts=4 noet
diff --git a/template.texinfo b/template.texinfo
new file mode 100644
index 0000000..0db9542
--- /dev/null
+++ b/template.texinfo
@@ -0,0 +1,71 @@
+\input texinfo   @c -*-texinfo-*-
+@c %**start of header
+@setfilename %%MANUAL-FILENAME%%.info
+@settitle %%MANUAL-TITLE%%
+
+@c @exampleindent 2
+@c @documentencoding utf-8
+
+@c %**end of header
+
+@c for install-info
+@c @dircategory %%INFO-CATEGORY%%
+@c @direntry
+@c * %%MANUAL-FILENAME%%:           %%PROJECT-DESCRIPTION%%
+@c @end direntry
+
+@c Show types, functions, and concepts in the same index.
+@syncodeindex tp cp
+@syncodeindex fn cp
+
+@copying
+@c Copyright @copyright{} 2084 John Doe 
+
+@include license.texinfo
+@end copying
+
+@titlepage
+@title %%MANUAL-TITLE%%
+@subtitle %%MANUAL-SUBTITLE%%
+@c @author John Doe
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top %%MANUAL-FILENAME%%
+@insertcopying
+@end ifnottex
+
+@c Top Menu
+@menu
+* Comprehensive Index::         
+@end menu
+
+
+@c @node First Chapter
+@c @chapter First Chapter
+
+@c @include include/fun-somepackage-somefunction.texinfo
+@c @include include/macro-somepackage-somemacro.texinfo
+
+@c @node First Section
+@c @section First Section
+
+@c @include include/fun-somepackage-somefunction.texinfo
+@c @include include/fun-somepackage-somefunction.texinfo
+
+
+
+@c We call this node ``Comprehensive Index'' so that texinfo's HTML
+@c output doesn't generate an index.html that'd overwrite the manual's
+@c initial page.
+@node Comprehensive Index
+@unnumbered Index
+@printindex cp
+
+@bye
diff --git a/texinfo-docstrings b/texinfo-docstrings
new file mode 100644
index 0000000..917f5bd
--- /dev/null
+++ b/texinfo-docstrings
@@ -0,0 +1,1271 @@
+#!/bin/sh
+#| CL-LAUNCH 2.07 CONFIGURATION
+SOFTWARE_FILE=.
+SOFTWARE_SYSTEM=
+SOFTWARE_INIT_FORMS=
+SYSTEMS_PATHS=
+INCLUDE_PATH=
+LISPS="cmucl sbcl clisp ecl openmcl gclcvs allegro lisp gcl"
+WRAPPER_CODE=
+DUMP=
+RESTART=
+IMAGE_BASE=
+IMAGE_DIR=
+IMAGE=
+# END OF CL-LAUNCH CONFIGURATION
+
+# This file was generated by CL-Launch 2.07
+# This file was automatically generated and contains parts of CL-Launch
+#
+# Please send your improvements to the author:
+# fare at tunes dot org < http://www.cliki.net/Fare%20Rideau >.
+#
+# CL-Launch is available under the terms of the bugroff license.
+#	http://www.geocities.com/SoHo/Cafe/5947/bugroff.html
+# You may at your leisure use the LLGPL instead < http://www.cliki.net/LLGPL >
+#
+# This software can be used in conjunction with any other software:
+# the result may consist in pieces of the two software glued together in
+# a same file, but even then these pieces remain well distinguished, and are
+# each available under its own copyright and licensing terms, as applicable.
+# The parts that come from the other software are subject to the terms of use
+# and distribution relative to said software, which may well be
+# more restrictive than the terms of this software (according to lawyers
+# and the armed henchmen they got the taxpayers to pay to enforce their laws).
+# The bits of code generated by cl-launch, however, remain available
+# under the terms of their own license, and you may service them as you wish:
+# manually, using cl-launch --update or whichever means you prefer.
+# That said, if you believe in any of that intellectual property scam,
+# you may be subject to the terms of my End-Seller License:
+#	http://www.livejournal.com/users/fare/21806.html
+#
+PROG="$0"
+# cl-launch 2.07 shell wrapper
+#   Find and execute the most appropriate supported Lisp implementation
+#   to evaluate software prepared with CL-Launch.
+#
+ECHOn () { printf '%s' "$*" ;}
+simple_term_p () {
+  case "$1" in *[!a-zA-Z0-9-+_,.:=%/]*) return 1 ;; *) return 0 ;; esac
+}
+kwote0 () { ECHOn "$1" | sed -e "s/\([\\\\\"\$\`]\)/\\\\\\1/g" ;}
+kwote () { if simple_term_p "$1" ; then ECHOn "$1" ; else kwote0 "$1" ; fi ;}
+load_form_0 () { echo "(load $1 :verbose nil :print nil)" ;}
+load_form () { load_form_0 "\"$(kwote "$1")\"" ;}
+ECHO () { printf '%s\n' "$*" ;}
+DBG () { ECHO "$*" >& 2 ;}
+abort () { ERR="$1" ; shift ; DBG "$*" ; exit "$ERR" ;}
+ABORT () { abort 42 "$*" ;}
+DO_LISP=do_exec_lisp
+HASH_BANG_FORM='(set-dispatch-macro-character #\# #\! #'\''(lambda(stream char arg)(declare(ignore char arg))(values (read-line stream))))'
+PACKAGE_FORM=" #.(progn(defpackage :cl-launch (:use :cl))())"
+MAYBE_PACKAGE_FORM=
+
+implementation_cmucl () {
+  implementation "${CMUCL:-cmucl}" || return 1
+  OPTIONS="${CMUCL_OPTIONS:- -quiet -batch -noinit}"
+  EVAL=-eval
+  ENDARGS=--
+  IMAGE_ARG=-core
+  EXEC_LISP=exec_lisp_noarg
+  # exec_lisp works fine, except in the corner case when the program's user
+  # would use arguments that cmucl would process as its own arguments, even
+  # though they are meant for the Lisp program. cmucl provides no way to
+  # specify that arguments after "--" don't really matter.
+  # And so we use exec_lisp_noarg.
+  BIN_ARG=CMUCL
+  OPTIONS_ARG=CMUCL_OPTIONS
+}
+implementation_lisp () {
+  implementation ${CMULISP:=lisp} || return 1
+  CMUCL=$CMULISP
+  implementation_cmucl "$@"
+}
+implementation_sbcl () {
+  implementation "${SBCL:-sbcl}" || return 1
+  OPTIONS="${SBCL_OPTIONS:- --noinform --userinit /dev/null --disable-debugger}"
+  # We purposefully specify --userinit /dev/null but NOT --sysinit /dev/null
+  EVAL=--eval # SBCL's eval can only handle one form per argument.
+  ENDARGS=--end-toplevel-options
+  IMAGE_ARG=--core
+  #! IMAGE_ARG=EXECUTABLE_IMAGE # not appropriate: only executable if specified as such
+  #! DIRECT_EXECUTABLE=t # won't work as of sbcl 0.9.17: we need to modify sbcl
+  #! so it leaves all argument parsing to the software.
+  EXEC_LISP=exec_lisp
+  BIN_ARG=SBCL
+  OPTIONS_ARG=SBCL_OPTIONS
+}
+implementation_clisp () {
+  implementation "${CLISP:-clisp}" || return 1
+  OPTIONS="${CLISP_OPTIONS:- -norc --quiet --quiet}"
+  EVAL=-x
+  LOAD=-i
+  ENDARGS="-- foo"
+  # if the first argument begins with - there might be problems,
+  # so we avoid that and take the cdr or ext:*args*
+  IMAGE_ARG=-M # for use without :executable t
+  #! IMAGE_ARG="EXECUTABLE_IMAGE" # we don't use this by default
+  #! DIRECT_EXECUTABLE=t # won't work as of unpatched 2.41: we need to modify clisp
+  #! so it leaves all argument parsing to the software. See for instance
+  #! http://article.gmane.org/gmane.lisp.clisp.devel/15476
+  EXEC_LISP=exec_lisp
+  BIN_ARG=CLISP
+  OPTIONS_ARG=CLISP_OPTIONS
+}
+implementation_lispworks () { ### NEVER TESTED
+  implementation "${LISPWORKS:-lispworks}" || return 1
+  OPTIONS="${LISPWORKS_OPTIONS:- -siteinit -}" # -init -
+  LOAD=-init #### No such thing found in the online documentation.
+  #! EVAL=-eval # No such thing found in the online documentation.
+  #! ENDARGS="--"
+  IMAGE_ARG="EXECUTABLE_IMAGE" # we don't use this by default
+  EXEC_LISP=exec_lisp_file
+  BIN_ARG=LISPWORKS
+  OPTIONS_ARG=LISPWORKS_OPTIONS
+}
+prepare_arg_form () {
+  ENDARGS= F=
+  for arg ; do
+    F="$F\"$(kwote "$arg")\""
+  done
+  MAYBE_PACKAGE_FORM="$PACKAGE_FORM"
+  LAUNCH_FORMS="(defparameter cl-launch::*arguments*'($F))${LAUNCH_FORMS}"
+}
+exec_lisp_noarg () {
+  prepare_arg_form "$@"
+  exec_lisp
+}
+exec_lisp_file () {
+  prepare_arg_form "$@"
+  LOADFILE=${TMP:-/tmp}/cl-load-file-$(date +%s)-$$
+  cat > $LOADFILE < /dev/null` ; then
+    return 0
+  else
+    return 1
+  fi
+}
+trylisp () {
+  IMPL="$1" ; shift
+  implementation_${IMPL} "$@"
+}
+do_exec_lisp () {
+  $EXEC_LISP "$@"
+}
+no_implementation_found () {
+  ABORT "$PROG: Cannot find a supported lisp implementation.
+Tried the following: $*"
+}
+ensure_implementation () {
+  trylisp "$1" || no_implementation_found "$1"
+}
+try_all_lisps () {
+  for l in $LISP $LISPS ; do
+    if trylisp $l ; then
+      $DO_LISP "$@"
+      return 0
+    fi
+  done
+  no_implementation_found "$LISP $LISPS"
+}
+exec_lisp () {
+  # SBCL wants only one form per --eval so we need put everything in one progn.
+  # However we also want any in-package form to be evaluated before any of the
+  # remaining forms is read, so we get it to be evaluated at read-time as the
+  # first thing in the main progn.
+  # GNU clisp allows multiple forms per -x but prints the result of every form
+  # evaluated and so we also need put everything in a single progn, and that progn
+  # must quit before it may return to the clisp frame that would print its value.
+  # CMUCL allows multiple forms per -eval and won't print values, so is ok anyway.
+  # I don't know about other Lisps, but they will all work this way.
+  LAUNCH_FORM="(progn${MAYBE_PACKAGE_FORM}${HASH_BANG_FORM}${LAUNCH_FORMS})"
+  if [ -n "$CL_LAUNCH_VERBOSE" ] ; then set -x ; fi
+  exec $LISP_BIN $IMAGE_OPT $IMAGE $OPTIONS $EVAL "$LAUNCH_FORM" $ENDARGS "$@"
+}
+launch_self () {
+  LAUNCH_FORMS="$(load_form "$PROG")"
+  try_all_lisps "$@"
+}
+invoke_image () {
+  if [ "x$IMAGE_ARG" = xEXECUTABLE_IMAGE ] ; then
+    LISP_BIN= IMAGE_OPT=
+  else
+    IMAGE_OPT="$IMAGE_ARG"
+  fi
+  PACKAGE_FORM=
+  HASH_BANG_FORM=
+  LAUNCH_FORMS="(cl-launch::resume)"
+  "$EXEC_LISP" "$@"
+}
+
+export CL_LAUNCH_PID=$$
+export CL_LAUNCH_FILE="$PROG"
+
+## execute configuration-provided code
+eval "$WRAPPER_CODE"
+
+### END OF CL-LAUNCH SHELL WRAPPER
+
+
+launch_self "$@"
+ABORT
+# |#
+#| ;;; cl-launch 2.07 lisp header
+|# ;;;; Silence our lisp implementation for quiet batch use...
+
+#| We'd like to evaluate as little as possible of the code without compilation.
+ This poses a typical bootstrapping problem: the more sophistication we want
+ to distinguish what to put where in what dynamic environment, the more code
+ we have to evaluate before we may actually load compiled files. And, then,
+ it is a waste of time to try to compile said code into a file. Moving things
+ to the shell can only help so much, and reduces flexibility. Our best bet is
+ to tell sbcl or cmucl to not try to optimize too hard.
+|#
+#-cl-launch (eval-when (:load-toplevel :execute :compile-toplevel)
+  (declaim (optimize (speed 1) (safety 2) (compilation-speed 3) #-gcl (debug 1)
+       	   #+sbcl (sb-ext:inhibit-warnings 3)
+           #+sbcl (sb-c::merge-tail-calls 3) ;-- this plus debug 1 (or sb-c::insert-debug-catch 0 ???) should ensure all tail calls are optimized, says jsnell
+	   #+cmu (ext:inhibit-warnings 3)))
+  #+gcl ;;; If using GCL, do some safety checks
+  (when (or #-ansi-cl t)
+    (format *error-output*
+     "CL-Launch only supports GCL in ANSI mode. Aborting.~%")
+    (lisp:quit))
+  #+gcl
+  (when (or (< system::*gcl-major-version* 2)
+            (and (= system::*gcl-major-version* 2)
+                 (< system::*gcl-minor-version* 7)))
+    (pushnew :gcl-pre2.7 *features*))
+  (setf *print-readably* nil ; allegro 5.0 notably will bork without this
+        *load-verbose* nil *compile-verbose* nil *compile-print* nil)
+  #+cmu (setf ext:*gc-verbose* nil)
+  #+clisp (setf custom:*source-file-types* nil custom:*compiled-file-types* nil)
+  #+gcl (setf compiler::*compiler-default-type* (pathname "")
+              compiler::*lsp-ext* "")
+  #+ecl (require 'cmp)
+
+  ;;;; Ensure package hygiene
+  (unless (find-package :cl-launch)
+    (if (find-package :common-lisp)
+       (defpackage :cl-launch (:use :common-lisp))
+       (make-package :cl-launch :use '(:lisp))))
+  (in-package :cl-launch))
+#-cl-launch (defmacro dbg (tag &rest exprs)
+  "simple debug statement macro:
+outputs a tag plus a list of source expressions and their resulting values, returns the last values"
+  (let ((res (gensym))(f (gensym)))
+  `(let ((,res))
+    (flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args)))
+      (,f "~&~A~%" ,tag)
+      ,@(mapcan
+         #'(lambda (x)
+            `((,f "~&  ~S => " ',x)
+              (,f "~{~S~^ ~}~%" (setf ,res (multiple-value-list ,x)))))
+         exprs)
+      (apply 'values ,res)))))
+#-cl-launch (eval-when (:load-toplevel :execute :compile-toplevel)
+  ;; Import a few symbols if needed
+  #+common-lisp-controller
+  (map () #'import
+       '(clc::*source-root*
+         clc::*fasl-root*
+         clc::calculate-fasl-root
+         clc::source-root-path-to-fasl-path
+         clc::alternative-root-path-to-fasl-path
+         clc::*redirect-fasl-files-to-cache*))
+  #+ecl
+  (map () #'import
+       '(c::system-ld-flag
+         c::library-type-p
+         c::built-type-p
+         c::builder
+         c::build-fasl
+         c::wt-filtered-data
+         c::init-function-name
+         c::data-init
+         c::compiler-cc
+         c::linker-cc
+         c::shared-cc
+         c::bundle-cc
+         c::safe-system
+         c::cmp-delete-file
+         c::+lisp-program-header+
+         c::+lisp-program-init+
+         c::+lisp-program-main+
+         c::+static-library-prefix+
+         c::+lisp-program-init+
+         ))
+  ;;; define getenv and quit in ways that minimize package conflicts
+  ;;; (use-package :cl-launch) while in cl-user.
+  #+(or openmcl allegro gcl clisp ecl)
+    (import '#+openmcl ccl::getenv
+             #+allegro sys:getenv
+             #+gcl system:getenv
+             #+clisp ext:getenv
+             #+ecl si:getenv
+      :cl-launch)
+  #+(or cmu sbcl lispworks)
+    (defun getenv (x)
+      #+sbcl (sb-ext:posix-getenv x)
+      #+lispworks (lispworks:environment-variable x)
+      #+cmu (cdr (assoc (intern x :keyword) ext:*environment-list*)))
+  (defun quit (&optional (code 0) (finish-output t))
+    (when finish-output ;; essential, for openmcl, and for standard compliance.
+      (finish-outputs))
+    #+cmu (unix:unix-exit code)
+    #+clisp (ext:quit code)
+    #+sbcl (sb-unix:unix-exit code)
+    #+openmcl (ccl:quit code)
+    #+gcl (lisp:quit code)
+    #+allegro (excl:exit code :quiet t)
+    #+ecl (si:quit code)
+    #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
+    #-(or cmu clisp sbcl openmcl gcl allegro ecl lispworks)
+    (error "Quitting not implemented")))
+#-cl-launch (eval-when (:load-toplevel :execute :compile-toplevel)
+  ;;;; Load ASDF
+  (ignore-errors (require :asdf))
+  ;;; Here is a fallback plan in case the lisp implementation isn't asdf-aware.
+  (unless (and (find-package :asdf) (find-symbol "OUTPUT-FILES" :asdf))
+    (defvar *asdf-path*
+      (or (and (getenv "ASDF_PATH") (probe-file (getenv "ASDF_PATH")))
+          (probe-file (merge-pathnames "src/asdf/asdf.lisp"
+                                       (user-homedir-pathname)))
+          (probe-file "/usr/share/common-lisp/source/asdf/asdf.lisp")))
+    (when *asdf-path*
+      (ignore-errors (load *asdf-path* :verbose nil :print nil)))))
+#-cl-launch (eval-when (:load-toplevel :execute :compile-toplevel)
+  ;;; Even in absence of asdf, at least create a package asdf.
+  (unless (find-package :asdf)
+    (make-package :asdf)))
+#-cl-launch (eval-when (:load-toplevel :execute :compile-toplevel)
+  ;;; Try to share this with asdf, in case we get asdf to support it one day.
+  (map () #'import
+       '(asdf::*output-pathname-translations*
+         asdf::resolve-symlinks
+         asdf::oos asdf::load-op asdf::find-system)))
+
+;;;; CL-Launch Initialization code
+#-cl-launch (progn
+
+(pushnew :cl-launch *features*)
+
+;;#+ecl (require 'cmp) ; ensure we use the compiler (we use e.g. *ecl-library-directory*)
+
+(dolist (s '(*arguments* getenv quit compile-and-load-file
+             compile-file-pathname* apply-pathname-translations
+	     *output-pathname-translations*
+             apply-output-pathname-translations))
+  (export s))
+
+;; To dynamically recompute from the environment at each invocation
+(defvar *cl-launch-file* nil)
+(defvar *verbose* nil)
+(defvar *lisp-fasl-cache* nil "lisp fasl cache hierarchy")
+(defvar *lisp-fasl-root* nil "top path for the fasl cache for current implementation")
+;; To dynamically recompute from the command-line at each invocation
+(defvar *arguments* nil "command-line parameters")
+
+;; Variables that define the current system
+(defvar *dumped* nil)
+(defvar *restart* nil)
+(defvar *init-forms* nil)
+(defvar *quit* t)
+
+;; Provide compatibility with clc 6.2
+(defvar *redirect-fasl-files-to-cache* t)
+
+#+ecl
+(defun command-line-arguments ()
+  (loop for i from 1 below (si:argc) collect (si:argv i)))
+
+(defun compute-arguments ()
+  #+gcl (setf system::*tmp-dir* (ensure-directory-name (or (getenv "TMP") "/tmp"))) ; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1
+  (setf *cl-launch-file* (getenv "CL_LAUNCH_FILE")
+        *verbose* (when (getenv "CL_LAUNCH_VERBOSE") t)
+        *lisp-fasl-cache* (let* ((cache-env (getenv "LISP_FASL_CACHE"))
+                            (cache-spec
+                             (cond
+                               ((null cache-env)
+                                (merge-pathnames
+                                 #p".cache/lisp-fasl/"
+                                 ;;(make-pathname :directory (list :relative ".cache" "lisp-fasl"))
+                                 (user-homedir-pathname)))
+                               ((equal cache-env "NIL") nil)
+                               (t (dirname->pathname cache-env)))))
+                       #+gcl-pre2.7 cache-spec #-gcl-pre2.7
+		       (when cache-spec
+                         (ensure-directories-exist cache-spec)
+                         (resolve-symlinks cache-spec)))
+        *lisp-fasl-root* (let* ((root-env
+                                 (when (getenv "LISP")
+                                   (let ((r (getenv "LISP_FASL_ROOT")))
+                                     (when r (if (equal r "NIL") :disabled
+                                                 (dirname->pathname r))))))
+                                (root-spec
+                                 (or root-env
+                                     (when *lisp-fasl-cache*
+                                       (merge-pathnames
+                                        (make-pathname
+                                         :directory (list :relative *implementation-name*))
+                                        *lisp-fasl-cache*)))))
+			   #+gcl-pre2.7 root-spec #-gcl-pre2.7
+                           (when root-spec
+                             (ensure-directories-exist root-spec)
+                             (resolve-symlinks root-spec))))
+  (calculate-output-pathname-translations)
+  (setf *arguments*
+   (or *arguments*
+       #+(or cmu gcl ecl lispworks)
+         (cdr (member "--"
+		      #+gcl si:*command-args*
+                      #+ecl (command-line-arguments)
+		      #+cmu extensions:*command-line-strings*
+                      #+lispworks system:*line-arguments-list*
+		      :test 'equal))
+       #+openmcl ccl:*unprocessed-command-line-arguments*
+       #+sbcl (cdr sb-ext:*posix-argv*)
+       #+allegro (cdr (sys:command-line-arguments))
+       #+clisp (cdr ext:*args*))))
+
+(defun register-paths (paths)
+  #-asdf (declare (ignore paths))
+  #+asdf
+  (dolist (p (reverse paths))
+    (pushnew p asdf::*central-registry* :test 'equal)))
+
+(defun load-stream (&optional (s #-clisp *standard-input*
+				 #+clisp *terminal-io*))
+  ;; GCL 2.6 can't load from a string-input-stream
+  ;; OpenMCL 1.1-pre cannot load from either *standard-input* or *terminal-io*
+  ;; Allegro 5, I don't remember but it must have been broken when I tested.
+  #+(or gcl-pre2.7 allegro)
+  (do ((eof '#:eof) (x t (read s nil eof))) ((eq x eof)) (eval x))
+  #-(or gcl-pre2.7 allegro)
+  (load s :verbose nil :print nil))
+
+(defun load-string (string)
+  (with-input-from-string (s string) (load-stream s)))
+
+(defun finish-outputs ()
+  (finish-output *error-output*)
+  (finish-output))
+
+(defun %abort (code fmt &rest args)
+  (apply #'format *error-output* fmt args)
+  (quit code))
+
+(defun resume ()
+  (compute-arguments)
+  (do-resume))
+
+(defun do-resume ()
+  (when *restart* (funcall *restart*))
+  (when *init-forms* (load-string *init-forms*))
+  (finish-outputs)
+  (when *quit* (quit 0)))
+
+(defun dump-image (filename &key executable (package :cl-user))
+  (declare (ignorable filename executable package))
+  (setf *dumped* (if executable :executable t)
+        *arguments* nil)
+  #+clisp
+  (ext:saveinitmem filename
+   :executable executable
+   :init-function (when executable #'resume)
+   ;; :parse-options (not executable) ;--- requires a patch to clisp
+   :script t
+   :quiet t
+   :norc t
+   :start-package package
+   :keep-global-handlers nil)
+  #+sbcl
+  (progn
+    ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself
+   (setf sb-ext::*gc-run-time* 0)
+   (apply 'sb-ext:save-lisp-and-die filename
+    :executable executable
+    (when executable (list :toplevel #'resume))))
+  #+cmu
+  (progn
+   (ext:gc :full t)
+   (setf ext:*batch-mode* nil)
+   (setf ext::*gc-run-time* 0)
+   (extensions:save-lisp filename))
+  #+openmcl
+  (ccl:save-application filename)
+  #+allegro
+  (progn
+   (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000
+   (excl:dumplisp :name filename :suppress-allegro-cl-banner t))
+  #+lispworks
+  (save-image filename :environment nil) ; XXXXX
+  #+gcl
+  (progn
+   (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t)
+   (si::save-system filename))
+  #-(or clisp sbcl cmu openmcl allegro gcl lispworks)
+  (%abort 11 "CL-Launch doesn't supports image dumping with this Lisp implementation.~%"))
+
+(defun run (&key paths load system dump restart init (quit 0))
+  (pushnew :cl-launched *features*)
+  (compute-arguments)
+  (when paths (register-paths paths))
+  (if dump
+      (build-and-dump dump load system restart init quit)
+      (build-and-run load system restart init quit)))
+
+(defun read-function (string)
+  `(function ,(read-from-string string)))
+
+(defun build-and-load (load system restart init quit)
+  (when load
+    (cond
+     ((eq load t) (load-stream))
+     ((streamp load) (load-stream load))
+     ((eq load :self) (load-file *cl-launch-file*))
+     (t (load-file load))))
+  (when system
+    #+asdf
+    (load-system system :verbose *verbose*)
+    #-asdf
+    (%abort 10 "ERROR: asdf requested, but not found~%"))
+  (setf *restart* (when restart (eval (read-function restart)))
+        *init-forms* init
+        *quit* quit))
+
+(defun build-and-run (load system restart init quit)
+  (build-and-load load system restart init quit)
+  (do-resume))
+
+#-ecl
+(defun build-and-dump (dump load system restart init quit)
+  (build-and-load load system restart init quit)
+  (dump-image dump :executable (getenv "CL_LAUNCH_EXECUTABLE"))
+  (quit))
+
+#+ecl (progn ;;; ECL PATCH: modifies and adds functions into ecl*/src/cmp/cmpmain.lsp
+;;; necessary for ecl 0.9i. The patch since made it to the development branch and so
+;;; will have to be removed from here when new ecl releases make it to our target
+;;; linux distributions.
+
+(defun system-ld-flag (library)
+  (let ((asdf (find-package "ASDF"))
+        system)
+    (labels ((asdfsym (x) (find-symbol (string x) asdf))
+             (asdfcall (fun &rest rest) (apply (asdfsym fun) rest))
+             (system-output (system type)
+               (let ((build (make-instance (asdfsym :build-op) :type type)))
+                 (first (asdfcall :output-files build system))))
+             (existing-system-output (system type)
+               (let ((o (system-output system type)))
+                 (and o (probe-file o))))
+             (find-archive (system)
+                 (or (existing-system-output system :library)
+                     (existing-system-output system :shared-library)))
+             (fallback () (format nil #-msvc "-l~A" #+msvc "~A.lib" (string-downcase library))))
+      (or (and asdf
+               (setf system (asdfcall :find-system library nil))
+               (find-archive system))
+        (fallback)))))
+
+(defun library-type-p (type)
+  (member type
+          #-msvc '("a" "so")
+          #+msvc '("lib" "dll")
+          :test #'equal))
+
+(defun built-type-p (type)
+  (or (equal type #-msvc "o" #+msvc "obj")
+      (library-type-p type)))
+
+(defun builder (target output-name &key lisp-files ld-flags shared-data-file
+		(init-name nil)
+		(prologue-code "")
+		(epilogue-code (when (eq target :program) '(SI::TOP-LEVEL)))
+		#+:win32 (system :console))
+  ;;
+  ;; The epilogue-code can be either a string made of C code, or a
+  ;; lisp form.  In the latter case we add some additional C code to
+  ;; clean up, and the lisp form is stored in a text representation,
+  ;; to avoid using the compiler.
+  ;;
+  (cond ((null epilogue-code)
+	 (setf epilogue-code ""))
+	((stringp epilogue-code)
+	 )
+	(t
+	 (with-standard-io-syntax
+	   (setq epilogue-code
+		 (with-output-to-string (stream)
+		   (princ "{ const char *lisp_code = " stream)
+		   (wt-filtered-data (write-to-string epilogue-code) stream)
+		   (princ ";
+cl_object output;
+si_select_package(make_simple_base_string(\"CL-USER\"));
+output = cl_safe_eval(c_string_to_object(lisp_code), Cnil, OBJNULL);
+" stream)
+		   (when (eq target :program)
+		     (princ "cl_shutdown(); return (output != OBJNULL);" stream))
+		   (princ #\} stream)
+		   )))))
+  ;;
+  ;; When a module is built out of several object files, we have to
+  ;; create an additional object file that initializes those ones.
+  ;; This routine is responsible for creating this file.
+  ;;
+  ;; To avoid name clashes, this object file will have a temporary
+  ;; file name (tmp-name).
+  ;;
+  (let* ((tmp-name (si::mkstemp #P"TMP:ECLINIT"))
+	 (c-name (si::coerce-to-filename
+		  (compile-file-pathname tmp-name :type :c)))
+	 (o-name (si::coerce-to-filename
+		  (compile-file-pathname tmp-name :type :object)))
+	 submodules
+	 c-file)
+    (dolist (item (reverse lisp-files))
+      (etypecase item
+        (symbol
+         (push (system-ld-flag item) ld-flags)
+         ;;---*** NOTE: reduce clashes by having a system prefix in the init-name
+         (push (init-function-name item "system") submodules))
+        ((or string pathname)
+         (let* ((pn (parse-namestring item))
+                (type (pathname-type pn))
+                (module (pathname-name pn))
+                (init-fn
+                 ;;---*** NOTE: it would reduce clashes to keep/add a
+                 ;;---*** system/library prefix in/to the init-name
+                 (if (library-type-p type)
+                   (let ((name
+                          (if (equal (subseq module 0 (length +static-library-prefix+))
+                                     +static-library-prefix+)
+                           (subseq module (length +static-library-prefix+))
+                           module)))
+                     (init-function-name name "system"))
+                   (init-function-name module)))
+                (built-pn
+                 (if (built-type-p type) pn
+                   (compile-file-pathname pn :type :object)))
+                (filename (si::coerce-to-filename built-pn)))
+           (push filename ld-flags)
+           (push init-fn submodules)))))
+    (setq c-file (open c-name :direction :output))
+    (format c-file +lisp-program-header+
+            #-(or :win32 :mingw32 :darwin) (if (eq :fasl target) nil submodules)
+            #+(or :win32 :mingw32 :darwin) submodules)
+    (cond (shared-data-file
+	   (data-init shared-data-file)
+	   (format c-file "
+#define VM ~A
+#ifdef ECL_DYNAMIC_VV
+static cl_object *VV;
+#else
+static cl_object VV[VM];
+#endif
+#define ECL_SHARED_DATA_FILE 1
+" (data-permanent-storage-size))
+	   (data-dump c-file))
+	  (t
+	   (format c-file "
+#define compiler_data_text NULL
+#define compiler_data_text_size 0
+#define VV NULL
+#define VM 0" c-file)))
+    (ecase target
+      (:program
+       (when (or (symbolp output-name) (stringp output-name))
+	 (setf output-name (compile-file-pathname output-name :type :program)))
+       (unless init-name
+	 (setf init-name (init-function-name (pathname-name output-name) nil)))
+       (format c-file +lisp-program-init+ init-name "" shared-data-file
+	       submodules "")
+       (format c-file #+:win32 (ecase system (:console +lisp-program-main+)
+				             (:windows +lisp-program-winmain+))
+	              #-:win32 +lisp-program-main+
+		      prologue-code init-name epilogue-code)
+       (close c-file)
+       (compiler-cc c-name o-name)
+       (apply #'linker-cc output-name (namestring o-name) ld-flags))
+      ((:library :static-library :lib)
+       (when (or (symbolp output-name) (stringp output-name))
+	 (setf output-name (compile-file-pathname output-name :type :lib)))
+       (unless init-name
+	 ;; Remove the leading "lib"
+	 (setf init-name (subseq (pathname-name output-name) (length +static-library-prefix+)))
+	 (setf init-name (init-function-name init-name "system")))
+       (format c-file +lisp-program-init+ init-name prologue-code
+	       shared-data-file submodules epilogue-code)
+       (close c-file)
+       (compiler-cc c-name o-name)
+       #-msvc
+       (progn
+       (safe-system (format nil "ar cr ~A ~A ~{~A ~}"
+			    output-name o-name ld-flags))
+       (safe-system (format nil "ranlib ~A" output-name)))
+       #+msvc
+       (unwind-protect
+         (progn
+           (with-open-file (f "static_lib.tmp" :direction :output :if-does-not-exist :create :if-exists :supersede)
+             (format f "/DEBUGTYPE:CV /OUT:~A ~A ~{~&\"~A\"~}"
+                     output-name o-name ld-flags))
+           (safe-system "link -lib @static_lib.tmp"))
+         (when (probe-file "static_lib.tmp")
+           (cmp-delete-file "static_lib.tmp")))
+       )
+      #+dlopen
+      ((:shared-library :dll)
+       (when (or (symbolp output-name) (stringp output-name))
+	 (setf output-name (compile-file-pathname output-name :type :dll)))
+       (unless init-name
+	 ;; Remove the leading "lib"
+	 (setf init-name (subseq (pathname-name output-name)
+				 (length +static-library-prefix+)))
+	 (setf init-name (init-function-name init-name nil)))
+       (format c-file +lisp-program-init+ init-name prologue-code
+	       shared-data-file submodules epilogue-code)
+       (close c-file)
+       (compiler-cc c-name o-name)
+       (apply #'shared-cc output-name o-name ld-flags))
+      #+dlopen
+      (:fasl
+       (when (or (symbolp output-name) (stringp output-name))
+	 (setf output-name (compile-file-pathname output-name :type :fasl)))
+       (unless init-name
+	 (setf init-name (init-function-name "CODE" nil)))
+       #-(or :win32 :mingw32 :darwin)
+       (setf submodules
+	     (mapcar #'(lambda (sm)
+			 (format nil "((ecl_init_function_t) ecl_library_symbol(Cblock, \"~A\", 0))" sm))
+		     submodules))
+       (format c-file +lisp-program-init+ init-name prologue-code shared-data-file
+	       submodules epilogue-code)
+       (close c-file)
+       (compiler-cc c-name o-name)
+       (apply #'bundle-cc output-name o-name ld-flags)))
+    (cmp-delete-file tmp-name)
+    (cmp-delete-file c-name)
+    (cmp-delete-file o-name)
+    output-name))
+);END OF ECL PATCH
+
+#+ecl
+(defun build-and-dump (dump load system restart init quit)
+  (setf *compile-verbose* *verbose*
+        c::*suppress-compiler-warnings* (not *verbose*)
+        c::*suppress-compiler-notes* (not *verbose*))
+  (let* ((library-type :library) ; :library :shared-library
+         (program-type :program) ; :program :fasl
+         (cl-launch-objects
+	  (let ((*features* (remove :cl-launch *features*))
+                (header (or *compile-file-pathname* *load-pathname* (getenv "CL_LAUNCH_HEADER"))))
+	    (list
+	     (compile-and-load-file header :verbose *verbose* :load nil :system-p t))))
+	 (file-objects
+	  (when load
+	    (list
+             (labels ((x (file)
+                        (compile-and-load-file file :verbose *verbose* :system-p t :load t))
+                      (xwt (s)
+                        (error "dumping image from a stream is unsupported")
+                        ;; should be dumping the stream to a temporary file then compiling
+                        ))
+               (cond
+                 ((eq load t) (xwt *standard-input*))
+                 ((streamp load) (xwt load))
+                 ((eq load :self) (x *cl-launch-file*))
+                 (t (x load)))))))
+	 (system-objects
+	  (when system
+	    (let* ((target (find-system system))
+                   (build (make-instance 'asdf:build-op :type library-type))
+                   (sysdep ()))
+              (loop for (op . component) in (asdf::traverse build target)
+                    when (typep component 'asdf:system)
+                    do (pushnew component sysdep)
+                    finally (setf sysdep (nreverse sysdep)))
+              (loop for system in sysdep
+                    nconc (asdf:output-files build system)
+                    do (asdf:oos 'asdf:compile-op system)
+                    do (asdf:oos 'asdf:build-op system :type library-type)))))
+         (executable (getenv "CL_LAUNCH_EXECUTABLE"))
+	 (init-code
+	  `(setf
+	    *load-verbose* nil
+            *dumped* ,(if executable :executable t)
+            ,@(when executable
+                '(*arguments* (command-line-arguments)))
+	    ,@(when restart
+		    `(*restart* ,(read-function restart)))
+	    ,@(when init
+		    `(*init-forms* ,init))
+	    ,@(unless quit
+		      `(*quit* nil))))
+         (epilogue-code
+          (ecase program-type
+            (:fasl init-code)
+            (:program `(progn ,init-code (resume)))))
+	 (fasl
+	  (builder program-type (parse-namestring dump)
+                   :lisp-files
+                   (append cl-launch-objects file-objects system-objects)
+                   :epilogue-code epilogue-code)))
+  (quit)))
+
+;;;; Find a unique directory name for current implementation for the fasl cache
+;;; (modified from SLIME's swank-loader.lisp)
+
+(defparameter *implementation-features*
+  '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp
+    :armedbear :gcl :ecl :scl))
+
+(defparameter *os-features*
+  '(:macosx :linux :windows :mswindows :win32
+    :solaris :darwin :sunos :hpux :unix))
+
+(defparameter *architecture-features*
+  '(:powerpc :ppc
+    :x86-64 :amd64 :x86 :i686 :i586 :i486 :pc386 :iapx386
+    :sparc64 :sparc :hppa64 :hppa))
+
+(defun lisp-version-string ()
+  #+cmu       (substitute-if #\_ (lambda (x) (find x " /"))
+                             (lisp-implementation-version))
+  #+scl       (lisp-implementation-version)
+  #+sbcl      (lisp-implementation-version)
+  #+ecl       (lisp-implementation-version)
+  #+openmcl   (format nil "~d.~d.fasl~d"
+                      ccl::*openmcl-major-version*
+                      ccl::*openmcl-minor-version*
+                      (logand ccl::fasl-version #xFF))
+  #+lispworks (lisp-implementation-version)
+  #+allegro   (format nil
+                      "~A~A~A"
+                      excl::*common-lisp-version-number*
+                      (if (eq 'h 'H) "A" "M")     ; ANSI vs MoDeRn
+                      (if (member :64bit *features*) "-64bit" ""))
+  #+clisp     (let ((s (lisp-implementation-version)))
+                (subseq s 0 (position #\space s)))
+  #+armedbear (lisp-implementation-version)
+  #+cormanlisp (lisp-implementation-version)
+  #+gcl       (let ((s (lisp-implementation-version))) (subseq s 4)))
+
+(defun ensure-directory-name (dn)
+   (if (eql #\/ (char dn (1- (length dn)))) dn
+      (concatenate 'string dn "/")))
+
+(defun dirname->pathname (dn)
+  (parse-namestring (ensure-directory-name dn)))
+
+(defun unique-directory-name (&optional warn)
+  "Return a name that can be used as a directory name that is
+unique to a Lisp implementation, Lisp implementation version,
+operating system, and hardware architecture."
+  (flet ((first-of (features)
+           (find-if #'(lambda (f) (find f *features*)) features))
+         (maybe-warn (value fstring &rest args)
+           (cond (value)
+                 (t (when warn (apply #'warn fstring args))
+                    "unknown"))))
+    (let ((lisp (maybe-warn (first-of *implementation-features*)
+                            "No implementation feature found in ~a."
+                            *implementation-features*))
+          (os   (maybe-warn (first-of *os-features*)
+                            "No os feature found in ~a." *os-features*))
+          (arch	(maybe-warn (first-of *architecture-features*)
+                            "No architecture feature found in ~a."
+                            *architecture-features*))
+          (version (maybe-warn (lisp-version-string)
+                               "Don't know how to get Lisp ~
+                                implementation version.")))
+      (format nil "~(~@{~a~^-~}~)" lisp version os arch))))
+
+(defvar *implementation-name* (unique-directory-name *verbose*)
+  "The name of the implementation, used to make a directory hierarchy for fasl files")
+
+;;;; Redefine the ASDF output-files method to put fasl's under the fasl cache.
+;;; (taken from common-lisp-controller's post-sysdef-install.lisp)
+
+;;#-common-lisp-controller (progn ; BEGIN of progn to disable caching when clc is detected
+
+(defparameter *wild-path*
+   (make-pathname :directory '(:relative :wild-inferiors)
+		  :name :wild :type :wild :version nil))
+
+(defun wilden (path)
+   (merge-pathnames *wild-path* path))
+
+#-asdf
+(defun resolve-symlinks (x)
+  #+allegro (excl:pathname-resolve-symbolic-links x)
+  #+gcl-pre2.7 (truename (merge-pathnames x *default-pathname-defaults*))
+  #-(or allegro gcl-pre2.7)
+  (truename x))
+
+(defvar *output-pathname-translations* nil
+  "a list of pathname translations, where every translation is a list
+of a source pathname and destination pathname.")
+
+(defun exclude-from-cache (&rest dirs)
+  (dolist (dir dirs)
+    (when dir
+      (let* ((p (if (pathnamep dir) dir (dirname->pathname dir)))
+             (n #+asdf (resolve-symlinks p) #-asdf p)
+             (w (wilden n)))
+        (pushnew (list w w)
+                 cl-launch::*output-pathname-translations*
+                 :test #'equal)))))
+
+(defun calculate-output-pathname-translations ()
+  (setf *output-pathname-translations*
+        `(#+(and common-lisp-controller (not gcl))
+          ,@(progn
+              #-gcl-pre2.7 (ensure-directories-exist (calculate-fasl-root))
+              (let* ((sr (resolve-symlinks *source-root*))
+                     (fr (resolve-symlinks *fasl-root*))
+                     (sp (wilden sr))
+                     (fp (wilden fr)))
+                `((,sp ,fp)
+                  (,fp ,fp)
+                  ,@(when *redirect-fasl-files-to-cache*
+                      `((,(wilden "/")
+                          ,(wilden (merge-pathnames
+                                    (make-pathname :directory '(:relative "local")) fr))))))))
+          #-(and common-lisp-controller (not gcl))
+          ,@(when (and *lisp-fasl-root* (not (eq *lisp-fasl-root* :disabled)))
+              `((,(wilden "/") ,(wilden *lisp-fasl-root*))))))
+
+  ;; Do not recompile in private cache system-installed sources
+  ;; that already have their accompanying precompiled fasls.
+  #+(or clisp sbcl cmucl gcl) ; no need for ECL: no source/fasl couples there.
+  (exclude-from-cache
+   #p"/usr/lib/"
+   #+clisp ext:*lib-directory*
+   #+gcl system::*lib-directory*
+   #+ecl c::*ecl-library-directory*
+   #+sbcl (getenv "SBCL_HOME")
+   #+cmu (truename #p"library:")))
+
+
+(defun apply-pathname-translations
+  (path &optional (translations *output-pathname-translations*))
+#+gcl-pre2.7 path ;;; gcl 2.6 lacks pathname-match-p, anyway
+#-gcl-pre2.7
+  (loop
+    for (source destination) in translations
+    when (pathname-match-p path source)
+    do (return (translate-pathname path source destination))
+    finally (return path)))
+
+#+asdf
+(handler-bind ((warning #'muffle-warning))
+  (defmethod asdf:output-files :around ((op asdf:operation) (c asdf:component))
+    "Method to rewrite output files to fasl-path"
+    (let ((orig (call-next-method)))
+       (mapcar #'apply-pathname-translations orig))))
+
+;; We provide cl-launch, no need to go looking for it further!
+#+asdf
+(unless (find-system :cl-launch nil)
+  (asdf:defsystem :cl-launch
+      #+gcl :pathname #+gcl "/dev/null"
+      :depends-on () :serial t :components ()))
+
+;);;END of progn to disable caching when clc is detected
+
+#|
+#+common-lisp-controller
+(defun beneath-clc-source-root? (pn)
+  "Returns T if pn's directory below *source-root*"
+  (when pn
+    (let ((root-dir (pathname-directory (resolve-symlinks *source-root*)))
+          (comp-dir (pathname-directory pn)))
+      (and (>= (length comp-dir)
+               (length root-dir))
+           (equalp root-dir (subseq comp-dir 0 (length root-dir)))))))
+|#
+
+(defun apply-output-pathname-translations (path)
+#|  #+common-lisp-controller
+  (progn
+    (if (beneath-clc-source-root? path)
+      (source-root-path-to-fasl-path path)
+      (alternative-root-path-to-fasl-path path)))
+  #-common-lisp-controller |#
+  (apply-pathname-translations path))
+
+#+asdf
+(defun load-system (system &key verbose)
+  (asdf:oos 'asdf:load-op system :verbose verbose))
+
+#+asdf
+(defun load-systems (&rest systems)
+  (dolist (s systems) (load-system s :verbose *verbose*)))
+
+(defun file-newer-p (new-file old-file)
+  "Returns true if NEW-FILE is strictly newer than OLD-FILE."
+  (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun compile-file-pathname* (source &rest args)
+  #-(or gcl ecl)
+  (apply-output-pathname-translations
+   (apply #'compile-file-pathname source args))
+  #+(or gcl ecl) ;; ECL BUG: compile-file-pathname doesn't accept system-p
+  (let* ((system-p (getf args :system-p))
+         (args (loop for (x y . z) on args by #'cddr nconc
+                     (unless (eq x :system-p)
+                       (list x y))))
+         (path (apply-output-pathname-translations
+                (apply #'compile-file-pathname source args))))
+    (if system-p
+        (make-pathname :type "o" :defaults path)
+        path)))
+
+#-(or cormanlisp)
+(defun compile-and-load-file (source &key force-recompile verbose (load t)
+                                     #+(or ecl gcl) system-p)
+  "compiles and load specified SOURCE file, if either required by keyword
+argument FORCE-RECOMPILE, or not yet existing, or not up-to-date.
+Keyword argument VERBOSE specifies whether to be verbose.
+Returns two values: the fasl path, and T if the file was (re)compiled"
+  (let* ((truesource (truename source))
+         (fasl
+          (compile-file-pathname* truesource
+                                  #+(or ecl gcl) :system-p #+(or ecl gcl) system-p))
+         (compiled-p
+          (when (or force-recompile
+                    (not (probe-file fasl))
+                    (not (file-newer-p fasl source)))
+            ;; When in doubt, don't trust and recompile, even though there are cases
+            ;; when on the first time of compiling a simple auto-generated file
+            ;; (e.g. from the automated test suite), the fasl ends up being written
+            ;; to disk within the same second as the source was produced, which cannot
+            ;; be distinguished from the reverse case where the source code was produced
+            ;; in the same split second as the previous version was done compiling.
+            ;; Could be tricky if a big system needs be recompiled as a dependency on
+            ;; an automatically generated file, but for cl-launch those dependencies are
+            ;; not detected anyway (BAD). If/when they are, and lacking better timestamps
+            ;; than the filesystem provides, you should sleep after you generate your source code.
+            #-gcl-pre2.7 (ensure-directories-exist fasl)
+            (multiple-value-bind (path warnings failures)
+                (compile-file truesource
+                              :output-file fasl
+                              #+ecl :system-p #+ecl system-p
+                              #-gcl-pre2.7 :print #-gcl-pre2.7 verbose
+                              #-gcl-pre2.7 :verbose #-gcl-pre2.7 verbose)
+              (declare (ignore warnings))
+              (unless (equal (truename fasl) (truename path))
+                (error "CL-Launch: file compiled to ~A, expected ~A" path fasl))
+              (when failures
+                (error "CL-Launch: failures while compiling ~A" source)))
+            t)))
+    (when load
+      (load #-(and ecl (not dlopen)) fasl
+            #+(and ecl (not dlopen)) (if system-p source fasl)
+            :verbose verbose))
+    (values fasl compiled-p)))
+
+#+(or cormanlisp)
+(defun compile-and-load-file (source &key force-recompile verbose load)
+  "Corman Lisp has trouble with compiled files (says SLIME)."
+  (declare (ignore force-recompile))
+  (when load
+    (load source :verbose verbose))
+  (force-output)
+  (values nil t))
+
+(defun load-file (source)
+  #-(or gcl-pre2.7 (and ecl (not dlopen)))
+  (compile-and-load-file source :verbose *verbose*)
+  #+gcl-pre2.7
+  (let* ((pn (parse-namestring source))) ; when compiling, gcl 2.6 will always
+    (if (pathname-type pn) ; add a type .lsp if type is missing, so avoid compilation
+      (compile-and-load-file source :verbose *verbose*)
+      (load source :verbose *verbose*)))
+  #+(and ecl (not dlopen))
+  (load source :verbose *verbose*)))
+;;;;; Return to the default package.
+(in-package :cl-user)
+
+;;; END OF CL-LAUNCH LISP HEADER
+
+
+;;;; CL-LAUNCH LISP INITIALIZATION CODE
+
+#-cl-launched
+(cl-launch::run :load :self)
+
+;;;; END OF CL-LAUNCH LISP INITIALIZATION CODE
+
+
+;;; 65bcc57c2179aad145614ec328ce5ba8 SOFTWARE WRAPPED BY CL-LAUNCH BEGINS HERE:
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; texinfo-docstrings.lisp --- Front-end script.
+;;;
+;;; Copyright (C) 2007, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+
+(in-package #:cl-launch)
+
+(defun print-help-and-quit ()
+  (write-line "Usage: texinfo-docstrings [html|pdf|all]    <css style> packages...")
+  (quit 1))
+
+(when (< (length *arguments*) 6)
+  (write-line "Not enough arguments.")
+  (print-help-and-quit))
+
+(defparameter *output*
+  (let ((arg1 (first *arguments*)))
+    (cond
+      ((string-equal arg1 "html") 'html)
+      ((string-equal arg1 "pdf") 'pdf)
+      ((string-equal arg1 "all") 'all)
+      (t (print-help-and-quit)))))
+
+(defparameter *system* (second *arguments*))
+(defparameter *filename* (third *arguments*))
+(defparameter *title* (fourth *arguments*))
+(defparameter *css-style* (fifth *arguments*))
+(defparameter *packages* (mapcar #'string-upcase (nthcdr 5 *arguments*)))
+
+(load-system *system*)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (asdf:oos 'asdf:load-op :texinfo-docstrings))
+
+(apply #'texinfo-docstrings:generate-includes "include/" *packages*)
+
+(defparameter *sysdir*
+  (namestring
+   (make-pathname :directory
+                  (pathname-directory
+                   (asdf:system-definition-pathname
+                    (asdf:find-system :texinfo-docstrings))))))
+
+(defparameter *gendocs-template-dir*
+  (or (getenv "GENDOCS_TEMPLATE_DIR") *sysdir*))
+
+(when (string-equal *css-style* "default")
+  (setq *css-style*
+        (format nil "~Astyles/~A"
+                *sysdir*
+                (case *output*
+                  (html "edi-style.css")
+                  (t "style.css")))))
+
+(let ((asdf::*verbose-out* *terminal-io*))
+  (ecase *output*
+    (html
+     (asdf:run-shell-command "echo not yet"))
+    (pdf
+     (asdf:run-shell-command "echo not yet"))
+    (all
+     (asdf:run-shell-command
+      "GENDOCS_TEMPLATE_DIR=~A sh ~Agendocs.sh --html \"--css-include=~A\" ~A \"~A\""
+      *gendocs-template-dir* *sysdir* *css-style* *filename* *title*))))
diff --git a/texinfo-docstrings.asd b/texinfo-docstrings.asd
new file mode 100644
index 0000000..5d1a925
--- /dev/null
+++ b/texinfo-docstrings.asd
@@ -0,0 +1,7 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+
+(asdf:defsystem texinfo-docstrings
+  :depends-on (#-sbcl closer-mop)
+  :components ((:file "docstrings")))
+
+;; vim: ft=lisp et
diff --git a/docstrings.lisp b/trunk/docstrings.lisp.original
similarity index 100%
copy from docstrings.lisp
copy to trunk/docstrings.lisp.original
diff --git a/trunk/gendocs.sh.original b/trunk/gendocs.sh.original
new file mode 100644
index 0000000..c775c99
--- /dev/null
+++ b/trunk/gendocs.sh.original
@@ -0,0 +1,300 @@
+#!/bin/sh
+# gendocs.sh -- generate a GNU manual in many formats.  This script is
+#   mentioned in maintain.texi.  See the help message below for usage details.
+
+scriptversion=2007-07-01.15
+
+# Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+#
+# This program 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# 
+# Original author: Mohit Agarwal.
+# Send bug reports and any other correspondence to bug-texinfo@gnu.org.
+
+prog=`basename "$0"`
+srcdir=`pwd`
+
+scripturl="http://savannah.gnu.org/cgi-bin/viewcvs/~checkout~/texinfo/texinfo/util/gendocs.sh"
+templateurl="http://savannah.gnu.org/cgi-bin/viewcvs/~checkout~/texinfo/texinfo/util/gendocs_template"
+
+: ${SETLANG="env LANG= LC_MESSAGES= LC_ALL= LANGUAGE="}
+: ${MAKEINFO="makeinfo"}
+: ${TEXI2DVI="texi2dvi -t @finalout"}
+: ${DVIPS="dvips"}
+: ${DOCBOOK2HTML="docbook2html"}
+: ${DOCBOOK2PDF="docbook2pdf"}
+: ${DOCBOOK2PS="docbook2ps"}
+: ${DOCBOOK2TXT="docbook2txt"}
+: ${GENDOCS_TEMPLATE_DIR="."}
+unset CDPATH
+
+version="gendocs.sh $scriptversion
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+There is NO warranty.  You may redistribute this software
+under the terms of the GNU General Public License.
+For more information about these matters, see the files named COPYING."
+
+usage="Usage: $prog [OPTION]... PACKAGE MANUAL-TITLE
+
+Generate various output formats from PACKAGE.texinfo (or .texi or .txi) source.
+See the GNU Maintainers document for a more extensive discussion:
+  http://www.gnu.org/prep/maintain_toc.html
+
+Options:
+  -o OUTDIR   write files into OUTDIR, instead of manual/.
+  --docbook   convert to DocBook too (xml, txt, html, pdf and ps).
+  --html ARG  pass indicated ARG to makeinfo for HTML targets.
+  --help      display this help and exit successfully.
+  --version   display version information and exit successfully.
+
+Simple example: $prog emacs \"GNU Emacs Manual\"
+
+Typical sequence:
+  cd YOURPACKAGESOURCE/doc
+  wget \"$scripturl\"
+  wget \"$templateurl\"
+  $prog YOURMANUAL \"GNU YOURMANUAL - One-line description\"
+
+Output will be in a new subdirectory \"manual\" (by default, use -o OUTDIR
+to override).  Move all the new files into your web CVS tree, as
+explained in the Web Pages node of maintain.texi.
+
+MANUAL-TITLE is included as part of the HTML <title> of the overall
+manual/index.html file.  It should include the name of the package being
+documented.  manual/index.html is created by substitution from the file
+$GENDOCS_TEMPLATE_DIR/gendocs_template.  (Feel free to modify the
+generic template for your own purposes.)
+
+If you have several manuals, you'll need to run this script several
+times with different YOURMANUAL values, specifying a different output
+directory with -o each time.  Then write (by hand) an overall index.html
+with links to them all.
+
+If a manual's texinfo sources are spread across several directories,
+first copy or symlink all Texinfo sources into a single directory.
+(Part of the script's work is to make a tar.gz of the sources.)
+
+You can set the environment variables MAKEINFO, TEXI2DVI, and DVIPS to
+control the programs that get executed, and GENDOCS_TEMPLATE_DIR to
+control where the gendocs_template file is looked for.  (With --docbook,
+the environment variables DOCBOOK2HTML, DOCBOOK2PDF, DOCBOOK2PS, and
+DOCBOOK2TXT are also respected.) 
+
+By default, makeinfo is run in the default (English) locale, since
+that's the language of most Texinfo manuals.  If you happen to have a
+non-English manual and non-English web site, check the SETLANG setting
+in the source.
+
+Email bug reports or enhancement requests to bug-texinfo@gnu.org.
+"
+
+calcsize()
+{
+  size=`ls -ksl $1 | awk '{print $1}'`
+  echo $size
+}
+
+outdir=manual
+html=
+PACKAGE=
+MANUAL_TITLE=
+
+while test $# -gt 0; do
+  case $1 in
+    --help) echo "$usage"; exit 0;;
+    --version) echo "$version"; exit 0;;
+    -o) shift; outdir=$1;;
+    --docbook) docbook=yes;;
+    --html) shift; html=$1;;
+    -*)
+      echo "$0: Unknown or ambiguous option \`$1'." >&2
+      echo "$0: Try \`--help' for more information." >&2
+      exit 1;;
+    *)
+      if test -z "$PACKAGE"; then
+        PACKAGE=$1
+      elif test -z "$MANUAL_TITLE"; then
+        MANUAL_TITLE=$1
+      else
+        echo "$0: extra non-option argument \`$1'." >&2
+        exit 1
+      fi;;
+  esac
+  shift
+done
+
+if test -s "$srcdir/$PACKAGE.texinfo"; then
+  srcfile=$srcdir/$PACKAGE.texinfo
+elif test -s "$srcdir/$PACKAGE.texi"; then
+  srcfile=$srcdir/$PACKAGE.texi
+elif test -s "$srcdir/$PACKAGE.txi"; then
+  srcfile=$srcdir/$PACKAGE.txi
+else
+  echo "$0: cannot find .texinfo or .texi or .txi for $PACKAGE in $srcdir." >&2
+  exit 1
+fi
+
+if test ! -r $GENDOCS_TEMPLATE_DIR/gendocs_template; then
+  echo "$0: cannot read $GENDOCS_TEMPLATE_DIR/gendocs_template." >&2
+  echo "$0: it is available from $templateurl." >&2
+  exit 1
+fi
+
+echo Generating output formats for $srcfile
+
+cmd="$SETLANG $MAKEINFO -o $PACKAGE.info \"$srcfile\""
+echo "Generating info files... ($cmd)"
+eval "$cmd"
+mkdir -p $outdir/
+tar czf $outdir/$PACKAGE.info.tar.gz $PACKAGE.info*
+info_tgz_size=`calcsize $outdir/$PACKAGE.info.tar.gz`
+# do not mv the info files, there's no point in having them available
+# separately on the web.
+
+cmd="${TEXI2DVI} \"$srcfile\""
+echo "Generating dvi ... ($cmd)"
+eval "$cmd"
+
+# now, before we compress dvi:
+echo Generating postscript...
+${DVIPS} $PACKAGE -o
+gzip -f -9 $PACKAGE.ps
+ps_gz_size=`calcsize $PACKAGE.ps.gz`
+mv $PACKAGE.ps.gz $outdir/
+
+# compress/finish dvi:
+gzip -f -9 $PACKAGE.dvi
+dvi_gz_size=`calcsize $PACKAGE.dvi.gz`
+mv $PACKAGE.dvi.gz $outdir/
+
+cmd="${TEXI2DVI} --pdf \"$srcfile\""
+echo "Generating pdf ... ($cmd)"
+eval "$cmd"
+pdf_size=`calcsize $PACKAGE.pdf`
+mv $PACKAGE.pdf $outdir/
+
+cmd="$SETLANG $MAKEINFO -o $PACKAGE.txt --no-split --no-headers \"$srcfile\""
+echo "Generating ASCII... ($cmd)"
+eval "$cmd"
+ascii_size=`calcsize $PACKAGE.txt`
+gzip -f -9 -c $PACKAGE.txt >$outdir/$PACKAGE.txt.gz
+ascii_gz_size=`calcsize $outdir/$PACKAGE.txt.gz`
+mv $PACKAGE.txt $outdir/
+
+cmd="$SETLANG $MAKEINFO --no-split --html -o $PACKAGE.html $html \"$srcfile\""
+echo "Generating monolithic html... ($cmd)"
+rm -rf $PACKAGE.html  # in case a directory is left over
+eval "$cmd"
+html_mono_size=`calcsize $PACKAGE.html`
+gzip -f -9 -c $PACKAGE.html >$outdir/$PACKAGE.html.gz
+html_mono_gz_size=`calcsize $outdir/$PACKAGE.html.gz`
+mv $PACKAGE.html $outdir/
+
+cmd="$SETLANG $MAKEINFO --html -o $PACKAGE.html $html \"$srcfile\""
+echo "Generating html by node... ($cmd)"
+eval "$cmd"
+split_html_dir=$PACKAGE.html
+(
+  cd ${split_html_dir} || exit 1
+  tar -czf ../$outdir/${PACKAGE}.html_node.tar.gz -- *.html
+)
+html_node_tgz_size=`calcsize $outdir/${PACKAGE}.html_node.tar.gz`
+rm -f $outdir/html_node/*.html
+mkdir -p $outdir/html_node/
+mv ${split_html_dir}/*.html $outdir/html_node/
+rmdir ${split_html_dir}
+
+echo Making .tar.gz for sources...
+srcfiles=`ls *.texinfo *.texi *.txi *.eps 2>/dev/null`
+tar cvzfh $outdir/$PACKAGE.texi.tar.gz $srcfiles
+texi_tgz_size=`calcsize $outdir/$PACKAGE.texi.tar.gz`
+
+if test -n "$docbook"; then
+  cmd="$SETLANG $MAKEINFO -o - --docbook \"$srcfile\" > ${srcdir}/$PACKAGE-db.xml"
+  echo "Generating docbook XML... $(cmd)"
+  eval "$cmd"
+  docbook_xml_size=`calcsize $PACKAGE-db.xml`
+  gzip -f -9 -c $PACKAGE-db.xml >$outdir/$PACKAGE-db.xml.gz
+  docbook_xml_gz_size=`calcsize $outdir/$PACKAGE-db.xml.gz`
+  mv $PACKAGE-db.xml $outdir/
+
+  cmd="${DOCBOOK2HTML} -o $split_html_db_dir ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook HTML... ($cmd)"
+  eval "$cmd"
+  split_html_db_dir=html_node_db
+  (
+    cd ${split_html_db_dir} || exit 1
+    tar -czf ../$outdir/${PACKAGE}.html_node_db.tar.gz -- *.html
+  )
+  html_node_db_tgz_size=`calcsize $outdir/${PACKAGE}.html_node_db.tar.gz`
+  rm -f $outdir/html_node_db/*.html
+  mkdir -p $outdir/html_node_db
+  mv ${split_html_db_dir}/*.html $outdir/html_node_db/
+  rmdir ${split_html_db_dir}
+
+  cmd="${DOCBOOK2TXT} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook ASCII... ($cmd)"
+  eval "$cmd"
+  docbook_ascii_size=`calcsize $PACKAGE-db.txt`
+  mv $PACKAGE-db.txt $outdir/
+
+  cmd="${DOCBOOK2PS} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PS... $(cmd)"
+  eval "$cmd"
+  gzip -f -9 -c $PACKAGE-db.ps >$outdir/$PACKAGE-db.ps.gz
+  docbook_ps_gz_size=`calcsize $outdir/$PACKAGE-db.ps.gz`
+  mv $PACKAGE-db.ps $outdir/
+
+  cmd="${DOCBOOK2PDF} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PDF... ($cmd)"
+  eval "$cmd"
+  docbook_pdf_size=`calcsize $PACKAGE-db.pdf`
+  mv $PACKAGE-db.pdf $outdir/
+fi
+
+echo Writing index file...
+curdate=`date '+%B %d, %Y'`
+sed \
+   -e "s!%%TITLE%%!$MANUAL_TITLE!g" \
+   -e "s!%%DATE%%!$curdate!g" \
+   -e "s!%%PACKAGE%%!$PACKAGE!g" \
+   -e "s!%%HTML_MONO_SIZE%%!$html_mono_size!g" \
+   -e "s!%%HTML_MONO_GZ_SIZE%%!$html_mono_gz_size!g" \
+   -e "s!%%HTML_NODE_TGZ_SIZE%%!$html_node_tgz_size!g" \
+   -e "s!%%INFO_TGZ_SIZE%%!$info_tgz_size!g" \
+   -e "s!%%DVI_GZ_SIZE%%!$dvi_gz_size!g" \
+   -e "s!%%PDF_SIZE%%!$pdf_size!g" \
+   -e "s!%%PS_GZ_SIZE%%!$ps_gz_size!g" \
+   -e "s!%%ASCII_SIZE%%!$ascii_size!g" \
+   -e "s!%%ASCII_GZ_SIZE%%!$ascii_gz_size!g" \
+   -e "s!%%TEXI_TGZ_SIZE%%!$texi_tgz_size!g" \
+   -e "s!%%DOCBOOK_HTML_NODE_TGZ_SIZE%%!$html_node_db_tgz_size!g" \
+   -e "s!%%DOCBOOK_ASCII_SIZE%%!$docbook_ascii_size!g" \
+   -e "s!%%DOCBOOK_PS_GZ_SIZE%%!$docbook_ps_gz_size!g" \
+   -e "s!%%DOCBOOK_PDF_SIZE%%!$docbook_pdf_size!g" \
+   -e "s!%%DOCBOOK_XML_SIZE%%!$docbook_xml_size!g" \
+   -e "s!%%DOCBOOK_XML_GZ_SIZE%%!$docbook_xml_gz_size!g" \
+   -e "s,%%SCRIPTURL%%,$scripturl,g" \
+   -e "s!%%SCRIPTNAME%%!$prog!g" \
+$GENDOCS_TEMPLATE_DIR/gendocs_template >$outdir/index.html
+
+echo "Done!  See $outdir/ subdirectory for new files."
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-end: "$"
+# End:
-- 
2.11.4.GIT