Commit | Line | Data |
---|---|---|
b670783a | 1 | ;;; tooltip.el --- show tooltip windows |
7840ced1 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1997, 1999-2013 Free Software Foundation, Inc. |
7840ced1 GM |
4 | |
5 | ;; Author: Gerd Moellmann <gerd@acm.org> | |
6 | ;; Keywords: help c mouse tools | |
bd78fa1d | 7 | ;; Package: emacs |
7840ced1 GM |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
7840ced1 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
7840ced1 GM |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
7840ced1 GM |
23 | |
24 | ;;; Commentary: | |
25 | ||
7840ced1 GM |
26 | ;;; Code: |
27 | ||
ba025fbd EZ |
28 | (require 'syntax) |
29 | ||
5673b222 JB |
30 | (defvar comint-prompt-regexp) |
31 | ||
e3947513 JL |
32 | (defgroup tooltip nil |
33 | "Customization group for the `tooltip' package." | |
34 | :group 'help | |
35 | :group 'gud | |
36 | :group 'mouse | |
37 | :group 'tools | |
38 | :version "21.1" | |
39 | :tag "Tool Tips") | |
40 | \f | |
e85dcd95 NR |
41 | ;;; Switching tooltips on/off |
42 | ||
e85dcd95 | 43 | (define-minor-mode tooltip-mode |
f823b8ca | 44 | "Toggle Tooltip mode. |
e1ac4066 GM |
45 | With a prefix argument ARG, enable Tooltip mode if ARG is positive, |
46 | and disable it otherwise. If called from Lisp, enable the mode | |
47 | if ARG is omitted or nil. | |
f823b8ca CY |
48 | |
49 | When this global minor mode is enabled, Emacs displays help | |
50 | text (e.g. for buttons and menu items that you put the mouse on) | |
51 | in a pop-up window. | |
52 | ||
53 | When Tooltip mode is disabled, Emacs displays help text in the | |
54 | echo area, instead of making a pop-up window." | |
e85dcd95 | 55 | :global t |
8431201e CY |
56 | ;; Even if we start on a text-only terminal, make this non-nil by |
57 | ;; default because we can open a graphical frame later (multi-tty). | |
58 | :init-value t | |
adba8116 | 59 | :initialize 'custom-initialize-delay |
e85dcd95 NR |
60 | :group 'tooltip |
61 | (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) | |
62 | (error "Sorry, tooltips are not yet available on this system")) | |
63 | (if tooltip-mode | |
64 | (progn | |
65 | (add-hook 'pre-command-hook 'tooltip-hide) | |
19423c53 | 66 | (add-hook 'tooltip-functions 'tooltip-help-tips)) |
e85dcd95 NR |
67 | (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) |
68 | (remove-hook 'pre-command-hook 'tooltip-hide)) | |
19423c53 | 69 | (remove-hook 'tooltip-functions 'tooltip-help-tips)) |
e85dcd95 | 70 | (setq show-help-function |
14c0a34d | 71 | (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) |
7840ced1 | 72 | |
e3947513 JL |
73 | \f |
74 | ;;; Customizable settings | |
7840ced1 | 75 | |
88751b11 | 76 | (defcustom tooltip-delay 0.7 |
7840ced1 | 77 | "Seconds to wait before displaying a tooltip the first time." |
7840ced1 GM |
78 | :type 'number |
79 | :group 'tooltip) | |
80 | ||
7840ced1 GM |
81 | (defcustom tooltip-short-delay 0.1 |
82 | "Seconds to wait between subsequent tooltips on different items." | |
7840ced1 GM |
83 | :type 'number |
84 | :group 'tooltip) | |
85 | ||
7840ced1 | 86 | (defcustom tooltip-recent-seconds 1 |
01b23b99 DL |
87 | "Display tooltips if changing tip items within this many seconds. |
88 | Do so after `tooltip-short-delay'." | |
7840ced1 GM |
89 | :type 'number |
90 | :group 'tooltip) | |
91 | ||
88751b11 | 92 | (defcustom tooltip-hide-delay 10 |
a93c8ba8 | 93 | "Hide tooltips automatically after this many seconds." |
a93c8ba8 GM |
94 | :type 'number |
95 | :group 'tooltip) | |
96 | ||
5fddd8e6 | 97 | (defcustom tooltip-x-offset 5 |
37a29d46 | 98 | "X offset, in pixels, for the display of tooltips. |
e3947513 JL |
99 | The offset is the distance between the X position of the mouse and |
100 | the left border of the tooltip window. It must be chosen so that the | |
101 | tooltip window doesn't contain the mouse when it pops up, or it may | |
102 | interfere with clicking where you wish. | |
7142670a EZ |
103 | |
104 | If `tooltip-frame-parameters' includes the `left' parameter, | |
105 | the value of `tooltip-x-offset' is ignored." | |
5fddd8e6 | 106 | :type 'integer |
e4df9b40 GM |
107 | :group 'tooltip) |
108 | ||
48736093 | 109 | (defcustom tooltip-y-offset +20 |
37a29d46 | 110 | "Y offset, in pixels, for the display of tooltips. |
e3947513 JL |
111 | The offset is the distance between the Y position of the mouse and |
112 | the top border of the tooltip window. It must be chosen so that the | |
113 | tooltip window doesn't contain the mouse when it pops up, or it may | |
114 | interfere with clicking where you wish. | |
7142670a EZ |
115 | |
116 | If `tooltip-frame-parameters' includes the `top' parameter, | |
117 | the value of `tooltip-y-offset' is ignored." | |
5fddd8e6 | 118 | :type 'integer |
e4df9b40 GM |
119 | :group 'tooltip) |
120 | ||
7840ced1 | 121 | (defcustom tooltip-frame-parameters |
5297bc10 | 122 | '((name . "tooltip") |
5fddd8e6 | 123 | (internal-border-width . 2) |
7840ced1 | 124 | (border-width . 1)) |
7142670a EZ |
125 | "Frame parameters used for tooltips. |
126 | ||
127 | If `left' or `top' parameters are included, they specify the absolute | |
38df7d21 JB |
128 | position to pop up the tooltip. |
129 | ||
130 | Note that font and color parameters are ignored, and the attributes | |
131 | of the `tooltip' face are used instead." | |
7840ced1 | 132 | :type 'sexp |
7840ced1 GM |
133 | :group 'tooltip) |
134 | ||
2621f5a9 GM |
135 | (defface tooltip |
136 | '((((class color)) | |
39440204 JPW |
137 | :background "lightyellow" |
138 | :foreground "black" | |
139 | :inherit variable-pitch) | |
140 | (t | |
141 | :inherit variable-pitch)) | |
2621f5a9 | 142 | "Face for tooltips." |
daf96a41 JL |
143 | :group 'tooltip |
144 | :group 'basic-faces) | |
2621f5a9 | 145 | |
90aff7c6 | 146 | (defcustom tooltip-use-echo-area nil |
42cc79e6 | 147 | "Use the echo area instead of tooltip frames for help and GUD tooltips. |
f823b8ca CY |
148 | This variable is obsolete; instead of setting it to t, disable |
149 | `tooltip-mode' (which has a similar effect)." | |
90aff7c6 | 150 | :type 'boolean |
90aff7c6 NR |
151 | :group 'tooltip) |
152 | ||
f823b8ca CY |
153 | (make-obsolete-variable 'tooltip-use-echo-area |
154 | "disable Tooltip mode instead" "24.1") | |
155 | ||
7840ced1 GM |
156 | \f |
157 | ;;; Variables that are not customizable. | |
158 | ||
e5bd0a28 SM |
159 | (define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1") |
160 | ||
19423c53 | 161 | (defvar tooltip-functions nil |
7840ced1 | 162 | "Functions to call to display tooltips. |
19423c53 JB |
163 | Each function is called with one argument EVENT which is a copy |
164 | of the last mouse movement event that occurred. If one of these | |
165 | functions displays the tooltip, it should return non-nil and the | |
166 | rest are not called.") | |
167 | ||
7840ced1 GM |
168 | (defvar tooltip-timeout-id nil |
169 | "The id of the timeout started when Emacs becomes idle.") | |
170 | ||
7840ced1 GM |
171 | (defvar tooltip-last-mouse-motion-event nil |
172 | "A copy of the last mouse motion event seen.") | |
173 | ||
7840ced1 GM |
174 | (defvar tooltip-hide-time nil |
175 | "Time when the last tooltip was hidden.") | |
176 | ||
1af98f07 RS |
177 | (defvar gud-tooltip-mode) ;; Prevent warning. |
178 | ||
7840ced1 GM |
179 | ;;; Event accessors |
180 | ||
181 | (defun tooltip-event-buffer (event) | |
182 | "Return the buffer over which event EVENT occurred. | |
183 | This might return nil if the event did not occur over a buffer." | |
184 | (let ((window (posn-window (event-end event)))) | |
185 | (and window (window-buffer window)))) | |
186 | ||
7840ced1 GM |
187 | \f |
188 | ;;; Timeout for tooltip display | |
189 | ||
7840ced1 GM |
190 | (defun tooltip-delay () |
191 | "Return the delay in seconds for the next tooltip." | |
ece5f847 SM |
192 | (if (and tooltip-hide-time |
193 | (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds)) | |
194 | tooltip-short-delay | |
195 | tooltip-delay)) | |
7840ced1 | 196 | |
06f76f9f | 197 | (defun tooltip-cancel-delayed-tip () |
7840ced1 GM |
198 | "Disable the tooltip timeout." |
199 | (when tooltip-timeout-id | |
200 | (disable-timeout tooltip-timeout-id) | |
201 | (setq tooltip-timeout-id nil))) | |
202 | ||
06f76f9f | 203 | (defun tooltip-start-delayed-tip () |
04cedb11 | 204 | "Add a one-shot timeout to call function `tooltip-timeout'." |
7840ced1 GM |
205 | (setq tooltip-timeout-id |
206 | (add-timeout (tooltip-delay) 'tooltip-timeout nil))) | |
207 | ||
06b60517 | 208 | (defun tooltip-timeout (_object) |
04cedb11 | 209 | "Function called when timer with id `tooltip-timeout-id' fires." |
19423c53 | 210 | (run-hook-with-args-until-success 'tooltip-functions |
7840ced1 GM |
211 | tooltip-last-mouse-motion-event)) |
212 | ||
7840ced1 | 213 | \f |
7840ced1 GM |
214 | ;;; Displaying tips |
215 | ||
2621f5a9 | 216 | (defun tooltip-set-param (alist key value) |
4b2bb9be | 217 | "Change the value of KEY in alist ALIST to VALUE. |
f1180544 | 218 | If there's no association for KEY in ALIST, add one, otherwise |
2621f5a9 GM |
219 | change the existing association. Value is the resulting alist." |
220 | (let ((param (assq key alist))) | |
221 | (if (consp param) | |
222 | (setcdr param value) | |
223 | (push (cons key value) alist)) | |
224 | alist)) | |
225 | ||
aa360da1 GM |
226 | (declare-function x-show-tip "xfns.c" |
227 | (string &optional frame parms timeout dx dy)) | |
228 | ||
cae07240 | 229 | (defun tooltip-show (text &optional use-echo-area) |
7142670a EZ |
230 | "Show a tooltip window displaying TEXT. |
231 | ||
1d6197fb | 232 | Text larger than `x-max-tooltip-size' is clipped. |
7142670a EZ |
233 | |
234 | If the alist in `tooltip-frame-parameters' includes `left' and `top' | |
235 | parameters, they determine the x and y position where the tooltip | |
236 | is displayed. Otherwise, the tooltip pops at offsets specified by | |
237 | `tooltip-x-offset' and `tooltip-y-offset' from the current mouse | |
1d6197fb NR |
238 | position. |
239 | ||
cae07240 KS |
240 | Optional second arg USE-ECHO-AREA non-nil means to show tooltip |
241 | in echo area." | |
242 | (if use-echo-area | |
14c0a34d | 243 | (tooltip-show-help-non-mode text) |
e5603149 | 244 | (condition-case error |
2621f5a9 GM |
245 | (let ((params (copy-sequence tooltip-frame-parameters)) |
246 | (fg (face-attribute 'tooltip :foreground)) | |
247 | (bg (face-attribute 'tooltip :background))) | |
06f76f9f GM |
248 | (when (stringp fg) |
249 | (setq params (tooltip-set-param params 'foreground-color fg)) | |
250 | (setq params (tooltip-set-param params 'border-color fg))) | |
251 | (when (stringp bg) | |
252 | (setq params (tooltip-set-param params 'background-color bg))) | |
2621f5a9 GM |
253 | (x-show-tip (propertize text 'face 'tooltip) |
254 | (selected-frame) | |
f3b05e99 | 255 | params |
a93c8ba8 | 256 | tooltip-hide-delay |
2621f5a9 GM |
257 | tooltip-x-offset |
258 | tooltip-y-offset)) | |
f1180544 | 259 | (error |
e5603149 GM |
260 | (message "Error while displaying tooltip: %s" error) |
261 | (sit-for 1) | |
262 | (message "%s" text))))) | |
263 | ||
aa360da1 GM |
264 | (declare-function x-hide-tip "xfns.c" ()) |
265 | ||
06b60517 | 266 | (defun tooltip-hide (&optional _ignored-arg) |
7840ced1 GM |
267 | "Hide a tooltip, if one is displayed. |
268 | Value is non-nil if tooltip was open." | |
06f76f9f | 269 | (tooltip-cancel-delayed-tip) |
7840ced1 | 270 | (when (x-hide-tip) |
a1f84f6d | 271 | (setq tooltip-hide-time (float-time)))) |
7840ced1 | 272 | |
7840ced1 GM |
273 | \f |
274 | ;;; Debugger-related functions | |
275 | ||
276 | (defun tooltip-identifier-from-point (point) | |
277 | "Extract the identifier at POINT, if any. | |
278 | Value is nil if no identifier exists at point. Identifier extraction | |
279 | is based on the current syntax table." | |
280 | (save-excursion | |
281 | (goto-char point) | |
ba025fbd EZ |
282 | (let* ((start (progn (skip-syntax-backward "w_") (point))) |
283 | (pstate (syntax-ppss))) | |
284 | (unless (or (looking-at "[0-9]") | |
285 | (nth 3 pstate) | |
286 | (nth 4 pstate)) | |
7840ced1 GM |
287 | (skip-syntax-forward "w_") |
288 | (when (> (point) start) | |
289 | (buffer-substring start (point))))))) | |
290 | ||
7840ced1 | 291 | (defmacro tooltip-region-active-p () |
8af7e4bd | 292 | "Value is non-nil if the region should override command actions." |
71dffedd | 293 | `(use-region-p)) |
7840ced1 | 294 | |
7840ced1 GM |
295 | (defun tooltip-expr-to-print (event) |
296 | "Return an expression that should be printed for EVENT. | |
297 | If a region is active and the mouse is inside the region, print | |
298 | the region. Otherwise, figure out the identifier around the point | |
299 | where the mouse is." | |
ece5f847 | 300 | (with-current-buffer (tooltip-event-buffer event) |
7840ced1 GM |
301 | (let ((point (posn-point (event-end event)))) |
302 | (if (tooltip-region-active-p) | |
303 | (when (and (<= (region-beginning) point) (<= point (region-end))) | |
304 | (buffer-substring (region-beginning) (region-end))) | |
305 | (tooltip-identifier-from-point point))))) | |
306 | ||
7840ced1 GM |
307 | (defun tooltip-process-prompt-regexp (process) |
308 | "Return regexp matching the prompt of PROCESS at the end of a string. | |
04cedb11 JB |
309 | The prompt is taken from the value of `comint-prompt-regexp' in |
310 | the buffer of PROCESS." | |
ece5f847 | 311 | (let ((prompt-regexp (with-current-buffer (process-buffer process) |
7840ced1 | 312 | comint-prompt-regexp))) |
ece5f847 SM |
313 | (concat "\n*" |
314 | ;; Most start with `^' but the one for `sdb' cannot be easily | |
315 | ;; stripped. Code the prompt for `sdb' fixed here. | |
316 | (if (= (aref prompt-regexp 0) ?^) | |
317 | (substring prompt-regexp 1) | |
318 | "\\*") | |
319 | "$"))) | |
7840ced1 | 320 | |
7840ced1 GM |
321 | (defun tooltip-strip-prompt (process output) |
322 | "Return OUTPUT with any prompt of PROCESS stripped from its end." | |
ece5f847 SM |
323 | (save-match-data |
324 | (if (string-match (tooltip-process-prompt-regexp process) output) | |
325 | (substring output 0 (match-beginning 0)) | |
326 | output))) | |
7840ced1 | 327 | |
7840ced1 | 328 | \f |
7840ced1 GM |
329 | ;;; Tooltip help. |
330 | ||
331 | (defvar tooltip-help-message nil | |
707731ee CY |
332 | "The last help message received via `show-help-function'. |
333 | This is used by `tooltip-show-help' and | |
334 | `tooltip-show-help-non-mode'.") | |
7840ced1 | 335 | |
ece5f847 SM |
336 | (defvar tooltip-previous-message nil |
337 | "The previous content of the echo area.") | |
338 | ||
339 | (defun tooltip-show-help-non-mode (help) | |
68a4b77d CY |
340 | "Function installed as `show-help-function' when Tooltip mode is off. |
341 | It is also called if Tooltip mode is on, for text-only displays." | |
ece5f847 | 342 | (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents. |
707731ee | 343 | (not cursor-in-echo-area)) ;Don't overwrite a prompt. |
ece5f847 SM |
344 | (cond |
345 | ((stringp help) | |
9bec41de CY |
346 | (setq help (replace-regexp-in-string "\n" ", " help)) |
347 | (unless (or tooltip-previous-message | |
707731ee CY |
348 | (string-equal help (current-message)) |
349 | (and (stringp tooltip-help-message) | |
350 | (string-equal tooltip-help-message | |
351 | (current-message)))) | |
ece5f847 | 352 | (setq tooltip-previous-message (current-message))) |
707731ee | 353 | (setq tooltip-help-message help) |
ece5f847 SM |
354 | (let ((message-truncate-lines t) |
355 | (message-log-max nil)) | |
9bec41de | 356 | (message "%s" help))) |
ece5f847 SM |
357 | ((stringp tooltip-previous-message) |
358 | (let ((message-log-max nil)) | |
359 | (message "%s" tooltip-previous-message) | |
360 | (setq tooltip-previous-message nil))) | |
361 | (t | |
362 | (message nil))))) | |
14c0a34d | 363 | |
90aff7c6 | 364 | (defun tooltip-show-help (msg) |
7840ced1 GM |
365 | "Function installed as `show-help-function'. |
366 | MSG is either a help string to display, or nil to cancel the display." | |
68a4b77d CY |
367 | (if (display-graphic-p) |
368 | (let ((previous-help tooltip-help-message)) | |
369 | (setq tooltip-help-message msg) | |
370 | (cond ((null msg) | |
371 | ;; Cancel display. This also cancels a delayed tip, if | |
372 | ;; there is one. | |
373 | (tooltip-hide)) | |
374 | ((equal previous-help msg) | |
375 | ;; Same help as before (but possibly the mouse has moved). | |
376 | ;; Keep what we have. | |
377 | ) | |
378 | (t | |
379 | ;; A different help. Remove a previous tooltip, and | |
380 | ;; display a new one, with some delay. | |
381 | (tooltip-hide) | |
382 | (tooltip-start-delayed-tip)))) | |
383 | ;; On text-only displays, try `tooltip-show-help-non-mode'. | |
384 | (tooltip-show-help-non-mode msg))) | |
7840ced1 | 385 | |
06b60517 | 386 | (defun tooltip-help-tips (_event) |
7840ced1 | 387 | "Hook function to display a help tooltip. |
19423c53 JB |
388 | This is installed on the hook `tooltip-functions', which |
389 | is run when the timer with id `tooltip-timeout-id' fires. | |
7840ced1 GM |
390 | Value is non-nil if this function handled the tip." |
391 | (when (stringp tooltip-help-message) | |
90aff7c6 | 392 | (tooltip-show tooltip-help-message tooltip-use-echo-area) |
7840ced1 GM |
393 | t)) |
394 | ||
5ce0fb91 | 395 | (provide 'tooltip) |
7840ced1 GM |
396 | |
397 | ;;; tooltip.el ends here |