Mercurial > emacs

comparison lisp/help.el @ 39651:444f50200adc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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 a8abe33e09d1
children 4bd383bb2137
comparison
equal deleted inserted replaced
39650:85be22a1994b 39651:444f50200adc
38 (defvar help-map (make-sparse-keymap) 38 (defvar help-map (make-sparse-keymap)
39 "Keymap for characters following the Help key.") 39 "Keymap for characters following the Help key.")
40 40
41 (defvar help-mode-map (make-sparse-keymap) 41 (defvar help-mode-map (make-sparse-keymap)
42 "Keymap for help mode.") 42 "Keymap for help mode.")
43
44 (set-keymap-parent help-mode-map button-buffer-map)
43 45
44 (define-key global-map (char-to-string help-char) 'help-command) 46 (define-key global-map (char-to-string help-char) 'help-command)
45 (define-key global-map [help] 'help-command) 47 (define-key global-map [help] 'help-command)
46 (define-key global-map [f1] 'help-command) 48 (define-key global-map [f1] 'help-command)
47 (fset 'help-command help-map) 49 (fset 'help-command help-map)
95 97
96 (define-key help-map "v" 'describe-variable) 98 (define-key help-map "v" 'describe-variable)
97 99
98 (define-key help-map "q" 'help-quit) 100 (define-key help-map "q" 'help-quit)
99 101
100 (define-key help-mode-map [mouse-2] 'help-follow-mouse)
101 (define-key help-mode-map "\C-c\C-b" 'help-go-back) 102 (define-key help-mode-map "\C-c\C-b" 'help-go-back)
102 (define-key help-mode-map "\C-c\C-c" 'help-follow) 103 (define-key help-mode-map "\C-c\C-c" 'help-follow)
103 (define-key help-mode-map "\t" 'help-next-ref)
104 (define-key help-mode-map [backtab] 'help-previous-ref)
105 (define-key help-mode-map [(shift tab)] 'help-previous-ref)
106 ;; Documentation only, since we use minor-mode-overriding-map-alist. 104 ;; Documentation only, since we use minor-mode-overriding-map-alist.
107 (define-key help-mode-map "\r" 'help-follow) 105 (define-key help-mode-map "\r" 'help-follow)
108 106
109 (defvar help-xref-stack nil 107 (defvar help-xref-stack nil
110 "A stack of ways by which to return to help buffers after following xrefs. 108 "A stack of ways by which to return to help buffers after following xrefs.
125 (defcustom help-mode-hook nil 123 (defcustom help-mode-hook nil
126 "Hook run by `help-mode'." 124 "Hook run by `help-mode'."
127 :type 'hook 125 :type 'hook
128 :group 'help) 126 :group 'help)
129 127
128
129 ;; Button types used by help
130
131 ;; Make some button types that all use the same naming conventions
132 (dolist (help-type '("function" "variable" "face"
133 "coding-system" "input-method" "character-set"))
134 (define-button-type (intern (purecopy (concat "help-" help-type)))
135 'help-function (intern (concat "describe-" help-type))
136 'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type))
137 'action #'help-button-action))
138
139 ;; make some more ideosyncratic button types
140
141 (define-button-type 'help-symbol
142 'help-function #'help-xref-interned
143 'help-echo (purecopy "mouse-2, RET: describe this symbol")
144 'action #'help-button-action)
145
146 (define-button-type 'help-back
147 'help-function #'help-xref-go-back
148 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer")
149 'action #'help-button-action)
150
151 (define-button-type 'help-info
152 'help-function #'info
153 'help-echo (purecopy"mouse-2, RET: read this Info node")
154 'action #'help-button-action)
155
156 (define-button-type 'help-customize-variable
157 'help-function (lambda (v)
158 (if help-xref-stack
159 (pop help-xref-stack))
160 (customize-variable v))
161 'help-echo (purecopy "mouse-2, RET: customize variable")
162 'action #'help-button-action)
163
164 (define-button-type 'help-function-def
165 'help-function (lambda (fun file)
166 (require 'find-func)
167 ;; Don't use find-function-noselect because it follows
168 ;; aliases (which fails for built-in functions).
169 (let* ((location (find-function-search-for-symbol
170 fun nil file)))
171 (pop-to-buffer (car location))
172 (goto-char (cdr location))))
173 'help-echo (purecopy "mouse-2, RET: find function's definition")
174 'action #'help-button-action)
175
176 (define-button-type 'help-variable-def
177 'help-function (lambda (arg)
178 (let ((location
179 (find-variable-noselect arg)))
180 (pop-to-buffer (car location))
181 (goto-char (cdr location))))
182 'help-echo (purecopy"mouse-2, RET: find variable's definition")
183 'action #'help-button-action)
184
185 (defun help-button-action (button)
186 "Call this button's help function."
187 (help-do-xref (button-start button)
188 (button-get button 'help-function)
189 (button-get button 'help-args)))
190
191
130 (defun help-mode () 192 (defun help-mode ()
131 "Major mode for viewing help text and navigating references in it. 193 "Major mode for viewing help text and navigating references in it.
132 Entry to this mode runs the normal hook `help-mode-hook'. 194 Entry to this mode runs the normal hook `help-mode-hook'.
133 Commands: 195 Commands:
134 \\{help-mode-map}" 196 \\{help-mode-map}"
693 (princ string) 755 (princ string)
694 (with-current-buffer "*Help*" 756 (with-current-buffer "*Help*"
695 (save-excursion 757 (save-excursion
696 (save-match-data 758 (save-match-data
697 (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) 759 (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
698 (help-xref-button 1 #'describe-function def 760 (help-xref-button 1 'help-function def)))))
699 "mouse-2, RET: describe this function")))))
700 (or file-name 761 (or file-name
701 (setq file-name (symbol-file function))) 762 (setq file-name (symbol-file function)))
702 (if file-name 763 (if file-name
703 (progn 764 (progn
704 (princ " in `") 765 (princ " in `")
708 (princ "'") 769 (princ "'")
709 ;; Make a hyperlink to the library. 770 ;; Make a hyperlink to the library.
710 (with-current-buffer "*Help*" 771 (with-current-buffer "*Help*"
711 (save-excursion 772 (save-excursion
712 (re-search-backward "`\\([^`']+\\)'" nil t) 773 (re-search-backward "`\\([^`']+\\)'" nil t)
713 (help-xref-button 774 (help-xref-button 1 'help-function-def function file-name)))))
714 1
715 #'(lambda (fun file)
716 (require 'find-func)
717 ;; Don't use find-function-noselect because it follows
718 ;; aliases (which fails for built-in functions).
719 (let* ((location (find-function-search-for-symbol
720 fun nil file)))
721 (pop-to-buffer (car location))
722 (goto-char (cdr location))))
723 (list function file-name)
724 "mouse-2, RET: find function's definition")))))
725 (if need-close (princ ")")) 775 (if need-close (princ ")"))
726 (princ ".") 776 (princ ".")
727 (terpri) 777 (terpri)
728 ;; Handle symbols aliased to other symbols. 778 ;; Handle symbols aliased to other symbols.
729 (setq def (indirect-function def)) 779 (setq def (indirect-function def))
816 (cond 866 (cond
817 ((looking-at "\"") (forward-sexp 1)) 867 ((looking-at "\"") (forward-sexp 1))
818 ((looking-at "#<") (search-forward ">" nil 'move)) 868 ((looking-at "#<") (search-forward ">" nil 'move))
819 ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") 869 ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
820 (let* ((sym (intern-soft (match-string 1))) 870 (let* ((sym (intern-soft (match-string 1)))
821 (fn (cond ((fboundp sym) #'describe-function) 871 (type (cond ((fboundp sym) 'help-function)
822 ((or (memq sym '(t nil)) 872 ((or (memq sym '(t nil))
823 (keywordp sym)) 873 (keywordp sym))
824 nil) 874 nil)
825 ((and sym (boundp sym)) 875 ((and sym (boundp sym))
826 #'describe-variable)))) 876 'help-variable))))
827 (when fn (help-xref-button 1 fn sym))) 877 (when type (help-xref-button 1 type sym)))
828 (goto-char (match-end 1))) 878 (goto-char (match-end 1)))
829 (t (forward-char 1)))))) 879 (t (forward-char 1))))))
830 (set-syntax-table ost)))) 880 (set-syntax-table ost))))
831 881
832 (defun describe-variable (variable &optional buffer) 882 (defun describe-variable (variable &optional buffer)
926 (princ (concat "You can " customize-label " this variable.")) 976 (princ (concat "You can " customize-label " this variable."))
927 (with-current-buffer "*Help*" 977 (with-current-buffer "*Help*"
928 (save-excursion 978 (save-excursion
929 (re-search-backward 979 (re-search-backward
930 (concat "\\(" customize-label "\\)") nil t) 980 (concat "\\(" customize-label "\\)") nil t)
931 (help-xref-button 1 (lambda (v) 981 (help-xref-button 1 'help-customize-variable variable)))))
932 (if help-xref-stack
933 (pop help-xref-stack))
934 (customize-variable v))
935 variable
936 "mouse-2, RET: customize variable")))))
937 ;; Make a hyperlink to the library if appropriate. (Don't 982 ;; Make a hyperlink to the library if appropriate. (Don't
938 ;; change the format of the buffer's initial line in case 983 ;; change the format of the buffer's initial line in case
939 ;; anything expects the current format.) 984 ;; anything expects the current format.)
940 (let ((file-name (symbol-file variable))) 985 (let ((file-name (symbol-file variable)))
941 (when file-name 986 (when file-name
943 (princ file-name) 988 (princ file-name)
944 (princ "'.") 989 (princ "'.")
945 (with-current-buffer "*Help*" 990 (with-current-buffer "*Help*"
946 (save-excursion 991 (save-excursion
947 (re-search-backward "`\\([^`']+\\)'" nil t) 992 (re-search-backward "`\\([^`']+\\)'" nil t)
948 (help-xref-button 993 (help-xref-button 1 'help-variable-def variable)))))
949 1 (lambda (arg)
950 (let ((location
951 (find-variable-noselect arg)))
952 (pop-to-buffer (car location))
953 (goto-char (cdr location))))
954 variable "mouse-2, RET: find variable's definition")))))
955 994
956 (print-help-return-message) 995 (print-help-return-message)
957 (save-excursion 996 (save-excursion
958 (set-buffer standard-output) 997 (set-buffer standard-output)
959 ;; Return the text we displayed. 998 ;; Return the text we displayed.
1156 (while (re-search-forward help-xref-info-regexp nil t) 1195 (while (re-search-forward help-xref-info-regexp nil t)
1157 (let ((data (match-string 1))) 1196 (let ((data (match-string 1)))
1158 (save-match-data 1197 (save-match-data
1159 (unless (string-match "^([^)]+)" data) 1198 (unless (string-match "^([^)]+)" data)
1160 (setq data (concat "(emacs)" data)))) 1199 (setq data (concat "(emacs)" data))))
1161 (help-xref-button 1 #'info data 1200 (help-xref-button 1 'help-info data))))
1162 "mouse-2, RET: read this Info node"))))
1163 ;; Mule related keywords. Do this before trying 1201 ;; Mule related keywords. Do this before trying
1164 ;; `help-xref-symbol-regexp' because some of Mule 1202 ;; `help-xref-symbol-regexp' because some of Mule
1165 ;; keywords have variable or function definitions. 1203 ;; keywords have variable or function definitions.
1166 (if help-xref-mule-regexp 1204 (if help-xref-mule-regexp
1167 (save-excursion 1205 (save-excursion
1169 (let* ((data (match-string 7)) 1207 (let* ((data (match-string 7))
1170 (sym (intern-soft data))) 1208 (sym (intern-soft data)))
1171 (cond 1209 (cond
1172 ((match-string 3) ; coding system 1210 ((match-string 3) ; coding system
1173 (and sym (coding-system-p sym) 1211 (and sym (coding-system-p sym)
1174 (help-xref-button 1212 (help-xref-button 6 'help-coding-system sym)))
1175 7 #'describe-coding-system sym
1176 "mouse-2, RET: describe this coding system")))
1177 ((match-string 4) ; input method 1213 ((match-string 4) ; input method
1178 (and (assoc data input-method-alist) 1214 (and (assoc data input-method-alist)
1179 (help-xref-button 1215 (help-xref-button 7 'help-input-method data)))
1180 7 #'describe-input-method data
1181 "mouse-2, RET: describe this input method")))
1182 ((or (match-string 5) (match-string 6)) ; charset 1216 ((or (match-string 5) (match-string 6)) ; charset
1183 (and sym (charsetp sym) 1217 (and sym (charsetp sym)
1184 (help-xref-button 1218 (help-xref-button 7 'help-character-set sym)))
1185 7 #'describe-character-set sym
1186 "mouse-2, RET: describe this character set")))
1187 ((assoc data input-method-alist) 1219 ((assoc data input-method-alist)
1188 (help-xref-button 1220 (help-xref-button 7 'help-character-set data))
1189 7 #'describe-input-method data
1190 "mouse-2, RET: describe this input method"))
1191 ((and sym (coding-system-p sym)) 1221 ((and sym (coding-system-p sym))
1192 (help-xref-button 1222 (help-xref-button 7 'help-coding-system sym))
1193 7 #'describe-coding-system sym
1194 "mouse-2, RET: describe this coding system"))
1195 ((and sym (charsetp sym)) 1223 ((and sym (charsetp sym))
1196 (help-xref-button 1224 (help-xref-button 7 'help-character-set sym)))))))
1197 7 #'describe-character-set sym
1198 "mouse-2, RET: describe this character set")))))))
1199 ;; Quoted symbols 1225 ;; Quoted symbols
1200 (save-excursion 1226 (save-excursion
1201 (while (re-search-forward help-xref-symbol-regexp nil t) 1227 (while (re-search-forward help-xref-symbol-regexp nil t)
1202 (let* ((data (match-string 8)) 1228 (let* ((data (match-string 8))
1203 (sym (intern-soft data))) 1229 (sym (intern-soft data)))
1204 (if sym 1230 (if sym
1205 (cond 1231 (cond
1206 ((match-string 3) ; `variable' &c 1232 ((match-string 3) ; `variable' &c
1207 (and (boundp sym) ; `variable' doesn't ensure 1233 (and (boundp sym) ; `variable' doesn't ensure
1208 ; it's actually bound 1234 ; it's actually bound
1209 (help-xref-button 1235 (help-xref-button 8 'help-variable sym)))
1210 8 #'describe-variable sym
1211 "mouse-2, RET: describe this variable")))
1212 ((match-string 4) ; `function' &c 1236 ((match-string 4) ; `function' &c
1213 (and (fboundp sym) ; similarly 1237 (and (fboundp sym) ; similarly
1214 (help-xref-button 1238 (help-xref-button 8 'help-function sym)))
1215 8 #'describe-function sym
1216 "mouse-2, RET: describe this function")))
1217 ((match-string 5) ; `face' 1239 ((match-string 5) ; `face'
1218 (and (facep sym) 1240 (and (facep sym)
1219 (help-xref-button 8 #'describe-face sym 1241 (help-xref-button 8 'help-face sym)))
1220 "mouse-2, RET: describe this face")))
1221 ((match-string 6)) ; nothing for `symbol' 1242 ((match-string 6)) ; nothing for `symbol'
1222 ((match-string 7) 1243 ((match-string 7)
1223 (help-xref-button 1244 ;; this used:
1224 8 1245 ;; #'(lambda (arg)
1225 #'(lambda (arg) 1246 ;; (let ((location
1226 (let ((location 1247 ;; (find-function-noselect arg)))
1227 (find-function-noselect arg))) 1248 ;; (pop-to-buffer (car location))
1228 (pop-to-buffer (car location)) 1249 ;; (goto-char (cdr location))))
1229 (goto-char (cdr location)))) 1250 (help-xref-button 8 'help-function-def sym))
1230 sym
1231 "mouse-2, RET: find function's definition"))
1232 ((and (boundp sym) (fboundp sym)) 1251 ((and (boundp sym) (fboundp sym))
1233 ;; We can't intuit whether to use the 1252 ;; We can't intuit whether to use the
1234 ;; variable or function doc -- supply both. 1253 ;; variable or function doc -- supply both.
1235 (help-xref-button 1254 (help-xref-button 8 'help-symbol sym))
1236 8 #'help-xref-interned sym
1237 "mouse-2, RET: describe this symbol"))
1238 ((boundp sym) 1255 ((boundp sym)
1239 (help-xref-button 1256 (help-xref-button 8 'help-variable sym))
1240 8 #'describe-variable sym
1241 "mouse-2, RET: describe this variable"))
1242 ((fboundp sym) 1257 ((fboundp sym)
1243 (help-xref-button 1258 (help-xref-button 8 'help-function sym))
1244 8 #'describe-function sym
1245 "mouse-2, RET: describe this function"))
1246 ((facep sym) 1259 ((facep sym)
1247 (help-xref-button 1260 (help-xref-button 8 'help-face sym)))))))
1248 8 #'describe-face sym)))))))
1249 ;; An obvious case of a key substitution: 1261 ;; An obvious case of a key substitution:
1250 (save-excursion 1262 (save-excursion
1251 (while (re-search-forward 1263 (while (re-search-forward
1252 ;; Assume command name is only word characters 1264 ;; Assume command name is only word characters
1253 ;; and dashes to get things like `use M-x foo.'. 1265 ;; and dashes to get things like `use M-x foo.'.
1254 "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) 1266 "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t)
1255 (let ((sym (intern-soft (match-string 1)))) 1267 (let ((sym (intern-soft (match-string 1))))
1256 (if (fboundp sym) 1268 (if (fboundp sym)
1257 (help-xref-button 1269 (help-xref-button 1 'help-function sym)))))
1258 1 #'describe-function sym
1259 "mouse-2, RET: describe this command")))))
1260 ;; Look for commands in whole keymap substitutions: 1270 ;; Look for commands in whole keymap substitutions:
1261 (save-excursion 1271 (save-excursion
1262 ;; Make sure to find the first keymap. 1272 ;; Make sure to find the first keymap.
1263 (goto-char (point-min)) 1273 (goto-char (point-min))
1264 ;; Find a header and the column at which the command 1274 ;; Find a header and the column at which the command
1276 (skip-chars-backward "^\t\n") 1286 (skip-chars-backward "^\t\n")
1277 (if (and (>= (current-column) col) 1287 (if (and (>= (current-column) col)
1278 (looking-at "\\(\\sw\\|-\\)+$")) 1288 (looking-at "\\(\\sw\\|-\\)+$"))
1279 (let ((sym (intern-soft (match-string 0)))) 1289 (let ((sym (intern-soft (match-string 0))))
1280 (if (fboundp sym) 1290 (if (fboundp sym)
1281 (help-xref-button 1291 (help-xref-button 0 'help-function sym))))
1282 0 #'describe-function sym
1283 "mouse-2, RET: describe this function"))))
1284 (zerop (forward-line))))))))) 1292 (zerop (forward-line)))))))))
1285 (set-syntax-table stab)) 1293 (set-syntax-table stab))
1286 ;; Delete extraneous newlines at the end of the docstring 1294 ;; Delete extraneous newlines at the end of the docstring
1287 (goto-char (point-max)) 1295 (goto-char (point-max))
1288 (while (and (not (bobp)) (bolp)) 1296 (while (and (not (bobp)) (bolp))
1289 (delete-char -1)) 1297 (delete-char -1))
1290 ;; Make a back-reference in this buffer if appropriate. 1298 ;; Make a back-reference in this buffer if appropriate.
1291 (when (and help-xref-following help-xref-stack) 1299 (when (and help-xref-following help-xref-stack)
1292 (save-excursion 1300 (insert "\n\n")
1293 (insert "\n\n" help-back-label)) 1301 (help-insert-xref-button help-back-label 'help-back
1294 ;; Just to provide the match data: 1302 (current-buffer))))
1295 (looking-at (concat "\n\n\\(" (regexp-quote help-back-label) "\\)"))
1296 (help-xref-button 1 #'help-xref-go-back (current-buffer))))
1297 ;; View mode steals RET from us. 1303 ;; View mode steals RET from us.
1298 (set (make-local-variable 'minor-mode-overriding-map-alist) 1304 (set (make-local-variable 'minor-mode-overriding-map-alist)
1299 (list (cons 'view-mode 1305 (list (cons 'view-mode
1300 (let ((map (make-sparse-keymap))) 1306 (let ((map (make-sparse-keymap)))
1301 (set-keymap-parent map view-mode-map) 1307 (set-keymap-parent map view-mode-map)
1302 (define-key map "\r" 'help-follow) 1308 (define-key map "\r" 'help-follow)
1303 map)))) 1309 map))))
1304 (set-buffer-modified-p old-modified)))) 1310 (set-buffer-modified-p old-modified))))
1305 1311
1306 (defun help-xref-button (match-number function data &optional help-echo) 1312 (defun help-xref-button (match-number type &rest args)
1307 "Make a hyperlink for cross-reference text previously matched. 1313 "Make a hyperlink for cross-reference text previously matched.
1308
1309 MATCH-NUMBER is the subexpression of interest in the last matched 1314 MATCH-NUMBER is the subexpression of interest in the last matched
1310 regexp. FUNCTION is a function to invoke when the button is 1315 regexp. TYPE is the type of button to use. Any remaining arguments are
1311 activated, applied to DATA. DATA may be a single value or a list. 1316 passed to the button's help-function when it is invoked.
1312 See `help-make-xrefs'. 1317 See `help-make-xrefs'."
1313 If optional arg HELP-ECHO is supplied, it is used as a help string."
1314 ;; Don't mung properties we've added specially in some instances. 1318 ;; Don't mung properties we've added specially in some instances.
1315 (unless (get-text-property (match-beginning match-number) 'help-xref) 1319 (unless (button-at (match-beginning match-number))
1316 (add-text-properties (match-beginning match-number) 1320 (make-text-button (match-beginning match-number)
1317 (match-end match-number) 1321 (match-end match-number)
1318 (list 'mouse-face 'highlight 1322 'type type 'help-args args)))
1319 'help-xref (cons function 1323
1320 (if (listp data) 1324 (defun help-insert-xref-button (string type &rest args)
1321 data
1322 (list data)))))
1323 (if help-echo
1324 (put-text-property (match-beginning match-number)
1325 (match-end match-number)
1326 'help-echo help-echo))
1327 (if help-highlight-p
1328 (put-text-property (match-beginning match-number)
1329 (match-end match-number)
1330 'face help-highlight-face))))
1331
1332 (defun help-insert-xref-button (string function data &optional help-echo)
1333 "Insert STRING and make a hyperlink from cross-reference text on it. 1325 "Insert STRING and make a hyperlink from cross-reference text on it.
1334 1326 TYPE is the type of button to use. Any remaining arguments are passed
1335 FUNCTION is a function to invoke when the button is activated, applied 1327 to the button's help-function when it is invoked.
1336 to DATA. DATA may be a single value or a list. See `help-make-xrefs'. 1328 See `help-make-xrefs'."
1337 If optional arg HELP-ECHO is supplied, it is used as a help string." 1329 (unless (button-at (point))
1338 (let ((pos (point))) 1330 (insert-text-button string 'type type 'help-args args)))
1339 (insert string)
1340 (goto-char pos)
1341 (search-forward string)
1342 (help-xref-button 0 function data help-echo)))
1343
1344 1331
1345 1332
1346 ;; Additional functions for (re-)creating types of help buffers. 1333 ;; Additional functions for (re-)creating types of help buffers.
1347 (defun help-xref-interned (symbol) 1334 (defun help-xref-interned (symbol)
1348 "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. 1335 "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
1371 (defun help-xref-mode (buffer) 1358 (defun help-xref-mode (buffer)
1372 "Do a `describe-mode' for the specified BUFFER." 1359 "Do a `describe-mode' for the specified BUFFER."
1373 (save-excursion 1360 (save-excursion
1374 (set-buffer buffer) 1361 (set-buffer buffer)
1375 (describe-mode))) 1362 (describe-mode)))
1363
1376 1364
1377 ;;; Navigation/hyperlinking with xrefs 1365 ;;; Navigation/hyperlinking with xrefs
1378
1379 (defun help-follow-mouse (click)
1380 "Follow the cross-reference that you click on."
1381 (interactive "e")
1382 (let* ((start (event-start click))
1383 (window (car start))
1384 (pos (car (cdr start))))
1385 (with-current-buffer (window-buffer window)
1386 (help-follow pos))))
1387 1366
1388 (defun help-xref-go-back (buffer) 1367 (defun help-xref-go-back (buffer)
1389 "From BUFFER, go back to previous help buffer text using `help-xref-stack'." 1368 "From BUFFER, go back to previous help buffer text using `help-xref-stack'."
1390 (let (item position method args) 1369 (let (item position method args)
1391 (with-current-buffer buffer 1370 (with-current-buffer buffer
1403 (goto-char (car position)))))) 1382 (goto-char (car position))))))
1404 1383
1405 (defun help-go-back () 1384 (defun help-go-back ()
1406 "Invoke the [back] button (if any) in the Help mode buffer." 1385 "Invoke the [back] button (if any) in the Help mode buffer."
1407 (interactive) 1386 (interactive)
1408 (help-follow (1- (point-max)))) 1387 (let ((back-button (button-at (1- (point-max)))))
1388 (if back-button
1389 (button-activate back-button)
1390 (error "No [back] button"))))
1391
1392 (defun help-do-xref (pos function args)
1393 "Call the help cross-reference function FUNCTION with args ARGS.
1394 Things are set up properly so that the resulting help-buffer has
1395 a proper [back] button."
1396 (setq help-xref-stack (cons (cons (cons pos (buffer-name))
1397 help-xref-stack-item)
1398 help-xref-stack))
1399 (setq help-xref-stack-item nil)
1400 ;; There is a reference at point. Follow it.
1401 (let ((help-xref-following t))
1402 (apply function args)))
1409 1403
1410 (defun help-follow (&optional pos) 1404 (defun help-follow (&optional pos)
1411 "Follow cross-reference at POS, defaulting to point. 1405 "Follow cross-reference at POS, defaulting to point.
1412 1406
1413 For the cross-reference format, see `help-make-xrefs'." 1407 For the cross-reference format, see `help-make-xrefs'."
1414 (interactive "d") 1408 (interactive "d")
1415 (unless pos 1409 (unless pos
1416 (setq pos (point))) 1410 (setq pos (point)))
1417 (let* ((help-data 1411 (unless (push-button pos)
1418 (or (and (not (= pos (point-max))) 1412 ;; check if the symbol under point is a function or variable
1419 (get-text-property pos 'help-xref)) 1413 (let ((sym
1420 (and (not (= pos (point-min))) 1414 (intern
1421 (get-text-property (1- pos) 'help-xref)) 1415 (save-excursion
1422 ;; check if the symbol under point is a function or variable 1416 (goto-char pos) (skip-syntax-backward "w_")
1423 (let ((sym 1417 (buffer-substring (point)
1424 (intern 1418 (progn (skip-syntax-forward "w_")
1425 (save-excursion 1419 (point)))))))
1426 (goto-char pos) (skip-syntax-backward "w_") 1420 (when (or (boundp sym) (fboundp sym))
1427 (buffer-substring (point) 1421 (help-do-xref pos #'help-xref-interned (list sym))))))
1428 (progn (skip-syntax-forward "w_")
1429 (point)))))))
1430 (when (or (boundp sym) (fboundp sym))
1431 (list #'help-xref-interned sym)))))
1432 (method (car help-data))
1433 (args (cdr help-data)))
1434 (when help-data
1435 (setq help-xref-stack (cons (cons (cons pos (buffer-name))
1436 help-xref-stack-item)
1437 help-xref-stack))
1438 (setq help-xref-stack-item nil)
1439 ;; There is a reference at point. Follow it.
1440 (let ((help-xref-following t))
1441 (apply method args)))))
1442
1443 ;; For tabbing through buffer.
1444 (defun help-next-ref ()
1445 "Find the next help cross-reference in the buffer."
1446 (interactive)
1447 (let (pos)
1448 (while (not pos)
1449 (if (get-text-property (point) 'help-xref) ; move off reference
1450 (goto-char (or (next-single-property-change (point) 'help-xref)
1451 (point))))
1452 (cond ((setq pos (next-single-property-change (point) 'help-xref))
1453 (if pos (goto-char pos)))
1454 ((bobp)
1455 (message "No cross references in the buffer.")
1456 (setq pos t))
1457 (t ; be circular
1458 (goto-char (point-min)))))))
1459
1460 (defun help-previous-ref ()
1461 "Find the previous help cross-reference in the buffer."
1462 (interactive)
1463 (let (pos)
1464 (while (not pos)
1465 (if (get-text-property (point) 'help-xref) ; move off reference
1466 (goto-char (or (previous-single-property-change (point) 'help-xref)
1467 (point))))
1468 (cond ((setq pos (previous-single-property-change (point) 'help-xref))
1469 (if pos (goto-char pos)))
1470 ((bobp)
1471 (message "No cross references in the buffer.")
1472 (setq pos t))
1473 (t ; be circular
1474 (goto-char (point-max)))))))
1475 1422
1476 1423
1477 ;;; Automatic resizing of temporary buffers. 1424 ;;; Automatic resizing of temporary buffers.
1478 1425
1479 (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) 1426 (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))