Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5076:d555581e3cba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix issues with display of argument docstrings -------------------- ChangeLog entries follow: -------------------- lib-src/ChangeLog addition: 2010-02-25 Ben Wing <ben@xemacs.org> * make-docfile.c: * make-docfile.c (write_c_args): Convert newlines to spaces so that argument lists are always on one line, because that's what function-documentation-1 expects. lisp/ChangeLog addition: c2010-02-25 Ben Wing <ben@xemacs.org> * autoload.el (make-autoload): Call cl-function-arglist with one arg. * cl-macs.el (cl-function-arglist): * cl-macs.el (cl-transform-lambda): Make cl-function-arglist take only one arg, the arglist; no function name passed. Also make sure to print () instead of nil when empty arglist, or function-documentation-1 won't recognize the arguments: line. * help.el (function-arglist): If empty arg, don't display extra space after function name.
author Ben Wing <ben@xemacs.org>
date Thu, 25 Feb 2010 04:10:52 -0600
parents cc74f60c150e
children 5502045ec510
comparison
equal deleted inserted replaced
5072:cc74f60c150e 5076:d555581e3cba
295 (if (memq '&cl-quote arg) 295 (if (memq '&cl-quote arg)
296 (setq arg (delq '&cl-quote arg))) 296 (setq arg (delq '&cl-quote arg)))
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, modified by ben@666.com
301 ;;;###autoload 301 ;;;###autoload
302 (defun cl-function-arglist (name arglist &optional omit-name) 302 (defun cl-function-arglist (arglist)
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.
308 (if (not (or (listp arglist) (symbolp arglist))) 305 (if (not (or (listp arglist) (symbolp arglist)))
309 "Not available" 306 "Not available"
310 (check-argument-type #'true-list-p arglist) 307 (check-argument-type #'true-list-p arglist)
311 (let ((print-gensym nil)) 308 (let ((print-gensym nil))
312 (condition-case nil 309 (condition-case nil
313 (prin1-to-string 310 (let ((args (cond ((null arglist) nil)
314 (let ((args (cond ((null arglist) nil) 311 ((listp arglist) (cl-upcase-arg arglist))
315 ((listp arglist) (cl-upcase-arg arglist)) 312 ((symbolp arglist)
316 ((symbolp arglist) 313 (cl-upcase-arg (list '&rest arglist)))
317 (cl-upcase-arg (list '&rest arglist))) 314 (t (wrong-type-argument 'listp arglist)))))
318 (t (wrong-type-argument 'listp arglist))))) 315 (if args (prin1-to-string args) "()"))
319 (if omit-name args
320 (cons (if (eq name 'cl-none) 'lambda name) args))))
321 (t "Not available"))))) 316 (t "Not available")))))
322 317
323 (defun cl-transform-lambda (form bind-block) 318 (defun cl-transform-lambda (form bind-block)
324 (let* ((args (car form)) (body (cdr form)) 319 (let* ((args (car form)) (body (cdr form))
325 (bind-defs nil) (bind-enquote nil) 320 (bind-defs nil) (bind-enquote nil)
326 (bind-inits nil) (bind-lets nil) (bind-forms nil) 321 (bind-inits nil) (bind-lets nil) (bind-forms nil)
327 (header nil) (simple-args nil) 322 (header nil) (simple-args nil)
328 (complex-arglist (cl-function-arglist bind-block args t)) 323 (complex-arglist (cl-function-arglist args))
329 (doc "")) 324 (doc ""))
330 (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) 325 (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
331 (push (pop body) header)) 326 (push (pop body) header))
332 (setq args (if (listp args) (copy-list args) (list '&rest args))) 327 (setq args (if (listp args) (copy-list args) (list '&rest args)))
333 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) 328 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
350 (setq simple-args (nreverse simple-args) 345 (setq simple-args (nreverse simple-args)
351 header (nreverse header)) 346 header (nreverse header))
352 ;; Add CL lambda list to documentation, if the CL lambda list differs 347 ;; Add CL lambda list to documentation, if the CL lambda list differs
353 ;; from the non-CL lambda list. npak@ispras.ru 348 ;; from the non-CL lambda list. npak@ispras.ru
354 (unless (equal complex-arglist 349 (unless (equal complex-arglist
355 (cl-function-arglist bind-block simple-args t)) 350 (cl-function-arglist simple-args))
356 (and (stringp (car header)) (setq doc (pop header))) 351 (and (stringp (car header)) (setq doc (pop header)))
357 ;; Stick the arguments onto the end of the doc string in a way that 352 ;; Stick the arguments onto the end of the doc string in a way that
358 ;; will be recognized specially by `function-arglist'. 353 ;; will be recognized specially by `function-arglist'.
359 (push (concat doc "\n\narguments: " complex-arglist "\n") 354 (push (concat doc "\n\narguments: " complex-arglist "\n")
360 header)) 355 header))