45236
|
1 ;;; tooltip.el --- show tooltip windows
|
25003
|
2
|
64762
|
3 ;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
25003
|
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
|
78236
|
13 ;; the Free Software Foundation; either version 3, or (at your option)
|
25003
|
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
|
64091
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
25003
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;;; Code:
|
|
29
|
65297
|
30 (defvar comint-prompt-regexp)
|
|
31
|
67706
|
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
|
67485
|
41 ;;; Switching tooltips on/off
|
|
42
|
|
43 (define-minor-mode tooltip-mode
|
70099
|
44 "Toggle Tooltip mode.
|
|
45 With ARG, turn Tooltip mode on if and only if ARG is positive.
|
68141
|
46 When this minor mode is enabled, Emacs displays help text
|
70099
|
47 in a pop-up window for buttons and menu items that you put the mouse on.
|
|
48 \(However, if `tooltip-use-echo-area' is non-nil, this and
|
|
49 all pop-up help appears in the echo area.)
|
|
50
|
|
51 When Tooltip mode is disabled, Emacs displays one line of
|
|
52 the help text in the echo area, and does not make a pop-up window."
|
67485
|
53 :global t
|
|
54 :init-value (not (or noninteractive
|
|
55 emacs-basic-display
|
|
56 (not (display-graphic-p))
|
|
57 (not (fboundp 'x-show-tip))))
|
|
58 :initialize 'custom-initialize-safe-default
|
|
59 :group 'tooltip
|
|
60 (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
|
|
61 (error "Sorry, tooltips are not yet available on this system"))
|
|
62 (if tooltip-mode
|
|
63 (progn
|
|
64 (add-hook 'pre-command-hook 'tooltip-hide)
|
|
65 (add-hook 'tooltip-hook 'tooltip-help-tips))
|
|
66 (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
|
|
67 (remove-hook 'pre-command-hook 'tooltip-hide))
|
|
68 (remove-hook 'tooltip-hook 'tooltip-help-tips))
|
|
69 (setq show-help-function
|
|
70 (if tooltip-mode 'tooltip-show-help nil)))
|
25003
|
71
|
67706
|
72
|
|
73 ;;; Customizable settings
|
25003
|
74
|
40679
|
75 (defcustom tooltip-delay 0.7
|
25003
|
76 "Seconds to wait before displaying a tooltip the first time."
|
|
77 :type 'number
|
|
78 :group 'tooltip)
|
|
79
|
|
80 (defcustom tooltip-short-delay 0.1
|
|
81 "Seconds to wait between subsequent tooltips on different items."
|
|
82 :type 'number
|
|
83 :group 'tooltip)
|
|
84
|
|
85 (defcustom tooltip-recent-seconds 1
|
25332
|
86 "Display tooltips if changing tip items within this many seconds.
|
|
87 Do so after `tooltip-short-delay'."
|
25003
|
88 :type 'number
|
|
89 :group 'tooltip)
|
|
90
|
40679
|
91 (defcustom tooltip-hide-delay 10
|
35401
|
92 "Hide tooltips automatically after this many seconds."
|
|
93 :type 'number
|
|
94 :group 'tooltip)
|
|
95
|
66348
|
96 (defcustom tooltip-x-offset 5
|
46025
|
97 "X offset, in pixels, for the display of tooltips.
|
67706
|
98 The offset is the distance between the X position of the mouse and
|
|
99 the left border of the tooltip window. It must be chosen so that the
|
|
100 tooltip window doesn't contain the mouse when it pops up, or it may
|
|
101 interfere with clicking where you wish.
|
40173
|
102
|
|
103 If `tooltip-frame-parameters' includes the `left' parameter,
|
|
104 the value of `tooltip-x-offset' is ignored."
|
66348
|
105 :type 'integer
|
33587
|
106 :group 'tooltip)
|
|
107
|
67531
|
108 (defcustom tooltip-y-offset +20
|
46025
|
109 "Y offset, in pixels, for the display of tooltips.
|
67706
|
110 The offset is the distance between the Y position of the mouse and
|
|
111 the top border of the tooltip window. It must be chosen so that the
|
|
112 tooltip window doesn't contain the mouse when it pops up, or it may
|
|
113 interfere with clicking where you wish.
|
40173
|
114
|
|
115 If `tooltip-frame-parameters' includes the `top' parameter,
|
|
116 the value of `tooltip-y-offset' is ignored."
|
66348
|
117 :type 'integer
|
33587
|
118 :group 'tooltip)
|
|
119
|
25003
|
120 (defcustom tooltip-frame-parameters
|
|
121 '((name . "tooltip")
|
66348
|
122 (internal-border-width . 2)
|
25003
|
123 (border-width . 1))
|
40173
|
124 "Frame parameters used for tooltips.
|
|
125
|
|
126 If `left' or `top' parameters are included, they specify the absolute
|
|
127 position to pop up the tooltip."
|
25003
|
128 :type 'sexp
|
|
129 :group 'tooltip)
|
|
130
|
35043
|
131 (defface tooltip
|
|
132 '((((class color))
|
52031
|
133 :background "lightyellow"
|
|
134 :foreground "black"
|
|
135 :inherit variable-pitch)
|
|
136 (t
|
|
137 :inherit variable-pitch))
|
35043
|
138 "Face for tooltips."
|
65732
|
139 :group 'tooltip
|
|
140 :group 'basic-faces)
|
35043
|
141
|
63441
|
142 (defcustom tooltip-use-echo-area nil
|
70099
|
143 "Use the echo area instead of tooltip frames for help and GUD tooltips.
|
|
144 To display multi-line help text in the echo area, set this to t
|
|
145 and enable `tooltip-mode'."
|
63441
|
146 :type 'boolean
|
|
147 :group 'tooltip)
|
|
148
|
25003
|
149
|
|
150 ;;; Variables that are not customizable.
|
|
151
|
|
152 (defvar tooltip-hook nil
|
|
153 "Functions to call to display tooltips.
|
|
154 Each function is called with one argument EVENT which is a copy of
|
|
155 the last mouse movement event that occurred.")
|
|
156
|
|
157 (defvar tooltip-timeout-id nil
|
|
158 "The id of the timeout started when Emacs becomes idle.")
|
|
159
|
|
160 (defvar tooltip-last-mouse-motion-event nil
|
|
161 "A copy of the last mouse motion event seen.")
|
|
162
|
|
163 (defvar tooltip-hide-time nil
|
|
164 "Time when the last tooltip was hidden.")
|
|
165
|
63938
|
166 (defvar gud-tooltip-mode) ;; Prevent warning.
|
|
167
|
25003
|
168 ;;; Event accessors
|
|
169
|
|
170 (defun tooltip-event-buffer (event)
|
|
171 "Return the buffer over which event EVENT occurred.
|
|
172 This might return nil if the event did not occur over a buffer."
|
|
173 (let ((window (posn-window (event-end event))))
|
|
174 (and window (window-buffer window))))
|
|
175
|
|
176
|
|
177 ;;; Timeout for tooltip display
|
|
178
|
|
179 (defun tooltip-delay ()
|
|
180 "Return the delay in seconds for the next tooltip."
|
|
181 (let ((delay tooltip-delay)
|
30481
|
182 (now (float-time)))
|
25003
|
183 (when (and tooltip-hide-time
|
|
184 (< (- now tooltip-hide-time) tooltip-recent-seconds))
|
|
185 (setq delay tooltip-short-delay))
|
|
186 delay))
|
|
187
|
35069
|
188 (defun tooltip-cancel-delayed-tip ()
|
25003
|
189 "Disable the tooltip timeout."
|
|
190 (when tooltip-timeout-id
|
|
191 (disable-timeout tooltip-timeout-id)
|
|
192 (setq tooltip-timeout-id nil)))
|
|
193
|
35069
|
194 (defun tooltip-start-delayed-tip ()
|
63483
8e09dea7559c
(tooltip-start-delayed-tip, tooltip-timeout, tooltip-use-echo-area,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
195 "Add a one-shot timeout to call function `tooltip-timeout'."
|
25003
|
196 (setq tooltip-timeout-id
|
|
197 (add-timeout (tooltip-delay) 'tooltip-timeout nil)))
|
|
198
|
|
199 (defun tooltip-timeout (object)
|
63483
8e09dea7559c
(tooltip-start-delayed-tip, tooltip-timeout, tooltip-use-echo-area,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
200 "Function called when timer with id `tooltip-timeout-id' fires."
|
25003
|
201 (run-hook-with-args-until-success 'tooltip-hook
|
|
202 tooltip-last-mouse-motion-event))
|
|
203
|
|
204
|
|
205 ;;; Displaying tips
|
|
206
|
35043
|
207 (defun tooltip-set-param (alist key value)
|
40178
|
208 "Change the value of KEY in alist ALIST to VALUE.
|
49597
|
209 If there's no association for KEY in ALIST, add one, otherwise
|
35043
|
210 change the existing association. Value is the resulting alist."
|
|
211 (let ((param (assq key alist)))
|
|
212 (if (consp param)
|
|
213 (setcdr param value)
|
|
214 (push (cons key value) alist))
|
|
215 alist))
|
|
216
|
61626
|
217 (defun tooltip-show (text &optional use-echo-area)
|
40173
|
218 "Show a tooltip window displaying TEXT.
|
|
219
|
61608
|
220 Text larger than `x-max-tooltip-size' is clipped.
|
40173
|
221
|
|
222 If the alist in `tooltip-frame-parameters' includes `left' and `top'
|
|
223 parameters, they determine the x and y position where the tooltip
|
|
224 is displayed. Otherwise, the tooltip pops at offsets specified by
|
|
225 `tooltip-x-offset' and `tooltip-y-offset' from the current mouse
|
61608
|
226 position.
|
|
227
|
61626
|
228 Optional second arg USE-ECHO-AREA non-nil means to show tooltip
|
|
229 in echo area."
|
|
230 (if use-echo-area
|
32431
|
231 (message "%s" text)
|
34540
|
232 (condition-case error
|
35043
|
233 (let ((params (copy-sequence tooltip-frame-parameters))
|
|
234 (fg (face-attribute 'tooltip :foreground))
|
|
235 (bg (face-attribute 'tooltip :background)))
|
35069
|
236 (when (stringp fg)
|
|
237 (setq params (tooltip-set-param params 'foreground-color fg))
|
|
238 (setq params (tooltip-set-param params 'border-color fg)))
|
|
239 (when (stringp bg)
|
|
240 (setq params (tooltip-set-param params 'background-color bg)))
|
35043
|
241 (x-show-tip (propertize text 'face 'tooltip)
|
|
242 (selected-frame)
|
35044
|
243 params
|
35401
|
244 tooltip-hide-delay
|
35043
|
245 tooltip-x-offset
|
|
246 tooltip-y-offset))
|
49597
|
247 (error
|
34540
|
248 (message "Error while displaying tooltip: %s" error)
|
|
249 (sit-for 1)
|
|
250 (message "%s" text)))))
|
|
251
|
25003
|
252 (defun tooltip-hide (&optional ignored-arg)
|
|
253 "Hide a tooltip, if one is displayed.
|
|
254 Value is non-nil if tooltip was open."
|
35069
|
255 (tooltip-cancel-delayed-tip)
|
25003
|
256 (when (x-hide-tip)
|
30481
|
257 (setq tooltip-hide-time (float-time))))
|
25003
|
258
|
|
259
|
|
260 ;;; Debugger-related functions
|
|
261
|
|
262 (defun tooltip-identifier-from-point (point)
|
|
263 "Extract the identifier at POINT, if any.
|
|
264 Value is nil if no identifier exists at point. Identifier extraction
|
|
265 is based on the current syntax table."
|
|
266 (save-excursion
|
|
267 (goto-char point)
|
|
268 (let ((start (progn (skip-syntax-backward "w_") (point))))
|
|
269 (unless (looking-at "[0-9]")
|
|
270 (skip-syntax-forward "w_")
|
|
271 (when (> (point) start)
|
|
272 (buffer-substring start (point)))))))
|
|
273
|
|
274 (defmacro tooltip-region-active-p ()
|
|
275 "Value is non-nil if the region is currently active."
|
|
276 (if (string-match "^GNU" (emacs-version))
|
|
277 `(and transient-mark-mode mark-active)
|
|
278 `(region-active-p)))
|
|
279
|
|
280 (defun tooltip-expr-to-print (event)
|
|
281 "Return an expression that should be printed for EVENT.
|
|
282 If a region is active and the mouse is inside the region, print
|
|
283 the region. Otherwise, figure out the identifier around the point
|
|
284 where the mouse is."
|
|
285 (save-excursion
|
|
286 (set-buffer (tooltip-event-buffer event))
|
|
287 (let ((point (posn-point (event-end event))))
|
|
288 (if (tooltip-region-active-p)
|
|
289 (when (and (<= (region-beginning) point) (<= point (region-end)))
|
|
290 (buffer-substring (region-beginning) (region-end)))
|
|
291 (tooltip-identifier-from-point point)))))
|
|
292
|
|
293 (defun tooltip-process-prompt-regexp (process)
|
|
294 "Return regexp matching the prompt of PROCESS at the end of a string.
|
63483
8e09dea7559c
(tooltip-start-delayed-tip, tooltip-timeout, tooltip-use-echo-area,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
295 The prompt is taken from the value of `comint-prompt-regexp' in
|
8e09dea7559c
(tooltip-start-delayed-tip, tooltip-timeout, tooltip-use-echo-area,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
296 the buffer of PROCESS."
|
25003
|
297 (let ((prompt-regexp (save-excursion
|
|
298 (set-buffer (process-buffer process))
|
|
299 comint-prompt-regexp)))
|
|
300 ;; Most start with `^' but the one for `sdb' cannot be easily
|
|
301 ;; stripped. Code the prompt for `sdb' fixed here.
|
|
302 (if (= (aref prompt-regexp 0) ?^)
|
|
303 (setq prompt-regexp (substring prompt-regexp 1))
|
|
304 (setq prompt-regexp "\\*"))
|
|
305 (concat "\n*" prompt-regexp "$")))
|
|
306
|
|
307 (defun tooltip-strip-prompt (process output)
|
|
308 "Return OUTPUT with any prompt of PROCESS stripped from its end."
|
|
309 (let ((prompt-regexp (tooltip-process-prompt-regexp process)))
|
|
310 (save-match-data
|
|
311 (when (string-match prompt-regexp output)
|
|
312 (setq output (substring output 0 (match-beginning 0)))))
|
|
313 output))
|
|
314
|
|
315
|
|
316 ;;; Tooltip help.
|
|
317
|
|
318 (defvar tooltip-help-message nil
|
63441
|
319 "The last help message received via `tooltip-show-help'.")
|
25003
|
320
|
63441
|
321 (defun tooltip-show-help (msg)
|
25003
|
322 "Function installed as `show-help-function'.
|
|
323 MSG is either a help string to display, or nil to cancel the display."
|
61161
|
324 (let ((previous-help tooltip-help-message))
|
25003
|
325 (setq tooltip-help-message msg)
|
|
326 (cond ((null msg)
|
35069
|
327 ;; Cancel display. This also cancels a delayed tip, if
|
|
328 ;; there is one.
|
25003
|
329 (tooltip-hide))
|
35069
|
330 ((equal previous-help msg)
|
|
331 ;; Same help as before (but possibly the mouse has moved).
|
|
332 ;; Keep what we have.
|
|
333 )
|
|
334 (t
|
49597
|
335 ;; A different help. Remove a previous tooltip, and
|
35069
|
336 ;; display a new one, with some delay.
|
25003
|
337 (tooltip-hide)
|
35069
|
338 (tooltip-start-delayed-tip)))))
|
25003
|
339
|
|
340 (defun tooltip-help-tips (event)
|
|
341 "Hook function to display a help tooltip.
|
35069
|
342 This is installed on the hook `tooltip-hook', which is run when
|
63483
8e09dea7559c
(tooltip-start-delayed-tip, tooltip-timeout, tooltip-use-echo-area,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
343 the timer with id `tooltip-timeout-id' fires.
|
25003
|
344 Value is non-nil if this function handled the tip."
|
|
345 (when (stringp tooltip-help-message)
|
63441
|
346 (tooltip-show tooltip-help-message tooltip-use-echo-area)
|
25003
|
347 t))
|
|
348
|
48601
|
349 (provide 'tooltip)
|
25003
|
350
|
58155
|
351 ;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f
|
25003
|
352 ;;; tooltip.el ends here
|