Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children b8cc9ab3f761
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
303 303
304 (defun key-or-menu-binding (key &optional menu-flag) 304 (defun key-or-menu-binding (key &optional menu-flag)
305 "Return the command invoked by KEY. 305 "Return the command invoked by KEY.
306 Like `key-binding', but handles menu events and toolbar presses correctly. 306 Like `key-binding', but handles menu events and toolbar presses correctly.
307 KEY is any value returned by `next-command-event'. 307 KEY is any value returned by `next-command-event'.
308 MENU-FLAG is a symbol that should be set to T if KEY is a menu event, 308 MENU-FLAG is a symbol that should be set to t if KEY is a menu event,
309 or NIL otherwise" 309 or nil otherwise"
310 (let (defn) 310 (let (defn)
311 (and menu-flag (set menu-flag nil)) 311 (and menu-flag (set menu-flag nil))
312 ;; If the key typed was really a menu selection, grab the form out 312 ;; If the key typed was really a menu selection, grab the form out
313 ;; of the event object and intuit the function that would be called, 313 ;; of the event object and intuit the function that would be called,
314 ;; and describe that instead. 314 ;; and describe that instead.
459 (defun help-buffer-name (name) 459 (defun help-buffer-name (name)
460 "Return a name for a Help buffer using string NAME for context." 460 "Return a name for a Help buffer using string NAME for context."
461 (if (and (integerp help-max-help-buffers) 461 (if (and (integerp help-max-help-buffers)
462 (> help-max-help-buffers 0) 462 (> help-max-help-buffers 0)
463 (stringp name)) 463 (stringp name))
464 (format "*%s: %s*" help-buffer-prefix-string name) 464 (if help-buffer-prefix-string
465 (format "*%s: %s*" help-buffer-prefix-string name)
466 (format "*%s*" name))
465 (format "*%s*" help-buffer-prefix-string))) 467 (format "*%s*" help-buffer-prefix-string)))
466 468
467 ;; Use this function for displaying help when C-h something is pressed 469 ;; Use this function for displaying help when C-h something is pressed
468 ;; or in similar situations. Do *not* use it when you are displaying 470 ;; or in similar situations. Do *not* use it when you are displaying
469 ;; a help message and then prompting for input in the minibuffer -- 471 ;; a help message and then prompting for input in the minibuffer --
653 (let ((heading (if mouse-only-p 655 (let ((heading (if mouse-only-p
654 (gettext "button binding\n------ -------\n") 656 (gettext "button binding\n------ -------\n")
655 (gettext "key binding\n--- -------\n"))) 657 (gettext "key binding\n--- -------\n")))
656 (buffer (current-buffer)) 658 (buffer (current-buffer))
657 (minor minor-mode-map-alist) 659 (minor minor-mode-map-alist)
660 (extent-maps (mapcar-extents
661 'extent-keymap
662 nil (current-buffer) (point) (point) nil 'keymap))
658 (local (current-local-map)) 663 (local (current-local-map))
659 (shadow '())) 664 (shadow '()))
660 (set-buffer standard-output) 665 (set-buffer standard-output)
666 (while extent-maps
667 (insert "Bindings for Text Region:\n"
668 heading)
669 (describe-bindings-internal
670 (car extent-maps) nil shadow prefix mouse-only-p)
671 (insert "\n")
672 (setq shadow (cons (car extent-maps) shadow)
673 extent-maps (cdr extent-maps)))
661 (while minor 674 (while minor
662 (let ((sym (car (car minor))) 675 (let ((sym (car (car minor)))
663 (map (cdr (car minor)))) 676 (map (cdr (car minor))))
664 (if (symbol-value-in-buffer sym buffer nil) 677 (if (symbol-value-in-buffer sym buffer nil)
665 (progn 678 (progn
933 (completing-read 946 (completing-read
934 (if fn 947 (if fn
935 (format (gettext "Describe function (default %s): ") 948 (format (gettext "Describe function (default %s): ")
936 fn) 949 fn)
937 (gettext "Describe function: ")) 950 (gettext "Describe function: "))
938 obarray 'fboundp t nil 'function-history)))) 951 obarray 'fboundp t nil 'function-history
939 (list (if (equal val "") fn (intern val))))) 952 (symbol-name fn)))))
953 (list (intern val))))
940 (with-displaying-help-buffer 954 (with-displaying-help-buffer
941 (lambda () 955 (lambda ()
942 (describe-function-1 function) 956 (describe-function-1 function)
943 ;; Return the text we displayed. 957 ;; Return the text we displayed.
944 (buffer-string nil nil standard-output)) 958 (buffer-string nil nil standard-output))
1002 (function-arglist 'function-arglist) 1016 (function-arglist 'function-arglist)
1003 => (function-arglist FUNCTION) 1017 => (function-arglist FUNCTION)
1004 1018
1005 This function is used by `describe-function-1' to list function 1019 This function is used by `describe-function-1' to list function
1006 arguments in the standard Lisp style." 1020 arguments in the standard Lisp style."
1007 (let* ((fndef (indirect-function function)) 1021 (let* ((fnc (indirect-function function))
1022 (fndef (if (eq (car-safe fnc) 'macro)
1023 (cdr fnc)
1024 fnc))
1008 (arglist 1025 (arglist
1009 (cond ((compiled-function-p fndef) 1026 (cond ((compiled-function-p fndef)
1010 (compiled-function-arglist fndef)) 1027 (compiled-function-arglist fndef))
1011 ((eq (car-safe fndef) 'lambda) 1028 ((eq (car-safe fndef) 'lambda)
1012 (nth 1 fndef)) 1029 (nth 1 fndef))
1013 ((subrp fndef) 1030 ((subrp fndef)
1014 (let* ((doc (documentation function)) 1031 (let* ((doc (documentation function))
1015 (args (and (string-match 1032 (args (and (string-match
1016 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" 1033 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'"
1017 doc) 1034 doc)
1018 (match-string 1 doc)))) 1035 (match-string 1 doc))))
1019 ;; If there are no arguments documented for the 1036 ;; If there are no arguments documented for the
1020 ;; subr, rather don't print anything. 1037 ;; subr, rather don't print anything.
1021 (cond ((null args) t) 1038 (cond ((null args) t)
1022 ((equal args "") nil) 1039 ((equal args "") nil)
1023 (args)))) 1040 (args))))
1024 (t t)))) 1041 (t t))))
1025 (cond ((listp arglist) 1042 (cond ((listp arglist)
1026 (prin1-to-string 1043 (prin1-to-string
1027 (cons function (mapcar (lambda (arg) 1044 (cons function (mapcar (lambda (arg)
1028 (if (memq arg '(&optional &rest)) 1045 (if (memq arg '(&optional &rest))
1029 arg 1046 arg
1222 (val (let ((enable-recursive-minibuffers t)) 1239 (val (let ((enable-recursive-minibuffers t))
1223 (completing-read 1240 (completing-read
1224 (if v 1241 (if v
1225 (format "Describe variable (default %s): " v) 1242 (format "Describe variable (default %s): " v)
1226 (gettext "Describe variable: ")) 1243 (gettext "Describe variable: "))
1227 obarray 'boundp t nil 'variable-history)))) 1244 obarray 'boundp t nil 'variable-history
1228 (list (if (equal val "") v (intern val))))) 1245 (symbol-name v)))))
1246 (list (intern val))))
1229 (with-displaying-help-buffer 1247 (with-displaying-help-buffer
1230 (lambda () 1248 (lambda ()
1231 (let ((origvar variable) 1249 (let ((origvar variable)
1232 aliases) 1250 aliases)
1233 (let ((print-escape-newlines t)) 1251 (let ((print-escape-newlines t))
1406 (princ (car cmd)) 1424 (princ (car cmd))
1407 (setq cmd (cdr cmd)) 1425 (setq cmd (cdr cmd))
1408 (if cmd (princ " "))))) 1426 (if cmd (princ " ")))))
1409 (terpri)))))) 1427 (terpri))))))
1410 1428
1411 ;; 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.
1412 (defun help-keymap-with-help-key (keymap form) 1430 (defun help-keymap-with-help-key (keymap form)
1413 "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
1414 invoking FORM like help-form. An existing binding is not overridden. 1432 invoking FORM like help-form. An existing binding is not overridden.
1415 If FORM is nil then no binding is made." 1433 If FORM is nil then no binding is made."
1416 (let ((map (copy-keymap keymap)) 1434 (let ((map (copy-keymap keymap))