From ceb6862836d438f92269b5a5e0dc4ad4953a9bac Mon Sep 17 00:00:00 2001 From: David Lichteblau Date: Sun, 14 Dec 2008 16:16:24 +0100 Subject: [PATCH] moved syntax functions into their own package called PARSE-DOCSTRINGS --- package.lisp | 41 ++++++++++ docstrings.lisp => parse-docstrings.lisp | 128 +++++++++++-------------------- syntax-sbcl.lisp | 70 ++++++++++++++--- texinfo-docstrings.asd | 3 +- writer-common.lisp | 31 +++++++- writer-html.lisp | 66 ++++++++++------ writer-texinfo.lisp | 117 ++++++++++++++-------------- 7 files changed, 281 insertions(+), 175 deletions(-) create mode 100644 package.lisp rename docstrings.lisp => parse-docstrings.lisp (78%) diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..4a1970a --- /dev/null +++ b/package.lisp @@ -0,0 +1,41 @@ +(defpackage #:parse-docstrings + (:use #:cl #-sbcl #:c2mop #+sbcl #:sb-mop) + (:export #:documentation* + #:collect-documentation + + #:collect-symbol-documentation + + #:get-name + #:get-kind + #:get-content + #:get-items + #:get-blocks + #:get-string + #:get-title + #:get-package-name + #:get-body + #:get-children + + #:document-block + #:itemization + #:section + #:paragraph + #:tabulation + #:tabulation-item + #:lisp-content + #:lisp-block + + #:documentation< + #:setf-name-p + + #:lambda-list)) + +(defpackage #:parse-docstrings.sbcl + (:use :cl) + (:export #:parse-docstring)) + +(defpackage #:texinfo-docstrings + (:use #:cl #-sbcl #:c2mop #+sbcl #:sb-mop) + (:export #:generate-includes #:document-package) + (:documentation + "Tools to generate TexInfo documentation from docstrings.")) diff --git a/docstrings.lisp b/parse-docstrings.lisp similarity index 78% rename from docstrings.lisp rename to parse-docstrings.lisp index 13caa15..9f0762d 100644 --- a/docstrings.lisp +++ b/parse-docstrings.lisp @@ -8,23 +8,13 @@ ;;;; by Nikodemus Siivola, Luis Oliveira, David Lichteblau, and others. ;;;; TODO -;;;; * Method documentation untested -;;;; * Method sorting, somehow -;;;; * Index for macros & constants? ;;;; * This is getting complicated enough that tests would be good #+sbcl ;; FIXME: should handle this in the .asd file (eval-when (:compile-toplevel :load-toplevel :execute) (require 'sb-introspect)) -(defpackage #:texinfo-docstrings - (:use #:cl #-sbcl #:c2mop #+sbcl #:sb-mop) - (:shadow #:documentation) - (:export #:generate-includes #:document-package) - (:documentation - "Tools to generate TexInfo documentation from docstrings.")) - -(in-package #:texinfo-docstrings) +(in-package #:parse-docstrings) (defun function-arglist (function) #+sbcl (sb-introspect:function-arglist function) @@ -44,16 +34,6 @@ variable) "A list of symbols accepted as second argument of `documentation'") -(defparameter *itemize-start-characters* '(#\* #\-) - "Characters that might start an itemization in docstrings when - at the start of a line.") - -(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+&" - "List of characters that make up symbols in a docstring.") - -(defparameter *symbol-delimiters* " ,.!?; -") - (defparameter *ordered-documentation-kinds* '(package type structure condition class macro)) @@ -69,8 +49,8 @@ (t (cons (car list) (flatten (cdr list)))))) -(defun whitespacep (char) - (find char #(#\tab #\space #\page))) +(defun flatten-to-string (list) + (format nil "~{~A~^~%~}" (flatten list))) (defun setf-name-p (name) (or (symbolp name) @@ -84,11 +64,6 @@ (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)) @@ -102,23 +77,11 @@ 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) (handler-bind ((warning #'muffle-warning)) (cl:documentation x doc-type))) -(defun flatten-to-string (list) - (format nil "~{~A~^~%~}" (flatten list))) + ;;;; generating various names @@ -141,31 +104,6 @@ symbols or lists of symbols.")) (method-qualifiers method) (specialized-lambda-list method))) -;;; 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" (package-name-prefix 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-prefix 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))) ;;;; parsing documentation strings @@ -199,9 +137,27 @@ symbols or lists of symbols.")) (body :initarg :body :reader get-body))) +;;;; frontend selection + +(defvar *default-docstring-parser* + 'parse-docstrings.sbcl:parse-docstring) + +(defgeneric docstring-parser-for (x)) + +(defmethod docstring-parser-for ((x package)) + (let ((configuration + (find-symbol "DOCSTRING-PARSER" x))) + (or (and configuration + (funcall configuration)) + *default-docstring-parser*))) + +(defmethod docstring-parser-for ((x symbol)) + (docstring-parser-for (symbol-package x))) + + ;;;; documentation class and related methods -(defclass documentation () +(defclass documentation* () ((name :initarg :name :reader get-name) (kind :initarg :kind :reader get-kind) (content :accessor get-content) @@ -219,7 +175,7 @@ symbols or lists of symbols.")) (t (error "Don't know which symbol to sort by: ~S" name))))) -(defmethod print-object ((documentation documentation) stream) +(defmethod print-object ((documentation documentation*) stream) (print-unreadable-object (documentation stream :type t) (princ (list (get-kind documentation) (get-name documentation)) stream))) @@ -227,17 +183,18 @@ symbols or lists of symbols.")) (defmethod make-documentation :around (x doc-type string) (let ((doc (call-next-method))) - (setf (get-content doc) (parse-docstring string)) + (setf (get-content doc) + (funcall (docstring-parser-for (if (packagep x) x (name x))) string)) doc)) (defmethod make-documentation ((x package) doc-type string) - (declare (ignore doc-type)) - (make-instance 'documentation + (declare (ignore doc-type string)) + (make-instance 'documentation* :name (name x) :kind 'package)) (defmethod make-documentation (x (doc-type (eql 'function)) string) - (declare (ignore doc-type)) + (declare (ignore doc-type string)) (let* ((fdef (and (fboundp x) (fdefinition x))) (name x) (kind (cond ((and (symbolp x) (special-operator-p x)) @@ -252,19 +209,20 @@ symbols or lists of symbols.")) 'function))) (children (when (eq kind 'generic-function) (collect-gf-documentation fdef)))) - (make-instance 'documentation + (make-instance 'documentation* :name (name x) :kind kind :children children))) (defmethod make-documentation ((x method) doc-type string) - (declare (ignore doc-type)) - (make-instance 'documentation + (declare (ignore doc-type string)) + (make-instance 'documentation* :name (name x) :kind 'method)) (defmethod make-documentation (x (doc-type (eql 'type)) string) - (make-instance 'documentation + (declare (ignore string)) + (make-instance 'documentation* :name (name x) :kind (etypecase (find-class x nil) (structure-class 'structure) @@ -273,24 +231,26 @@ symbols or lists of symbols.")) ((or built-in-class null) 'type)))) (defmethod make-documentation (x (doc-type (eql 'variable)) string) - (make-instance 'documentation + (declare (ignore string)) + (make-instance 'documentation* :name (name x) :kind (if (constantp x) 'constant 'variable))) (defmethod make-documentation (x (doc-type (eql 'setf)) string) - (declare (ignore doc-type)) - (make-instance 'documentation + (declare (ignore doc-type string)) + (make-instance 'documentation* :name (name x) :kind 'setf-expander)) (defmethod make-documentation (x doc-type string) - (make-instance 'documentation + (declare (ignore string)) + (make-instance 'documentation* :name (name x) :kind doc-type)) -(defun maybe-documentation (x doc-type) +(defun 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))) @@ -355,13 +315,13 @@ there is no corresponding docstring." (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) + for doc = (documentation* method t) when doc collect doc)) (defun collect-name-documentation (name) (loop for type in *documentation-types* - for doc = (maybe-documentation name type) + for doc = (documentation* name type) when doc collect doc)) @@ -382,7 +342,7 @@ package, as well as for the package itself." (check-type package package) (do-external-symbols (symbol package) (setf docs (nconc (collect-symbol-documentation symbol) docs))) - (let ((doc (maybe-documentation *documentation-package* t))) + (let ((doc (documentation* *documentation-package* t))) (when doc (push doc docs))) docs)) diff --git a/syntax-sbcl.lisp b/syntax-sbcl.lisp index eaf9f97..dc7b7ba 100644 --- a/syntax-sbcl.lisp +++ b/syntax-sbcl.lisp @@ -26,10 +26,51 @@ ;;;; Lines containing only a SYMBOL that are followed by indented ;;;; lines are marked up as @table @code, with the SYMBOL as the item. -(in-package #:texinfo-docstrings) +(in-package #:parse-docstrings.sbcl) + + +;;;; utilities + +(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 whitespacep (char) + (find char #(#\tab #\space #\page))) + +(defun indentation (line) + "Position of first non-SPACE character in LINE." + (position-if-not (lambda (c) (char= c #\Space)) line)) + +(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 flatten-to-string (list) + (format nil "~{~A~^~%~}" (flatten list))) + ;;; line markups +(defparameter *itemize-start-characters* '(#\* #\-) + "Characters that might start an itemization in docstrings when + at the start of a line.") + +(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+&" + "List of characters that make up symbols in a docstring.") + +(defparameter *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 ... @@ -156,6 +197,11 @@ an item in an itemization." (tabulation-p offset step lines direction) (tabulation-body-p offset step lines)))))) +(defun empty-p (line-number lines) + (or (eql -1 line-number) + (and (< line-number (length lines)) + (not (indentation (svref lines line-number)))))) + (defun maybe-tabulation-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 @@ -194,7 +240,7 @@ followed another tabulation label or a tabulation body." (current nil)) (labels ((end-paragraph () (when current - (push (make-instance 'paragraph + (push (make-instance 'parse-docstrings:paragraph :string (flatten-to-string (reverse current))) parsed) (setf current nil))) @@ -227,11 +273,12 @@ followed another tabulation label or a tabulation body." for line = (and (< index (length lines)) (svref lines index)) while (indentation line) collect line))) - (values (length lisp) (make-instance 'lisp-block :string (flatten-to-string lisp))))) + (values (length lisp) (make-instance 'parse-docstrings:lisp-block + :string (flatten-to-string lisp))))) (defun section (paragraphs) (if (cdr paragraphs) - (make-instance 'section :blocks paragraphs) + (make-instance 'parse-docstrings:section :blocks paragraphs) (car paragraphs))) (defun parse-maybe-itemization (lines starting-line) @@ -243,7 +290,7 @@ followed another tabulation label or a tabulation body." (lines-consumed 0)) (labels ((end-paragraph () (when current - (push (make-instance 'paragraph + (push (make-instance 'parse-docstrings:paragraph :string (flatten-to-string (reverse current))) paragraphs) (setf current nil))) @@ -288,7 +335,8 @@ followed another tabulation label or a tabulation body." (end-item)) ;; a single-item itemization isn't. (if (> (length items) 1) - (values lines-consumed (make-instance 'itemization :items (nreverse items))) + (values lines-consumed (make-instance 'parse-docstrings:itemization + :items (nreverse items))) (values nil nil)))) @@ -302,14 +350,16 @@ followed another tabulation label or a tabulation body." (lines-consumed 0)) (labels ((end-paragraph () (when current - (push (make-instance 'paragraph + (push (make-instance 'parse-docstrings:paragraph :string (flatten-to-string (reverse current))) paragraphs) (setf current nil))) (end-item () (end-paragraph) (when paragraphs - (push (make-instance 'tabulation-item :title title :body (section (reverse paragraphs))) + (push (make-instance 'parse-docstrings:tabulation-item + :title title + :body (section (reverse paragraphs))) items) (setf paragraphs nil title nil))) @@ -342,4 +392,6 @@ followed another tabulation label or a tabulation body." ;; end of itemization (loop-finish)))) (end-item)) - (values lines-consumed (make-instance 'tabulation :items (reverse items))))) + (values lines-consumed + (make-instance 'parse-docstrings:tabulation + :items (reverse items))))) diff --git a/texinfo-docstrings.asd b/texinfo-docstrings.asd index a291f58..a4d55d1 100644 --- a/texinfo-docstrings.asd +++ b/texinfo-docstrings.asd @@ -3,7 +3,8 @@ (asdf:defsystem texinfo-docstrings :depends-on (#-sbcl closer-mop) :serial t - :components ((:file "docstrings") + :components ((:file "package") + (:file "parse-docstrings") (:file "syntax-sbcl") (:file "writer-common") (:file "writer-html") diff --git a/writer-common.lisp b/writer-common.lisp index 8f9a1b5..829421a 100644 --- a/writer-common.lisp +++ b/writer-common.lisp @@ -11,10 +11,37 @@ ;;;; Written by Rudi Schlatte , mangled ;;;; by Nikodemus Siivola, Luis Oliveira, David Lichteblau, and others. +;;;; TODO +;;;; * Method documentation untested +;;;; * Method sorting, somehow +;;;; * Index for macros & constants? +;;;; * This is getting complicated enough that tests would be good + (in-package #:texinfo-docstrings) (defvar *document-output*) +;;;; 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 flatten-to-string (list) + (format nil "~{~A~^~%~}" (flatten list))) + +(defun ensure-class-precedence-list (class) + (unless (class-finalized-p class) + (finalize-inheritance class)) + (class-precedence-list class)) + + ;;;; document formats (defclass document-format () @@ -74,8 +101,8 @@ docstring contains invalid Texinfo markup, you lose." (if output-file (pathname output-file) (document-package-pathname package :format real-format))) - (docs (sort (collect-documentation real-package) - #'documentation<))) + (docs (sort (parse-docstrings:collect-documentation real-package) + #'parse-docstrings:documentation<))) (with-document-file (f real-output-file format real-package) (dolist (doc docs) (format-doc f doc format))) diff --git a/writer-html.lisp b/writer-html.lisp index 3a6ca45..d328083 100644 --- a/writer-html.lisp +++ b/writer-html.lisp @@ -49,22 +49,22 @@ (defun html-text (string) (with-output-to-string (result) (let ((last 0)) - (dolist (symbol/index (locate-symbols string)) + (dolist (symbol/index (parse-docstrings.sbcl::locate-symbols string)) (write-string (html-escape (subseq string last (first symbol/index))) result) (let ((symbol-name (apply #'subseq string symbol/index))) (format result "~A" (html-escape symbol-name))) (setf last (second symbol/index))) (write-string (html-escape (subseq string last)) result)))) -(defmethod format-doc (stream (doc documentation) format) - (let ((name (html-escape (princ-to-string (get-name doc))))) +(defmethod format-doc (stream (doc parse-docstrings:documentation*) format) + (let ((name (html-escape (princ-to-string (parse-docstrings:get-name doc))))) (with-html (stream :div '(:class "item")) (with-html (stream :div '(:class "type")) (format-html stream :a (list :name name) - (html-escape (format nil "[~A]" (string-downcase (princ-to-string (get-kind doc))))))) + (html-escape (format nil "[~A]" (string-downcase (princ-to-string (parse-docstrings:get-kind doc))))))) (with-html (stream :div '(:class "signature")) (format-html stream :code '(:class "name") name) - (let ((ll (lambda-list doc))) + (let ((ll (parse-docstrings:lambda-list doc))) (when ll (with-html (stream :span '(:class "args")) (dolist (elt ll) @@ -79,16 +79,23 @@ (format-html stream :var () (html-escape (string-downcase (princ-to-string elt)))))))) (markup-ll elt))))))) (with-html (stream :div '(:class "item-body")) - (let ((content (get-content doc))) + (let ((content (parse-docstrings:get-content doc))) (format-doc stream content format))))) (terpri stream)) -(defmethod format-doc (stream (lisp lisp-block) (format (eql :html))) - (format-html stream :pre '(:class "lisp") (html-escape (get-string lisp)))) - -(defmethod format-doc (stream (list itemization) (format (eql :html))) +(defmethod format-doc (stream + (lisp parse-docstrings:lisp-block) + (format (eql :html))) + (format-html stream + :pre + '(:class "lisp") + (html-escape (parse-docstrings:get-string lisp)))) + +(defmethod format-doc (stream + (list parse-docstrings:itemization) + (format (eql :html))) (with-html (stream :ul '(:class "itemization")) - (dolist (item (get-items list)) + (dolist (item (parse-docstrings:get-items list)) (with-html (stream :li '(:class "item")) (format-html-item stream item))))) @@ -97,23 +104,36 @@ (defmethod format-html-item (stream item) (format-doc stream item :html)) -(defmethod format-html-item (stream (item section)) - (dolist (b (get-blocks item)) +(defmethod format-html-item (stream (item parse-docstrings:section)) + (dolist (b (parse-docstrings:get-blocks item)) (format-doc stream b :html))) -(defmethod format-doc (stream (section section) (format (eql :html))) - (dolist (b (get-blocks section)) +(defmethod format-doc (stream + (section parse-docstrings:section) + (format (eql :html))) + (dolist (b (parse-docstrings:get-blocks section)) (format-doc stream b format))) -(defmethod format-doc (stream (paragraph paragraph) (format (eql :html))) - (format-html stream :p '() (html-text (get-string paragraph)))) - -(defmethod format-doc (stream (tabulation tabulation) (format (eql :html))) +(defmethod format-doc (stream + (paragraph parse-docstrings:paragraph) + (format (eql :html))) + (format-html stream + :p + '() + (html-text (parse-docstrings:get-string paragraph)))) + +(defmethod format-doc (stream + (tabulation parse-docstrings:tabulation) + (format (eql :html))) (with-html (stream :dl '(:class "tabulation")) - (dolist (i (get-items tabulation)) + (dolist (i (parse-docstrings:get-items tabulation)) (format-doc stream i format)))) -(defmethod format-doc (stream (item tabulation-item) (format (eql :html))) - (format-html stream :dt '(:class "tabulation-title") (html-escape (get-title item))) +(defmethod format-doc (stream + (item parse-docstrings:tabulation-item) + (format (eql :html))) + (format-html stream :dt + '(:class "tabulation-title") + (html-escape (parse-docstrings:get-title item))) (with-html (stream :dd '(:class "tabulation-body")) - (format-html-item stream (get-body item)))) + (format-html-item stream (parse-docstrings:get-body item)))) diff --git a/writer-texinfo.lisp b/writer-texinfo.lisp index 27ae514..ec124a2 100644 --- a/writer-texinfo.lisp +++ b/writer-texinfo.lisp @@ -62,24 +62,30 @@ up filename handling. See `*character-replacements*' and name)) (defun include-pathname (doc) - (let* ((kind (get-kind doc)) + (let* ((kind (parse-docstrings:get-kind doc)) (name (nstring-downcase (if (eq 'package kind) - (format nil "package-~A" (alphanumize (get-name doc))) + (format nil "package-~A" + (alphanumize (parse-docstrings:get-name doc))) (format nil "~A-~A-~A" - (case (get-kind doc) + (case (parse-docstrings:get-kind doc) ((function generic-function) "fun") (structure "struct") (variable "var") - (otherwise (symbol-name (get-kind doc)))) - (alphanumize (get-package-name doc)) - (alphanumize (get-name doc))))))) + (otherwise + (symbol-name (parse-docstrings:get-kind doc)))) + (alphanumize + (parse-docstrings:get-package-name doc)) + (alphanumize + (parse-docstrings:get-name doc))))))) (make-pathname :name name :type "texinfo"))) ;;; Node names for DOCUMENTATION instances (defun package-name-prefix (doc) - (format nil "~@[~A:~]" (and *prepend-package-names* (get-package-name doc)))) + (format nil "~@[~A:~]" + (and *prepend-package-names* + (parse-docstrings:get-package-name doc)))) (defgeneric name-using-kind/name (kind name doc)) @@ -93,7 +99,7 @@ up filename handling. See `*character-replacements*' and (defmethod name-using-kind/name (kind (name list) doc) (declare (ignore kind)) - (assert (setf-name-p name)) + (assert (parse-docstrings:setf-name-p name)) (format nil "(setf ~A~A)" (package-name-prefix doc) (second name))) (defmethod name-using-kind/name ((kind (eql 'method)) name doc) @@ -104,9 +110,39 @@ up filename handling. See `*character-replacements*' and (defun node-name (doc) "Returns TexInfo node name as a string for a DOCUMENTATION instance." - (let ((kind (get-kind doc))) + (let ((kind (parse-docstrings:get-kind doc))) (format nil "~:(~A~) ~(~A~)" - kind (name-using-kind/name kind (get-name doc) doc)))) + kind + (name-using-kind/name kind (parse-docstrings:get-name doc) doc)))) + +;;; 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" (package-name-prefix doc) name)) + +(defmethod title-using-kind/name (kind (name list) doc) + (declare (ignore kind)) + (assert (parse-docstrings:setf-name-p name)) + (format nil "(setf ~A~A)" (package-name-prefix 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 (parse-docstrings:get-kind doc) + (parse-docstrings:get-name doc) + doc))) + ;;;; turning text into texinfo @@ -120,10 +156,6 @@ with #\@. Optionally downcase the result." do (write-char char s))))) (if downcasep (nstring-downcase result) result))) -(defun empty-p (line-number lines) - (or (eql -1 line-number) - (and (< line-number (length lines)) - (not (indentation (svref lines line-number)))))) ;;;; texinfo formatting tools @@ -152,14 +184,14 @@ with #\@. Optionally downcase the result." ;; 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)))) + (parse-docstrings::docstring slot t)))) (defun texinfo-anchor (doc) (format *document-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))) + (let ((kind (parse-docstrings:get-kind doc))) (format *document-output* "@~A {~:(~A~)} ~(~A~@[ ~{~A~^ ~}~]~)~%" (case kind ((package constant variable) @@ -171,11 +203,11 @@ with #\@. Optionally downcase the result." (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind)) (title-name doc) - (lambda-list doc)))) + (parse-docstrings:lambda-list doc)))) (defun texinfo-index (doc) (let ((title (title-name doc))) - (case (get-kind doc) + (case (parse-docstrings:get-kind doc) ((structure type class condition) (format *document-output* "@tindex ~A~%" title)) ((variable constant) @@ -184,8 +216,8 @@ with #\@. Optionally downcase the result." (format *document-output* "@findex ~A~%" title))))) (defun texinfo-inferred-body (doc) - (when (member (get-kind doc) '(class structure condition)) - (let ((name (get-name doc))) + (when (member (parse-docstrings:get-kind doc) '(class structure condition)) + (let ((name (parse-docstrings:get-name doc))) ;; class precedence list (format *document-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%" @@ -222,14 +254,14 @@ with #\@. Optionally downcase the result." (slot-definition-readers slot) (slot-definition-writers slot))))))) ;; FIXME: Would be neater to handler as children - (write-texinfo-string (docstring slot t))) + (write-texinfo-string (parse-docstrings::docstring slot t))) (format *document-output* "@end itemize~%~%")))))) (defun texinfo-body (doc) - (write-texinfo-string (get-string doc))) + (write-texinfo-string (parse-docstrings:get-string doc))) (defun texinfo-end (doc) - (write-line (case (get-kind doc) + (write-line (case (parse-docstrings:get-kind doc) ((package variable constant) "@end defvr") ((structure type class condition) "@end deftp") (t "@end deffn")) @@ -244,7 +276,7 @@ with #\@. Optionally downcase the result." (texinfo-body doc) (texinfo-end doc) ;; FIXME: Children should be sorted one way or another - (mapc #'write-texinfo (get-children doc))) + (mapc #'write-texinfo (parse-docstrings:get-children doc))) (defmacro with-texinfo-file (pathname &body forms) `(with-open-file (*document-output* ,pathname @@ -267,7 +299,7 @@ markup, you lose." (ensure-directories-exist directory) (let ((*prepend-package-names* (> (length packages) 1))) (dolist (package packages) - (dolist (doc (collect-documentation + (dolist (doc (parse-docstrings:collect-documentation (find-package package) (string-downcase (etypecase package (symbol (symbol-name package)) @@ -279,35 +311,8 @@ markup, you lose." ;;;; TEXINFO OUTPUT -(defmethod format-doc (stream (lisp lisp-block) (format (eql :texinfo))) +(defmethod format-doc (stream + (lisp parse-docstrings:lisp-block) + (format (eql :texinfo))) (format stream "@lisp~%~A~%@end lisp" - (texinfo-escape (get-string lisp)))) - - -(with-output-to-string (s) - (format-doc s - (nth-value 1 (parse-maybe-itemization - (vector " * foo" - " baasd asd" - " * quux asd asd" - " askdjalksjd alsdjlaksjd " - "" - " asldkjaslkdja sf klsajhf ksjahf askjf" - ) - 0)) - :html)) - -(with-output-to-string (s) - (format-doc s - (nth-value 1 (parse-maybe-tabulation - (vector " FOO" - " baasd asd" - "" - " BAR" - " zot tot" - " askdjalksjd alsdjlaksjd " - "" - " asldkjaslkdja sf klsajhf ksjahf askjf" - ) - 0)) - :html)) + (texinfo-escape (parse-docstrings:get-string lisp)))) -- 2.11.4.GIT