>From 91bc06b1aeae857e005ddb4636876bc4a09b7fb1 Mon Sep 17 00:00:00 2001
From: Morgan Veyret <address@hidden>
Date: Wed, 9 Apr 2008 22:34:53 +0200
Subject: [PATCH] Fixed manual generation with clisp.

Now it shouldn't crash anymore but the generated documentation lacks functions and commands arguments list.
---
 Makefile.in |   12 +++++----
 manual.lisp |   77 +++++++++++++++++++++++++++++++++++-----------------------
 2 files changed, 53 insertions(+), 36 deletions(-)

diff --git a/Makefile.in b/Makefile.in
index 8339627..0f103a2 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1,9 +1,11 @@
 address@hidden@
 
-clisp_OPTS=-K full -on-error exit ./make-image.lisp
-sbcl_OPTS=--load ./make-image.lisp
+clisp_BUILDOPTS=-K full -on-error exit ./make-image.lisp
+sbcl_BUILDOPTS=--load ./make-image.lisp
+
+clisp_INFOOPTS=-K full -on-error exit -x "(asdf:operate 'asdf:load-op :stumpwm) (load \"manual.lisp\")(stumpwm::generate-manual)(ext:exit)"
+sbcl_INFOOPTS=--eval "(progn (require 'asdf) (require 'stumpwm) (load \"manual.lisp\"))" --eval "(progn (stumpwm::generate-manual) (sb-ext:quit))"
 
-LISP_OPTS= $(@address@hidden)
 
 # You shouldn't have to edit past this
 
@@ -18,10 +20,10 @@ stumpwm.info: stumpwm.texi
 
 # FIXME: This rule is too hardcoded 
 stumpwm.texi: stumpwm.texi.in
-	sbcl --eval "(progn (require 'asdf) (require 'stumpwm) (load \"manual.lisp\"))" --eval "(progn (stumpwm::generate-manual) (sb-ext:quit))"
+	$(LISP) $(@address@hidden)
 
 stumpwm: $(FILES)
-	$(LISP) $(LISP_OPTS)
+	$(LISP) $(@address@hidden)
 
 release:
 	git-archive --format=tar address@hidden@/ HEAD > address@hidden@.tar
diff --git a/manual.lisp b/manual.lisp
index 45ca14a..c63dba3 100644
--- a/manual.lisp
+++ b/manual.lisp
@@ -28,51 +28,66 @@
 
 (defun generate-function-doc (s line)
   (ppcre:register-groups-bind (name) ("^@@@ (.*)" line)
-			      (let ((fn (if (find #\( name :test 'char=)
-					    ;; handle (setf <symbol>) functions
-					    (with-standard-io-syntax
-					      (let ((*package* (find-package :stumpwm)))
-						(fdefinition (read-from-string name))))
-					    (symbol-function (find-symbol (string-upcase name) :stumpwm))))
-				    (*print-pretty* nil))
-				(format s "@defun ~a ~{~a~^ ~}~%~a~&@end defun~%~%"
-					name (sb-impl::%simple-fun-arglist fn)
-					(documentation fn 'function))
-				t)))
+      (let ((fn (if (find #\( name :test 'char=)
+                    ;; handle (setf <symbol>) functions
+                    (with-standard-io-syntax
+                      (let ((*package* (find-package :stumpwm)))
+                        (fdefinition (read-from-string name))))
+                    (symbol-function (find-symbol (string-upcase name)
+                                                  :stumpwm))))
+            (*print-pretty* nil))
+        #+sbcl (format s "@defun ~a ~{~a~^ ~}~%~a~&@end defun~%~%"
+                       name (sb-impl::%simple-fun-arglist fn)
+                       (documentation fn 'function))
+        #+clisp (format s "@defun ~a ~{~a~^ ~}~%~a~&@end defun~%~%"
+                       name (ext:arglist fn)
+                       (documentation fn 'function))
+        #-(or clisp sbcl)
+        (format s "@defun ~a ~%~a~&@end defun~%~%"
+                name
+                (documentation fn 'function))
+        t)))
 
 (defun generate-macro-doc (s line)
   (declare (ignore s line)))
 
 (defun generate-variable-doc (s line)
   (ppcre:register-groups-bind (name) ("^### (.*)" line)
-			      (let ((sym (find-symbol (string-upcase name) :stumpwm)))
-				(format s "@defvar ~a~%~a~&@end defvar~%~%"
-					name (documentation sym 'variable))
-				t)))
+      (let ((sym (find-symbol (string-upcase name) :stumpwm)))
+        (format s "@defvar ~a~%~a~&@end defvar~%~%"
+                name (documentation sym 'variable))
+        t)))
 
 (defun generate-hook-doc (s line)
   (ppcre:register-groups-bind (name) ("^\\$\\$\\$ (.*)" line)
-			      (let ((sym (find-symbol (string-upcase name) :stumpwm)))
-				(format s "@defvr {Hook} ~a~%~a~&@end defvr~%~%"
-					name (documentation sym 'variable))
-				t)))
+      (let ((sym (find-symbol (string-upcase name) :stumpwm)))
+        (format s "@defvr {Hook} ~a~%~a~&@end defvr~%~%"
+                name (documentation sym 'variable))
+        t)))
 
 (defun generate-command-doc (s line)
   (ppcre:register-groups-bind (name) ("^!!! (.*)" line)
-			      (let ((cmd (symbol-function (find-symbol (string-upcase name) :stumpwm))))
-				(format s "@deffn {Command} ~a ~{~a~^ ~}~%~a~&@end deffn~%~%"
-					name (sb-impl::%simple-fun-arglist cmd)
-                                        (documentation cmd 'function))
-				t)))
+      (let ((cmd (symbol-function (find-symbol (string-upcase name) :stumpwm))))
+        #+sbcl (format s "@deffn {Command} ~a ~{~a~^ ~}~%~a~&@end deffn~%~%"
+                       name (sb-impl::%simple-fun-arglist cmd)
+                       (documentation cmd 'function))
+        #+clisp (format s "@deffn {Command} ~a ~{~a~^ ~}~%~a~&@end deffn~%~%"
+                       name (ext:arglist cmd)
+                       (documentation cmd 'function))
+        #-(or clisp sbcl)
+        (format s "@deffn {Command} ~a ~%~a~&@end deffn~%~%"
+                name ;(sb-impl::%simple-fun-arglist cmd)
+                (documentation cmd 'function))
+        t)))
 
 (defun generate-manual (&key (in #p"stumpwm.texi.in") (out #p"stumpwm.texi"))
   (with-open-file (os out :direction :output :if-exists :supersede)
     (with-open-file (is in :direction :input)
       (loop for line = (read-line is nil is)
-	 until (eq line is) do
-	   (or (generate-function-doc os line)
-	       (generate-macro-doc os line)
-	       (generate-hook-doc os line)
-	       (generate-variable-doc os line)
-	       (generate-command-doc os line)
-	       (write-line line os))))))
+         until (eq line is) do
+           (or (generate-function-doc os line)
+               (generate-macro-doc os line)
+               (generate-hook-doc os line)
+               (generate-variable-doc os line)
+               (generate-command-doc os line)
+               (write-line line os))))))
-- 
1.5.4.5