Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents b8cc9ab3f761
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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 (if help-buffer-prefix-string 464 (format "*%s: %s*" help-buffer-prefix-string name)
465 (format "*%s: %s*" help-buffer-prefix-string name)
466 (format "*%s*" name))
467 (format "*%s*" help-buffer-prefix-string))) 465 (format "*%s*" help-buffer-prefix-string)))
468 466
469 ;; Use this function for displaying help when C-h something is pressed 467 ;; Use this function for displaying help when C-h something is pressed
470 ;; or in similar situations. Do *not* use it when you are displaying 468 ;; or in similar situations. Do *not* use it when you are displaying
471 ;; a help message and then prompting for input in the minibuffer -- 469 ;; a help message and then prompting for input in the minibuffer --
655 (let ((heading (if mouse-only-p 653 (let ((heading (if mouse-only-p
656 (gettext "button binding\n------ -------\n") 654 (gettext "button binding\n------ -------\n")
657 (gettext "key binding\n--- -------\n"))) 655 (gettext "key binding\n--- -------\n")))
658 (buffer (current-buffer)) 656 (buffer (current-buffer))
659 (minor minor-mode-map-alist) 657 (minor minor-mode-map-alist)
660 (extent-maps (mapcar-extents
661 'extent-keymap
662 nil (current-buffer) (point) (point) nil 'keymap))
663 (local (current-local-map)) 658 (local (current-local-map))
664 (shadow '())) 659 (shadow '()))
665 (set-buffer standard-output) 660 (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)))
674 (while minor 661 (while minor
675 (let ((sym (car (car minor))) 662 (let ((sym (car (car minor)))
676 (map (cdr (car minor)))) 663 (map (cdr (car minor))))
677 (if (symbol-value-in-buffer sym buffer nil) 664 (if (symbol-value-in-buffer sym buffer nil)
678 (progn 665 (progn
728 (interactive) 715 (interactive)
729 (if (and (boundp 'Installation-string) 716 (if (and (boundp 'Installation-string)
730 (stringp Installation-string)) 717 (stringp Installation-string))
731 (with-displaying-help-buffer 718 (with-displaying-help-buffer
732 (lambda () 719 (lambda ()
733 (princ 720 (princ Installation-string))
734 (if (fboundp 'decode-coding-string)
735 (decode-coding-string Installation-string 'automatic-conversion)
736 Installation-string)))
737 "Installation") 721 "Installation")
738 (error "No Installation information available."))) 722 (error "No Installation information available.")))
739 723
740 (defun view-emacs-news () 724 (defun view-emacs-news ()
741 "Display info on recent changes to XEmacs." 725 "Display info on recent changes to XEmacs."
949 (completing-read 933 (completing-read
950 (if fn 934 (if fn
951 (format (gettext "Describe function (default %s): ") 935 (format (gettext "Describe function (default %s): ")
952 fn) 936 fn)
953 (gettext "Describe function: ")) 937 (gettext "Describe function: "))
954 obarray 'fboundp t nil 'function-history 938 obarray 'fboundp t nil 'function-history))))
955 (symbol-name fn))))) 939 (list (if (equal val "") fn (intern val)))))
956 (list (intern val))))
957 (with-displaying-help-buffer 940 (with-displaying-help-buffer
958 (lambda () 941 (lambda ()
959 (describe-function-1 function) 942 (describe-function-1 function)
960 ;; Return the text we displayed. 943 ;; Return the text we displayed.
961 (buffer-string nil nil standard-output)) 944 (buffer-string nil nil standard-output))
1019 (function-arglist 'function-arglist) 1002 (function-arglist 'function-arglist)
1020 => (function-arglist FUNCTION) 1003 => (function-arglist FUNCTION)
1021 1004
1022 This function is used by `describe-function-1' to list function 1005 This function is used by `describe-function-1' to list function
1023 arguments in the standard Lisp style." 1006 arguments in the standard Lisp style."
1024 (let* ((fnc (indirect-function function)) 1007 (let* ((fndef (indirect-function function))
1025 (fndef (if (eq (car-safe fnc) 'macro)
1026 (cdr fnc)
1027 fnc))
1028 (arglist 1008 (arglist
1029 (cond ((compiled-function-p fndef) 1009 (cond ((compiled-function-p fndef)
1030 (compiled-function-arglist fndef)) 1010 (compiled-function-arglist fndef))
1031 ((eq (car-safe fndef) 'lambda) 1011 ((eq (car-safe fndef) 'lambda)
1032 (nth 1 fndef)) 1012 (nth 1 fndef))
1033 ((subrp fndef) 1013 ((subrp fndef)
1034 (let* ((doc (documentation function)) 1014 (let* ((doc (documentation function))
1035 (args (and (string-match 1015 (args (and (string-match
1036 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" 1016 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'"
1037 doc) 1017 doc)
1038 (match-string 1 doc)))) 1018 (match-string 1 doc))))
1039 ;; If there are no arguments documented for the 1019 ;; If there are no arguments documented for the
1040 ;; subr, rather don't print anything. 1020 ;; subr, rather don't print anything.
1041 (cond ((null args) t) 1021 (cond ((null args) t)
1042 ((equal args "") nil) 1022 ((equal args "") nil)
1043 (args)))) 1023 (args))))
1044 (t t)))) 1024 (t t))))
1045 (cond ((listp arglist) 1025 (cond ((listp arglist)
1046 (prin1-to-string 1026 (prin1-to-string
1047 (cons function (mapcar (lambda (arg) 1027 (cons function (mapcar (lambda (arg)
1048 (if (memq arg '(&optional &rest)) 1028 (if (memq arg '(&optional &rest))
1049 arg 1029 arg
1242 (val (let ((enable-recursive-minibuffers t)) 1222 (val (let ((enable-recursive-minibuffers t))
1243 (completing-read 1223 (completing-read
1244 (if v 1224 (if v
1245 (format "Describe variable (default %s): " v) 1225 (format "Describe variable (default %s): " v)
1246 (gettext "Describe variable: ")) 1226 (gettext "Describe variable: "))
1247 obarray 'boundp t nil 'variable-history 1227 obarray 'boundp t nil 'variable-history))))
1248 (symbol-name v))))) 1228 (list (if (equal val "") v (intern val)))))
1249 (list (intern val))))
1250 (with-displaying-help-buffer 1229 (with-displaying-help-buffer
1251 (lambda () 1230 (lambda ()
1252 (let ((origvar variable) 1231 (let ((origvar variable)
1253 aliases) 1232 aliases)
1254 (let ((print-escape-newlines t)) 1233 (let ((print-escape-newlines t))
1427 (princ (car cmd)) 1406 (princ (car cmd))
1428 (setq cmd (cdr cmd)) 1407 (setq cmd (cdr cmd))
1429 (if cmd (princ " "))))) 1408 (if cmd (princ " ")))))
1430 (terpri)))))) 1409 (terpri))))))
1431 1410
1432 ;; Stop gap for 21.0 until we do help-char etc properly. 1411 ;; Stop gap for 21.0 untill we do help-char etc properly.
1433 (defun help-keymap-with-help-key (keymap form) 1412 (defun help-keymap-with-help-key (keymap form)
1434 "Return a copy of KEYMAP with an help-key binding according to help-char 1413 "Return a copy of KEYMAP with an help-key binding according to help-char
1435 invoking FORM like help-form. An existing binding is not overridden. 1414 invoking FORM like help-form. An existing binding is not overridden.
1436 If FORM is nil then no binding is made." 1415 If FORM is nil then no binding is made."
1437 (let ((map (copy-keymap keymap)) 1416 (let ((map (copy-keymap keymap))