X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=doc%2Fmanual%2Fdocstrings.lisp;h=06482302c7455c5f1b62acf15505642fbaa2d75c;hb=1c0ce8a24b12334a9eb7908ad72d329394d537c7;hp=b70364250aafa751b3aacf10d4af63650570f4ed;hpb=3ca0c1fb909a134fafd4941d6945037d6809ae8c;p=sbcl.git diff --git a/doc/manual/docstrings.lisp b/doc/manual/docstrings.lisp index b703642..0648230 100644 --- a/doc/manual/docstrings.lisp +++ b/doc/manual/docstrings.lisp @@ -83,7 +83,7 @@ you deserve to lose.") "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* " ,.!?;") @@ -118,6 +118,11 @@ you deserve to lose.") (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)) @@ -221,6 +226,15 @@ symbols or lists of symbols.")) (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)) @@ -231,12 +245,18 @@ symbols or lists of symbols.")) (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" @@ -370,6 +390,9 @@ there is no corresponding docstring." (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)) @@ -383,13 +406,24 @@ there is no corresponding docstring." (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 @@ -410,39 +444,60 @@ with #\@. Optionally downcase the result." ;;; 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 @@ -474,11 +529,16 @@ semicolon, and the previous line is empty" (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 @@ -681,35 +741,43 @@ followed another tabulation label or a tabulation body." "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~%~%")))))) @@ -728,7 +796,6 @@ followed another tabulation label or a tabulation body." "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) @@ -777,6 +844,48 @@ package, as well as for the package itself." :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 @@ -793,6 +902,10 @@ markup, you lose." (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)