Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 5514:9d519ab9fd68
Be a little better about deciding when to add CL docstring argument info.
2011-05-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-transform-lambda):
Move the code to decide whether to add argument information to the
docstring a little later, so the information about what the
function's docstring ends up being is a little more exact.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 29 May 2011 18:17:09 +0100 |
| parents | 7b5254f6e0d5 |
| children | 544e6336d37c |
comparison
equal
deleted
inserted
replaced
| 5513:cf2733b1ff4b | 5514:9d519ab9fd68 |
|---|---|
| 378 (push (pop args) simple-args)) | 378 (push (pop args) simple-args)) |
| 379 (or (eq bind-block 'cl-none) | 379 (or (eq bind-block 'cl-none) |
| 380 (setq body (list (list* 'block bind-block body)))) | 380 (setq body (list (list* 'block bind-block body)))) |
| 381 (setq simple-args (nreverse simple-args) | 381 (setq simple-args (nreverse simple-args) |
| 382 header (nreverse header)) | 382 header (nreverse header)) |
| 383 ;; Add CL lambda list to documentation, if the CL lambda list differs | |
| 384 ;; from the non-CL lambda list. npak@ispras.ru | |
| 385 (unless (equal complex-arglist | |
| 386 (cl-function-arglist simple-args)) | |
| 387 (and (stringp (car header)) (setq doc (pop header))) | |
| 388 ;; Stick the arguments onto the end of the doc string in a way that | |
| 389 ;; will be recognized specially by `function-arglist'. | |
| 390 (push (concat doc "\n\narguments: " complex-arglist "\n") | |
| 391 header)) | |
| 392 (if (null args) | 383 (if (null args) |
| 393 (list* nil simple-args (nconc header body)) | 384 (list* nil simple-args (nconc header body)) |
| 394 (if (memq '&optional simple-args) (push '&optional args)) | 385 (if (memq '&optional simple-args) (push '&optional args)) |
| 395 (cl-do-arglist args nil (- (length simple-args) | 386 (cl-do-arglist args nil (- (length simple-args) |
| 396 (if (memq '&optional simple-args) 1 0))) | 387 (if (memq '&optional simple-args) 1 0))) |
| 397 (setq bind-lets (nreverse bind-lets)) | 388 (setq bind-lets (nreverse bind-lets)) |
| 398 ;; This code originally needed to create the keywords itself, that | 389 ;; This code originally needed to create the keywords itself, that |
| 399 ;; wasn't done by the Lisp reader; the first element of the result | 390 ;; wasn't done by the Lisp reader; the first element of the result |
| 400 ;; list comprised code to do this. It's not used any more. | 391 ;; list comprised code to do this. It's not used any more. |
| 401 (list* nil (nconc simple-args (list '&rest (car (pop bind-lets)))) | 392 (list* nil (prog1 |
| 393 (setq simple-args | |
| 394 (nconc simple-args | |
| 395 (list '&rest (car (pop bind-lets))))) | |
| 396 ;; Add CL lambda list to documentation, if the CL lambda | |
| 397 ;; list differs from the non-CL lambda | |
| 398 ;; list. npak@ispras.ru | |
| 399 (unless (equal complex-arglist | |
| 400 (cl-function-arglist simple-args)) | |
| 401 (and (stringp (car header)) (setq doc (pop header))) | |
| 402 ;; Stick the arguments onto the end of the doc string | |
| 403 ;; in a way that will be recognized specially by | |
| 404 ;; `function-arglist'. | |
| 405 (push (concat doc "\n\narguments: " complex-arglist "\n") | |
| 406 header))) | |
| 402 ;; XEmacs change: we add usage information using Nickolay's | 407 ;; XEmacs change: we add usage information using Nickolay's |
| 403 ;; approach above | 408 ;; approach above |
| 404 (nconc header | 409 (nconc header |
| 405 (list (nconc (list 'let* bind-lets) | 410 (list (nconc (list 'let* bind-lets) |
| 406 (nreverse bind-forms) body))))))) | 411 (nreverse bind-forms) body))))))) |