"Characters that might start an itemization in docstrings when
at the start of a line.")
-(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+&"
+(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+&#'"
"List of characters that make up symbols in a docstring.")
(defparameter *symbol-delimiters* " ,.!?;")
(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))
(let ((kind (get-kind doc)))
(format nil "~:(~A~) ~(~A~)" kind (name-using-kind/name kind (get-name doc) doc))))
+(defun package-shortest-name (package)
+ (let* ((names (cons (package-name package) (package-nicknames package)))
+ (sorted (sort (copy-list names) #'< :key #'length)))
+ (car sorted)))
+
+(defun package-macro-name (package)
+ (let ((short-name (package-shortest-name package)))
+ (remove-if-not #'alpha-char-p (string-downcase short-name))))
+
;;; Definition titles for DOCUMENTATION instances
(defgeneric title-using-kind/name (kind name doc))
(defmethod title-using-kind/name (kind (name symbol) doc)
(declare (ignore kind))
- (format nil "~A:~A" (package-name (get-package doc)) name))
+ (let* ((symbol-name (symbol-name name))
+ (earmuffsp (and (char= (char symbol-name 0) #\*)
+ (char= (char symbol-name (1- (length symbol-name))) #\*)
+ (some #'alpha-char-p symbol-name))))
+ (if earmuffsp
+ (format nil "@~A{@earmuffs{~A}}" (package-macro-name (get-package doc)) (subseq symbol-name 1 (1- (length symbol-name))))
+ (format nil "@~A{~A}" (package-macro-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)" (package-name (get-package doc)) (second name)))
+ (format nil "@setf{@~A{~A}}" (package-macro-name (get-package doc)) (second name)))
(defmethod title-using-kind/name ((kind (eql 'method)) name doc)
(format nil "~{~A ~}~A"
((package constant variable type structure class condition nil)
nil)
(method
- (third (get-name doc)))
+ (third (get-name doc)))
(t
;; KLUDGE: Eugh.
;;
(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))
(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 (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< (string (get-name x)) (string (get-name y)))
+ (string< (get-string-name x) (get-string-name y))
(< p1 p2))))
;;;; turning text into texinfo
;;; line markups
+(defvar *not-symbols* '("ANSI" "CLHS" "UNIX"))
+
(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))
- ;; 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*))
- ;; symbol end; remember it if it's not "A" or "I"
- (when (or (> i (1+ begin)) (not (member (char line begin) '(#\A #\I))))
- (push (list begin i) result))
- (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)))))
+ (let (result)
+ (flet ((grab (start end)
+ (unless (member (subseq line start end) *not-symbols*)
+ (push (list start end) result)))
+ (got-symbol-p (start)
+ (let ((end (when (< start (length line))
+ (position #\space line :start start))))
+ (when end
+ (every (lambda (char) (find char *symbol-characters*))
+ (subseq line start end))))))
+ (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))
+ ((and (eql #\( (char line i)) (got-symbol-p (1+ i)))
+ ;; a type designator, or a function call as part of the text?
+ (multiple-value-bind (exp end)
+ (let ((*package* (find-package :cl-user)))
+ (ignore-errors (read-from-string line nil nil :start i)))
+ (when exp
+ (grab i end)
+ (setf begin nil
+ maybe-begin nil
+ i end))))
+ (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
(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"))))
+ (flet ((maybe-line (index)
+ (and (< index (length lines)) (svref lines index))))
+ (let ((lisp (loop for index = line-number then (1+ index)
+ for line = (maybe-line index)
+ while (or (indentation line)
+ ;; Allow empty lines in middle of lisp sections.
+ (let ((next (1+ index)))
+ (lisp-section-p (maybe-line next) next lines)))
+ collect line)))
+ (values (length lisp) `("@lisp" ,@lisp "@end lisp")))))
;;; itemized sections
"deffn"))
(map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
(title-name doc)
- (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)))))
+ ;; &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 @andkey and friends to &key.
+ (mapcar (lambda (name)
+ (if (member name lambda-list-keywords)
+ (format nil "@and~A{}" (remove #\- (subseq (string name) 1)))
+ name))
+ (lambda-list doc)))))
(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{~(~{@w{~A}~^, ~}~)}~%~%"
+ (format *texinfo-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
(remove-if (lambda (class) (hide-superclass-p name class))
- (mapcar #'class-name (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)))))
(when slots
(format *texinfo-output* "Slots:~%@itemize~%")
(dolist (slot slots)
- (format *texinfo-output* "@item ~(@code{~A} ~
- ~@[--- initargs: @code{~{@w{~S}~^, ~}}~]~)~%~%"
+ (format *texinfo-output*
+ "@item ~(@code{~A}~#[~:; --- ~]~
+ ~:{~2*~@[~2:*~A~P: ~{@code{@w{~S}}~^, ~}~]~:^; ~}~)~%~%"
(slot-definition-name slot)
- (slot-definition-initargs 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~%~%"))))))
"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)
:if-exists :supersede)
,@forms))
+(defun write-package-macro (package)
+ (let* ((package-name (package-shortest-name package))
+ (macro-name (package-macro-name package)))
+ ;; KLUDGE: SB-SEQUENCE has a shorter nickname SEQUENCE, but we
+ ;; want to document the SB- variant.
+ (when (eql (find-package "SB-SEQUENCE") (find-package package))
+ (setf package-name "SB-SEQUENCE"))
+ (write-packageish-macro package-name macro-name)))
+
+(defun write-packageish-macro (package-name macro-name)
+ ;; a word of explanation about the iftex branch here is probably
+ ;; warranted. The package information should be present for
+ ;; clarity, because these produce body text as well as index
+ ;; entries (though in info output it's more important to use a
+ ;; very restricted character set because the info reader parses
+ ;; the link, and colon is a special character). In TeX output we
+ ;; make the package name unconditionally small, and arrange such
+ ;; that the start of the symbol name is at a constant horizontal
+ ;; offset, that offset being such that the longest package names
+ ;; have the "sb-" extending into the left margin. (At the moment,
+ ;; the length of the longest package name, sb-concurrency, is
+ ;; hard-coded).
+ (format *texinfo-output* "~
+@iftex
+@macro ~A{name}
+{@smallertt@phantom{concurrency:}~@[@llap{~(~A~):}~]}\\name\\
+@end macro
+@end iftex
+@ifinfo
+@macro ~2:*~A{name}
+\\name\\
+@end macro
+@end ifinfo
+@ifnottex
+@ifnotinfo
+@macro ~:*~A{name}
+\\name\\ ~@[[~(~A~)]~]
+@end macro
+@end ifnotinfo
+@end ifnottex~%"
+ macro-name package-name))
+
(defun generate-includes (directory &rest packages)
"Create files in `directory' containing Texinfo markup of all
docstrings of each exported symbol in `packages'. `directory' is
(dolist (doc (collect-documentation (find-package package)))
(with-texinfo-file (merge-pathnames (include-pathname doc) directory)
(write-texinfo doc))))
+ (with-texinfo-file (merge-pathnames "package-macros.texinfo" directory)
+ (dolist (package packages)
+ (write-package-macro package))
+ (write-packageish-macro nil "nopkg"))
directory)))
(defun document-package (package &optional filename)
projects / sbcl.git / blobdiff