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)