Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5070:b0f4adffca7d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix so that CL docstrings (with &key, etc.) handled properly -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-23 Ben Wing <ben@xemacs.org> * autoload.el: * autoload.el (make-autoload): * cl-macs.el (cl-function-arglist): * cl-macs.el (cl-transform-lambda): Don't add argument list with the tag "Common Lisp lambda list:"; instead add in "standard" form using "arguments:" and omitting the function name. Add an arg to `cl-function-arglist' to omit the name and use it in autoload.el instead of just hacking it off. * help.el: * help.el (function-arglist): * help.el (function-documentation-1): New. Extract out common code to recognize and/or strip the arglist from documentation into `function-documentation-1'. Use in `function-arglist' and `function-documentation'. Modify `function-arglist' so it looks for the `arguments: ' stuff in all doc strings, not just subrs/autoloads, so that CL functions get recognized properly. Change the regexp used to match "arguments: " specs to allow nested parens inside the arg list (happens when you have a default value specified in a CL arglist).
author Ben Wing <ben@xemacs.org>
date Tue, 23 Feb 2010 01:12:13 -0600
parents 8800b5350a13
children cc74f60c150e
comparison
equal deleted inserted replaced
5069:14f0dd1fabdb 5070:b0f4adffca7d
297 (mapcar 'cl-upcase-arg arg))) 297 (mapcar 'cl-upcase-arg arg)))
298 (t arg))) ; Maybe we are in initializer 298 (t arg))) ; Maybe we are in initializer
299 299
300 ;; npak@ispras.ru 300 ;; npak@ispras.ru
301 ;;;###autoload 301 ;;;###autoload
302 (defun cl-function-arglist (name arglist) 302 (defun cl-function-arglist (name arglist &optional omit-name)
303 "Returns string with printed representation of arguments list. 303 "Returns string with printed representation of arguments list.
304 Supports Common Lisp lambda lists." 304 Supports Common Lisp lambda lists."
305 ;; #### I would just change this so that OMIT-NAME is always true and
306 ;; eliminate the argument, but this function is autoloaded, which means
307 ;; someone might be using it somewhere.
305 (if (not (or (listp arglist) (symbolp arglist))) 308 (if (not (or (listp arglist) (symbolp arglist)))
306 "Not available" 309 "Not available"
307 (check-argument-type #'true-list-p arglist) 310 (check-argument-type #'true-list-p arglist)
308 (let ((print-gensym nil)) 311 (let ((print-gensym nil))
309 (condition-case nil 312 (condition-case nil
310 (prin1-to-string 313 (prin1-to-string
311 (cons (if (eq name 'cl-none) 'lambda name) 314 (let ((args (cond ((null arglist) nil)
312 (cond ((null arglist) nil) 315 ((listp arglist) (cl-upcase-arg arglist))
313 ((listp arglist) (cl-upcase-arg arglist)) 316 ((symbolp arglist)
314 ((symbolp arglist) 317 (cl-upcase-arg (list '&rest arglist)))
315 (cl-upcase-arg (list '&rest arglist))) 318 (t (wrong-type-argument 'listp arglist)))))
316 (t (wrong-type-argument 'listp arglist))))) 319 (if omit-name args
317 (t "Not available"))))) 320 (cons (if (eq name 'cl-none) 'lambda name) args))))
321 (t "Not available")))))
318 322
319 (defun cl-transform-lambda (form bind-block) 323 (defun cl-transform-lambda (form bind-block)
320 (let* ((args (car form)) (body (cdr form)) 324 (let* ((args (car form)) (body (cdr form))
321 (bind-defs nil) (bind-enquote nil) 325 (bind-defs nil) (bind-enquote nil)
322 (bind-inits nil) (bind-lets nil) (bind-forms nil) 326 (bind-inits nil) (bind-lets nil) (bind-forms nil)
323 (header nil) (simple-args nil) 327 (header nil) (simple-args nil)
324 (complex-arglist (cl-function-arglist bind-block args)) 328 (complex-arglist (cl-function-arglist bind-block args t))
325 (doc "")) 329 (doc ""))
326 (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) 330 (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
327 (push (pop body) header)) 331 (push (pop body) header))
328 (setq args (if (listp args) (copy-list args) (list '&rest args))) 332 (setq args (if (listp args) (copy-list args) (list '&rest args)))
329 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) 333 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
346 (setq simple-args (nreverse simple-args) 350 (setq simple-args (nreverse simple-args)
347 header (nreverse header)) 351 header (nreverse header))
348 ;; Add CL lambda list to documentation, if the CL lambda list differs 352 ;; Add CL lambda list to documentation, if the CL lambda list differs
349 ;; from the non-CL lambda list. npak@ispras.ru 353 ;; from the non-CL lambda list. npak@ispras.ru
350 (unless (equal complex-arglist 354 (unless (equal complex-arglist
351 (cl-function-arglist bind-block simple-args)) 355 (cl-function-arglist bind-block simple-args t))
352 (and (stringp (car header)) (setq doc (pop header))) 356 (and (stringp (car header)) (setq doc (pop header)))
353 (push (concat doc 357 ;; Stick the arguments onto the end of the doc string in a way that
354 "\n\nCommon Lisp lambda list:\n" 358 ;; will be recognized specially by `function-arglist'.
355 " " complex-arglist "\n\n") 359 (push (concat doc "\n\narguments: " complex-arglist "\n")
356 header)) 360 header))
357 (if (null args) 361 (if (null args)
358 (list* nil simple-args (nconc header body)) 362 (list* nil simple-args (nconc header body))
359 (if (memq '&optional simple-args) (push '&optional args)) 363 (if (memq '&optional simple-args) (push '&optional args))
360 (cl-do-arglist args nil (- (length simple-args) 364 (cl-do-arglist args nil (- (length simple-args)
361 (if (memq '&optional simple-args) 1 0))) 365 (if (memq '&optional simple-args) 1 0)))