X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fhelp.el;h=1ac1780dec349a3db3bbb5c14efa3726c2eb06a8;hp=eb7b1b6c835e16f5e6fa3c6c27d482a31c5c7772;hb=414b512c0774e67ba8e160b605447d862d3be166;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921 diff --git a/lisp/help.el b/lisp/help.el index eb7b1b6..1ac1780 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,6 +1,7 @@ ;;; help.el --- help commands for XEmacs. ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2001 Ben Wing. ;; Maintainer: FSF ;; Keywords: help, internal, dumped @@ -51,7 +52,7 @@ (defvar help-map (let ((map (make-sparse-keymap))) (set-keymap-name map 'help-map) (set-keymap-prompt - map (purecopy (gettext "(Type ? for further options)"))) + map (gettext "(Type ? for further options)")) map) "Keymap for characters following the Help key.") @@ -240,10 +241,8 @@ If the optional argument BURY is non-nil, the help buffer is buried, otherwise it is killed." (interactive) (let ((buf (current-buffer))) - (cond ((frame-property (selected-frame) 'help-window-config) - (set-window-configuration - (frame-property (selected-frame) 'help-window-config)) - (set-frame-property (selected-frame) 'help-window-config nil)) + (cond (help-window-config + (set-window-configuration help-window-config)) ((not (one-window-p)) (delete-window))) (if bury @@ -256,7 +255,7 @@ otherwise it is killed." ;; This is a grody hack of the same genotype as `advertised-undo'; if the ;; bindings of Backspace and C-h are the same, we want the menubar to claim -;; that `info' in invoked with `C-h i', not `BS i'. +;; that `info' is invoked with `C-h i', not `BS i'. (defun deprecated-help-command () (interactive) @@ -266,47 +265,15 @@ otherwise it is killed." ;;(define-key global-map 'backspace 'deprecated-help-command) -;; This function has been moved to help-nomule.el and mule-help.el. -;; TUTORIAL arg is XEmacs addition -;(defun help-with-tutorial (&optional tutorial) -; "Select the XEmacs learn-by-doing tutorial. -;Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\"." -; (interactive) -; (if (null tutorial) -; (setq tutorial "TUTORIAL")) -; (let ((file (expand-file-name (concat "~/" tutorial)))) -; (delete-other-windows) -; (if (get-file-buffer file) -; (switch-to-buffer (get-file-buffer file)) -; (switch-to-buffer (create-file-buffer file)) -; (setq buffer-file-name file) -; (setq default-directory (expand-file-name "~/")) -; (setq buffer-auto-save-file-name nil) -; (insert-file-contents (expand-file-name tutorial data-directory)) -; (goto-char (point-min)) -; (search-forward "\n<<") -; (delete-region (point-at-bol) (point-at-eol)) -; (let ((n (- (window-height (selected-window)) -; (count-lines (point-min) (point)) -; 6))) -; (if (< n 12) -; (newline n) -; ;; Some people get confused by the large gap. -; (newline (/ n 2)) -; (insert "[Middle of page left blank for didactic purposes. " -; "Text continues below]") -; (newline (- n (/ n 2))))) -; (goto-char (point-min)) -; (set-buffer-modified-p nil)))) +;; help-with-tutorial moved to help-nomule.el and mule-help.el. ;; used by describe-key, describe-key-briefly, insert-key-binding, etc. - (defun key-or-menu-binding (key &optional menu-flag) "Return the command invoked by KEY. Like `key-binding', but handles menu events and toolbar presses correctly. KEY is any value returned by `next-command-event'. -MENU-FLAG is a symbol that should be set to T if KEY is a menu event, - or NIL otherwise" +MENU-FLAG is a symbol that should be set to t if KEY is a menu event, + or nil otherwise." (let (defn) (and menu-flag (set menu-flag nil)) ;; If the key typed was really a menu selection, grab the form out @@ -461,14 +428,12 @@ You should never set this directory, only let-bind it.") (if (and (integerp help-max-help-buffers) (> help-max-help-buffers 0) (stringp name)) - (format "*%s: %s*" help-buffer-prefix-string name) + (if help-buffer-prefix-string + (format "*%s: %s*" help-buffer-prefix-string name) + (format "*%s*" name)) (format "*%s*" help-buffer-prefix-string))) -;; Use this function for displaying help when C-h something is pressed -;; or in similar situations. Do *not* use it when you are displaying -;; a help message and then prompting for input in the minibuffer -- -;; this macro usually selects the help buffer, which is not what you -;; want in those situations. +;; with-displaying-help-buffer ;; #### Should really be a macro to eliminate the requirement of ;; caller to code a lambda form in THUNK -- mrb @@ -478,9 +443,30 @@ You should never set this directory, only let-bind it.") ;; another name (which is a shame, because w-d-h-b is a perfect name ;; for a macro) that uses with-displaying-help-buffer internally. +(defcustom mode-for-help 'help-mode + "*Mode that help buffers are put into.") + +(defvar help-sticky-window nil +;; Window into which help buffers will be displayed, rather than +;; always searching for a new one. This is INTERNAL and liable to +;; change its interface and/or name at any moment. It should be +;; bound, not set. +) + +(defvar help-window-config nil) + +(make-variable-buffer-local 'help-window-config) +(put 'help-window-config 'permanent-local t) + (defun with-displaying-help-buffer (thunk &optional name) "Form which makes a help buffer with given NAME and evaluates BODY there. -The actual name of the buffer is generated by the function `help-buffer-name'." +The actual name of the buffer is generated by the function `help-buffer-name'. + +Use this function for displaying help when C-h something is pressed or +in similar situations. Do *not* use it when you are displaying a help +message and then prompting for input in the minibuffer -- this macro +usually selects the help buffer, which is not what you want in those +situations." (let* ((winconfig (current-window-configuration)) (was-one-window (one-window-p)) (buffer-name (help-buffer-name name)) @@ -490,19 +476,28 @@ The actual name of the buffer is generated by the function `help-buffer-name'." (mapcar 'window-frame (windows-of-buffer buffer-name))))))) (help-register-and-maybe-prune-excess buffer-name) - (prog1 (with-output-to-temp-buffer buffer-name - (prog1 (funcall thunk) - (save-excursion - (set-buffer standard-output) - (help-mode)))) + ;; if help-sticky-window is bogus or deleted, get rid of it. + (if (and help-sticky-window (or (not (windowp help-sticky-window)) + (not (window-live-p help-sticky-window)))) + (setq help-sticky-window nil)) + (prog1 + (let ((temp-buffer-show-function + (if help-sticky-window + #'(lambda (buffer) + (set-window-buffer help-sticky-window buffer)) + temp-buffer-show-function))) + (with-output-to-temp-buffer buffer-name + (prog1 (funcall thunk) + (save-excursion + (set-buffer standard-output) + (funcall mode-for-help))))) (let ((helpwin (get-buffer-window buffer-name))) (when helpwin - (with-current-buffer (window-buffer helpwin) - ;; If the *Help* buffer is already displayed on this - ;; frame, don't override the previous configuration - (when help-not-visible - (set-frame-property (selected-frame) - 'help-window-config winconfig))) + ;; If the *Help* buffer is already displayed on this + ;; frame, don't override the previous configuration + (when help-not-visible + (with-current-buffer (window-buffer helpwin) + (setq help-window-config winconfig))) (when help-selects-help-window (select-window helpwin)) (cond ((eq helpwin (selected-window)) @@ -586,8 +581,11 @@ describes the minor mode." (setq indicator (cdr indicator))) (while (and indicator (symbolp indicator)) (setq indicator (symbol-value indicator))) - (princ (format "%s minor mode (indicator%s):\n" - pretty-minor-mode indicator)) + (princ (format "%s minor mode (%s):\n" + pretty-minor-mode + (if indicator + (format "indicator%s" indicator) + "no indicator"))) (princ (documentation minor-mode)) (princ "\n\n----\n\n")))) (setq minor-modes (cdr minor-modes))))) @@ -596,25 +594,27 @@ describes the minor mode." ;; So keyboard macro definitions are documented correctly (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) +;; view a read-only file intelligently +(defun Help-find-file (file) + (if (fboundp 'view-file) + (view-file file) + (find-file-read-only file) + (goto-char (point-min)))) + (defun describe-distribution () "Display info on how to obtain the latest version of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "DISTRIB"))) + (Help-find-file (locate-data-file "DISTRIB"))) (defun describe-beta () "Display info on how to deal with Beta versions of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "BETA")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "BETA"))) (defun describe-copying () "Display info on how you may redistribute copies of XEmacs." (interactive) - (find-file-read-only - (locate-data-file "COPYING")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "COPYING"))) (defun describe-pointer () "Show a list of all defined mouse buttons, and their definitions." @@ -624,9 +624,7 @@ describes the minor mode." (defun describe-project () "Display info on the GNU project." (interactive) - (find-file-read-only - (locate-data-file "GNU")) - (goto-char (point-min))) + (Help-find-file (locate-data-file "GNU"))) (defun describe-no-warranty () "Display info on all the kinds of warranty XEmacs does NOT have." @@ -639,10 +637,10 @@ describes the minor mode." (defun describe-bindings (&optional prefix mouse-only-p) "Show a list of all defined keys, and their definitions. The list is put in a buffer, which is displayed. -If the optional argument PREFIX is supplied, only commands which -start with that sequence of keys are described. -If the second argument (prefix arg, interactively) is non-null -then only the mouse bindings are displayed." +If optional first argument PREFIX is supplied, only commands +which start with that sequence of keys are described. +If optional second argument MOUSE-ONLY-P (prefix arg, interactively) +is non-nil then only the mouse bindings are displayed." (interactive (list nil current-prefix-arg)) (with-displaying-help-buffer (lambda () @@ -655,9 +653,20 @@ then only the mouse bindings are displayed." (gettext "key binding\n--- -------\n"))) (buffer (current-buffer)) (minor minor-mode-map-alist) + (extent-maps (mapcar-extents + 'extent-keymap + nil (current-buffer) (point) (point) nil 'keymap)) (local (current-local-map)) (shadow '())) (set-buffer standard-output) + (while extent-maps + (insert "Bindings for Text Region:\n" + heading) + (describe-bindings-internal + (car extent-maps) nil shadow prefix mouse-only-p) + (insert "\n") + (setq shadow (cons (car extent-maps) shadow) + extent-maps (cdr extent-maps))) (while minor (let ((sym (car (car minor))) (map (cdr (car minor)))) @@ -717,28 +726,30 @@ of the key sequence that ran this command." (stringp Installation-string)) (with-displaying-help-buffer (lambda () - (princ Installation-string)) + (princ + (if (fboundp 'decode-coding-string) + (decode-coding-string Installation-string 'automatic-conversion) + Installation-string))) "Installation") (error "No Installation information available."))) (defun view-emacs-news () "Display info on recent changes to XEmacs." (interactive) - (find-file (locate-data-file "NEWS"))) + (Help-find-file (expand-file-name "NEWS" data-directory))) (defun xemacs-www-page () "Go to the XEmacs World Wide Web page." (interactive) - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function "http://www.xemacs.org/") + (if (fboundp 'browse-url) + (browse-url "http://www.xemacs.org/") (error "xemacs-www-page requires browse-url"))) (defun xemacs-www-faq () "View the latest and greatest XEmacs FAQ using the World Wide Web." (interactive) - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function - "http://www.xemacs.org/faq/index.html") + (if (fboundp 'browse-url) + (browse-url "http://www.xemacs.org/faq/index.html") (error "xemacs-www-faq requires browse-url"))) (defun xemacs-local-faq () @@ -751,6 +762,11 @@ instead, to ensure that you get the most up-to-date information." (Info-find-node "xemacs-faq" "Top")) (switch-to-buffer "*info*")) +(defun view-sample-init-el () + "Display the sample init.el file." + (interactive) + (Help-find-file (locate-data-file "sample.init.el"))) + (defcustom view-lossage-key-count 100 "*Number of keys `view-lossage' shows. The maximum number of available keys is governed by `recent-keys-ring-size'." @@ -846,7 +862,7 @@ The number of messages shown is controlled by `view-lossage-message-count'." help-map) (defmacro with-syntax-table (syntab &rest body) - "Evaluate BODY with the syntax-table SYNTAB" + "Evaluate BODY with the SYNTAB as the current syntax table." `(let ((stab (syntax-table))) (unwind-protect (progn @@ -906,6 +922,21 @@ list containing point. If that doesn't give a function, return nil." (setq obj (read (current-buffer))) (and (symbolp obj) (fboundp obj) obj))))))) +(defun function-at-event (event) + "Return the function whose name is around the position of EVENT. +EVENT should be a mouse event. When calling from a popup or context menu, +use `last-popup-menu-event' to find out where the mouse was clicked. +\(You cannot use (interactive \"e\"), unfortunately. This returns a +misc-user event.) + +If the event contains no position, or the position is not over text, or +there is no function around that point, nil is returned." + (if (and event (event-buffer event) (event-point event)) + (save-excursion + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (function-at-point)))) + ;; Default to nil for the non-hackers? Not until we find a way to ;; distinguish hackers from non-hackers automatically! (defcustom describe-function-show-arglist t @@ -935,8 +966,9 @@ When run interactively, it defaults to any function found by (format (gettext "Describe function (default %s): ") fn) (gettext "Describe function: ")) - obarray 'fboundp t nil 'function-history)))) - (list (if (equal val "") fn (intern val))))) + obarray 'fboundp t nil 'function-history + (symbol-name fn))))) + (list (intern val)))) (with-displaying-help-buffer (lambda () (describe-function-1 function) @@ -1004,24 +1036,27 @@ For example: This function is used by `describe-function-1' to list function arguments in the standard Lisp style." - (let* ((fndef (indirect-function function)) + (let* ((fnc (indirect-function function)) + (fndef (if (eq (car-safe fnc) 'macro) + (cdr fnc) + fnc)) (arglist - (cond ((compiled-function-p fndef) - (compiled-function-arglist fndef)) - ((eq (car-safe fndef) 'lambda) - (nth 1 fndef)) - ((subrp fndef) - (let* ((doc (documentation function)) - (args (and (string-match - "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" - doc) - (match-string 1 doc)))) - ;; If there are no arguments documented for the - ;; subr, rather don't print anything. - (cond ((null args) t) - ((equal args "") nil) - (args)))) - (t t)))) + (cond ((compiled-function-p fndef) + (compiled-function-arglist fndef)) + ((eq (car-safe fndef) 'lambda) + (nth 1 fndef)) + ((subrp fndef) + (let* ((doc (documentation function)) + (args (and (string-match + "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" + doc) + (match-string 1 doc)))) + ;; If there are no arguments documented for the + ;; subr, rather don't print anything. + (cond ((null args) t) + ((equal args "") nil) + (args)))) + (t t)))) (cond ((listp arglist) (prin1-to-string (cons function (mapcar (lambda (arg) @@ -1040,15 +1075,148 @@ part of the documentation of internal subroutines." (let ((doc (condition-case nil (or (documentation function) (gettext "not documented")) - (void-function "")))) + (void-function "(alias for undefined function)") + (error "(unexpected error from `documention')")))) (if (and strip-arglist (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc)) (setq doc (substring doc 0 (match-beginning 0)))) doc)) +;; replacement for `princ' that puts the text in the specified face, +;; if possible +(defun Help-princ-face (object face) + (cond ((bufferp standard-output) + (let ((opoint (point standard-output))) + (princ object) + (put-nonduplicable-text-property opoint (point standard-output) + 'face face standard-output))) + ((markerp standard-output) + (let ((buf (marker-buffer standard-output)) + (pos (marker-position standard-output))) + (princ object) + (put-nonduplicable-text-property + pos (marker-position standard-output) 'face face buf))) + (t (princ object)))) + +;; replacement for `prin1' that puts the text in the specified face, +;; if possible +(defun Help-prin1-face (object face) + (cond ((bufferp standard-output) + (let ((opoint (point standard-output))) + (prin1 object) + (put-nonduplicable-text-property opoint (point standard-output) + 'face face standard-output))) + ((markerp standard-output) + (let ((buf (marker-buffer standard-output)) + (pos (marker-position standard-output))) + (prin1 object) + (put-nonduplicable-text-property + pos (marker-position standard-output) 'face face buf))) + (t (prin1 object)))) + +(defvar help-symbol-regexp + (let ((sym-char "[+a-zA-Z0-9_:*]") + (sym-char-no-dash "[-+a-zA-Z0-9_:*]")) + (concat "\\(" + ;; a symbol with a - in it. + "\\<\\(" sym-char-no-dash "+\\(-" sym-char-no-dash "+\\)+\\)\\>" + "\\|" + "`\\(" sym-char "+\\)'" + "\\)"))) + +(defun help-symbol-run-function-1 (ev ex fun) + (let ((help-sticky-window + ;; if we were called from a help buffer, make sure the new help + ;; goes in the same window. + (if (and (event-buffer ev) + (symbol-value-in-buffer 'help-window-config + (event-buffer ev))) + (event-window ev) + help-sticky-window))) + (funcall fun (extent-property ex 'help-symbol)))) + +(defun help-symbol-run-function (fun) + (let ((ex (extent-at-event last-popup-menu-event 'help-symbol))) + (when ex + (help-symbol-run-function-1 last-popup-menu-event ex fun)))) + +(defvar help-symbol-function-context-menu + '(["View %_Documentation" (help-symbol-run-function 'describe-function)] + ["Find %_Function Source" (help-symbol-run-function 'find-function)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] + )) + +(defvar help-symbol-variable-context-menu + '(["View %_Documentation" (help-symbol-run-function 'describe-variable)] + ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] + )) + +(defvar help-symbol-function-and-variable-context-menu + '(["View Function %_Documentation" (help-symbol-run-function + 'describe-function)] + ["View Variable D%_ocumentation" (help-symbol-run-function + 'describe-variable)] + ["Find %_Function Source" (help-symbol-run-function 'find-function)] + ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Tag" (help-symbol-run-function 'find-tag)] + )) + +(defun frob-help-extents (buffer) + ;; Look through BUFFER, starting at the buffer's point and continuing + ;; till end of file, and find documented functions and variables. + ;; any such symbol found is tagged with an extent, that sets up these + ;; properties: + ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over) + ;; 2. help-symbol is the name of the symbol. + ;; 3. face is 'hyper-apropos-hyperlink. + ;; 4. context-menu is a list of context menu items, specific to whether + ;; the symbol is a function, variable, or both. + ;; 5. activate-function will cause the function or variable to be described, + ;; replacing the existing help contents. + (save-excursion + (set-buffer buffer) + (let (b e name) + (while (re-search-forward help-symbol-regexp nil t) + (setq b (or (match-beginning 2) (match-beginning 4))) + (setq e (or (match-end 2) (match-end 4))) + (setq name (buffer-substring b e)) + (let* ((sym (intern-soft name)) + (var (and sym (boundp sym) + (documentation-property sym + 'variable-documentation t))) + (fun (and sym (fboundp sym) + (condition-case nil + (documentation sym t) + (void-function "(alias for undefined function)") + (error "(unexpected error from `documention')"))))) + (when (or var fun) + (let ((ex (make-extent b e))) + (require 'hyper-apropos) + (set-extent-property ex 'mouse-face 'highlight) + (set-extent-property ex 'help-symbol sym) + (set-extent-property ex 'face 'hyper-apropos-hyperlink) + (set-extent-property + ex 'context-menu + (cond ((and var fun) + help-symbol-function-and-variable-context-menu) + (var help-symbol-variable-context-menu) + (fun help-symbol-function-context-menu))) + (set-extent-property + ex 'activate-function + (if fun + #'(lambda (ev ex) + (help-symbol-run-function-1 ev ex 'describe-function)) + #'(lambda (ev ex) + (help-symbol-run-function-1 ev ex 'describe-variable)))) + ))))))) ;; 11 parentheses! + (defun describe-function-1 (function &optional nodoc) "This function does the work for `describe-function'." - (princ (format "`%s' is " function)) + (princ "`") + ;; (Help-princ-face function 'font-lock-function-name-face) overkill + (princ function) + (princ "' is ") (let* ((def function) aliases file-name autoload-file kbd-macro-p fndef macrop) (while (and (symbolp def) (fboundp def)) @@ -1112,7 +1280,8 @@ part of the documentation of internal subroutines." (if describe-function-show-arglist (let ((arglist (function-arglist function))) (when arglist - (princ arglist) + (require 'hyper-apropos) + (Help-princ-face arglist 'hyper-apropos-documentation) (terpri)))) (terpri) (cond (kbd-macro-p @@ -1141,7 +1310,13 @@ part of the documentation of internal subroutines." (unless (and obsolete aliases) (let ((doc (function-documentation function t))) (princ "Documentation:\n") - (princ doc) + (let ((oldp (point standard-output)) + newp) + (princ doc) + (setq newp (point standard-output)) + (goto-char oldp standard-output) + (frob-help-extents standard-output) + (goto-char newp standard-output)) (unless (or (equal doc "") (eq ?\n (aref doc (1- (length doc))))) (terpri))))))))) @@ -1155,7 +1330,6 @@ part of the documentation of internal subroutines." (message nil) (message (function-arglist function))) - (defun variable-at-point () (ignore-errors (with-syntax-table emacs-lisp-mode-syntax-table @@ -1168,6 +1342,21 @@ part of the documentation of internal subroutines." (let ((obj (read (current-buffer)))) (and (symbolp obj) (boundp obj) obj)))))) +(defun variable-at-event (event) + "Return the variable whose name is around the position of EVENT. +EVENT should be a mouse event. When calling from a popup or context menu, +use `last-popup-menu-event' to find out where the mouse was clicked. +\(You cannot use (interactive \"e\"), unfortunately. This returns a +misc-user event.) + +If the event contains no position, or the position is not over text, or +there is no variable around that point, nil is returned." + (if (and event (event-buffer event) (event-point event)) + (save-excursion + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (variable-at-point)))) + (defun variable-obsolete-p (variable) "Return non-nil if VARIABLE is obsolete." (not (null (get variable 'byte-obsolete-variable)))) @@ -1224,14 +1413,19 @@ part of the documentation of internal subroutines." (if v (format "Describe variable (default %s): " v) (gettext "Describe variable: ")) - obarray 'boundp t nil 'variable-history)))) - (list (if (equal val "") v (intern val))))) + obarray 'boundp t nil 'variable-history + (symbol-name v))))) + (list (intern val)))) (with-displaying-help-buffer (lambda () (let ((origvar variable) aliases) (let ((print-escape-newlines t)) - (princ (format "`%s' is " (symbol-name variable))) + (princ "`") + ;; (Help-princ-face (symbol-name variable) + ;; 'font-lock-variable-name-face) overkill + (princ (symbol-name variable)) + (princ "' is ") (while (variable-alias variable) (let ((newvar (variable-alias variable))) (if aliases @@ -1252,9 +1446,11 @@ part of the documentation of internal subroutines." (if file-name (princ (format " -- loaded from \"%s\"\n" file-name)))) (princ "\nValue: ") - (if (not (boundp variable)) - (princ "void\n") - (prin1 (symbol-value variable)) + (require 'hyper-apropos) + (if (not (boundp variable)) + (Help-princ-face "void\n" 'hyper-apropos-documentation) + (Help-prin1-face (symbol-value variable) + 'hyper-apropos-documentation) (terpri)) (terpri) (cond ((local-variable-p variable (current-buffer)) @@ -1295,7 +1491,13 @@ part of the documentation of internal subroutines." (when (or (not obsolete) (not aliases)) (if doc ;; note: documentation-property calls substitute-command-keys. - (princ doc) + (let ((oldp (point standard-output)) + newp) + (princ doc) + (setq newp (point standard-output)) + (goto-char oldp standard-output) + (frob-help-extents standard-output) + (goto-char newp standard-output)) (princ "not documented as a variable.")))) (terpri))) (format "variable `%s'" variable))) @@ -1321,7 +1523,8 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." val) (setq val (read-command (if fn (format "Where is command (default %s): " fn) - "Where is command: "))) + "Where is command: ") + (and fn (symbol-name fn)))) (list (if (equal (symbol-name val) "") fn val) current-prefix-arg))) @@ -1408,7 +1611,7 @@ after the listing is made.)" (if cmd (princ " "))))) (terpri)))))) -;; Stop gap for 21.0 untill we do help-char etc properly. +;; Stop gap for 21.0 until we do help-char etc properly. (defun help-keymap-with-help-key (keymap form) "Return a copy of KEYMAP with an help-key binding according to help-char invoking FORM like help-form. An existing binding is not overridden. @@ -1428,5 +1631,4 @@ after the listing is made.)" (with-displaying-help-buffer (insert string))))) - ;;; help.el ends here