comparison lisp/help.el @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents a5df635868b2
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
1016 (function-arglist 'function-arglist) 1016 (function-arglist 'function-arglist)
1017 => (function-arglist FUNCTION) 1017 => (function-arglist FUNCTION)
1018 1018
1019 This function is used by `describe-function-1' to list function 1019 This function is used by `describe-function-1' to list function
1020 arguments in the standard Lisp style." 1020 arguments in the standard Lisp style."
1021 (let* ((fndef (indirect-function function)) 1021 (let* ((fnc (indirect-function function))
1022 (fndef (if (eq (car-safe fnc) 'macro)
1023 (cdr fnc)
1024 fnc))
1022 (arglist 1025 (arglist
1023 (cond ((compiled-function-p fndef) 1026 (cond ((compiled-function-p fndef)
1024 (compiled-function-arglist fndef)) 1027 (compiled-function-arglist fndef))
1025 ((eq (car-safe fndef) 'lambda) 1028 ((eq (car-safe fndef) 'lambda)
1026 (nth 1 fndef)) 1029 (nth 1 fndef))
1027 ((subrp fndef) 1030 ((subrp fndef)
1028 (let* ((doc (documentation function)) 1031 (let* ((doc (documentation function))
1029 (args (and (string-match 1032 (args (and (string-match
1030 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" 1033 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'"
1031 doc) 1034 doc)
1032 (match-string 1 doc)))) 1035 (match-string 1 doc))))
1033 ;; If there are no arguments documented for the 1036 ;; If there are no arguments documented for the
1034 ;; subr, rather don't print anything. 1037 ;; subr, rather don't print anything.
1035 (cond ((null args) t) 1038 (cond ((null args) t)
1036 ((equal args "") nil) 1039 ((equal args "") nil)
1037 (args)))) 1040 (args))))
1038 (t t)))) 1041 (t t))))
1039 (cond ((listp arglist) 1042 (cond ((listp arglist)
1040 (prin1-to-string 1043 (prin1-to-string
1041 (cons function (mapcar (lambda (arg) 1044 (cons function (mapcar (lambda (arg)
1042 (if (memq arg '(&optional &rest)) 1045 (if (memq arg '(&optional &rest))
1043 arg 1046 arg
1421 (princ (car cmd)) 1424 (princ (car cmd))
1422 (setq cmd (cdr cmd)) 1425 (setq cmd (cdr cmd))
1423 (if cmd (princ " "))))) 1426 (if cmd (princ " ")))))
1424 (terpri)))))) 1427 (terpri))))))
1425 1428
1426 ;; Stop gap for 21.0 untill we do help-char etc properly. 1429 ;; Stop gap for 21.0 until we do help-char etc properly.
1427 (defun help-keymap-with-help-key (keymap form) 1430 (defun help-keymap-with-help-key (keymap form)
1428 "Return a copy of KEYMAP with an help-key binding according to help-char 1431 "Return a copy of KEYMAP with an help-key binding according to help-char
1429 invoking FORM like help-form. An existing binding is not overridden. 1432 invoking FORM like help-form. An existing binding is not overridden.
1430 If FORM is nil then no binding is made." 1433 If FORM is nil then no binding is made."
1431 (let ((map (copy-keymap keymap)) 1434 (let ((map (copy-keymap keymap))