Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/doc/manual
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21084/doc/manual

Modified Files:
	intro.texinfo docstrings.lisp beyond-ansi.texinfo 
Log Message:
0.8.9.57:

Prettify docstrings:

  * Detect and format itemized sections and tabulated descriptions
    (see the documentation for save-lisp-and-die)

... docstrings.lisp is getting large and unordered; the next tuit will
    likely be spent cleaning up and moving the docstring extractor
    into contrib/


Index: intro.texinfo
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/manual/intro.texinfo,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- intro.texinfo	16 Apr 2004 14:17:39 -0000	1.4
+++ intro.texinfo	23 Apr 2004 14:36:33 -0000	1.5
@@ -211,10 +211,10 @@
 @itemize
 
 @item
-SBCL has dropped support for many CMUCL extensions, (e.g. IP
-networking, remote procedure call, Unix system interface, and X11
-interface).  Most of these are now available as contributed or
-third-party modules.
+SBCL has removed many CMUCL extensions, (e.g. IP networking, remote
+procedure call, Unix system interface, and X11 interface) from the
+core system.  Most of these are available as contributed modules
+(distributed with sbcl) or third-party modules instead.
 
 @item
 SBCL has deleted or deprecated some nonstandard features and code

Index: docstrings.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/manual/docstrings.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- docstrings.lisp	14 Apr 2004 08:55:42 -0000	1.6
+++ docstrings.lisp	23 Apr 2004 14:36:33 -0000	1.7
@@ -4,13 +4,27 @@
 ;;;; @include-ready documentation from the docstrings of exported
 ;;;; symbols of specified packages.
 
+
 ;;;; This software is part of the SBCL software system. SBCL is in the
 ;;;; public domain and is provided with absolutely no warranty. See
 ;;;; the COPYING file for more information.
-
+;;;;
 ;;;; Written by Rudi Schlatte <rudi@...>
 
 
+;;;; Formatting heuristics (tweaked to format SAVE-LISP-AND-DIE sanely):
+;;;;
+;;;; Formats SYMBOL as @code{symbol}, or @var{symbol} if symbol is in
+;;;; the argument list of the defun / defmacro.
+;;;;
+;;;; Lines starting with * or - that are followed by intented lines
+;;;; are marked up with @itemize.
+;;;;
+;;;; Lines containing only a SYMBOL that are followed by indented
+;;;; lines are marked up as @table @code, with the SYMBOL as the item.
+
+
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require 'sb-introspect))
 
@@ -69,16 +83,20 @@
 (defvar *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+"
   "List of characters that make up symbols in a docstring.")
 
-(defvar *symbol-delimiters* " ,.!?")
+(defvar *symbol-delimiters* " ,.!?;")
 
 (defun locate-symbols (line)
   "Return a list of index pairs of symbol-like parts of LINE."
+  ;; This would be a good application for a regex ...
   (do ((result nil)
        (begin nil)
        (maybe-begin t)
        (i 0 (1+ i)))
       ((= i (length line))
-       (when begin (push (list begin i) result))
+       ;; symbol at end of line
+       (when (and begin (or (> i (1+ begin))
+                            (not (member (char line begin) '(#\A #\I)))))
+         (push (list begin i) result))
        (nreverse result))
     (cond
       ((and begin (find (char line i) *symbol-delimiters*))
@@ -96,33 +114,190 @@
              maybe-begin nil))
       ((find (char line i) *symbol-delimiters*)
        ;; potential symbol begin after this position
-       (setf maybe-begin t)))))
+       (setf maybe-begin t))
+      (t
+       ;; Not reading a symbol, not at potential start of symbol
+       (setf maybe-begin nil)))))
 
 (defun all-symbols (list)
-  (cond ((or (null list) (numberp list)) nil)
-        ((atom list) (list list))
-        (t (append (all-symbols (car list)) (all-symbols (cdr list))))))
+  (cond ((null list) nil)
+        ((symbolp list) (list list))
+        ((consp list) (append (all-symbols (car list))
+                              (all-symbols (cdr list))))
+        (t nil)))
+
+
+(defun frob-doc-line (line var-symbols)
+  "Format symbols in LINE texinfo-style: either as code or as
+  variables if the symbol in question is contained in
+  var-symbols."
+  (with-output-to-string (result)
+    (let ((last 0))
+      (dolist (symbol-index (locate-symbols line))
+        (write-string (subseq line last (first symbol-index)) result)
+        (let ((symbol-name (apply #'subseq line symbol-index)))
+          (format result (if (member symbol-name var-symbols
+                                     :test #'string=)
+                             "@var{~A}"
+                             "@code{~A}")
+                  (string-downcase symbol-name)))
+        (setf last (second symbol-index)))
+      (write-string (subseq line last) result))))
+
+(defparameter *itemize-start-characters* '(#\* #\-)
+  "Characters that might start an itemization in docstrings when
+  at the start of a line.")
+
+(defun indentation (line)
+  "Position of first non-SPACE character in LINE."
+  (position-if-not (lambda (c) (char= c #\Space)) line))
+
+(defun maybe-itemize-offset (line)
+  "Return NIL or the indentation offset if LINE looks like it
+  starts an item in an itemization."
+  (let ((offset (indentation line)))
+    (when (and offset
+               (member (char line offset) *itemize-start-characters*
+                       :test #'char=))
+      offset)))
+
+(defun collect-maybe-itemized-section (lines starting-line arglist-symbols)
+  ;; Return index of next line to be processed outside
+  (let ((this-offset (maybe-itemize-offset (svref lines starting-line)))
+        (result nil)
+        (lines-consumed 0))
+    (loop for line-number from starting-line below (length lines)
+       for line = (svref lines line-number)
+       for indentation = (indentation line)
+       for offset = (maybe-itemize-offset line)
+       do (cond
+            ((not indentation)
+             ;; empty line -- inserts paragraph.
+             (push "" result)
+             (incf lines-consumed))
+            ((and offset (> indentation this-offset))
+             ;; nested itemization -- handle recursively
+             (multiple-value-bind (sub-lines-consumed sub-itemization)
+                 (collect-maybe-itemized-section lines line-number
+                                                 arglist-symbols)
+               (when sub-lines-consumed
+                 (incf line-number (1- sub-lines-consumed)) ; +1 on next loop
+                 (incf lines-consumed sub-lines-consumed)
+                 (setf result (nconc (nreverse sub-itemization) result)))))
+            ((and offset (= indentation this-offset))
+             ;; start of new item
+             (push (format nil "@item ~A"
+                           (frob-doc-line (subseq line (1+ offset))
+                                          arglist-symbols))
+                   result)
+             (incf lines-consumed))
+            ((and (not offset) (> indentation this-offset))
+             ;; continued item from previous line
+             (push (frob-doc-line line arglist-symbols) result)
+             (incf lines-consumed))
+            (t
+             ;; end of itemization
+             (loop-finish))))
+    (if
+     ;; a single-line itemization isn't.
+     (> (count-if (lambda (line) (> (length line) 0)) result) 1)
+     (values lines-consumed
+             `("@itemize" ,@(reverse result) "@end itemize"))
+     nil)))
+
+
+(defun maybe-table-offset (line)
+  "Return NIL or the indentation offset if LINE looks like it
+  starts an item in a tabulation, i.e., there's only a symbol on the line."
+  (let ((offset (indentation line)))
+    (when (and offset
+               (every (lambda (c)
+                        (or (char= c #\Space)
+                            (find c *symbol-characters* :test #'char=)))
+                      line))
+      offset)))
+
+
+(defun collect-maybe-table-section (lines starting-line arglist-symbols)
+  ;; Return index of next line to be processed outside
+  (let ((this-offset (maybe-table-offset (svref lines starting-line)))
+        (result nil)
+        (lines-consumed 0))
+    (loop for line-number from starting-line below (length lines)
+       for line = (svref lines line-number)
+       for indentation = (indentation line)
+       for offset = (maybe-table-offset line)
+       do (cond
+            ((not indentation)
+             ;; empty line -- inserts paragraph.
+             (push "" result)
+             (incf lines-consumed))
+            ((and offset (= indentation this-offset))
+             ;; start of new item, or continuation of previous item
+             (if (and result (search "@item" (car result) :test #'char=))
+                 (push (format nil "@itemx ~A"
+                               (frob-doc-line line arglist-symbols))
+                       result)
+                 (progn
+                   (push "" result)
+                   (push (format nil "@item ~A"
+                                 (frob-doc-line line arglist-symbols))
+                         result)))
+             (incf lines-consumed))
+            ((> indentation this-offset)
+             ;; continued item from previous line
+             (push (frob-doc-line line arglist-symbols) result)
+             (incf lines-consumed))
+            (t
+             ;; end of itemization
+             (loop-finish))))
+    (if
+     ;; a single-line table isn't.
+     (> (count-if (lambda (line) (> (length line) 0)) result) 1)
+     (values lines-consumed
+             `("" "@table @code" ,@(reverse result) "@end table" ""))
+     nil)))
+
+
+
+
+(defun string-as-lines (string)
+  (coerce (with-input-from-string (s string)
+            (loop for line = (read-line s nil nil)
+               while line collect line))
+          'vector))
 
 (defun frob-docstring (docstring symbol-arglist)
   "Try to guess as much formatting for a raw docstring as possible."
   ;; Per-line processing is not necessary now, but it will be when we
   ;; attempt itemize / table auto-detection in docstrings
   (with-output-to-string (result)
-    (let ((arglist-symbols (all-symbols symbol-arglist)))
-      (with-input-from-string (s (texinfoify docstring nil))
-        (loop for line = (read-line s nil nil)
-           while line
-           do (let ((last 0))
-                (dolist (symbol-index (locate-symbols line))
-                  (write-string (subseq line last (first symbol-index)) result)
-                  (let ((symbol-name (apply #'subseq line symbol-index)))
-                    (format result (if (member symbol-name arglist-symbols
-                                               :test #'string=)
-                                       "@var{~A}"
-                                       "@code{~A}")
-                            (string-downcase symbol-name)))
-                  (setf last (second symbol-index)))
-                (write-line (subseq line last) result)))))))
+    (let ((arglist-symbols (all-symbols symbol-arglist))
+          (doc-lines (string-as-lines (texinfoify docstring nil))))
+      (loop for line-number from 0 below (length doc-lines)
+           for line = (svref doc-lines line-number)
+         do (cond
+              ((maybe-itemize-offset line)
+               (multiple-value-bind (lines-consumed itemized-lines)
+                   (collect-maybe-itemized-section doc-lines line-number
+                                                   arglist-symbols)
+                 (cond (lines-consumed
+                        (dolist (item-line itemized-lines)
+                          (write-line item-line result))
+                        (incf line-number (1- lines-consumed)))
+                       (t (write-line (frob-doc-line line arglist-symbols)
+                             result)))))
+              ((maybe-table-offset line)
+               (multiple-value-bind (lines-consumed itemized-lines)
+                   (collect-maybe-table-section doc-lines line-number
+                                                   arglist-symbols)
+                 (cond (lines-consumed
+                        (dolist (item-line itemized-lines)
+                          (write-line item-line result))
+                        (incf line-number (1- lines-consumed)))
+                       (t (write-line (frob-doc-line line arglist-symbols)
+                             result)))))
+              (t (write-line (frob-doc-line line arglist-symbols) result)))))))
 
 ;;; Begin, rest and end of definition.
 

Index: beyond-ansi.texinfo
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/manual/beyond-ansi.texinfo,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- beyond-ansi.texinfo	16 Apr 2004 14:17:39 -0000	1.5
+++ beyond-ansi.texinfo	23 Apr 2004 14:36:33 -0000	1.6
@@ -112,7 +112,7 @@
 
 SBCL is derived from CMUCL, which implements many extensions to the
 ANSI standard. SBCL doesn't support as many extensions as CMUCL, but
-it still has quite a few.
+it still has quite a few.  @xref{Contributed Modules}.
 
 
 @menu