Commit | Line | Data |
---|---|---|
b670783a | 1 | ;;; tooltip.el --- show tooltip windows |
7840ced1 | 2 | |
8bc973e9 | 3 | ;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005 |
f2a1c81b | 4 | ;; Free Software Foundation, Inc. |
7840ced1 GM |
5 | |
6 | ;; Author: Gerd Moellmann <gerd@acm.org> | |
7 | ;; Keywords: help c mouse tools | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 2, or (at your option) | |
14 | ;; any later version. | |
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 | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 | ;; Boston, MA 02111-1307, USA. | |
25 | ||
26 | ;;; Commentary: | |
27 | ||
7840ced1 GM |
28 | ;;; Code: |
29 | ||
7840ced1 GM |
30 | ;;; Customizable settings |
31 | ||
32 | (defgroup tooltip nil | |
33 | "Customization group for the `tooltip' package." | |
34 | :group 'help | |
3e6ed970 | 35 | :group 'gud |
7840ced1 GM |
36 | :group 'mouse |
37 | :group 'tools | |
01b23b99 | 38 | :version "21.1" |
7840ced1 GM |
39 | :tag "Tool Tips") |
40 | ||
88751b11 | 41 | (defcustom tooltip-delay 0.7 |
7840ced1 GM |
42 | "Seconds to wait before displaying a tooltip the first time." |
43 | :tag "Delay" | |
44 | :type 'number | |
45 | :group 'tooltip) | |
46 | ||
7840ced1 GM |
47 | (defcustom tooltip-short-delay 0.1 |
48 | "Seconds to wait between subsequent tooltips on different items." | |
49 | :tag "Short delay" | |
50 | :type 'number | |
51 | :group 'tooltip) | |
52 | ||
7840ced1 | 53 | (defcustom tooltip-recent-seconds 1 |
01b23b99 DL |
54 | "Display tooltips if changing tip items within this many seconds. |
55 | Do so after `tooltip-short-delay'." | |
7840ced1 GM |
56 | :tag "Recent seconds" |
57 | :type 'number | |
58 | :group 'tooltip) | |
59 | ||
88751b11 | 60 | (defcustom tooltip-hide-delay 10 |
a93c8ba8 GM |
61 | "Hide tooltips automatically after this many seconds." |
62 | :tag "Hide delay" | |
63 | :type 'number | |
64 | :group 'tooltip) | |
65 | ||
e4df9b40 | 66 | (defcustom tooltip-x-offset nil |
37a29d46 | 67 | "X offset, in pixels, for the display of tooltips. |
e4df9b40 GM |
68 | The offset is relative to the position of the mouse. It must |
69 | be chosen so that the tooltip window doesn't contain the mouse | |
7142670a EZ |
70 | when it pops up. If the value is nil, the default offset is 5 |
71 | pixels. | |
72 | ||
73 | If `tooltip-frame-parameters' includes the `left' parameter, | |
74 | the value of `tooltip-x-offset' is ignored." | |
e4df9b40 GM |
75 | :tag "X offset" |
76 | :type '(choice (const :tag "Default" nil) | |
77 | (integer :tag "Offset" :value 1)) | |
78 | :group 'tooltip) | |
79 | ||
e4df9b40 | 80 | (defcustom tooltip-y-offset nil |
37a29d46 | 81 | "Y offset, in pixels, for the display of tooltips. |
e4df9b40 GM |
82 | The offset is relative to the position of the mouse. It must |
83 | be chosen so that the tooltip window doesn't contain the mouse | |
7142670a EZ |
84 | when it pops up. If the value is nil, the default offset is -10 |
85 | pixels. | |
86 | ||
87 | If `tooltip-frame-parameters' includes the `top' parameter, | |
88 | the value of `tooltip-y-offset' is ignored." | |
e4df9b40 GM |
89 | :tag "Y offset" |
90 | :type '(choice (const :tag "Default" nil) | |
91 | (integer :tag "Offset" :value 1)) | |
92 | :group 'tooltip) | |
93 | ||
7840ced1 GM |
94 | (defcustom tooltip-frame-parameters |
95 | '((name . "tooltip") | |
7840ced1 | 96 | (internal-border-width . 5) |
7840ced1 | 97 | (border-width . 1)) |
7142670a EZ |
98 | "Frame parameters used for tooltips. |
99 | ||
100 | If `left' or `top' parameters are included, they specify the absolute | |
101 | position to pop up the tooltip." | |
7840ced1 GM |
102 | :type 'sexp |
103 | :tag "Frame Parameters" | |
104 | :group 'tooltip) | |
105 | ||
2621f5a9 GM |
106 | (defface tooltip |
107 | '((((class color)) | |
39440204 JPW |
108 | :background "lightyellow" |
109 | :foreground "black" | |
110 | :inherit variable-pitch) | |
111 | (t | |
112 | :inherit variable-pitch)) | |
2621f5a9 GM |
113 | "Face for tooltips." |
114 | :group 'tooltip) | |
115 | ||
90aff7c6 NR |
116 | (defcustom tooltip-use-echo-area nil |
117 | "Use the echo area instead of tooltip frames for help and GUD tooltips." | |
118 | :type 'boolean | |
119 | :tag "Use echo area" | |
120 | :group 'tooltip) | |
121 | ||
122 | (make-obsolete-variable 'tooltip-use-echo-area | |
04cedb11 JB |
123 | "To display help tooltips in the echo area turn `tooltip-mode' off. |
124 | To display GUD tooltips in the echo area turn `gud-tooltip-mode' on and set | |
125 | `gud-tooltip-echo-area' to t." "22.1") | |
90aff7c6 | 126 | |
7840ced1 GM |
127 | \f |
128 | ;;; Variables that are not customizable. | |
129 | ||
130 | (defvar tooltip-hook nil | |
131 | "Functions to call to display tooltips. | |
132 | Each function is called with one argument EVENT which is a copy of | |
133 | the last mouse movement event that occurred.") | |
134 | ||
7840ced1 GM |
135 | (defvar tooltip-timeout-id nil |
136 | "The id of the timeout started when Emacs becomes idle.") | |
137 | ||
7840ced1 GM |
138 | (defvar tooltip-last-mouse-motion-event nil |
139 | "A copy of the last mouse motion event seen.") | |
140 | ||
7840ced1 GM |
141 | (defvar tooltip-hide-time nil |
142 | "Time when the last tooltip was hidden.") | |
143 | ||
7840ced1 GM |
144 | ;;; Event accessors |
145 | ||
146 | (defun tooltip-event-buffer (event) | |
147 | "Return the buffer over which event EVENT occurred. | |
148 | This might return nil if the event did not occur over a buffer." | |
149 | (let ((window (posn-window (event-end event)))) | |
150 | (and window (window-buffer window)))) | |
151 | ||
7840ced1 GM |
152 | ;;; Switching tooltips on/off |
153 | ||
154 | ;; We don't set track-mouse globally because this is a big redisplay | |
155 | ;; problem in buffers having a pre-command-hook or such installed, | |
156 | ;; which does a set-buffer, like the summary buffer of Gnus. Calling | |
157 | ;; set-buffer prevents redisplay optimizations, so every mouse motion | |
158 | ;; would be accompanied by a full redisplay. | |
159 | ||
160 | ;;;###autoload | |
8bc973e9 NR |
161 | (define-minor-mode tooltip-mode |
162 | "Toggle Tooltip display. | |
7840ced1 | 163 | With ARG, turn tooltip mode on if and only if ARG is positive." |
8bc973e9 | 164 | :global t |
d5e2843d LT |
165 | ;; If you change the :init-value below, you also need to change the |
166 | ;; corresponding code in startup.el. | |
167 | :init-value (not (or noninteractive | |
8b8f03c8 YM |
168 | (and (boundp 'emacs-quick-startup) emacs-quick-startup) |
169 | (not (and (fboundp 'display-graphic-p) | |
170 | (display-graphic-p))) | |
d5e2843d | 171 | (not (fboundp 'x-show-tip)))) |
8bc973e9 | 172 | :group 'tooltip |
ef75a647 | 173 | (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) |
c6da4eb4 | 174 | (error "Sorry, tooltips are not yet available on this system")) |
a93d8344 NR |
175 | (if tooltip-mode |
176 | (progn | |
177 | (add-hook 'pre-command-hook 'tooltip-hide) | |
178 | (add-hook 'tooltip-hook 'tooltip-help-tips)) | |
179 | (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) | |
180 | (remove-hook 'pre-command-hook 'tooltip-hide)) | |
181 | (remove-hook 'tooltip-hook 'tooltip-help-tips)) | |
182 | (setq show-help-function | |
90aff7c6 | 183 | (if tooltip-mode 'tooltip-show-help nil))) |
dea87733 | 184 | |
7840ced1 GM |
185 | \f |
186 | ;;; Timeout for tooltip display | |
187 | ||
7840ced1 GM |
188 | (defun tooltip-delay () |
189 | "Return the delay in seconds for the next tooltip." | |
190 | (let ((delay tooltip-delay) | |
a1f84f6d | 191 | (now (float-time))) |
7840ced1 GM |
192 | (when (and tooltip-hide-time |
193 | (< (- now tooltip-hide-time) tooltip-recent-seconds)) | |
194 | (setq delay tooltip-short-delay)) | |
195 | delay)) | |
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 | ||
7840ced1 | 208 | (defun tooltip-timeout (object) |
04cedb11 | 209 | "Function called when timer with id `tooltip-timeout-id' fires." |
7840ced1 GM |
210 | (run-hook-with-args-until-success 'tooltip-hook |
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 | ||
cae07240 | 226 | (defun tooltip-show (text &optional use-echo-area) |
7142670a EZ |
227 | "Show a tooltip window displaying TEXT. |
228 | ||
1d6197fb | 229 | Text larger than `x-max-tooltip-size' is clipped. |
7142670a EZ |
230 | |
231 | If the alist in `tooltip-frame-parameters' includes `left' and `top' | |
232 | parameters, they determine the x and y position where the tooltip | |
233 | is displayed. Otherwise, the tooltip pops at offsets specified by | |
234 | `tooltip-x-offset' and `tooltip-y-offset' from the current mouse | |
1d6197fb NR |
235 | position. |
236 | ||
cae07240 KS |
237 | Optional second arg USE-ECHO-AREA non-nil means to show tooltip |
238 | in echo area." | |
239 | (if use-echo-area | |
72200f89 | 240 | (message "%s" text) |
e5603149 | 241 | (condition-case error |
2621f5a9 GM |
242 | (let ((params (copy-sequence tooltip-frame-parameters)) |
243 | (fg (face-attribute 'tooltip :foreground)) | |
244 | (bg (face-attribute 'tooltip :background))) | |
06f76f9f GM |
245 | (when (stringp fg) |
246 | (setq params (tooltip-set-param params 'foreground-color fg)) | |
247 | (setq params (tooltip-set-param params 'border-color fg))) | |
248 | (when (stringp bg) | |
249 | (setq params (tooltip-set-param params 'background-color bg))) | |
2621f5a9 GM |
250 | (x-show-tip (propertize text 'face 'tooltip) |
251 | (selected-frame) | |
f3b05e99 | 252 | params |
a93c8ba8 | 253 | tooltip-hide-delay |
2621f5a9 GM |
254 | tooltip-x-offset |
255 | tooltip-y-offset)) | |
f1180544 | 256 | (error |
e5603149 GM |
257 | (message "Error while displaying tooltip: %s" error) |
258 | (sit-for 1) | |
259 | (message "%s" text))))) | |
260 | ||
7840ced1 GM |
261 | (defun tooltip-hide (&optional ignored-arg) |
262 | "Hide a tooltip, if one is displayed. | |
263 | Value is non-nil if tooltip was open." | |
06f76f9f | 264 | (tooltip-cancel-delayed-tip) |
7840ced1 | 265 | (when (x-hide-tip) |
a1f84f6d | 266 | (setq tooltip-hide-time (float-time)))) |
7840ced1 | 267 | |
7840ced1 GM |
268 | \f |
269 | ;;; Debugger-related functions | |
270 | ||
271 | (defun tooltip-identifier-from-point (point) | |
272 | "Extract the identifier at POINT, if any. | |
273 | Value is nil if no identifier exists at point. Identifier extraction | |
274 | is based on the current syntax table." | |
275 | (save-excursion | |
276 | (goto-char point) | |
277 | (let ((start (progn (skip-syntax-backward "w_") (point)))) | |
278 | (unless (looking-at "[0-9]") | |
279 | (skip-syntax-forward "w_") | |
280 | (when (> (point) start) | |
281 | (buffer-substring start (point))))))) | |
282 | ||
7840ced1 GM |
283 | (defmacro tooltip-region-active-p () |
284 | "Value is non-nil if the region is currently active." | |
285 | (if (string-match "^GNU" (emacs-version)) | |
286 | `(and transient-mark-mode mark-active) | |
287 | `(region-active-p))) | |
288 | ||
7840ced1 GM |
289 | (defun tooltip-expr-to-print (event) |
290 | "Return an expression that should be printed for EVENT. | |
291 | If a region is active and the mouse is inside the region, print | |
292 | the region. Otherwise, figure out the identifier around the point | |
293 | where the mouse is." | |
294 | (save-excursion | |
295 | (set-buffer (tooltip-event-buffer event)) | |
296 | (let ((point (posn-point (event-end event)))) | |
297 | (if (tooltip-region-active-p) | |
298 | (when (and (<= (region-beginning) point) (<= point (region-end))) | |
299 | (buffer-substring (region-beginning) (region-end))) | |
300 | (tooltip-identifier-from-point point))))) | |
301 | ||
7840ced1 GM |
302 | (defun tooltip-process-prompt-regexp (process) |
303 | "Return regexp matching the prompt of PROCESS at the end of a string. | |
04cedb11 JB |
304 | The prompt is taken from the value of `comint-prompt-regexp' in |
305 | the buffer of PROCESS." | |
7840ced1 GM |
306 | (let ((prompt-regexp (save-excursion |
307 | (set-buffer (process-buffer process)) | |
308 | comint-prompt-regexp))) | |
309 | ;; Most start with `^' but the one for `sdb' cannot be easily | |
310 | ;; stripped. Code the prompt for `sdb' fixed here. | |
311 | (if (= (aref prompt-regexp 0) ?^) | |
312 | (setq prompt-regexp (substring prompt-regexp 1)) | |
313 | (setq prompt-regexp "\\*")) | |
314 | (concat "\n*" prompt-regexp "$"))) | |
315 | ||
7840ced1 GM |
316 | (defun tooltip-strip-prompt (process output) |
317 | "Return OUTPUT with any prompt of PROCESS stripped from its end." | |
318 | (let ((prompt-regexp (tooltip-process-prompt-regexp process))) | |
319 | (save-match-data | |
320 | (when (string-match prompt-regexp output) | |
321 | (setq output (substring output 0 (match-beginning 0))))) | |
322 | output)) | |
323 | ||
7840ced1 | 324 | \f |
7840ced1 GM |
325 | ;;; Tooltip help. |
326 | ||
327 | (defvar tooltip-help-message nil | |
90aff7c6 | 328 | "The last help message received via `tooltip-show-help'.") |
7840ced1 | 329 | |
90aff7c6 | 330 | (defun tooltip-show-help (msg) |
7840ced1 GM |
331 | "Function installed as `show-help-function'. |
332 | MSG is either a help string to display, or nil to cancel the display." | |
86f0d417 | 333 | (let ((previous-help tooltip-help-message)) |
7840ced1 GM |
334 | (setq tooltip-help-message msg) |
335 | (cond ((null msg) | |
06f76f9f GM |
336 | ;; Cancel display. This also cancels a delayed tip, if |
337 | ;; there is one. | |
7840ced1 | 338 | (tooltip-hide)) |
06f76f9f GM |
339 | ((equal previous-help msg) |
340 | ;; Same help as before (but possibly the mouse has moved). | |
341 | ;; Keep what we have. | |
342 | ) | |
7840ced1 | 343 | (t |
f1180544 | 344 | ;; A different help. Remove a previous tooltip, and |
06f76f9f GM |
345 | ;; display a new one, with some delay. |
346 | (tooltip-hide) | |
347 | (tooltip-start-delayed-tip))))) | |
7840ced1 | 348 | |
7840ced1 GM |
349 | (defun tooltip-help-tips (event) |
350 | "Hook function to display a help tooltip. | |
06f76f9f | 351 | This is installed on the hook `tooltip-hook', which is run when |
04cedb11 | 352 | the timer with id `tooltip-timeout-id' fires. |
7840ced1 GM |
353 | Value is non-nil if this function handled the tip." |
354 | (when (stringp tooltip-help-message) | |
90aff7c6 | 355 | (tooltip-show tooltip-help-message tooltip-use-echo-area) |
7840ced1 GM |
356 | t)) |
357 | ||
5ce0fb91 | 358 | (provide 'tooltip) |
7840ced1 | 359 | |
18385083 | 360 | ;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f |
7840ced1 | 361 | ;;; tooltip.el ends here |