[armedbear-cvs] r13682 - trunk/abcl/doc/manual

[mevenson at common-lisp.net]

Author: mevenson
Date: Fri Oct 28 01:19:45 2011
New Revision: 13682

Log:
First plausible implementation of docstring groveling (unfinished).

Modified:
   trunk/abcl/doc/manual/grovel.lisp

Modified: trunk/abcl/doc/manual/grovel.lisp
==============================================================================
--- trunk/abcl/doc/manual/grovel.lisp	Thu Oct 27 23:18:44 2011	(r13681)
+++ trunk/abcl/doc/manual/grovel.lisp	Fri Oct 28 01:19:45 2011	(r13682)
@@ -2,21 +2,48 @@
 (defun grovel-docstrings-as-tex (&optional (package (find-package :java)))
   (with-open-file (stream "java.tex" :direction :output)
     (loop :for symbol :being :each :external-symbol :of package 
-       :collecting (symbol-tex symbol))))
+       :collecting (symbol-as-tex symbol))))
 
 (asdf:load-system 'swank) ;; XXX Does this load the SWANK-BACKEND package as well
 
+(defun arglist-as-string (symbol)
+  (loop :for arg :in (arglist symbol)
+     :collecting (format nil "~A" (symbol-name arg))))
+
+(defvar *type-alist* 
+  '((:function . "Function")
+    (:macro . "Macro")
+    (:variable . "Variable")
+    (:generic-function . "Generic Function")))
+
 (defun symbol-as-tex (symbol)
-  "Return the TeX representation of a SYMBOL as a string."
-  (let (type documentation arglist 
-             (doc (swank-backend:describe-symbol-for-emacs symbol)))
-    (cond ((find :function doc)
+  "Return the TeX representation of a SYMBOL as Tex."
+  (let (type documentation arglist doc)
+    (when (setf doc (swank-backend:describe-symbol-for-emacs symbol))
+        (cond 
+          ((find :function doc)
            (setf type :function
-                 documentation (second doc)))
+                 documentation (second doc)
+                 arglist (arglist-as-string symbol)))
           ((find :variable doc)
            (setf type :variable 
+                 documentation (second doc)))
+          ((find :macro doc)
+           (setf type :macro
+                 documentation (second doc)))
+          ((find :generic-function doc)
+           (setf type :generic-function
                  documentation (second doc))))
-    (warn "Unfinished implementation.")))
+        (format nil "\\ref{~A:~A}~&--- ~A [\\textbf{~A}]: ~A"
+                (symbol-name symbol)
+                (package-name (symbol-package symbol))
+                (cdr (assoc type *type-alist*))
+                (symbol-name symbol)
+                (package-name (symbol-package symbol))))))
+                
+
+
+