Mercurial > emacs
changeset 39651:444f50200adc
(help-mode-map): Make button-buffer-map our parent.
Don't bind mouse events or tab/backtab.
(help-function, help-variable, help-face, help-coding-system)
(help-input-method, help-character-set, help-back, help-info)
(help-customize-variable, help-function-def, help-variable-def):
New button types.
(help-button-action): New function.
(describe-function-1): Pass help button-types to `help-xref-button'
rather than help function and help-echo string. Don't put multiple
help-function args in a list to pass them to help-xref-button, just pass
them as multiple arguments. Use `help-insert-xref-button' to make
[back]-button, rather than `help-xref-button'.
(help-xref-button): Take a button-type TYPE as a parameter rather than a
function. Remove HELP-ECHO parameter. Remove DATA parameter and add a
&rest parameter ARGS to serve the same purpose. Use `make-text-button'
to add the button.
(help-insert-xref-button): Use `insert-text-button' to add the button.
(help-follow-mouse, help-next-ref, help-previous-ref): Functions removed.
(help-do-xref): New function.
(help-follow): Use `push-button' and `help-do-xref' to do most of the work.
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 07 Oct 2001 12:05:22 +0000 |
| parents | 85be22a1994b |
| children | cd4ae2af5d87 |
| files | lisp/help.el |
| diffstat | 1 files changed, 141 insertions(+), 194 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/help.el Sun Oct 07 11:38:15 2001 +0000 +++ b/lisp/help.el Sun Oct 07 12:05:22 2001 +0000 @@ -41,6 +41,8 @@ (defvar help-mode-map (make-sparse-keymap) "Keymap for help mode.") +(set-keymap-parent help-mode-map button-buffer-map) + (define-key global-map (char-to-string help-char) 'help-command) (define-key global-map [help] 'help-command) (define-key global-map [f1] 'help-command) @@ -97,12 +99,8 @@ (define-key help-map "q" 'help-quit) -(define-key help-mode-map [mouse-2] 'help-follow-mouse) (define-key help-mode-map "\C-c\C-b" 'help-go-back) (define-key help-mode-map "\C-c\C-c" 'help-follow) -(define-key help-mode-map "\t" 'help-next-ref) -(define-key help-mode-map [backtab] 'help-previous-ref) -(define-key help-mode-map [(shift tab)] 'help-previous-ref) ;; Documentation only, since we use minor-mode-overriding-map-alist. (define-key help-mode-map "\r" 'help-follow) @@ -127,6 +125,70 @@ :type 'hook :group 'help) + +;; Button types used by help + +;; Make some button types that all use the same naming conventions +(dolist (help-type '("function" "variable" "face" + "coding-system" "input-method" "character-set")) + (define-button-type (intern (purecopy (concat "help-" help-type))) + 'help-function (intern (concat "describe-" help-type)) + 'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type)) + 'action #'help-button-action)) + +;; make some more ideosyncratic button types + +(define-button-type 'help-symbol + 'help-function #'help-xref-interned + 'help-echo (purecopy "mouse-2, RET: describe this symbol") + 'action #'help-button-action) + +(define-button-type 'help-back + 'help-function #'help-xref-go-back + 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer") + 'action #'help-button-action) + +(define-button-type 'help-info + 'help-function #'info + 'help-echo (purecopy"mouse-2, RET: read this Info node") + 'action #'help-button-action) + +(define-button-type 'help-customize-variable + 'help-function (lambda (v) + (if help-xref-stack + (pop help-xref-stack)) + (customize-variable v)) + 'help-echo (purecopy "mouse-2, RET: customize variable") + 'action #'help-button-action) + +(define-button-type 'help-function-def + 'help-function (lambda (fun file) + (require 'find-func) + ;; Don't use find-function-noselect because it follows + ;; aliases (which fails for built-in functions). + (let* ((location (find-function-search-for-symbol + fun nil file))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + 'help-echo (purecopy "mouse-2, RET: find function's definition") + 'action #'help-button-action) + +(define-button-type 'help-variable-def + 'help-function (lambda (arg) + (let ((location + (find-variable-noselect arg))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + 'help-echo (purecopy"mouse-2, RET: find variable's definition") + 'action #'help-button-action) + +(defun help-button-action (button) + "Call this button's help function." + (help-do-xref (button-start button) + (button-get button 'help-function) + (button-get button 'help-args))) + + (defun help-mode () "Major mode for viewing help text and navigating references in it. Entry to this mode runs the normal hook `help-mode-hook'. @@ -695,8 +757,7 @@ (save-excursion (save-match-data (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) - (help-xref-button 1 #'describe-function def - "mouse-2, RET: describe this function"))))) + (help-xref-button 1 'help-function def))))) (or file-name (setq file-name (symbol-file function))) (if file-name @@ -710,18 +771,7 @@ (with-current-buffer "*Help*" (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button - 1 - #'(lambda (fun file) - (require 'find-func) - ;; Don't use find-function-noselect because it follows - ;; aliases (which fails for built-in functions). - (let* ((location (find-function-search-for-symbol - fun nil file))) - (pop-to-buffer (car location)) - (goto-char (cdr location)))) - (list function file-name) - "mouse-2, RET: find function's definition"))))) + (help-xref-button 1 'help-function-def function file-name))))) (if need-close (princ ")")) (princ ".") (terpri) @@ -818,13 +868,13 @@ ((looking-at "#<") (search-forward ">" nil 'move)) ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") (let* ((sym (intern-soft (match-string 1))) - (fn (cond ((fboundp sym) #'describe-function) + (type (cond ((fboundp sym) 'help-function) ((or (memq sym '(t nil)) (keywordp sym)) nil) ((and sym (boundp sym)) - #'describe-variable)))) - (when fn (help-xref-button 1 fn sym))) + 'help-variable)))) + (when type (help-xref-button 1 type sym))) (goto-char (match-end 1))) (t (forward-char 1)))))) (set-syntax-table ost)))) @@ -928,12 +978,7 @@ (save-excursion (re-search-backward (concat "\\(" customize-label "\\)") nil t) - (help-xref-button 1 (lambda (v) - (if help-xref-stack - (pop help-xref-stack)) - (customize-variable v)) - variable - "mouse-2, RET: customize variable"))))) + (help-xref-button 1 'help-customize-variable variable))))) ;; Make a hyperlink to the library if appropriate. (Don't ;; change the format of the buffer's initial line in case ;; anything expects the current format.) @@ -945,13 +990,7 @@ (with-current-buffer "*Help*" (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button - 1 (lambda (arg) - (let ((location - (find-variable-noselect arg))) - (pop-to-buffer (car location)) - (goto-char (cdr location)))) - variable "mouse-2, RET: find variable's definition"))))) + (help-xref-button 1 'help-variable-def variable))))) (print-help-return-message) (save-excursion @@ -1158,8 +1197,7 @@ (save-match-data (unless (string-match "^([^)]+)" data) (setq data (concat "(emacs)" data)))) - (help-xref-button 1 #'info data - "mouse-2, RET: read this Info node")))) + (help-xref-button 1 'help-info data)))) ;; Mule related keywords. Do this before trying ;; `help-xref-symbol-regexp' because some of Mule ;; keywords have variable or function definitions. @@ -1171,31 +1209,19 @@ (cond ((match-string 3) ; coding system (and sym (coding-system-p sym) - (help-xref-button - 7 #'describe-coding-system sym - "mouse-2, RET: describe this coding system"))) + (help-xref-button 6 'help-coding-system sym))) ((match-string 4) ; input method (and (assoc data input-method-alist) - (help-xref-button - 7 #'describe-input-method data - "mouse-2, RET: describe this input method"))) + (help-xref-button 7 'help-input-method data))) ((or (match-string 5) (match-string 6)) ; charset (and sym (charsetp sym) - (help-xref-button - 7 #'describe-character-set sym - "mouse-2, RET: describe this character set"))) + (help-xref-button 7 'help-character-set sym))) ((assoc data input-method-alist) - (help-xref-button - 7 #'describe-input-method data - "mouse-2, RET: describe this input method")) + (help-xref-button 7 'help-character-set data)) ((and sym (coding-system-p sym)) - (help-xref-button - 7 #'describe-coding-system sym - "mouse-2, RET: describe this coding system")) + (help-xref-button 7 'help-coding-system sym)) ((and sym (charsetp sym)) - (help-xref-button - 7 #'describe-character-set sym - "mouse-2, RET: describe this character set"))))))) + (help-xref-button 7 'help-character-set sym))))))) ;; Quoted symbols (save-excursion (while (re-search-forward help-xref-symbol-regexp nil t) @@ -1206,46 +1232,32 @@ ((match-string 3) ; `variable' &c (and (boundp sym) ; `variable' doesn't ensure ; it's actually bound - (help-xref-button - 8 #'describe-variable sym - "mouse-2, RET: describe this variable"))) + (help-xref-button 8 'help-variable sym))) ((match-string 4) ; `function' &c (and (fboundp sym) ; similarly - (help-xref-button - 8 #'describe-function sym - "mouse-2, RET: describe this function"))) + (help-xref-button 8 'help-function sym))) ((match-string 5) ; `face' (and (facep sym) - (help-xref-button 8 #'describe-face sym - "mouse-2, RET: describe this face"))) + (help-xref-button 8 'help-face sym))) ((match-string 6)) ; nothing for `symbol' ((match-string 7) - (help-xref-button - 8 - #'(lambda (arg) - (let ((location - (find-function-noselect arg))) - (pop-to-buffer (car location)) - (goto-char (cdr location)))) - sym - "mouse-2, RET: find function's definition")) +;; this used: +;; #'(lambda (arg) +;; (let ((location +;; (find-function-noselect arg))) +;; (pop-to-buffer (car location)) +;; (goto-char (cdr location)))) + (help-xref-button 8 'help-function-def sym)) ((and (boundp sym) (fboundp sym)) ;; We can't intuit whether to use the ;; variable or function doc -- supply both. - (help-xref-button - 8 #'help-xref-interned sym - "mouse-2, RET: describe this symbol")) + (help-xref-button 8 'help-symbol sym)) ((boundp sym) - (help-xref-button - 8 #'describe-variable sym - "mouse-2, RET: describe this variable")) + (help-xref-button 8 'help-variable sym)) ((fboundp sym) - (help-xref-button - 8 #'describe-function sym - "mouse-2, RET: describe this function")) + (help-xref-button 8 'help-function sym)) ((facep sym) - (help-xref-button - 8 #'describe-face sym))))))) + (help-xref-button 8 'help-face sym))))))) ;; An obvious case of a key substitution: (save-excursion (while (re-search-forward @@ -1254,9 +1266,7 @@ "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) (let ((sym (intern-soft (match-string 1)))) (if (fboundp sym) - (help-xref-button - 1 #'describe-function sym - "mouse-2, RET: describe this command"))))) + (help-xref-button 1 'help-function sym))))) ;; Look for commands in whole keymap substitutions: (save-excursion ;; Make sure to find the first keymap. @@ -1278,9 +1288,7 @@ (looking-at "\\(\\sw\\|-\\)+$")) (let ((sym (intern-soft (match-string 0)))) (if (fboundp sym) - (help-xref-button - 0 #'describe-function sym - "mouse-2, RET: describe this function")))) + (help-xref-button 0 'help-function sym)))) (zerop (forward-line))))))))) (set-syntax-table stab)) ;; Delete extraneous newlines at the end of the docstring @@ -1289,11 +1297,9 @@ (delete-char -1)) ;; Make a back-reference in this buffer if appropriate. (when (and help-xref-following help-xref-stack) - (save-excursion - (insert "\n\n" help-back-label)) - ;; Just to provide the match data: - (looking-at (concat "\n\n\\(" (regexp-quote help-back-label) "\\)")) - (help-xref-button 1 #'help-xref-go-back (current-buffer)))) + (insert "\n\n") + (help-insert-xref-button help-back-label 'help-back + (current-buffer)))) ;; View mode steals RET from us. (set (make-local-variable 'minor-mode-overriding-map-alist) (list (cons 'view-mode @@ -1303,44 +1309,25 @@ map)))) (set-buffer-modified-p old-modified)))) -(defun help-xref-button (match-number function data &optional help-echo) +(defun help-xref-button (match-number type &rest args) "Make a hyperlink for cross-reference text previously matched. - MATCH-NUMBER is the subexpression of interest in the last matched -regexp. FUNCTION is a function to invoke when the button is -activated, applied to DATA. DATA may be a single value or a list. -See `help-make-xrefs'. -If optional arg HELP-ECHO is supplied, it is used as a help string." +regexp. TYPE is the type of button to use. Any remaining arguments are +passed to the button's help-function when it is invoked. +See `help-make-xrefs'." ;; Don't mung properties we've added specially in some instances. - (unless (get-text-property (match-beginning match-number) 'help-xref) - (add-text-properties (match-beginning match-number) - (match-end match-number) - (list 'mouse-face 'highlight - 'help-xref (cons function - (if (listp data) - data - (list data))))) - (if help-echo - (put-text-property (match-beginning match-number) - (match-end match-number) - 'help-echo help-echo)) - (if help-highlight-p - (put-text-property (match-beginning match-number) - (match-end match-number) - 'face help-highlight-face)))) + (unless (button-at (match-beginning match-number)) + (make-text-button (match-beginning match-number) + (match-end match-number) + 'type type 'help-args args))) -(defun help-insert-xref-button (string function data &optional help-echo) +(defun help-insert-xref-button (string type &rest args) "Insert STRING and make a hyperlink from cross-reference text on it. - -FUNCTION is a function to invoke when the button is activated, applied -to DATA. DATA may be a single value or a list. See `help-make-xrefs'. -If optional arg HELP-ECHO is supplied, it is used as a help string." - (let ((pos (point))) - (insert string) - (goto-char pos) - (search-forward string) - (help-xref-button 0 function data help-echo))) - +TYPE is the type of button to use. Any remaining arguments are passed +to the button's help-function when it is invoked. +See `help-make-xrefs'." + (unless (button-at (point)) + (insert-text-button string 'type type 'help-args args))) ;; Additional functions for (re-)creating types of help buffers. @@ -1373,18 +1360,10 @@ (save-excursion (set-buffer buffer) (describe-mode))) + ;;; Navigation/hyperlinking with xrefs -(defun help-follow-mouse (click) - "Follow the cross-reference that you click on." - (interactive "e") - (let* ((start (event-start click)) - (window (car start)) - (pos (car (cdr start)))) - (with-current-buffer (window-buffer window) - (help-follow pos)))) - (defun help-xref-go-back (buffer) "From BUFFER, go back to previous help buffer text using `help-xref-stack'." (let (item position method args) @@ -1405,7 +1384,22 @@ (defun help-go-back () "Invoke the [back] button (if any) in the Help mode buffer." (interactive) - (help-follow (1- (point-max)))) + (let ((back-button (button-at (1- (point-max))))) + (if back-button + (button-activate back-button) + (error "No [back] button")))) + +(defun help-do-xref (pos function args) + "Call the help cross-reference function FUNCTION with args ARGS. +Things are set up properly so that the resulting help-buffer has +a proper [back] button." + (setq help-xref-stack (cons (cons (cons pos (buffer-name)) + help-xref-stack-item) + help-xref-stack)) + (setq help-xref-stack-item nil) + ;; There is a reference at point. Follow it. + (let ((help-xref-following t)) + (apply function args))) (defun help-follow (&optional pos) "Follow cross-reference at POS, defaulting to point. @@ -1414,64 +1408,17 @@ (interactive "d") (unless pos (setq pos (point))) - (let* ((help-data - (or (and (not (= pos (point-max))) - (get-text-property pos 'help-xref)) - (and (not (= pos (point-min))) - (get-text-property (1- pos) 'help-xref)) - ;; check if the symbol under point is a function or variable - (let ((sym - (intern - (save-excursion - (goto-char pos) (skip-syntax-backward "w_") - (buffer-substring (point) - (progn (skip-syntax-forward "w_") - (point))))))) - (when (or (boundp sym) (fboundp sym)) - (list #'help-xref-interned sym))))) - (method (car help-data)) - (args (cdr help-data))) - (when help-data - (setq help-xref-stack (cons (cons (cons pos (buffer-name)) - help-xref-stack-item) - help-xref-stack)) - (setq help-xref-stack-item nil) - ;; There is a reference at point. Follow it. - (let ((help-xref-following t)) - (apply method args))))) - -;; For tabbing through buffer. -(defun help-next-ref () - "Find the next help cross-reference in the buffer." - (interactive) - (let (pos) - (while (not pos) - (if (get-text-property (point) 'help-xref) ; move off reference - (goto-char (or (next-single-property-change (point) 'help-xref) - (point)))) - (cond ((setq pos (next-single-property-change (point) 'help-xref)) - (if pos (goto-char pos))) - ((bobp) - (message "No cross references in the buffer.") - (setq pos t)) - (t ; be circular - (goto-char (point-min))))))) - -(defun help-previous-ref () - "Find the previous help cross-reference in the buffer." - (interactive) - (let (pos) - (while (not pos) - (if (get-text-property (point) 'help-xref) ; move off reference - (goto-char (or (previous-single-property-change (point) 'help-xref) - (point)))) - (cond ((setq pos (previous-single-property-change (point) 'help-xref)) - (if pos (goto-char pos))) - ((bobp) - (message "No cross references in the buffer.") - (setq pos t)) - (t ; be circular - (goto-char (point-max))))))) + (unless (push-button pos) + ;; check if the symbol under point is a function or variable + (let ((sym + (intern + (save-excursion + (goto-char pos) (skip-syntax-backward "w_") + (buffer-substring (point) + (progn (skip-syntax-forward "w_") + (point))))))) + (when (or (boundp sym) (fboundp sym)) + (help-do-xref pos #'help-xref-interned (list sym)))))) ;;; Automatic resizing of temporary buffers.