chore(3p/lisp): Unvendor alexandria and use nixpkgs sources r/3254

Change-Id: Idee3cb18ac42bd820d87aac0c68206436c1f4691
Reviewed-on: https://cl.tvl.fyi/c/depot/+/4338
Autosubmit: tazjin <mail@tazj.in>
Tested-by: BuildkiteCI
Reviewed-by: grfn <grfn@gws.fyi>

1 files changed, 0 insertions, 881 deletions

diff --git a/third_party/lisp/alexandria/doc/docstrings.lisp b/third_party/lisp/alexandria/doc/docstrings.lisp
deleted file mode 100644
index 51dda07d09b7..000000000000
--- a/third_party/lisp/alexandria/doc/docstrings.lisp
+++ /dev/null
@@ -1,881 +0,0 @@
-;;; -*- lisp -*-
-
-;;;; A docstring extractor for the sbcl manual.  Creates
-;;;; @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@constantly.at>, mangled
-;;;; by Nikodemus Siivola.
-
-;;;; TODO
-;;;; * Verbatim text
-;;;; * Quotations
-;;;; * Method documentation untested
-;;;; * Method sorting, somehow
-;;;; * Index for macros & constants?
-;;;; * This is getting complicated enough that tests would be good
-;;;; * Nesting (currently only nested itemizations work)
-;;;; * doc -> internal form -> texinfo (so that non-texinfo format are also
-;;;;   easily generated)
-
-;;;; FIXME: The description below is no longer complete. This
-;;;; should possibly be turned into a contrib with proper documentation.
-
-;;;; 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))
-
-(defpackage :sb-texinfo
-  (:use :cl :sb-mop)
-  (:shadow #:documentation)
-  (:export #:generate-includes #:document-package)
-  (:documentation
-   "Tools to generate TexInfo documentation from docstrings."))
-
-(in-package :sb-texinfo)
-
-;;;; various specials and parameters
-
-(defvar *texinfo-output*)
-(defvar *texinfo-variables*)
-(defvar *documentation-package*)
-(defvar *base-package*)
-
-(defparameter *undocumented-packages* '(sb-pcl sb-int sb-kernel sb-sys sb-c))
-
-(defparameter *documentation-types*
-  '(compiler-macro
-    function
-    method-combination
-    setf
-    ;;structure  ; also handled by `type'
-    type
-    variable)
-  "A list of symbols accepted as second argument of `documentation'")
-
-(defparameter *character-replacements*
-  '((#\* . "star") (#\/ . "slash") (#\+ . "plus")
-    (#\< . "lt") (#\> . "gt")
-    (#\= . "equals"))
-  "Characters and their replacement names that `alphanumize' uses. If
-the replacements contain any of the chars they're supposed to replace,
-you deserve to lose.")
-
-(defparameter *characters-to-drop* '(#\\ #\` #\')
-  "Characters that should be removed by `alphanumize'.")
-
-(defparameter *texinfo-escaped-chars* "@{}"
-  "Characters that must be escaped with #\@ for Texinfo.")
-
-(defparameter *itemize-start-characters* '(#\* #\-)
-  "Characters that might start an itemization in docstrings when
-  at the start of a line.")
-
-(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890*:-+&#'"
-  "List of characters that make up symbols in a docstring.")
-
-(defparameter *symbol-delimiters* " ,.!?;")
-
-(defparameter *ordered-documentation-kinds*
-  '(package type structure condition class macro))
-
-;;;; utilities
-
-(defun flatten (list)
-  (cond ((null list)
-         nil)
-        ((consp (car list))
-         (nconc (flatten (car list)) (flatten (cdr list))))
-        ((null (cdr list))
-         (cons (car list) nil))
-        (t
-         (cons (car list) (flatten (cdr list))))))
-
-(defun whitespacep (char)
-  (find char #(#\tab #\space #\page)))
-
-(defun setf-name-p (name)
-  (or (symbolp name)
-      (and (listp name) (= 2 (length name)) (eq (car name) 'setf))))
-
-(defgeneric specializer-name (specializer))
-
-(defmethod specializer-name ((specializer eql-specializer))
-  (list 'eql (eql-specializer-object specializer)))
-
-(defmethod specializer-name ((specializer class))
-  (class-name specializer))
-
-(defun ensure-class-precedence-list (class)
-  (unless (class-finalized-p class)
-    (finalize-inheritance class))
-  (class-precedence-list class))
-
-(defun specialized-lambda-list (method)
-  ;; courtecy of AMOP p. 61
-  (let* ((specializers (method-specializers method))
-         (lambda-list (method-lambda-list method))
-         (n-required (length specializers)))
-    (append (mapcar (lambda (arg specializer)
-                      (if  (eq specializer (find-class 't))
-                           arg
-                           `(,arg ,(specializer-name specializer))))
-                    (subseq lambda-list 0 n-required)
-                    specializers)
-           (subseq lambda-list n-required))))
-
-(defun string-lines (string)
-  "Lines in STRING as a vector."
-  (coerce (with-input-from-string (s string)
-            (loop for line = (read-line s nil nil)
-               while line collect line))
-          'vector))
-
-(defun indentation (line)
-  "Position of first non-SPACE character in LINE."
-  (position-if-not (lambda (c) (char= c #\Space)) line))
-
-(defun docstring (x doc-type)
-  (cl:documentation x doc-type))
-
-(defun flatten-to-string (list)
-  (format nil "~{~A~^-~}" (flatten list)))
-
-(defun alphanumize (original)
-  "Construct a string without characters like *`' that will f-star-ck
-up filename handling. See `*character-replacements*' and
-`*characters-to-drop*' for customization."
-  (let ((name (remove-if (lambda (x) (member x *characters-to-drop*))
-                         (if (listp original)
-                             (flatten-to-string original)
-                             (string original))))
-        (chars-to-replace (mapcar #'car *character-replacements*)))
-    (flet ((replacement-delimiter (index)
-             (cond ((or (< index 0) (>= index (length name))) "")
-                   ((alphanumericp (char name index)) "-")
-                   (t ""))))
-      (loop for index = (position-if #'(lambda (x) (member x chars-to-replace))
-                                     name)
-         while index
-         do (setf name (concatenate 'string (subseq name 0 index)
-                                    (replacement-delimiter (1- index))
-                                    (cdr (assoc (aref name index)
-                                                *character-replacements*))
-                                    (replacement-delimiter (1+ index))
-                                    (subseq name (1+ index))))))
-    name))
-
-;;;; generating various names
-
-(defgeneric name (thing)
-  (:documentation "Name for a documented thing. Names are either
-symbols or lists of symbols."))
-
-(defmethod name ((symbol symbol))
-  symbol)
-
-(defmethod name ((cons cons))
-  cons)
-
-(defmethod name ((package package))
-  (short-package-name package))
-
-(defmethod name ((method method))
-  (list
-   (generic-function-name (method-generic-function method))
-   (method-qualifiers method)
-   (specialized-lambda-list method)))
-
-;;; Node names for DOCUMENTATION instances
-
-(defgeneric name-using-kind/name (kind name doc))
-
-(defmethod name-using-kind/name (kind (name string) doc)
-  (declare (ignore kind doc))
-  name)
-
-(defmethod name-using-kind/name (kind (name symbol) doc)
-  (declare (ignore kind))
-  (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod name-using-kind/name (kind (name list) doc)
-  (declare (ignore kind))
-  (assert (setf-name-p name))
-  (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod name-using-kind/name ((kind (eql 'method)) name doc)
-  (format nil "~A~{ ~A~} ~A"
-          (name-using-kind/name nil (first name) doc)
-          (second name)
-          (third name)))
-
-(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))))
-
-(defun short-package-name (package)
-  (unless (eq package *base-package*)
-    (car (sort (copy-list (cons (package-name package) (package-nicknames package)))
-               #'< :key #'length))))
-
-;;; Definition titles for DOCUMENTATION instances
-
-(defgeneric title-using-kind/name (kind name doc))
-
-(defmethod title-using-kind/name (kind (name string) doc)
-  (declare (ignore kind doc))
-  name)
-
-(defmethod title-using-kind/name (kind (name symbol) doc)
-  (declare (ignore kind))
-  (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod title-using-kind/name (kind (name list) doc)
-  (declare (ignore kind))
-  (assert (setf-name-p name))
-  (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod title-using-kind/name ((kind (eql 'method)) name doc)
-  (format nil "~{~A ~}~A"
-          (second name)
-          (title-using-kind/name nil (first name) doc)))
-
-(defun title-name (doc)
-  "Returns a string to be used as name of the definition."
-  (string-downcase (title-using-kind/name (get-kind doc) (get-name doc) doc)))
-
-(defun include-pathname (doc)
-  (let* ((kind (get-kind doc))
-         (name (nstring-downcase
-                (if (eq 'package kind)
-                    (format nil "package-~A" (alphanumize (get-name doc)))
-                    (format nil "~A-~A-~A"
-                            (case (get-kind doc)
-                              ((function generic-function) "fun")
-                              (structure "struct")
-                              (variable "var")
-                              (otherwise (symbol-name (get-kind doc))))
-                            (alphanumize (let ((*base-package* nil))
-                                           (short-package-name (get-package doc))))
-                            (alphanumize (get-name doc)))))))
-    (make-pathname :name name  :type "texinfo")))
-
-;;;; documentation class and related methods
-
-(defclass documentation ()
-  ((name :initarg :name :reader get-name)
-   (kind :initarg :kind :reader get-kind)
-   (string :initarg :string :reader get-string)
-   (children :initarg :children :initform nil :reader get-children)
-   (package :initform *documentation-package* :reader get-package)))
-
-(defmethod print-object ((documentation documentation) stream)
-  (print-unreadable-object (documentation stream :type t)
-    (princ (list (get-kind documentation) (get-name documentation)) stream)))
-
-(defgeneric make-documentation (x doc-type string))
-
-(defmethod make-documentation ((x package) doc-type string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'package
-                 :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'function)) string)
-  (declare (ignore doc-type))
-  (let* ((fdef (and (fboundp x) (fdefinition x)))
-         (name x)
-         (kind (cond ((and (symbolp x) (special-operator-p x))
-                      'special-operator)
-                     ((and (symbolp x) (macro-function x))
-                      'macro)
-                     ((typep fdef 'generic-function)
-                      (assert (or (symbolp name) (setf-name-p name)))
-                      'generic-function)
-                     (fdef
-                      (assert (or (symbolp name) (setf-name-p name)))
-                      'function)))
-         (children (when (eq kind 'generic-function)
-                     (collect-gf-documentation fdef))))
-    (make-instance 'documentation
-                   :name (name x)
-                   :string string
-                   :kind kind
-                   :children children)))
-
-(defmethod make-documentation ((x method) doc-type string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'method
-                 :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'type)) string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :string string
-                 :kind (etypecase (find-class x nil)
-                         (structure-class 'structure)
-                         (standard-class 'class)
-                         (sb-pcl::condition-class 'condition)
-                         ((or built-in-class null) 'type))))
-
-(defmethod make-documentation (x (doc-type (eql 'variable)) string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :string string
-                 :kind (if (constantp x)
-                           'constant
-                           'variable)))
-
-(defmethod make-documentation (x (doc-type (eql 'setf)) string)
-  (declare (ignore doc-type))
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind 'setf-expander
-                 :string string))
-
-(defmethod make-documentation (x doc-type string)
-  (make-instance 'documentation
-                 :name (name x)
-                 :kind doc-type
-                 :string string))
-
-(defun maybe-documentation (x doc-type)
-  "Returns a DOCUMENTATION instance for X and DOC-TYPE, or NIL if
-there is no corresponding docstring."
-  (let ((docstring (docstring x doc-type)))
-    (when docstring
-      (make-documentation x doc-type docstring))))
-
-(defun lambda-list (doc)
-  (case (get-kind doc)
-    ((package constant variable type structure class condition nil)
-     nil)
-    (method
-     (third (get-name doc)))
-    (t
-     ;; KLUDGE: Eugh.
-     ;;
-     ;; believe it or not, the above comment was written before CSR
-     ;; came along and obfuscated this.  (2005-07-04)
-     (when (symbolp (get-name doc))
-       (labels ((clean (x &key optional key)
-                  (typecase x
-                    (atom x)
-                    ((cons (member &optional))
-                     (cons (car x) (clean (cdr x) :optional t)))
-                    ((cons (member &key))
-                     (cons (car x) (clean (cdr x) :key t)))
-                    ((cons (member &whole &environment))
-                     ;; Skip these
-                     (clean (cdr x) :optional optional :key key))
-                    ((cons cons)
-                     (cons
-                      (cond (key (if (consp (caar x))
-                                     (caaar x)
-                                     (caar x)))
-                            (optional (caar x))
-                            (t (clean (car x))))
-                      (clean (cdr x) :key key :optional optional)))
-                    (cons
-                     (cons
-                      (cond ((or key optional) (car x))
-                            (t (clean (car x))))
-                      (clean (cdr x) :key key :optional optional))))))
-         (clean (sb-introspect:function-lambda-list (get-name doc))))))))
-
-(defun get-string-name (x)
-  (let ((name (get-name x)))
-    (cond ((symbolp name)
-           (symbol-name name))
-          ((and (consp name) (eq 'setf (car name)))
-           (symbol-name (second name)))
-          ((stringp name)
-           name)
-          (t
-           (error "Don't know which symbol to use for name ~S" name)))))
-
-(defun documentation< (x y)
-  (let ((p1 (position (get-kind x) *ordered-documentation-kinds*))
-        (p2 (position (get-kind y) *ordered-documentation-kinds*)))
-    (if (or (not (and p1 p2)) (= p1 p2))
-        (string< (get-string-name x) (get-string-name y))
-        (< p1 p2))))
-
-;;;; turning text into texinfo
-
-(defun escape-for-texinfo (string &optional downcasep)
-  "Return STRING with characters in *TEXINFO-ESCAPED-CHARS* escaped
-with #\@. Optionally downcase the result."
-  (let ((result (with-output-to-string (s)
-                  (loop for char across string
-                        when (find char *texinfo-escaped-chars*)
-                        do (write-char #\@ s)
-                        do (write-char char s)))))
-    (if downcasep (nstring-downcase result) result)))
-
-(defun empty-p (line-number lines)
-  (and (< -1 line-number (length lines))
-       (not (indentation (svref lines line-number)))))
-
-;;; line markups
-
-(defvar *not-symbols* '("ANSI" "CLHS"))
-
-(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 ...
-  (let (result)
-    (flet ((grab (start end)
-             (unless (member (subseq line start end) '("ANSI" "CLHS"))
-               (push (list start end) result))))
-      (do ((begin nil)
-           (maybe-begin t)
-           (i 0 (1+ i)))
-          ((= i (length line))
-           ;; symbol at end of line
-           (when (and begin (or (> i (1+ begin))
-                                (not (member (char line begin) '(#\A #\I)))))
-             (grab begin i))
-           (nreverse result))
-        (cond
-          ((and begin (find (char line i) *symbol-delimiters*))
-           ;; symbol end; remember it if it's not "A" or "I"
-           (when (or (> i (1+ begin)) (not (member (char line begin) '(#\A #\I))))
-             (grab begin i))
-           (setf begin nil
-                 maybe-begin t))
-          ((and begin (not (find (char line i) *symbol-characters*)))
-           ;; Not a symbol: abort
-           (setf begin nil))
-          ((and maybe-begin (not begin) (find (char line i) *symbol-characters*))
-           ;; potential symbol begin at this position
-           (setf begin i
-                 maybe-begin nil))
-          ((find (char line i) *symbol-delimiters*)
-           ;; potential symbol begin after this position
-           (setf maybe-begin t))
-          (t
-           ;; Not reading a symbol, not at potential start of symbol
-           (setf maybe-begin nil)))))))
-
-(defun texinfo-line (line)
-  "Format symbols in LINE texinfo-style: either as code or as
-variables if the symbol in question is contained in symbols
-*TEXINFO-VARIABLES*."
-  (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 *texinfo-variables*
-                                     :test #'string=)
-                             "@var{~A}"
-                             "@code{~A}")
-                  (string-downcase symbol-name)))
-        (setf last (second symbol/index)))
-      (write-string (subseq line last) result))))
-
-;;; lisp sections
-
-(defun lisp-section-p (line line-number lines)
-  "Returns T if the given LINE looks like start of lisp code --
-ie. if it starts with whitespace followed by a paren or
-semicolon, and the previous line is empty"
-  (let ((offset (indentation line)))
-    (and offset
-         (plusp offset)
-         (find (find-if-not #'whitespacep line) "(;")
-         (empty-p (1- line-number) lines))))
-
-(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))
-                    while (indentation line)
-                    collect line)))
-    (values (length lisp) `("@lisp" ,@lisp "@end lisp"))))
-
-;;; itemized sections
-
-(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))
-         (char (when offset (char line offset))))
-    (and offset
-         (member char *itemize-start-characters* :test #'char=)
-         (char= #\Space (find-if-not (lambda (c) (char= c char))
-                                     line :start offset))
-         offset)))
-
-(defun collect-maybe-itemized-section (lines starting-line)
-  ;; 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
-             ;; FIXME: tables in itemizations go wrong
-             (multiple-value-bind (sub-lines-consumed sub-itemization)
-                 (collect-maybe-itemized-section lines line-number)
-               (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"
-                           (texinfo-line (subseq line (1+ offset))))
-                   result)
-             (incf lines-consumed))
-            ((and (not offset) (> indentation this-offset))
-             ;; continued item from previous line
-             (push (texinfo-line line) result)
-             (incf lines-consumed))
-            (t
-             ;; end of itemization
-             (loop-finish))))
-    ;; a single-line itemization isn't.
-    (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
-        (values lines-consumed `("@itemize" ,@(reverse result) "@end itemize"))
-        nil)))
-
-;;; table sections
-
-(defun tabulation-body-p (offset line-number lines)
-  (when (< line-number (length lines))
-    (let ((offset2 (indentation (svref lines line-number))))
-      (and offset2 (< offset offset2)))))
-
-(defun tabulation-p (offset line-number lines direction)
-  (let ((step  (ecase direction
-                 (:backwards (1- line-number))
-                 (:forwards (1+ line-number)))))
-    (when (and (plusp line-number) (< line-number (length lines)))
-      (and (eql offset (indentation (svref lines line-number)))
-           (or (when (eq direction :backwards)
-                 (empty-p step lines))
-               (tabulation-p offset step lines direction)
-               (tabulation-body-p offset step lines))))))
-
-(defun maybe-table-offset (line-number lines)
-  "Return NIL or the indentation offset if LINE looks like it starts
-an item in a tabulation. Ie, if it is (1) indented, (2) preceded by an
-empty line, another tabulation label, or a tabulation body, (3) and
-followed another tabulation label or a tabulation body."
-  (let* ((line (svref lines line-number))
-         (offset (indentation line))
-         (prev (1- line-number))
-         (next (1+ line-number)))
-    (when (and offset (plusp offset))
-      (and (or (empty-p prev lines)
-               (tabulation-body-p offset prev lines)
-               (tabulation-p offset prev lines :backwards))
-           (or (tabulation-body-p offset next lines)
-               (tabulation-p offset next lines :forwards))
-           offset))))
-
-;;; FIXME: This and itemization are very similar: could they share
-;;; some code, mayhap?
-
-(defun collect-maybe-table-section (lines starting-line)
-  ;; Return index of next line to be processed outside
-  (let ((this-offset (maybe-table-offset starting-line lines))
-        (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-number lines)
-          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" (texinfo-line line))
-                          result)
-                    (progn
-                      (push "" result)
-                      (push (format nil "@item ~A" (texinfo-line line))
-                            result)))
-                (incf lines-consumed))
-               ((> indentation this-offset)
-                ;; continued item from previous line
-                (push (texinfo-line line) result)
-                (incf lines-consumed))
-               (t
-                ;; end of itemization
-                (loop-finish))))
-     ;; a single-line table isn't.
-    (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
-        (values lines-consumed
-                `("" "@table @emph" ,@(reverse result) "@end table" ""))
-        nil)))
-
-;;; section markup
-
-(defmacro with-maybe-section (index &rest forms)
-  `(multiple-value-bind (count collected) (progn ,@forms)
-    (when count
-      (dolist (line collected)
-        (write-line line *texinfo-output*))
-      (incf ,index (1- count)))))
-
-(defun write-texinfo-string (string &optional lambda-list)
-  "Try to guess as much formatting for a raw docstring as possible."
-  (let ((*texinfo-variables* (flatten lambda-list))
-        (lines (string-lines (escape-for-texinfo string nil))))
-      (loop for line-number from 0 below (length lines)
-            for line = (svref lines line-number)
-            do (cond
-                 ((with-maybe-section line-number
-                    (and (lisp-section-p line line-number lines)
-                         (collect-lisp-section lines line-number))))
-                 ((with-maybe-section line-number
-                    (and (maybe-itemize-offset line)
-                         (collect-maybe-itemized-section lines line-number))))
-                 ((with-maybe-section line-number
-                    (and (maybe-table-offset line-number lines)
-                         (collect-maybe-table-section lines line-number))))
-                 (t
-                  (write-line (texinfo-line line) *texinfo-output*))))))
-
-;;;; texinfo formatting tools
-
-(defun hide-superclass-p (class-name super-name)
-  (let ((super-package (symbol-package super-name)))
-    (or
-     ;; 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*))
-          (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
-     ;; simply as a matter of convenience. The assumption here is that
-     ;; the inheritance is incidental unless the name of the condition
-     ;; begins with SIMPLE-.
-     (and (member super-name '(simple-error simple-condition))
-          (let ((prefix "SIMPLE-"))
-            (mismatch prefix (string class-name) :end2 (length prefix)))
-          t ; don't return number from MISMATCH
-          ))))
-
-(defun hide-slot-p (symbol slot)
-  ;; FIXME: There is no pricipal reason to avoid the slot docs fo
-  ;; structures and conditions, but their DOCUMENTATION T doesn't
-  ;; currently work with them the way we'd like.
-  (not (and (typep (find-class symbol nil) 'standard-class)
-            (docstring slot t))))
-
-(defun texinfo-anchor (doc)
-  (format *texinfo-output* "@anchor{~A}~%" (node-name doc)))
-
-;;; KLUDGE: &AUX *PRINT-PRETTY* here means "no linebreaks please"
-(defun texinfo-begin (doc &aux *print-pretty*)
-  (let ((kind (get-kind doc)))
-    (format *texinfo-output* "@~A {~:(~A~)} ~({~A}~@[ ~{~A~^ ~}~]~)~%"
-            (case kind
-              ((package constant variable)
-               "defvr")
-              ((structure class condition type)
-               "deftp")
-              (t
-               "deffn"))
-            (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
-            (title-name doc)
-            ;; &foo would be amusingly bold in the pdf thanks to TeX/Texinfo
-            ;; interactions,so we escape the ampersand -- amusingly for TeX.
-            ;; sbcl.texinfo defines macros that expand @&key and friends to &key.
-            (mapcar (lambda (name)
-                      (if (member name lambda-list-keywords)
-                          (format nil "@~A" name)
-                          name))
-                    (lambda-list doc)))))
-
-(defun texinfo-index (doc)
-  (let ((title (title-name doc)))
-    (case (get-kind doc)
-      ((structure type class condition)
-       (format *texinfo-output* "@tindex ~A~%" title))
-      ((variable constant)
-       (format *texinfo-output* "@vindex ~A~%" title))
-      ((compiler-macro function method-combination macro generic-function)
-       (format *texinfo-output* "@findex ~A~%" title)))))
-
-(defun texinfo-inferred-body (doc)
-  (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}~^, ~}~)}~%~%"
-              (remove-if (lambda (class)  (hide-superclass-p name class))
-                         (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)))))
-        (when slots
-          (format *texinfo-output* "Slots:~%@itemize~%")
-          (dolist (slot slots)
-            (format *texinfo-output*
-                    "@item ~(@code{~A}~#[~:; --- ~]~
-                      ~:{~2*~@[~2:*~A~P: ~{@code{@w{~S}}~^, ~}~]~:^; ~}~)~%~%"
-                    (slot-definition-name slot)
-                    (remove
-                     nil
-                     (mapcar
-                      (lambda (name things)
-                        (if things
-                            (list name (length things) things)))
-                      '("initarg" "reader"  "writer")
-                      (list
-                       (slot-definition-initargs slot)
-                       (slot-definition-readers slot)
-                       (slot-definition-writers slot)))))
-            ;; FIXME: Would be neater to handler as children
-            (write-texinfo-string (docstring slot t)))
-          (format *texinfo-output* "@end itemize~%~%"))))))
-
-(defun texinfo-body (doc)
-  (write-texinfo-string (get-string doc)))
-
-(defun texinfo-end (doc)
-  (write-line (case (get-kind doc)
-                ((package variable constant) "@end defvr")
-                ((structure type class condition) "@end deftp")
-                (t "@end deffn"))
-              *texinfo-output*))
-
-(defun write-texinfo (doc)
-  "Writes TexInfo for a DOCUMENTATION instance to *TEXINFO-OUTPUT*."
-  (texinfo-anchor doc)
-  (texinfo-begin doc)
-  (texinfo-index doc)
-  (texinfo-inferred-body doc)
-  (texinfo-body doc)
-  (texinfo-end doc)
-  ;; FIXME: Children should be sorted one way or another
-  (mapc #'write-texinfo (get-children doc)))
-
-;;;; main logic
-
-(defun collect-gf-documentation (gf)
-  "Collects method documentation for the generic function GF"
-  (loop for method in (generic-function-methods gf)
-        for doc = (maybe-documentation method t)
-        when doc
-        collect doc))
-
-(defun collect-name-documentation (name)
-  (loop for type in *documentation-types*
-        for doc = (maybe-documentation name type)
-        when doc
-        collect doc))
-
-(defun collect-symbol-documentation (symbol)
-  "Collects all docs for a SYMBOL and (SETF SYMBOL), returns a list of
-the form DOC instances. See `*documentation-types*' for the possible
-values of doc-type."
-  (nconc (collect-name-documentation symbol)
-         (collect-name-documentation (list 'setf symbol))))
-
-(defun collect-documentation (package)
-  "Collects all documentation for all external symbols of the given
-package, as well as for the package itself."
-  (let* ((*documentation-package* (find-package package))
-         (docs nil))
-    (check-type package package)
-    (do-external-symbols (symbol package)
-      (setf docs (nconc (collect-symbol-documentation symbol) docs)))
-    (let ((doc (maybe-documentation *documentation-package* t)))
-      (when doc
-        (push doc docs)))
-    docs))
-
-(defmacro with-texinfo-file (pathname &body forms)
-  `(with-open-file (*texinfo-output* ,pathname
-                                    :direction :output
-                                    :if-does-not-exist :create
-                                    :if-exists :supersede)
-    ,@forms))
-
-(defun write-ifnottex ()
-  ;; We use @&key, etc to escape & from TeX in lambda lists -- so we need to
-  ;; define them for info as well.
-  (flet ((macro (name)
-                 (let ((string (string-downcase name)))
-                   (format *texinfo-output* "@macro ~A~%~A~%@end macro~%" string string))))
-    (macro '&allow-other-keys)
-    (macro '&optional)
-    (macro '&rest)
-    (macro '&key)
-    (macro '&body)))
-
-(defun generate-includes (directory packages &key (base-package :cl-user))
-  "Create files in `directory' containing Texinfo markup of all
-docstrings of each exported symbol in `packages'. `directory' is
-created if necessary. If you supply a namestring that doesn't end in a
-slash, you lose. The generated files are of the form
-\"<doc-type>_<packagename>_<symbol-name>.texinfo\" and can be included
-via @include statements. Texinfo syntax-significant characters are
-escaped in symbol names, but if a docstring contains invalid Texinfo
-markup, you lose."
-  (handler-bind ((warning #'muffle-warning))
-    (let ((directory (merge-pathnames (pathname directory)))
-          (*base-package* (find-package base-package)))
-      (ensure-directories-exist directory)
-      (dolist (package packages)
-        (dolist (doc (collect-documentation (find-package package)))
-          (with-texinfo-file (merge-pathnames (include-pathname doc) directory)
-            (write-texinfo doc))))
-      (with-texinfo-file (merge-pathnames "ifnottex.texinfo" directory)
-        (write-ifnottex))
-      directory)))
-
-(defun document-package (package &optional filename)
-  "Create a file containing all available documentation for the
-exported symbols of `package' in Texinfo format. If `filename' is not
-supplied, a file \"<packagename>.texinfo\" is generated.
-
-The definitions can be referenced using Texinfo statements like
-@ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
-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 (short-package-name package))
-                                   :type "texinfo")))
-           (docs (sort (collect-documentation package) #'documentation<)))
-      (with-texinfo-file filename
-        (dolist (doc docs)
-          (write-texinfo doc)))
-      filename)))