Mercurial > hg > xemacs-beta
comparison lisp/help.el @ 4694:2ac296807b88
Don't needlessly intern symbols, #'function-arglist, #'cl-function-arglist
2009-09-20 Aidan Kehoe <kehoea@parhasard.net>
* help.el (function-arglist):
Show the double-quotes in the sample output, correctly.
Bind print-gensym to nil, now we're using uninterned symbols.
Don't #'mapcar + #'intern to create uppercase symbols, use #'loop
and #'make-symbol instead.
* cl-macs.el (cl-upcase-arg):
Don't intern the upcased symbols we're using for cosmetic reasons.
Trust #'true-list-p in #'cl-function-arglist to detect
circularity.
(cl-function-arglist): Bind print-gensym to nil, now we're
printing uninterned symbols and would prefer to avoid the gensym
syntax.
(cl-transform-lambda): Only add the Common Lisp lambda list:
argument information when that differs frmo the normal argument
information.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 20 Sep 2009 21:41:22 +0100 |
parents | e9b88e997479 |
children | fee33ab25966 |
comparison
equal
deleted
inserted
replaced
4693:80cd90837ac5 | 4694:2ac296807b88 |
---|---|
1173 (defun function-arglist (function) | 1173 (defun function-arglist (function) |
1174 "Return a string giving the argument list of FUNCTION. | 1174 "Return a string giving the argument list of FUNCTION. |
1175 For example: | 1175 For example: |
1176 | 1176 |
1177 (function-arglist 'function-arglist) | 1177 (function-arglist 'function-arglist) |
1178 => (function-arglist FUNCTION) | 1178 => \"(function-arglist FUNCTION)\" |
1179 | 1179 |
1180 This function is used by `describe-function-1' to list function | 1180 This function is used by `describe-function-1' to list function |
1181 arguments in the standard Lisp style." | 1181 arguments in the standard Lisp style." |
1182 (let* ((fnc (indirect-function function)) | 1182 (let* ((fnc (indirect-function function)) |
1183 (fndef (if (eq (car-safe fnc) 'macro) | 1183 (fndef (if (eq (car-safe fnc) 'macro) |
1201 ;; If there are no arguments documented for the | 1201 ;; If there are no arguments documented for the |
1202 ;; subr, rather don't print anything. | 1202 ;; subr, rather don't print anything. |
1203 (cond ((null args) t) | 1203 (cond ((null args) t) |
1204 ((equal args "") nil) | 1204 ((equal args "") nil) |
1205 (args)))) | 1205 (args)))) |
1206 (t t)))) | 1206 (t t))) |
1207 (print-gensym nil)) | |
1207 (cond ((listp arglist) | 1208 (cond ((listp arglist) |
1208 (prin1-to-string | 1209 (prin1-to-string |
1209 (cons function (mapcar (lambda (arg) | 1210 (cons function (loop |
1210 (if (memq arg '(&optional &rest)) | 1211 for arg in arglist |
1211 arg | 1212 collect (if (memq arg '(&optional &rest)) |
1212 (intern (upcase (symbol-name arg))))) | 1213 arg |
1213 arglist)) | 1214 (make-symbol (upcase (symbol-name |
1215 arg)))))) | |
1216 | |
1214 t)) | 1217 t)) |
1215 ((stringp arglist) | 1218 ((stringp arglist) |
1216 (format "(%s %s)" function arglist))))) | 1219 (format "(%s %s)" function arglist))))) |
1217 | 1220 |
1218 (defun function-documentation (function &optional strip-arglist) | 1221 (defun function-documentation (function &optional strip-arglist) |