1 | ;;; $Id: user-manual.lisp,v 1.28 1997/12/03 02:38:33 marek Exp $
|
---|
2 | ;;; ****************************************************************
|
---|
3 | ;;; CHANGE LOG:
|
---|
4 | ;;; * Added package stuff
|
---|
5 | ;;; * Modified by M. Rychlik (rychlik@math.arizona.edu)
|
---|
6 | ;;; so that create-manuals accepts a directory prefix
|
---|
7 | ;;; ****************************************************************
|
---|
8 |
|
---|
9 | (defpackage "USER-MANUAL"
|
---|
10 | (:export create-user-manual create-manuals text scribe latex))
|
---|
11 | (in-package "USER-MANUAL")
|
---|
12 |
|
---|
13 | ;;; Thu Oct 20 20:18:29 1994 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
|
---|
14 | ;;; user-manual.lisp -- 48831 bytes
|
---|
15 |
|
---|
16 | ;;; ****************************************************************
|
---|
17 | ;;; Automatic User Manual Creation *********************************
|
---|
18 | ;;; ****************************************************************
|
---|
19 | ;;;
|
---|
20 | ;;; The Automatic User Manual Creation system is a common lisp portable
|
---|
21 | ;;; system for automatically generating user's guides from the
|
---|
22 | ;;; source definitions and their documentation strings. It uses several
|
---|
23 | ;;; heuristics for formatting the documentation segments nicely.
|
---|
24 | ;;; If Waters' XP pretty printer is available, it uses that instead to
|
---|
25 | ;;; format the argument lists.
|
---|
26 | ;;;
|
---|
27 | ;;; The user guide for this file was created using this program and
|
---|
28 | ;;; provides a good example of its capabilities. It was created by
|
---|
29 | ;;; evaluating (create-user-manual "user-manual.lisp").
|
---|
30 | ;;;
|
---|
31 | ;;; Written by Mark Kantrowitz, December 1990.
|
---|
32 | ;;;
|
---|
33 | ;;; Address: Carnegie Mellon University
|
---|
34 | ;;; School of Computer Science
|
---|
35 | ;;; Pittsburgh, PA 15213
|
---|
36 | ;;;
|
---|
37 | ;;; Copyright (c) 1990. All rights reserved.
|
---|
38 | ;;;
|
---|
39 | ;;; See general license below.
|
---|
40 | ;;;
|
---|
41 | |
---|
42 |
|
---|
43 | ;;; ****************************************************************
|
---|
44 | ;;; General License Agreement and Lack of Warranty *****************
|
---|
45 | ;;; ****************************************************************
|
---|
46 | ;;;
|
---|
47 | ;;; This software is distributed in the hope that it will be useful (both
|
---|
48 | ;;; in and of itself and as an example of lisp programming), but WITHOUT
|
---|
49 | ;;; ANY WARRANTY. The author(s) do not accept responsibility to anyone for
|
---|
50 | ;;; the consequences of using it or for whether it serves any particular
|
---|
51 | ;;; purpose or works at all. No warranty is made about the software or its
|
---|
52 | ;;; performance.
|
---|
53 | ;;;
|
---|
54 | ;;; Use and copying of this software and the preparation of derivative
|
---|
55 | ;;; works based on this software are permitted, so long as the following
|
---|
56 | ;;; conditions are met:
|
---|
57 | ;;; o The copyright notice and this entire notice are included intact
|
---|
58 | ;;; and prominently carried on all copies and supporting documentation.
|
---|
59 | ;;; o No fees or compensation are charged for use, copies, or
|
---|
60 | ;;; access to this software. You may charge a nominal
|
---|
61 | ;;; distribution fee for the physical act of transferring a
|
---|
62 | ;;; copy, but you may not charge for the program itself.
|
---|
63 | ;;; o If you modify this software, you must cause the modified
|
---|
64 | ;;; file(s) to carry prominent notices (a Change Log)
|
---|
65 | ;;; describing the changes, who made the changes, and the date
|
---|
66 | ;;; of those changes.
|
---|
67 | ;;; o Any work distributed or published that in whole or in part
|
---|
68 | ;;; contains or is a derivative of this software or any part
|
---|
69 | ;;; thereof is subject to the terms of this agreement. The
|
---|
70 | ;;; aggregation of another unrelated program with this software
|
---|
71 | ;;; or its derivative on a volume of storage or distribution
|
---|
72 | ;;; medium does not bring the other program under the scope
|
---|
73 | ;;; of these terms.
|
---|
74 | ;;; o Permission is granted to manufacturers and distributors of
|
---|
75 | ;;; lisp compilers and interpreters to include this software
|
---|
76 | ;;; with their distribution.
|
---|
77 | ;;;
|
---|
78 | ;;; This software is made available AS IS, and is distributed without
|
---|
79 | ;;; warranty of any kind, either expressed or implied.
|
---|
80 | ;;;
|
---|
81 | ;;; In no event will the author(s) or their institutions be liable to you
|
---|
82 | ;;; for damages, including lost profits, lost monies, or other special,
|
---|
83 | ;;; incidental or consequential damages arising out of or in connection
|
---|
84 | ;;; with the use or inability to use (including but not limited to loss of
|
---|
85 | ;;; data or data being rendered inaccurate or losses sustained by third
|
---|
86 | ;;; parties or a failure of the program to operate as documented) the
|
---|
87 | ;;; program, even if you have been advised of the possibility of such
|
---|
88 | ;;; damanges, or for any claim by any other party, whether in an action of
|
---|
89 | ;;; contract, negligence, or other tortious action.
|
---|
90 | ;;;
|
---|
91 | ;;; The current version of this software and a variety of related
|
---|
92 | ;;; utilities may be obtained by anonymous ftp from ftp.cs.cmu.edu
|
---|
93 | ;;; (128.2.206.173) or any other CS machine in the directory
|
---|
94 | ;;; user/ai/lang/lisp/code/tools/user_man/
|
---|
95 | ;;;
|
---|
96 | ;;; Please send bug reports, comments, questions and suggestions to
|
---|
97 | ;;; mkant@cs.cmu.edu. We would also appreciate receiving any changes
|
---|
98 | ;;; or improvements you may make.
|
---|
99 | ;;;
|
---|
100 | ;;; If you wish to be added to the Lisp-Utilities@cs.cmu.edu mailing list,
|
---|
101 | ;;; send email to Lisp-Utilities-Request@cs.cmu.edu with your name, email
|
---|
102 | ;;; address, and affiliation. This mailing list is primarily for
|
---|
103 | ;;; notification about major updates, bug fixes, and additions to the lisp
|
---|
104 | ;;; utilities collection. The mailing list is intended to have low traffic.
|
---|
105 | ;;;
|
---|
106 | |
---|
107 |
|
---|
108 | ;;; ********************************
|
---|
109 | ;;; Change Log *********************
|
---|
110 | ;;; ********************************
|
---|
111 | ;;;
|
---|
112 | ;;; mk = Mark Kantrowitz <mkant@cs.cmu.edu>
|
---|
113 | ;;; duff = David A. Duff <duff@starbase.MITRE.ORG>
|
---|
114 | ;;; rit = Jean-Francois Rit <rit@cs.stanford.edu>
|
---|
115 | ;;; wds = William D Smith <smithwd@kona.crd.ge.com>
|
---|
116 | ;;; dick = Dick Jackson <jackson@ciitip.ciit.nrc.ca>
|
---|
117 | ;;; ma = Marco Antoniotti <marcoxa@image.cs.nyu.edu>
|
---|
118 | ;;; fdmm = Fernando D. Mato Mira <matomira@epfl.ch>
|
---|
119 | ;;;
|
---|
120 | ;;; 24-JAN-91 duff Fixed bug in documentation handler for defstructs.
|
---|
121 | ;;; 24-JAN-91 duff Documentation-handlers for Lucid.
|
---|
122 | ;;; 28-JAN-91 rit Changed format clauses with @: to :@ in handle-form-output.
|
---|
123 | ;;; Otherwise Franz Allegro CL barfs.
|
---|
124 | ;;; mk Note that CLtL2 specifies that either is OK, although
|
---|
125 | ;;; :@ is traditional.
|
---|
126 | ;;; 28-JAN-91 mk Added Scribe output format in addition to TEXT output
|
---|
127 | ;;; format.
|
---|
128 | ;;; 31-JAN-91 duff Doc-handler for define-condition.
|
---|
129 | ;;; 05-FEB-91 wds Added doc-handlers for defmethod, defgeneric, defclass,
|
---|
130 | ;;; deftype and defsetf.
|
---|
131 | ;;; 05-FEB-91 mk Fixed handler for defmethod to handle qualifiers such
|
---|
132 | ;;; as :before, :after, and :around. Fixed defsetf handler
|
---|
133 | ;;; to include alternate format. Extended deftype handler.
|
---|
134 | ;;; 07-FEB-91 dick Doc-handlers for CLOS defclass. [This was better than
|
---|
135 | ;;; wds's. I've merged the capabilities of the two.
|
---|
136 | ;;; Also, I added :blank for use in leaving the args
|
---|
137 | ;;; position blank, and fixed split-string to not
|
---|
138 | ;;; trim whitespace in certain circumstances. --mk]
|
---|
139 | ;;; 08-FEB-91 wds Specialized the code using conditional read macros
|
---|
140 | ;;; in case XP package not present.
|
---|
141 | ;;; 05-JAN-93 ma Changed some of the inner working to add LaTeX
|
---|
142 | ;;; support: defvar, defconstant and defparameter have
|
---|
143 | ;;; their doc-handlers changed when they have nil as
|
---|
144 | ;;; default and support functions have bee added for
|
---|
145 | ;;; LaTeX. Also the structure of handle-form-output
|
---|
146 | ;;; has been slightly changed.
|
---|
147 | ;;; A LaTeX document including entries obtained via
|
---|
148 | ;;; create-user-manual must contain (e.g. by '\input')
|
---|
149 | ;;; the 'lisp:documentation' environment as defined in
|
---|
150 | ;;; the companion file 'lisp-documentation.tex'.
|
---|
151 | ;;; 03-MAR-93 fdmm Added doc-handler for ECLOS defconstraint.
|
---|
152 | ;;; 03-MAR-93 fdmm Added create-manuals.
|
---|
153 | ;;; 03-MAR-93 fdmm Enhanced defclass doc-handler to output metaclass, readers,
|
---|
154 | ;;; writers, initargs and slot type info.
|
---|
155 | ;;; 04-MAR-93 fdmm Fixed bug in handle-form-output (let --> let*).
|
---|
156 | ;;; 05-MAR-93 fdmm Added basic FrameMaker(tm) support.
|
---|
157 | ;;; 17-OCT-94 fdmm Added doc-handler for ECLOS defdaemon.
|
---|
158 | ;;; 17-OCT-94 fdmm Accepts now :latex, etc. keywords, to avoid package
|
---|
159 | ;;; problems, but still accepts `bad style' arguments for
|
---|
160 | ;;; backwards compatibility.
|
---|
161 | ;;; 20-OCT-94 mk Added *userman-version* parameter.
|
---|
162 |
|
---|
163 |
|
---|
164 | ;;; ********************************
|
---|
165 | ;;; To Do **************************
|
---|
166 | ;;; ********************************
|
---|
167 | ;;;
|
---|
168 | ;;; Generalize it to also use the definition's comments to create
|
---|
169 | ;;; even more documentation. Essentially, change the #\; macro
|
---|
170 | ;;; character so that instead of killing the remainder of the line,
|
---|
171 | ;;; it processes it for the documentation. By making this program
|
---|
172 | ;;; understand some sort of structured comments, we can have it
|
---|
173 | ;;; ignore comment stubs and only include the meaty stuff.
|
---|
174 | ;;;
|
---|
175 | ;;; Clean up use of XP pretty printer.
|
---|
176 | ;;;
|
---|
177 | ;;; Need 'latex output-format. In 'scribe mode, need to convert @ to @@.
|
---|
178 | ;;;
|
---|
179 | ;;; Note that using :output-format 'scribe and running scribe with
|
---|
180 | ;;; the -device FILE arguments should produce output similar to
|
---|
181 | ;;; :output-format 'text, except without semicolons in the left margin.
|
---|
182 | ;;;
|
---|
183 | |
---|
184 |
|
---|
185 | ;;; ********************************
|
---|
186 | ;;; Documentation Types ************
|
---|
187 | ;;; ********************************
|
---|
188 | ;;;
|
---|
189 | ;;; This is a list of the documentation types currently supported:
|
---|
190 | ;;; + = things in user-manual.lisp
|
---|
191 | ;;; - = things still missing from user-manual.lisp
|
---|
192 | ;;;
|
---|
193 | ;;; COMMON-LISP forms:
|
---|
194 | ;;;
|
---|
195 | ;;; + (DEFCLASS name super-types slots &rest options )
|
---|
196 | ;;; + (DEFCONSTANT name initial-value &optional documentation )
|
---|
197 | ;;; + (DEFGENERIC name lambda-list &rest options )
|
---|
198 | ;;; + (DEFMACRO name lambda-list documentation ... )
|
---|
199 | ;;; + (DEFMETHOD name lambda-list documentation ... )
|
---|
200 | ;;; - defpackage
|
---|
201 | ;;; + (DEFPARAMETER name initial-value &optional documentation )
|
---|
202 | ;;; + (DEFSETF name function documentation )
|
---|
203 | ;;; + (DEFSTRUCT name+options documentation &rest slots )
|
---|
204 | ;;; + (DEFTYPE name lambda-list documentation ... )
|
---|
205 | ;;; + (DEFUN name lambda-list documentation ... )
|
---|
206 | ;;; + (DEFVAR name &optional initial-value documentation )
|
---|
207 | ;;;
|
---|
208 | ;;; ECLOS forms:
|
---|
209 | ;;;
|
---|
210 | ;;; + (DEFCONSTRAINT name super-types lambda-list documentation ...)
|
---|
211 | ;;; + (DEFDAEMON name super-types lambda-list documentation ...)
|
---|
212 | ;;;
|
---|
213 | |
---|
214 |
|
---|
215 | ;;; ********************************
|
---|
216 | ;;; Notes **************************
|
---|
217 | ;;; ********************************
|
---|
218 | ;;;
|
---|
219 | ;;; USER-MANUAL has been tested (successfully) in the following lisps:
|
---|
220 | ;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
|
---|
221 | ;;; Macintosh Allegro Common Lisp (1.3.2)
|
---|
222 | ;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
|
---|
223 | ;;; Lucid CL (Version 2.1 6-DEC-87)
|
---|
224 | ;;;
|
---|
225 | ;;; USER-MANUAL needs to be tested in the following lisps:
|
---|
226 | ;;; Symbolics Common Lisp (8.0)
|
---|
227 | ;;; Lucid Common Lisp (3.0)
|
---|
228 | ;;; Lucid Common Lisp (4.0)
|
---|
229 | ;;; KCL (June 3, 1987 or later)
|
---|
230 | ;;; AKCL (1.86, June 30, 1987 or later)
|
---|
231 | ;;; TI (Release 4.1 or later)
|
---|
232 | ;;; Ibuki Common Lisp (01/01, October 15, 1987)
|
---|
233 | ;;; Golden Common Lisp (3.1 IBM-PC)
|
---|
234 | ;;; VAXLisp (2.0, 3.1)
|
---|
235 | ;;; HP Common Lisp (same as Lucid?)
|
---|
236 | ;;; Procyon Common Lisp
|
---|
237 |
|
---|
238 | |
---|
239 |
|
---|
240 | ;;; ********************************
|
---|
241 | ;;; User Guide *********************
|
---|
242 | ;;; ********************************
|
---|
243 | ;;;
|
---|
244 | ;;; EXTRACT-DOCUMENTATION (body) [MACRO]
|
---|
245 | ;;;
|
---|
246 | ;;; ATOM-OR-CAR (list-or-atom) [FUNCTION]
|
---|
247 | ;;;
|
---|
248 | ;;; *DOCUMENTATION-HANDLERS* (make-hash-table :test [VARIABLE]
|
---|
249 | ;;; (function equal))
|
---|
250 | ;;; Hash table of entries of the form (handler description),
|
---|
251 | ;;; where definer is the car of the definition form handled (for
|
---|
252 | ;;; example, DEFUN or DEFMACRO), handler is a function which takes the
|
---|
253 | ;;; form as input and value-returns the name, argument-list and
|
---|
254 | ;;; documentation string, and description is a one-word equivalent of
|
---|
255 | ;;; definer (for example, FUNCTION or MACRO).
|
---|
256 | ;;;
|
---|
257 | ;;; DEFINE-DOC-HANDLER (definer arglist description &body body) [MACRO]
|
---|
258 | ;;; Defines a new documentation handler. DEFINER is the car of the
|
---|
259 | ;;; definition form handled (e.g., defun), DESCRIPTION is a one-word
|
---|
260 | ;;; string equivalent of definer (e.g., "function"), and ARGLIST
|
---|
261 | ;;; and BODY together define a function that takes the form as input
|
---|
262 | ;;; and value-returns the name, argument-list, documentation string,
|
---|
263 | ;;; and a list of any qualifiers of the form.
|
---|
264 | ;;;
|
---|
265 | ;;; FIND-DOC-HANDLER (definer) [FUNCTION]
|
---|
266 | ;;; Given the car of a form, finds the appropriate documentation
|
---|
267 | ;;; handler for the form if one exists.
|
---|
268 | ;;;
|
---|
269 | ;;; DEFINE-DOC-HANDLER (form) [DOC-HANDLER]
|
---|
270 | ;;; Documentation handler for doc-handlers.
|
---|
271 | ;;;
|
---|
272 | ;;; DEFVAR (form) [DOC-HANDLER]
|
---|
273 | ;;; Documentation handler for variables.
|
---|
274 | ;;;
|
---|
275 | ;;; DEFCONSTANT (form) [DOC-HANDLER]
|
---|
276 | ;;; Documentation handler for constants.
|
---|
277 | ;;;
|
---|
278 | ;;; DEFPARAMETER (form) [DOC-HANDLER]
|
---|
279 | ;;; Documentation handler for parameters.
|
---|
280 | ;;;
|
---|
281 | ;;; DEFUN (form) [DOC-HANDLER]
|
---|
282 | ;;; Documentation handler for functions.
|
---|
283 | ;;;
|
---|
284 | ;;; DEFMACRO (form) [DOC-HANDLER]
|
---|
285 | ;;; Documentation handler for macros.
|
---|
286 | ;;;
|
---|
287 | ;;; DEFSTRUCT (form) [DOC-HANDLER]
|
---|
288 | ;;; Documentation handler for structures.
|
---|
289 | ;;;
|
---|
290 | ;;; DEFINE-CONDITION (form) [DOC-HANDLER]
|
---|
291 | ;;; Documentation handler for conditions.
|
---|
292 | ;;;
|
---|
293 | ;;; DEFTYPE (form) [DOC-HANDLER]
|
---|
294 | ;;; Documentation handler for types.
|
---|
295 | ;;;
|
---|
296 | ;;; DEFSETF (form) [DOC-HANDLER]
|
---|
297 | ;;; Documentation handler for setf mappings.
|
---|
298 | ;;;
|
---|
299 | ;;; DEFMETHOD (form) [DOC-HANDLER]
|
---|
300 | ;;; Documentation handler for methods.
|
---|
301 | ;;;
|
---|
302 | ;;; DEFGENERIC (form) [DOC-HANDLER]
|
---|
303 | ;;; Documentation handler for generic functions.
|
---|
304 | ;;;
|
---|
305 | ;;; DEFCLASS (form) [DOC-HANDLER]
|
---|
306 | ;;; Documentation handler for classs.
|
---|
307 | ;;;
|
---|
308 | ;;; DEFCONSTRAINT (form) [DOC-HANDLER]
|
---|
309 | ;;; Documentation handler for constraints.
|
---|
310 | ;;;
|
---|
311 | ;;; DEFDAEMON (form) [DOC-HANDLER]
|
---|
312 | ;;; Documentation handler for daemons.
|
---|
313 | ;;;
|
---|
314 | ;;; *FAILED-DEFINITION-TYPES* "()" [VARIABLE]
|
---|
315 | ;;; List of definition types that create-user-manual couldn't handle.
|
---|
316 | ;;;
|
---|
317 | ;;; CREATE-USER-MANUAL (filename &key (output-format (quote text)) [FUNCTION]
|
---|
318 | ;;; (output-stream *standard-output*))
|
---|
319 | ;;; Automatically creates a user manual for the functions in a file by
|
---|
320 | ;;; collecting the documentation strings and argument lists of the
|
---|
321 | ;;; functions and formatting the output nicely. Returns a list of the
|
---|
322 | ;;; definition types of the forms it couldn't handle. Output-format
|
---|
323 | ;;; may be either 'TEXT or 'SCRIBE.
|
---|
324 | ;;;
|
---|
325 | ;;; HANDLE-FORM-OUTPUT (form &optional (output-format (quote text)) [FUNCTION]
|
---|
326 | ;;; (stream *standard-output*))
|
---|
327 | ;;; This function takes a form as input and outputs its documentation
|
---|
328 | ;;; segment to the output stream.
|
---|
329 | ;;;
|
---|
330 | ;;; OUTPUT-TEXT-DOCUMENTATION (name type args documentation [FUNCTION]
|
---|
331 | ;;; args-tab-pos type-pos
|
---|
332 | ;;; &optional (stream *standard-output*))
|
---|
333 | ;;; Prints out the user guide entry for a form in TEXT mode.
|
---|
334 | ;;;
|
---|
335 | ;;; OUTPUT-SCRIBE-DOCUMENTATION (name type args documentation [FUNCTION]
|
---|
336 | ;;; &optional
|
---|
337 | ;;; (stream *standard-output*))
|
---|
338 | ;;; Prints out the user guide entry for a form in SCRIBE mode.
|
---|
339 | ;;;
|
---|
340 | ;;; XP-SPLIT-STRING (arglist width) [FUNCTION]
|
---|
341 | ;;; PPrints the arglist into a string of specified width. Assumes
|
---|
342 | ;;; that we're running the XP pretty printer.
|
---|
343 | ;;;
|
---|
344 | ;;; SPLIT-STRING (string width &optional arglistp filled [FUNCTION]
|
---|
345 | ;;; (trim-whitespace t))
|
---|
346 | ;;; Splits a string into a list of strings, each of which is shorter
|
---|
347 | ;;; than the specified width. Tries to be intelligent about where to
|
---|
348 | ;;; split the string if it is an argument list. If filled is T,
|
---|
349 | ;;; tries to fill out the strings as much as possible. This function
|
---|
350 | ;;; is used to break up long argument lists nicely, and to break up
|
---|
351 | ;;; wide lines of documentation nicely.
|
---|
352 | ;;;
|
---|
353 | ;;; SPLIT-POINT (string max-length &optional arglistp filled) [FUNCTION]
|
---|
354 | ;;; Finds an appropriate point to break the string at given a target
|
---|
355 | ;;; length. If arglistp is T, tries to find an intelligent position to
|
---|
356 | ;;; break the string. If filled is T, tries to fill out the string as
|
---|
357 | ;;; much as possible.
|
---|
358 | ;;;
|
---|
359 | ;;; LAMBDA-LIST-KEYWORD-POSITION (string [FUNCTION]
|
---|
360 | ;;; &optional end trailer-only)
|
---|
361 | ;;; If the previous symbol is a lambda-list keyword, returns
|
---|
362 | ;;; its position. Otherwise returns end.
|
---|
363 | ;;;
|
---|
364 | ;;; BALANCED-PARENTHESIS-POSITION (string &optional end) [FUNCTION]
|
---|
365 | ;;; Finds the position of the left parenthesis which is closest to END
|
---|
366 | ;;; but leaves the prefix of the string with balanced parentheses or
|
---|
367 | ;;; at most 1 unbalanced left parenthesis.
|
---|
368 | ;;;
|
---|
369 | ;;; PARSE-WITH-DELIMITER (line &optional (delim #\newline)) [FUNCTION]
|
---|
370 | ;;; Breaks LINE into a list of strings, using DELIM as a
|
---|
371 | ;;; breaking point.
|
---|
372 | ;;;
|
---|
373 | |
---|
374 |
|
---|
375 | ;;; ********************************
|
---|
376 | ;;; Version Information ************
|
---|
377 | ;;; ********************************
|
---|
378 |
|
---|
379 | (defparameter *userman-version* "2.0 20-OCT-94"
|
---|
380 | "Current verison number/date for User-Manual.")
|
---|
381 |
|
---|
382 | (defun userman-copyright (&optional (stream *standard-output*))
|
---|
383 | "Prints a User Manual copyright notice and header upon startup."
|
---|
384 | (format stream "~%;;; ~V,,,'*A" 73 "*")
|
---|
385 | (format stream "~%;;; UserMan: Automatic User Manual Creation.")
|
---|
386 | (format stream "~%;;; Version ~A." *userman-version*)
|
---|
387 | (format stream "~%;;; Written by Mark Kantrowitz, CMU School of Computer Science.")
|
---|
388 | (format stream "~%;;; Copyright (c) 1990-94. All rights reserved.")
|
---|
389 | (format stream "~%;;; Use, copying, modification, and distribution permitted.")
|
---|
390 | (format stream "~%;;; See the copyright notice in the source for details.")
|
---|
391 | (format stream "~%;;; ~V,,,'*A~%" 73 "*")
|
---|
392 | (force-output stream))
|
---|
393 |
|
---|
394 | (userman-copyright)
|
---|
395 |
|
---|
396 | ;;; ********************************
|
---|
397 | ;;; Check for XP *******************
|
---|
398 | ;;; ********************************
|
---|
399 |
|
---|
400 | ;; If the XP package is available, add :XP to *features* so that
|
---|
401 | ;; the conditional read macros will work.
|
---|
402 | (when (find-package "XP") (push :XP *FEATURES*))
|
---|
403 |
|
---|
404 | ;;; ********************************
|
---|
405 | ;;; Utilities **********************
|
---|
406 | ;;; ********************************
|
---|
407 |
|
---|
408 | (defmacro extract-documentation (body)
|
---|
409 | `(when (and (stringp (car ,body))
|
---|
410 | (cdr ,body))
|
---|
411 | (pop ,body)))
|
---|
412 |
|
---|
413 | (defun atom-or-car (list-or-atom)
|
---|
414 | (if (listp list-or-atom)
|
---|
415 | (first list-or-atom)
|
---|
416 | list-or-atom))
|
---|
417 |
|
---|
418 | ;;; ********************************
|
---|
419 | ;;; Documentation Handlers *********
|
---|
420 | ;;; ********************************
|
---|
421 | (defvar *documentation-handlers* (make-hash-table :test #'equal)
|
---|
422 | "Hash table of entries of the form (handler description),
|
---|
423 | where definer is the car of the definition form handled (for example,
|
---|
424 | DEFUN or DEFMACRO), handler is a function which takes the form as input
|
---|
425 | and value-returns the name, argument-list and documentation string,
|
---|
426 | and description is a one-word equivalent of definer (for example,
|
---|
427 | FUNCTION or MACRO).")
|
---|
428 |
|
---|
429 | (defmacro define-doc-handler (definer arglist description &body body)
|
---|
430 | "Defines a new documentation handler. DEFINER is the car of the
|
---|
431 | definition form handled (e.g., defun), DESCRIPTION is a one-word
|
---|
432 | string equivalent of definer (e.g., \"function\"), and ARGLIST
|
---|
433 | and BODY together define a function that takes the form as input
|
---|
434 | and value-returns the name, argument-list, documentation string,
|
---|
435 | and a list of any qualifiers of the form."
|
---|
436 | `(setf (gethash ',definer *documentation-handlers*)
|
---|
437 | (list #'(lambda ,arglist
|
---|
438 | ,@body)
|
---|
439 | ,description)))
|
---|
440 |
|
---|
441 | (defun find-doc-handler (definer)
|
---|
442 | "Given the car of a form, finds the appropriate documentation
|
---|
443 | handler for the form if one exists."
|
---|
444 | (gethash definer *documentation-handlers*))
|
---|
445 |
|
---|
446 | (define-doc-handler define-doc-handler (form)
|
---|
447 | "doc-handler"
|
---|
448 | ;; name arglist documentation-string
|
---|
449 | (values (second form)
|
---|
450 | (third form)
|
---|
451 | (format nil "Documentation handler for ~A~P."
|
---|
452 | (fourth form) 2)))
|
---|
453 |
|
---|
454 | ;;; Changed the return form for the arguments in defvar, defconstant
|
---|
455 | ;;; and defparameter (basically 'listified' them).
|
---|
456 |
|
---|
457 | (define-doc-handler defvar (form)
|
---|
458 | "variable"
|
---|
459 | ;; name arglist documentation-string
|
---|
460 | (values (second form)
|
---|
461 | (list (third form))
|
---|
462 | (fourth form)))
|
---|
463 |
|
---|
464 | (define-doc-handler defconstant (form)
|
---|
465 | "constant"
|
---|
466 | ;; name arglist documentation-string
|
---|
467 | (values (second form)
|
---|
468 | (list (third form))
|
---|
469 | (fourth form)))
|
---|
470 |
|
---|
471 | (define-doc-handler defparameter (form)
|
---|
472 | "parameter"
|
---|
473 | ;; name arglist documentation-string
|
---|
474 | (values (second form)
|
---|
475 | (list (third form))
|
---|
476 | (fourth form)))
|
---|
477 |
|
---|
478 | (define-doc-handler defun (form)
|
---|
479 | "function"
|
---|
480 | ;; name arglist documentation-string
|
---|
481 | (values (second form)
|
---|
482 | (third form)
|
---|
483 | (when (stringp (fourth form)) (fourth form))))
|
---|
484 |
|
---|
485 | (define-doc-handler defconstraint (form)
|
---|
486 | "constraint"
|
---|
487 | ;; name super-types arglist documentation-string
|
---|
488 | (let ((superclass-names (third form)))
|
---|
489 | (values (second form)
|
---|
490 | (fourth form)
|
---|
491 | (format nil "~@[~A~]~%Superclasses~%~:[~:(~A~)~;~{~(~A~)~}~]"
|
---|
492 | (when (stringp (fifth form)) (fifth form))
|
---|
493 | superclass-names (or superclass-names "None."))))) ; super-types
|
---|
494 |
|
---|
495 | (define-doc-handler defdaemon (form)
|
---|
496 | "daemon"
|
---|
497 | ;; name super-types arglist documentation-string
|
---|
498 | (let ((superclass-names (third form)))
|
---|
499 | (values (second form)
|
---|
500 | (fourth form)
|
---|
501 | (format nil "~@[~A~]~%Superclasses~%~:[~:(~A~)~;~{~(~A~)~}~]"
|
---|
502 | (when (stringp (fifth form)) (fifth form))
|
---|
503 | superclass-names (or superclass-names "None."))))) ; super-types
|
---|
504 |
|
---|
505 | (define-doc-handler defmacro (form)
|
---|
506 | "macro"
|
---|
507 | ;; name arglist documentation-string
|
---|
508 | (values (second form)
|
---|
509 | (third form)
|
---|
510 | (when (stringp (fourth form)) (fourth form))))
|
---|
511 |
|
---|
512 | (define-doc-handler defstruct (form)
|
---|
513 | "structure"
|
---|
514 | ;; name arglist documentation-string
|
---|
515 | (values (atom-or-car (second form))
|
---|
516 | (mapcar #'atom-or-car
|
---|
517 | (if (stringp (third form))
|
---|
518 | (cdddr form)
|
---|
519 | (cddr form)))
|
---|
520 | (third form)))
|
---|
521 |
|
---|
522 | (define-doc-handler define-condition (form)
|
---|
523 | "condition"
|
---|
524 | (values (cadr form)
|
---|
525 | ;; handled here like defstruct.
|
---|
526 | ;; might want to skip this and return nil.
|
---|
527 | (mapcar #'atom-or-car (fourth form))
|
---|
528 | (cadr (find :documentation (nthcdr 4 form) :key #'car))))
|
---|
529 |
|
---|
530 | (define-doc-handler DEFTYPE (form)
|
---|
531 | "type"
|
---|
532 | (let ((name (second form))
|
---|
533 | (args (third form))
|
---|
534 | doc def)
|
---|
535 | (setq form (cdddr form))
|
---|
536 | (setq doc (extract-documentation form))
|
---|
537 | (when (null (cdr form))
|
---|
538 | (setq def (car form)))
|
---|
539 | ;; We give a try at the type definition if the body of the deftype
|
---|
540 | ;; form consists of a single form.
|
---|
541 | (if def
|
---|
542 | (values name def doc (list args))
|
---|
543 | (values name args doc))))
|
---|
544 |
|
---|
545 | #|
|
---|
546 | (define-doc-handler DEFTYPE (form)
|
---|
547 | "type"
|
---|
548 | (values (second form)
|
---|
549 | (third form)
|
---|
550 | (fourth form)))
|
---|
551 | |#
|
---|
552 |
|
---|
553 | (define-doc-handler DEFSETF (form)
|
---|
554 | "setf mapping"
|
---|
555 | ;; name args doc.
|
---|
556 | ;; defsetf has two formats:
|
---|
557 | ;; (defsetf name update-fn doc)
|
---|
558 | ;; (defsetf name lambda-list (store-variable) doc-string body)
|
---|
559 | (cond ((listp (third form))
|
---|
560 | ;; long format
|
---|
561 | (values `(setf ,(second form))
|
---|
562 | (fourth form) ; store variable
|
---|
563 | (fifth form)))
|
---|
564 | (t
|
---|
565 | ;; short format
|
---|
566 | (values `(setf ,(second form))
|
---|
567 | (third form)
|
---|
568 | (fourth form)))))
|
---|
569 |
|
---|
570 | ;;; ********************************
|
---|
571 | ;;; CLOS Related *******************
|
---|
572 | ;;; ********************************
|
---|
573 |
|
---|
574 | (define-doc-handler DEFMETHOD (form)
|
---|
575 | "method"
|
---|
576 | ;; name arglist documentation-string
|
---|
577 | ;; (defmethod name {qualifiers}* lambda-list [ {decl}* || doc ] body)
|
---|
578 | (let (name quals args doc)
|
---|
579 | (setf name (second form))
|
---|
580 | (do ((form (cddr form) (cdr form)))
|
---|
581 | ((or (null form)
|
---|
582 | ;; qualifiers are non-nil atoms while lambda-list is a list.
|
---|
583 | (listp (car form)))
|
---|
584 | (setq quals (nreverse quals))
|
---|
585 | (setq args (car form))
|
---|
586 | (setq form (cdr form))
|
---|
587 | (setq doc (extract-documentation form))
|
---|
588 | (values name args doc quals))
|
---|
589 | (when (atom (car form))
|
---|
590 | (push (car form) quals)))))
|
---|
591 |
|
---|
592 | #|
|
---|
593 | (define-doc-handler DEFMETHOD (form)
|
---|
594 | "method"
|
---|
595 | ;; name arglist documentation-string
|
---|
596 | (let* ((name (second form))
|
---|
597 | (qual (when (symbolp (third form)) (third form)))
|
---|
598 | (args (if qual
|
---|
599 | (cons qual (fourth form))
|
---|
600 | (third form)))
|
---|
601 | (doc (if qual (fifth form) (fourth form))))
|
---|
602 | (values name args doc)))
|
---|
603 |
|
---|
604 | ;; Dick's version:
|
---|
605 | (define-doc-handler defmethod (form)
|
---|
606 | "method"
|
---|
607 | ;; name arglist documentation-string
|
---|
608 | (if (listp (third form))
|
---|
609 | (values (second form)
|
---|
610 | (third form)
|
---|
611 | (format nil "Primary method~%~A"
|
---|
612 | (if (stringp (fourth form))
|
---|
613 | (fourth form)
|
---|
614 | "")))
|
---|
615 | (values (second form)
|
---|
616 | (fourth form)
|
---|
617 | (format nil ":~A method~%~A"
|
---|
618 | (third form)
|
---|
619 | (if (stringp (fifth form))
|
---|
620 | (fifth form)
|
---|
621 | "")))))
|
---|
622 |
|
---|
623 | |#
|
---|
624 |
|
---|
625 | ;;; DEFGENERIC: misses many options (eg, compile optimizations, etc.)
|
---|
626 | (define-doc-handler DEFGENERIC (form)
|
---|
627 | "generic function"
|
---|
628 | ;; name arglist documentation-string
|
---|
629 | (values (second form)
|
---|
630 | (third form)
|
---|
631 | ;; doc-string is embedded in body of DEFGENERIC:
|
---|
632 | (second (assoc :documentation (cdddr form)))))
|
---|
633 |
|
---|
634 | (defun listify (x)
|
---|
635 | (if (null x)
|
---|
636 | x
|
---|
637 | (if (atom x)
|
---|
638 | (list x)
|
---|
639 | x)))
|
---|
640 |
|
---|
641 | (defun null-or-cdr (l)
|
---|
642 | (if l
|
---|
643 | (cdr l)
|
---|
644 | l))
|
---|
645 |
|
---|
646 | (defun null-or-cadr (l)
|
---|
647 | (if l
|
---|
648 | (cadr l)
|
---|
649 | l))
|
---|
650 |
|
---|
651 | (define-doc-handler DEFCLASS (form)
|
---|
652 | "class"
|
---|
653 | ;; name super-types slots &rest options
|
---|
654 | (let ((class-options (nthcdr 4 form))
|
---|
655 | (class-name (second form))
|
---|
656 | (superclass-names (third form))
|
---|
657 | (slots (fourth form)))
|
---|
658 | (values class-name
|
---|
659 | :blank ; no args per se
|
---|
660 | (format nil "~@[~A~]~@[~%Metaclass~%~(~A~)~]~%Superclasses~%~:[~:(~A~)~;~{~(~A~)~}~]~
|
---|
661 | ~%Initialization Arguments~:[~%None.~;~@[~:{~@[~%The :~(~A~) argument is a ~@[~(~A~)~]~]~}~]~]~
|
---|
662 | ~%Readers~:[~%None.~;~@[~{~@[~{~@[~{~%~(~A~)~AGeneric Function~
|
---|
663 | ~%~A~(~A~)~
|
---|
664 | ~%Returns ~@[~A~]~
|
---|
665 | ~}~]~
|
---|
666 | ~}~]~
|
---|
667 | ~}~]~]~
|
---|
668 | ~%Writers~:[~%None.~;~@[~{~@[~{~@[~{~%setf (~(~A~) ~(~A~))~AGeneric Setf Form~
|
---|
669 | ~%~A~(~A~)~
|
---|
670 | ~%The ~(~A~) argument should be a ~
|
---|
671 | ~@[~A~]~
|
---|
672 | ~}~]~
|
---|
673 | ~}~]~
|
---|
674 | ~}~]~]"
|
---|
675 | ;; Class documentation
|
---|
676 | (second (assoc :documentation class-options))
|
---|
677 | ;; Metaclass
|
---|
678 | (second (assoc :metaclass class-options))
|
---|
679 | ;; Superclasses
|
---|
680 | superclass-names (or superclass-names "None.")
|
---|
681 | slots
|
---|
682 | (mapcar #'(lambda (slot)
|
---|
683 | (if (atom slot)
|
---|
684 | nil
|
---|
685 | (let ((key (null-or-cadr (member :initarg slot))))
|
---|
686 | (if key
|
---|
687 | (list key
|
---|
688 | (null-or-cadr (member :type slot)))
|
---|
689 | nil))))
|
---|
690 | slots)
|
---|
691 | slots
|
---|
692 | (mapcar #'(lambda (slot)
|
---|
693 | (if (atom slot)
|
---|
694 | nil
|
---|
695 | (mapcar #'(lambda (acc)
|
---|
696 | (list acc #\tab
|
---|
697 | #\tab class-name
|
---|
698 | (null-or-cadr (member :documentation slot))
|
---|
699 | ))
|
---|
700 | (append (listify (null-or-cadr (member :reader slot)))
|
---|
701 | (listify (null-or-cadr (member :accessor slot)))))))
|
---|
702 |
|
---|
703 | slots)
|
---|
704 | slots
|
---|
705 | (mapcar #'(lambda (slot)
|
---|
706 | (if (atom slot)
|
---|
707 | nil
|
---|
708 | (mapcar #'(lambda (acc)
|
---|
709 | (list acc class-name #\tab
|
---|
710 | #\tab acc
|
---|
711 | acc
|
---|
712 | (null-or-cadr (member :documentation slot))
|
---|
713 | ))
|
---|
714 | (append (listify (null-or-cadr (member :writer slot)))
|
---|
715 | (listify (null-or-cadr (member :accessor slot)))))))
|
---|
716 |
|
---|
717 | slots)
|
---|
718 | ))))
|
---|
719 |
|
---|
720 |
|
---|
721 | ;;; ********************************
|
---|
722 | ;;; Doc Handlers for Lucid's FFI ***
|
---|
723 | ;;; ********************************
|
---|
724 | ;;; Doc-handlers for Lucid's foreign function interface
|
---|
725 |
|
---|
726 | #+:lucid
|
---|
727 | (define-doc-handler def-foreign-synonym-type (form)
|
---|
728 | "foreign synonym type"
|
---|
729 | (values (second form) (third form) nil))
|
---|
730 |
|
---|
731 | #+:lucid
|
---|
732 | (define-doc-handler def-foreign-struct (form)
|
---|
733 | "foreign synonym type"
|
---|
734 | (values (second form)
|
---|
735 | (mapcar #'car
|
---|
736 | (cddr form))
|
---|
737 | nil))
|
---|
738 |
|
---|
739 | #+:lucid
|
---|
740 | (define-doc-handler def-foreign-function (form)
|
---|
741 | "foreign function"
|
---|
742 | (values (atom-or-car (second form))
|
---|
743 | (if (stringp (third form))
|
---|
744 | (cddr form)
|
---|
745 | (cdddr form))
|
---|
746 | (third form)))
|
---|
747 |
|
---|
748 |
|
---|
749 | |
---|
750 |
|
---|
751 | ;;; ********************************
|
---|
752 | ;;; Create User Manual *************
|
---|
753 | ;;; ********************************
|
---|
754 | (defvar *failed-definition-types* nil
|
---|
755 | "List of definition types that create-user-manual couldn't handle.")
|
---|
756 |
|
---|
757 | (defun create-user-manual (filename &key
|
---|
758 | (output-format 'text)
|
---|
759 | (output-stream *standard-output*)
|
---|
760 | (purge-latex t)
|
---|
761 | (purge-latex-in-doc-strings t))
|
---|
762 | "Automatically creates a user manual for the functions in a file by
|
---|
763 | collecting the documentation strings and argument lists of the
|
---|
764 | functions and formatting the output nicely. Returns a list of the
|
---|
765 | definition types of the forms it couldn't handle. Output-format may
|
---|
766 | be either 'TEXT, 'SCRIBE or 'LATEX. In this last case the extra
|
---|
767 | keyword 'purge-latex' may be specified: if non nil the latex filter
|
---|
768 | will try to substitute possible dangerous characters like '&', '\\' and
|
---|
769 | '#'."
|
---|
770 | (setq *failed-definition-types* nil)
|
---|
771 | (with-open-file (stream filename :direction :input)
|
---|
772 | (let ((eof (gensym)))
|
---|
773 | (format t "~%;;; Formatting ")
|
---|
774 | (case output-format
|
---|
775 | ((text :text) (format t "text"))
|
---|
776 | ((scribe :scribe) (format t "SCRIBE"))
|
---|
777 | ((latex :latex) (format t "LaTeX")))
|
---|
778 | (format t " manual from Lisp file: ~a" filename)
|
---|
779 | (do ((form (read stream nil eof nil)
|
---|
780 | (read stream nil eof nil)))
|
---|
781 | ((eq form eof)
|
---|
782 | *failed-definition-types*)
|
---|
783 | (when (listp form)
|
---|
784 | (handle-form-output form
|
---|
785 | output-format
|
---|
786 | output-stream
|
---|
787 | purge-latex
|
---|
788 | purge-latex-in-doc-strings))))))
|
---|
789 |
|
---|
790 | (defun handle-form-output (form &optional (output-format 'text)
|
---|
791 | (stream *standard-output*)
|
---|
792 | (purge-latex t)
|
---|
793 | (purge-latex-in-doc-strings t))
|
---|
794 | "This function takes a form as input and outputs its documentation
|
---|
795 | segment to the output stream."
|
---|
796 | (let* ((key (first form))
|
---|
797 | (handler-entry (find-doc-handler key)))
|
---|
798 | (cond (handler-entry
|
---|
799 | (let ((handler (first handler-entry))
|
---|
800 | (type (second handler-entry))
|
---|
801 | )
|
---|
802 | (multiple-value-bind (name args documentation qualifiers)
|
---|
803 | (funcall handler form)
|
---|
804 | (let ((name-length 0)
|
---|
805 | (args (cond ((stringp args) ; variable
|
---|
806 | (format nil "~S" args))
|
---|
807 | ((null args)
|
---|
808 | "()")
|
---|
809 | ((eq args :blank) "")
|
---|
810 | (t args)))
|
---|
811 | (type-pos (- 80 1)) ; 1 for right margin
|
---|
812 | (args-list-form args)
|
---|
813 | )
|
---|
814 | (setq name (format nil "~:@(~A~)~@[~{ ~S~}~]" name qualifiers)
|
---|
815 | type (format nil "~:@(~A~)" type)
|
---|
816 | name-length (length name)
|
---|
817 | )
|
---|
818 | ;; subtract the width of [type]
|
---|
819 | (decf type-pos (+ (length type) 2))
|
---|
820 | (let ((width (- type-pos (+ 1 4 1 ) name-length)))
|
---|
821 | (unless (or (eq output-format 'text)
|
---|
822 | (eq output-format :text))
|
---|
823 | ;; Add in the width of ";;; " since we use it
|
---|
824 | ;; only in text mode.
|
---|
825 | (incf width 4))
|
---|
826 | (setq args
|
---|
827 | #+:XP(xp-split-string args width)
|
---|
828 | #-:XP(split-string (format nil "~(~S~)" args)
|
---|
829 | width t)))
|
---|
830 | (ccase output-format
|
---|
831 | ((text :text)
|
---|
832 | (output-text-documentation name type args documentation
|
---|
833 | name-length type-pos
|
---|
834 | stream))
|
---|
835 | ((scribe :scribe)
|
---|
836 | (output-scribe-documentation name type args documentation
|
---|
837 | stream))
|
---|
838 | ((latex :latex)
|
---|
839 | (output-latex-documentation name type
|
---|
840 | args-list-form
|
---|
841 | documentation
|
---|
842 | stream
|
---|
843 | purge-latex
|
---|
844 | purge-latex-in-doc-strings)))
|
---|
845 | ))))
|
---|
846 | ((eq key 'eval-when)
|
---|
847 | (dolist (f (cddr form))
|
---|
848 | (handle-form-output f output-format stream)))
|
---|
849 | (t
|
---|
850 | (pushnew key *failed-definition-types*)))))
|
---|
851 |
|
---|
852 | (defun find-keyword (sym)
|
---|
853 | (find-symbol (symbol-name sym) :keyword))
|
---|
854 |
|
---|
855 | (defun output-frame-documentation (name type args documentation
|
---|
856 | &optional (stream *standard-output*))
|
---|
857 | "Prints out the user guide entry for a form in FrameMaker(tm) mode."
|
---|
858 | (format stream "~%~A~A~A~%" name #\tab (string-capitalize (symbol-name type)))
|
---|
859 | (when (and args (not (equal args '(()))))
|
---|
860 | (format stream "Syntax~%")
|
---|
861 | (format stream "~A" name)
|
---|
862 | (format stream "~A" #\tab)
|
---|
863 | (let ((&rest-p nil)
|
---|
864 | (&key-p nil)
|
---|
865 | (&aux-p nil)
|
---|
866 | (&optional-p nil)
|
---|
867 | (first-&aux-p t)
|
---|
868 | (first-&key-p t)
|
---|
869 | (first-&optional-p t))
|
---|
870 | (dolist (arg args)
|
---|
871 | (case arg
|
---|
872 | (&rest (setf &rest-p t)
|
---|
873 | (setf &key-p nil)
|
---|
874 | (setf &optional-p nil)
|
---|
875 | (format stream "~%~A&rest~A" #\tab #\tab))
|
---|
876 | (&key (setf &key-p t)
|
---|
877 | (setf &rest-p nil)
|
---|
878 | (setf &optional-p nil)
|
---|
879 | (format stream "~%~A&key~A" #\tab #\tab))
|
---|
880 | (&optional (setf &optional-p t)
|
---|
881 | (setf &rest-p nil)
|
---|
882 | (setf &key-p nil)
|
---|
883 | (format stream "~%~A&optional~A" #\tab #\tab))
|
---|
884 | (&aux (setf &aux-p t)
|
---|
885 | (setf &rest-p nil)
|
---|
886 | (setf &key-p nil)
|
---|
887 | (setf &optional-p nil)
|
---|
888 | (format stream "~%~A&aux" #\tab))
|
---|
889 | (t (cond (&rest-p
|
---|
890 | (format stream "~(~A~)" arg))
|
---|
891 | (&aux-p
|
---|
892 | (unless first-&aux-p
|
---|
893 | (format stream "~%~%~A~A" #\tab #\tab)
|
---|
894 | (setf first-&aux-p nil))
|
---|
895 | (format stream "~(~A~)" arg))
|
---|
896 | (&key-p
|
---|
897 | (unless first-&key-p
|
---|
898 | (format stream "~%~%~A~A" #\tab #\tab)
|
---|
899 | (setf first-&key-p nil))
|
---|
900 | (if (listp arg)
|
---|
901 | (let ((key (car arg)))
|
---|
902 | (if (listp key)
|
---|
903 | (format stream "~((:~A ~A)~)"
|
---|
904 | (car key)
|
---|
905 | (second arg))
|
---|
906 | (format stream "(:~(~A~) ~(~A)~)"
|
---|
907 | key
|
---|
908 | (second arg))))
|
---|
909 | (format stream "~(~A~) " arg)))
|
---|
910 | (&optional-p
|
---|
911 | (unless first-&optional-p
|
---|
912 | (format stream "~%~%~A~A" #\tab #\tab)
|
---|
913 | (setf first-&optional-p nil))
|
---|
914 | (format stream "~(~A~) "
|
---|
915 | (if (listp arg)
|
---|
916 | (cons (car arg) (cadr arg))
|
---|
917 | arg)))
|
---|
918 | (t ;;(if (listp arg)
|
---|
919 | ;; (format stream "(~(~A~) ~(~A~))" (first arg) (second arg))
|
---|
920 | (format stream "~%~A~(~A~)" #\tab arg)))))))
|
---|
921 | (when args
|
---|
922 | (format stream "~%Arguments")
|
---|
923 | (let ((&rest-p nil)
|
---|
924 | (&key-p nil)
|
---|
925 | (&optional-p nil))
|
---|
926 | (dolist (arg args)
|
---|
927 | (case arg
|
---|
928 | (&rest (setf &rest-p t))
|
---|
929 | (&key (setf &key-p t)
|
---|
930 | (setf &rest-p nil)
|
---|
931 | (setf &optional-p nil))
|
---|
932 | (&optional (setf &optional-p t)
|
---|
933 | (setf &rest-p nil)
|
---|
934 | (setf &key-p nil))
|
---|
935 | (&aux (setf &rest-p nil)
|
---|
936 | (setf &key-p nil)
|
---|
937 | (setf &optional-p nil))
|
---|
938 | (&allow-other-keys (setf &rest-p nil))
|
---|
939 | (t (cond (&rest-p
|
---|
940 | (format stream "~%The ~(~A~) argument consists of " arg)
|
---|
941 | (setf &rest-p nil))
|
---|
942 | (t (format stream "~%The ")
|
---|
943 | (cond (&key-p
|
---|
944 | (if (listp arg)
|
---|
945 | (let ((key (car arg)))
|
---|
946 | (format stream ":~(~A~)"
|
---|
947 | (if (listp key)
|
---|
948 | (car key)
|
---|
949 | key)))
|
---|
950 | (format stream ":~(~A~)" arg)))
|
---|
951 | (&optional-p
|
---|
952 | (format stream "~(~A~)"
|
---|
953 | (if (listp arg)
|
---|
954 | (car arg)
|
---|
955 | arg)))
|
---|
956 | (t (if (listp arg)
|
---|
957 | (format stream "~(~A~)" (car arg))
|
---|
958 | (format stream "~(~A~)" arg))))
|
---|
959 | (format stream " argument is a "))))))))
|
---|
960 | (format stream "~%Values~%The result is ")
|
---|
961 | (format stream "~%Purpose"))
|
---|
962 | (when (stringp documentation)
|
---|
963 | (format stream "~%")
|
---|
964 | (format stream documentation)))
|
---|
965 |
|
---|
966 | (defun output-text-documentation (name type args documentation args-tab-pos
|
---|
967 | type-pos
|
---|
968 | &optional (stream *standard-output*))
|
---|
969 | "Prints out the user guide entry for a form in TEXT mode."
|
---|
970 | (format stream "~%;;; ~A ~A ~VT[~A]" name (first args) type-pos type)
|
---|
971 | (dolist (arg (rest args))
|
---|
972 | (format stream "~%;;; ~0,1,V,' @A"
|
---|
973 | (+ #+:XP 1 #-:XP 2 args-tab-pos)
|
---|
974 | arg))
|
---|
975 | (when (stringp documentation)
|
---|
976 | ;; We give a line width of 70 characters for documentation
|
---|
977 | ;; strings. This leaves us room for a left margin of
|
---|
978 | ;; ";;; " and a right margin of 3 spaces (2 chars left of []).
|
---|
979 | (dolist (string (split-string documentation 70 nil nil nil))
|
---|
980 | (format stream "~&;;; ~A" string)))
|
---|
981 | (format stream "~%;;;"))
|
---|
982 |
|
---|
983 | (defun output-scribe-documentation (name type args documentation
|
---|
984 | &optional (stream *standard-output*))
|
---|
985 | "Prints out the user guide entry for a form in SCRIBE mode."
|
---|
986 | (format stream "~%@begin(format,group)~%@tabclear()")
|
---|
987 | (format stream "~%@t[~(~A~)] @^~A@>[~:(~A~)]"
|
---|
988 | name (first args) type)
|
---|
989 | (dolist (arg (rest args))
|
---|
990 | (format stream #+:XP "~%@\\@ ~A" #-:XP "~%@\\~A"
|
---|
991 | arg))
|
---|
992 | (format stream "~%@tabclear()")
|
---|
993 | ;; (format stream "~%@hinge()")
|
---|
994 | (format stream "~%@begin(quotation,indent 0,size +0)")
|
---|
995 | (when (stringp documentation)
|
---|
996 | (dolist (string (split-string documentation 70 nil nil nil))
|
---|
997 | (format stream "~%~A" string)))
|
---|
998 | (format stream "~%@end(quotation)~%@end(format)~%"))
|
---|
999 |
|
---|
1000 | (defun output-latex-documentation (name type args documentation
|
---|
1001 | &optional
|
---|
1002 | (stream *standard-output*)
|
---|
1003 | (purge-documentation t)
|
---|
1004 | (purge-documentation-in-doc-strings t))
|
---|
1005 | "Prints out the user guide entry for a form in LaTeX mode."
|
---|
1006 | (format stream "\\begin{lisp:documentation}")
|
---|
1007 | (format stream "{~(~A~)}{~A}" (purge-string-for-latex name purge-documentation) type)
|
---|
1008 | (format stream "~:[{\\ }~;{~{~(~A~) ~}}~]~%"
|
---|
1009 | args (preprocess-lisp-latex-clashes args purge-documentation))
|
---|
1010 | (if (stringp documentation)
|
---|
1011 | (format stream "~{~A~%~}"
|
---|
1012 | (split-string (purge-string-for-latex documentation
|
---|
1013 | purge-documentation-in-doc-strings)
|
---|
1014 | 70 nil nil nil))
|
---|
1015 | (format stream "{\\ } % NO DOCUMENTATION FOR ~A~%" name))
|
---|
1016 | (format stream "\\end{lisp:documentation}~2%"))
|
---|
1017 |
|
---|
1018 | (defun purge-string-for-latex (a-string purge-doc)
|
---|
1019 | "Tries to purge a string from characters that are potentially
|
---|
1020 | dangerous for LaTeX."
|
---|
1021 | (if purge-doc
|
---|
1022 | (with-input-from-string (a-str a-string)
|
---|
1023 | (with-output-to-string (result)
|
---|
1024 | (let ((eos (gensym)))
|
---|
1025 | (do ((c (read-char a-str nil eos nil)
|
---|
1026 | (read-char a-str nil eos nil)))
|
---|
1027 | ((eq c eos) result)
|
---|
1028 | (case c
|
---|
1029 | (#\& (format result "\\&"))
|
---|
1030 | (#\\ (format result "$\\backslash$")) ; I have to
|
---|
1031 | ; resort to math
|
---|
1032 | ; mode to do this.
|
---|
1033 | (#\# (format result "\\#"))
|
---|
1034 | (#\$ (format result "\\$"))
|
---|
1035 | (#\% (format result "\\%"))
|
---|
1036 | (#\{ (format result "\\{"))
|
---|
1037 | (#\} (format result "\\}"))
|
---|
1038 | (#\_ (format result "\\_}"))
|
---|
1039 | (#\> (format result "$>$")) ;how to do this right? (M.R)
|
---|
1040 | (#\< (format result "$<$"))
|
---|
1041 | (#\^ (format result "\\symbol{94}"))
|
---|
1042 | (#\~ (format result "\\symbol{126}"))
|
---|
1043 | (t (format result "~C" c)))))
|
---|
1044 | ))
|
---|
1045 | a-string
|
---|
1046 | ))
|
---|
1047 |
|
---|
1048 | (defun preprocess-lambda-keywords (args)
|
---|
1049 | "Unused"
|
---|
1050 | (mapcar #'(lambda (arg)
|
---|
1051 | (if (member arg lambda-list-keywords :test #'eq)
|
---|
1052 | (format nil "{\\sf \\~(~A~)}" arg)
|
---|
1053 | arg))
|
---|
1054 | args))
|
---|
1055 |
|
---|
1056 | (defun preprocess-lisp-latex-clashes (args purge-doc)
|
---|
1057 | "This function is used to make the strings for the arguments of the
|
---|
1058 | form digestible for LaTeX, e.g. by removing '#' and '&'."
|
---|
1059 | (if (stringp args)
|
---|
1060 | (list args)
|
---|
1061 | (mapcar #'(lambda (arg)
|
---|
1062 | (cond ((member arg lambda-list-keywords :test #'eq)
|
---|
1063 | (format nil "{\\sf \\~(~A~)}" arg))
|
---|
1064 | ((listp arg) ; OK OK I am missing cons cells!
|
---|
1065 | (preprocess-specials arg purge-doc))
|
---|
1066 | ((characterp arg)
|
---|
1067 | (preprocess-character arg))
|
---|
1068 | (t (purge-string-for-latex
|
---|
1069 | (format nil "~S" arg)
|
---|
1070 | purge-doc))))
|
---|
1071 | args)))
|
---|
1072 |
|
---|
1073 | (defun preprocess-character (c)
|
---|
1074 | "Low level processing of single characters, when passed as defaults
|
---|
1075 | to optional, key and aux parameters."
|
---|
1076 | ;; The stupid LaTeX manual does not tell be how to produce a single
|
---|
1077 | ;; '\' without being in math mode, so I have to trick it.
|
---|
1078 | (case c
|
---|
1079 | (#\newline "\\#$\\backslash${newline}")
|
---|
1080 | (#\space "\\#$\\backslash${space}")
|
---|
1081 | (#\rubout "\\#$\\backslash${rubout}")
|
---|
1082 | (#\page "\\#$\\backslash${page}")
|
---|
1083 | (#\backspace "\\#$\\backslash${backspace}")
|
---|
1084 | (#\return "\\#$\\backslash${return}")
|
---|
1085 | (#\linefeed "\\#$\\backslash${linefeed}")
|
---|
1086 | (t c)))
|
---|
1087 |
|
---|
1088 | (defun preprocess-specials (list-form purge-doc)
|
---|
1089 | "Processing of some 'special' forms. Only 'quote' and 'function' are
|
---|
1090 | treated for the time being."
|
---|
1091 | (case (first list-form)
|
---|
1092 | (function
|
---|
1093 | (format nil "\\#'~A"
|
---|
1094 | (purge-string-for-latex
|
---|
1095 | (format nil "~A" (second list-form))
|
---|
1096 | purge-doc)))
|
---|
1097 | (quote
|
---|
1098 | (format nil "'~A"
|
---|
1099 | (purge-string-for-latex
|
---|
1100 | (format nil "~A" (second list-form))
|
---|
1101 | purge-doc)))
|
---|
1102 | (t (preprocess-lisp-latex-clashes list-form purge-doc))))
|
---|
1103 |
|
---|
1104 | #+:XP
|
---|
1105 | (defun xp-split-string (arglist width)
|
---|
1106 | "PPrints the arglist into a string of specified width. Assumes
|
---|
1107 | that we're running the XP pretty printer."
|
---|
1108 | (let ((xp::*default-right-margin* width)
|
---|
1109 | (xp::*print-miser-width* 30)
|
---|
1110 | string)
|
---|
1111 | (cond ((stringp arglist) (list arglist))
|
---|
1112 | (t
|
---|
1113 | (setq string
|
---|
1114 | (with-output-to-string (stream) (pprint arglist stream)))
|
---|
1115 | (setq string (format nil "~(~A~)" string))
|
---|
1116 | (setq string (remove-if #'(lambda (x) (string-equal x ""))
|
---|
1117 | (parse-with-delimiter string #\newline)))
|
---|
1118 | string))))
|
---|
1119 |
|
---|
1120 | (defun split-string (string width
|
---|
1121 | &optional arglistp filled (trim-whitespace t))
|
---|
1122 | "Splits a string into a list of strings, each of which is shorter
|
---|
1123 | than the specified width. Tries to be intelligent about where to
|
---|
1124 | split the string if it is an argument list. If filled is T,
|
---|
1125 | tries to fill out the strings as much as possible. This function
|
---|
1126 | is used to break up long argument lists nicely, and to break up
|
---|
1127 | wide lines of documentation nicely."
|
---|
1128 | (let ((string-list (parse-with-delimiter string #\newline))
|
---|
1129 | (result nil))
|
---|
1130 | (do* ((rest string-list (rest rest))
|
---|
1131 | (s (car rest) (car rest)))
|
---|
1132 | ((null rest)
|
---|
1133 | (nreverse result))
|
---|
1134 | (multiple-value-bind (first second) (split-point s width arglistp filled)
|
---|
1135 | (if trim-whitespace
|
---|
1136 | (setf first (string-trim '(#\space #\tab) first))
|
---|
1137 | (when (and (> (length first) 0)
|
---|
1138 | (char= (char first 0) #\space))
|
---|
1139 | (if (and (> (length first) 3)
|
---|
1140 | (char= (char first 1) #\space)
|
---|
1141 | (char= (char first 2) #\space)
|
---|
1142 | (not (char= (char first 3) #\space)))
|
---|
1143 | (setf first (string-trim '(#\space #\tab) first))
|
---|
1144 | (setf first (subseq first 1)))))
|
---|
1145 | (when (not (string-equal first ""))
|
---|
1146 | (push first result))
|
---|
1147 | (when (and second (not (string-equal second "")))
|
---|
1148 | (setf rest
|
---|
1149 | (list*
|
---|
1150 | nil
|
---|
1151 | (concatenate 'string
|
---|
1152 | (string-trim '(#\space #\tab) second)
|
---|
1153 | " "
|
---|
1154 | (and (cadr rest)
|
---|
1155 | (string-trim '(#\space #\tab)
|
---|
1156 | (cadr rest))))
|
---|
1157 | (cddr rest))))))))
|
---|
1158 |
|
---|
1159 | ;;; need some way for the last line from an arglist to possibly
|
---|
1160 | ;;; be split, even if it has a perfect fit.
|
---|
1161 | (defun split-point (string max-length &optional arglistp filled)
|
---|
1162 | "Finds an appropriate point to break the string at given a target length.
|
---|
1163 | If arglistp is T, tries to find an intelligent position to break the
|
---|
1164 | string. If filled is T, tries to fill out the string as much as possible."
|
---|
1165 | ;; we probably should split some strings that are short enough anyway
|
---|
1166 | ;; but need a base condition to prevent infinite loops.
|
---|
1167 | (cond ((< (length string) max-length)
|
---|
1168 | (let ((lambda (lambda-list-keyword-position string (length string)
|
---|
1169 | t)))
|
---|
1170 | (if (and arglistp lambda (not (zerop lambda)))
|
---|
1171 | (values (subseq string 0 lambda)
|
---|
1172 | (unless (= lambda (length string))
|
---|
1173 | (subseq string lambda)))
|
---|
1174 | string)))
|
---|
1175 | (t
|
---|
1176 | ;; Find the first space that breaks the arglist.
|
---|
1177 | ;; If parentheses are not balanced at this point,
|
---|
1178 | ;; go to the first balanced paren that isn't at position
|
---|
1179 | ;; zero (actually, the conditions are much more complex).
|
---|
1180 | ;; Then check if the previous "word" is a lambda-list keyword.
|
---|
1181 | ;; This gives it a preference for lambda-list keywords.
|
---|
1182 | (let* ((space-pos (position #\space string :from-end t
|
---|
1183 | :end max-length))
|
---|
1184 | (pos space-pos))
|
---|
1185 | (when arglistp
|
---|
1186 | (let* ((paren (balanced-parenthesis-position
|
---|
1187 | string (or space-pos max-length)))
|
---|
1188 | (lambda (lambda-list-keyword-position
|
---|
1189 | string (or paren max-length))))
|
---|
1190 | (cond ((and lambda paren space-pos arglistp
|
---|
1191 | (not (zerop lambda))
|
---|
1192 | (or (not filled)
|
---|
1193 | (< (- max-length 10) lambda max-length)))
|
---|
1194 | (setq pos lambda))
|
---|
1195 | ((and paren space-pos
|
---|
1196 | arglistp
|
---|
1197 | (not (zerop paren))
|
---|
1198 | (or (not filled)
|
---|
1199 | (< (- max-length 10) paren max-length)))
|
---|
1200 | (setq pos paren)))))
|
---|
1201 | (if pos
|
---|
1202 | (values (subseq string 0 pos)
|
---|
1203 | (unless (= pos (length string))
|
---|
1204 | (subseq string pos)))
|
---|
1205 | string)))))
|
---|
1206 |
|
---|
1207 | (defun lambda-list-keyword-position (string &optional end trailer-only)
|
---|
1208 | "If the previous symbol is a lambda-list keyword, returns
|
---|
1209 | its position. Otherwise returns end."
|
---|
1210 | ;; possibly extend this to also search for colons for keywords?
|
---|
1211 | (when (null end) (setf end (length string)))
|
---|
1212 | (let ((ampersand (position #\& string :from-end t :end end))
|
---|
1213 | (rightmost-space (position #\space string :from-end t :end end)))
|
---|
1214 | (if ampersand
|
---|
1215 | (cond ((find (string-trim '(#\space) (subseq string ampersand end))
|
---|
1216 | lambda-list-keywords
|
---|
1217 | :key #'symbol-name
|
---|
1218 | :test #'string-equal)
|
---|
1219 | ampersand)
|
---|
1220 | ((and rightmost-space (not trailer-only)
|
---|
1221 | (< ampersand rightmost-space)
|
---|
1222 | (find (string-trim '(#\space)
|
---|
1223 | (subseq string
|
---|
1224 | ampersand rightmost-space))
|
---|
1225 | lambda-list-keywords
|
---|
1226 | :key #'symbol-name
|
---|
1227 | :test #'string-equal))
|
---|
1228 | ampersand)
|
---|
1229 | (t
|
---|
1230 | end))
|
---|
1231 | end)))
|
---|
1232 |
|
---|
1233 | (defun balanced-parenthesis-position (string &optional end)
|
---|
1234 | "Finds the position of the left parenthesis which is closest to END
|
---|
1235 | but leaves the prefix of the string with balanced parentheses or
|
---|
1236 | at most 1 unbalanced left parenthesis."
|
---|
1237 | (when (null end) (setf end (length string)))
|
---|
1238 | (let* ((num-left (count #\( string :end end))
|
---|
1239 | (num-right (count #\) string :end end))
|
---|
1240 | (imbalance (max 0 (- num-left num-right)))
|
---|
1241 | (leftmost-left-paren (position #\( string :end end))
|
---|
1242 | (leftmost-right-paren (position #\) string :end end))
|
---|
1243 | (rightmost-left-paren (position #\( string :end end :from-end t)))
|
---|
1244 | (cond ((and leftmost-left-paren leftmost-right-paren
|
---|
1245 | (< leftmost-right-paren leftmost-left-paren))
|
---|
1246 | ;; if we have ")(", break after the right paren.
|
---|
1247 | leftmost-left-paren)
|
---|
1248 | ((and leftmost-right-paren (not leftmost-left-paren))
|
---|
1249 | ;; we have a right paren but no left
|
---|
1250 | (1+ (position #\) string :from-end t :end end)))
|
---|
1251 | ((or (= imbalance 0)
|
---|
1252 | (and (or (char= (char string 0) #\()
|
---|
1253 | (char= (char string 0) #\&))
|
---|
1254 | (cond (leftmost-right-paren
|
---|
1255 | ;; there's a right paren and the left
|
---|
1256 | ;; parens before it account for the imbalance
|
---|
1257 | ;; actually, we need to do a fancier balancing
|
---|
1258 | ;; operation here to absorb balanced left
|
---|
1259 | ;; parentheses.
|
---|
1260 | (not (< (1- (count #\( string
|
---|
1261 | :end leftmost-right-paren))
|
---|
1262 | imbalance)))
|
---|
1263 | ((find #\space string :end rightmost-left-paren)
|
---|
1264 | nil)
|
---|
1265 | (t))))
|
---|
1266 | ;; either we're balanced, or the imbalance is due to
|
---|
1267 | ;; left-parens at the left edge.
|
---|
1268 | end)
|
---|
1269 | (t
|
---|
1270 | ;; let's try to reduce the imbalance
|
---|
1271 | (if (and rightmost-left-paren (not (zerop rightmost-left-paren)))
|
---|
1272 | (balanced-parenthesis-position string rightmost-left-paren)
|
---|
1273 | end)))))
|
---|
1274 |
|
---|
1275 | ;;; This was a preliminary BUILD-SYMBOL.
|
---|
1276 | ;;; I've given a more complex implementation of this to Mark
|
---|
1277 | ;;; to include in EXTENSIONS or something like that. - fdmm
|
---|
1278 | (defun um-build-symbol (symbol &key (prefix nil prefix-p)
|
---|
1279 | (suffix nil suffix-p)
|
---|
1280 | (package nil package-p))
|
---|
1281 | "Build a symbol concatenating prefix (if not null), symbol, and suffix (if not null).
|
---|
1282 | The newly generated symbol is interned in package, if not null, or in the SYMBOL-PACKAGE of symbol, otherwise."
|
---|
1283 | (let ((newname (symbol-name symbol)))
|
---|
1284 | (when prefix-p
|
---|
1285 | (setf newname (concatenate 'string (symbol-name prefix) newname)))
|
---|
1286 | (when suffix-p
|
---|
1287 | (setf newname (concatenate 'string newname (symbol-name suffix))))
|
---|
1288 | (if package-p
|
---|
1289 | (intern newname package)
|
---|
1290 | (intern newname (symbol-package symbol)))))
|
---|
1291 |
|
---|
1292 | (defun create-manuals (files &key (prefix nil)
|
---|
1293 | (extension '.cl)
|
---|
1294 | (output-format 'text)
|
---|
1295 | (purge-latex t)
|
---|
1296 | (purge-latex-in-doc-strings t))
|
---|
1297 | (format t "~%;;;~%;;; User manuals will be created in directory ~A~%;;;" (string-downcase prefix))
|
---|
1298 | (loop for file in files do
|
---|
1299 | (WITH-OPEN-FILE
|
---|
1300 | (STREAM (string-downcase
|
---|
1301 | (symbol-name
|
---|
1302 | (um-build-symbol file
|
---|
1303 | :prefix prefix
|
---|
1304 | :suffix (case output-format
|
---|
1305 | ((text :text) '.txt)
|
---|
1306 | ;What would be a `standard' extension for SCRIBE?
|
---|
1307 | ((scribe :scribe) '.scb)
|
---|
1308 | ((frame :frame) '.fm)
|
---|
1309 | ((latex :latex) '.tex)))))
|
---|
1310 | :DIRECTION :OUTPUT
|
---|
1311 | :if-does-not-exist :create
|
---|
1312 | :IF-EXISTS :new-version)
|
---|
1313 | (CREATE-USER-MANUAL (string-downcase (symbol-name
|
---|
1314 | (um-build-symbol file
|
---|
1315 | :suffix extension)))
|
---|
1316 | :OUTPUT-STREAM STREAM
|
---|
1317 | :output-format output-format
|
---|
1318 | :purge-latex purge-latex
|
---|
1319 | :purge-latex-in-doc-strings purge-latex-in-doc-strings)))
|
---|
1320 | (format t "~%;;;~%;;; END OF MANUAL PROCESSING.~%;;;"))
|
---|
1321 |
|
---|
1322 | (defun parse-with-delimiter (line &optional (delim #\newline))
|
---|
1323 | "Breaks LINE into a list of strings, using DELIM as a
|
---|
1324 | breaking point."
|
---|
1325 | ;; what about #\return instead of #\newline?
|
---|
1326 | (let ((pos (position delim line)))
|
---|
1327 | (cond (pos
|
---|
1328 | (cons (subseq line 0 pos)
|
---|
1329 | (parse-with-delimiter (subseq line (1+ pos)) delim)))
|
---|
1330 | (t
|
---|
1331 | (list line)))))
|
---|
1332 |
|
---|
1333 | ;;; ********************************
|
---|
1334 | ;;; Dead Code **********************
|
---|
1335 | ;;; ********************************
|
---|
1336 |
|
---|
1337 | #|
|
---|
1338 | ;(split-string "the quick brown fox jumped over the lazy dogs" 20)
|
---|
1339 |
|
---|
1340 | (split-string "(((&OPTIONAL (NODE (QUOTE NODE)) (QUEUE (QUOTE QUEUE))
|
---|
1341 | (CHILDREN (QUOTE CHILDREN)) VISITED)
|
---|
1342 | INITIAL-QUEUE CHILDREN-FORM &OPTIONAL
|
---|
1343 | (DEQUEUE-FORM (QUOTE (POP QUEUE)))
|
---|
1344 | (MERGE-FORM (QUOTE (SETQ QUEUE (APPEND QUEUE PROGENY))))
|
---|
1345 | RESULT-FORM)
|
---|
1346 | &BODY BODY)" 30 t)
|
---|
1347 |
|
---|
1348 | ;(BALANCED-PARENTHESIS-POSITION "foo the (bar baz) (biz" )
|
---|
1349 |
|
---|
1350 | |#
|
---|
1351 |
|
---|