Line data Source code
1 : ;;; tooltip.el --- show tooltip windows
2 :
3 : ;; Copyright (C) 1997, 1999-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Gerd Moellmann <gerd@acm.org>
6 : ;; Keywords: help c mouse tools
7 : ;; Package: emacs
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 3 of the License, or
14 : ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;;; Code:
27 :
28 : (require 'syntax)
29 :
30 : (defvar comint-prompt-regexp)
31 :
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 :
41 : ;;; Switching tooltips on/off
42 :
43 : (define-minor-mode tooltip-mode
44 : "Toggle Tooltip mode.
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.
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."
55 : :global t
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
59 : :initialize 'custom-initialize-delay
60 : :group 'tooltip
61 0 : (if (and tooltip-mode (fboundp 'x-show-tip))
62 0 : (progn
63 0 : (add-hook 'pre-command-hook 'tooltip-hide)
64 0 : (add-hook 'tooltip-functions 'tooltip-help-tips))
65 0 : (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
66 0 : (remove-hook 'pre-command-hook 'tooltip-hide))
67 0 : (remove-hook 'tooltip-functions 'tooltip-help-tips))
68 0 : (setq show-help-function
69 0 : (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode)))
70 :
71 :
72 : ;;; Customizable settings
73 :
74 : (defcustom tooltip-delay 0.7
75 : "Seconds to wait before displaying a tooltip the first time."
76 : :type 'number
77 : :group 'tooltip)
78 :
79 : (defcustom tooltip-short-delay 0.1
80 : "Seconds to wait between subsequent tooltips on different items."
81 : :type 'number
82 : :group 'tooltip)
83 :
84 : (defcustom tooltip-recent-seconds 1
85 : "Display tooltips if changing tip items within this many seconds.
86 : Do so after `tooltip-short-delay'."
87 : :type 'number
88 : :group 'tooltip)
89 :
90 : (defcustom tooltip-hide-delay 10
91 : "Hide tooltips automatically after this many seconds."
92 : :type 'number
93 : :group 'tooltip)
94 :
95 : (defcustom tooltip-x-offset 5
96 : "X offset, in pixels, for the display of tooltips.
97 : The offset is the distance between the X position of the mouse and
98 : the left border of the tooltip window. It must be chosen so that the
99 : tooltip window doesn't contain the mouse when it pops up, or it may
100 : interfere with clicking where you wish.
101 :
102 : If `tooltip-frame-parameters' includes the `left' parameter,
103 : the value of `tooltip-x-offset' is ignored."
104 : :type 'integer
105 : :group 'tooltip)
106 :
107 : (defcustom tooltip-y-offset +20
108 : "Y offset, in pixels, for the display of tooltips.
109 : The offset is the distance between the Y position of the mouse and
110 : the top border of the tooltip window. It must be chosen so that the
111 : tooltip window doesn't contain the mouse when it pops up, or it may
112 : interfere with clicking where you wish.
113 :
114 : If `tooltip-frame-parameters' includes the `top' parameter,
115 : the value of `tooltip-y-offset' is ignored."
116 : :type 'integer
117 : :group 'tooltip)
118 :
119 : (defcustom tooltip-frame-parameters
120 : '((name . "tooltip")
121 : (internal-border-width . 2)
122 : (border-width . 1)
123 : (no-special-glyphs . t))
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.
128 :
129 : Note that font and color parameters are ignored, and the attributes
130 : of the `tooltip' face are used instead."
131 : :type '(repeat (cons :format "%v"
132 : (symbol :tag "Parameter")
133 : (sexp :tag "Value")))
134 : :group 'tooltip
135 : :version "26.1")
136 :
137 : (defface tooltip
138 : '((((class color))
139 : :background "lightyellow"
140 : :foreground "black"
141 : :inherit variable-pitch)
142 : (t
143 : :inherit variable-pitch))
144 : "Face for tooltips."
145 : :group 'tooltip
146 : :group 'basic-faces)
147 :
148 : (defcustom tooltip-use-echo-area nil
149 : "Use the echo area instead of tooltip frames for help and GUD tooltips.
150 : This variable is obsolete; instead of setting it to t, disable
151 : `tooltip-mode' (which has a similar effect)."
152 : :type 'boolean
153 : :group 'tooltip)
154 :
155 : (make-obsolete-variable 'tooltip-use-echo-area
156 : "disable Tooltip mode instead" "24.1" 'set)
157 :
158 :
159 : ;;; Variables that are not customizable.
160 :
161 : (define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
162 :
163 : (defvar tooltip-functions nil
164 : "Functions to call to display tooltips.
165 : Each function is called with one argument EVENT which is a copy
166 : of the last mouse movement event that occurred. If one of these
167 : functions displays the tooltip, it should return non-nil and the
168 : rest are not called.")
169 :
170 : (defvar tooltip-timeout-id nil
171 : "The id of the timeout started when Emacs becomes idle.")
172 :
173 : (defvar tooltip-last-mouse-motion-event nil
174 : "A copy of the last mouse motion event seen.")
175 :
176 : (defvar tooltip-hide-time nil
177 : "Time when the last tooltip was hidden.")
178 :
179 : (defvar gud-tooltip-mode) ;; Prevent warning.
180 :
181 : ;;; Event accessors
182 :
183 : (defun tooltip-event-buffer (event)
184 : "Return the buffer over which event EVENT occurred.
185 : This might return nil if the event did not occur over a buffer."
186 0 : (let ((window (posn-window (event-end event))))
187 0 : (and window (window-buffer window))))
188 :
189 :
190 : ;;; Timeout for tooltip display
191 :
192 : (defun tooltip-delay ()
193 : "Return the delay in seconds for the next tooltip."
194 0 : (if (and tooltip-hide-time
195 0 : (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds))
196 0 : tooltip-short-delay
197 0 : tooltip-delay))
198 :
199 : (defun tooltip-cancel-delayed-tip ()
200 : "Disable the tooltip timeout."
201 0 : (when tooltip-timeout-id
202 0 : (disable-timeout tooltip-timeout-id)
203 0 : (setq tooltip-timeout-id nil)))
204 :
205 : (defun tooltip-start-delayed-tip ()
206 : "Add a one-shot timeout to call function `tooltip-timeout'."
207 0 : (setq tooltip-timeout-id
208 0 : (add-timeout (tooltip-delay) 'tooltip-timeout nil)))
209 :
210 : (defun tooltip-timeout (_object)
211 : "Function called when timer with id `tooltip-timeout-id' fires."
212 0 : (run-hook-with-args-until-success 'tooltip-functions
213 0 : tooltip-last-mouse-motion-event))
214 :
215 :
216 : ;;; Displaying tips
217 :
218 : (defun tooltip-set-param (alist key value)
219 : "Change the value of KEY in alist ALIST to VALUE.
220 : If there's no association for KEY in ALIST, add one, otherwise
221 : change the existing association. Value is the resulting alist."
222 : (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
223 0 : (setf (alist-get key alist) value)
224 0 : alist)
225 :
226 : (declare-function x-show-tip "xfns.c"
227 : (string &optional frame parms timeout dx dy))
228 :
229 : (defun tooltip-show (text &optional use-echo-area)
230 : "Show a tooltip window displaying TEXT.
231 :
232 : Text larger than `x-max-tooltip-size' is clipped.
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
238 : position.
239 :
240 : Optional second arg USE-ECHO-AREA non-nil means to show tooltip
241 : in echo area."
242 0 : (if use-echo-area
243 0 : (tooltip-show-help-non-mode text)
244 0 : (condition-case error
245 0 : (let ((params (copy-sequence tooltip-frame-parameters))
246 0 : (fg (face-attribute 'tooltip :foreground))
247 0 : (bg (face-attribute 'tooltip :background)))
248 0 : (when (stringp fg)
249 0 : (setf (alist-get 'foreground-color params) fg)
250 0 : (setf (alist-get 'border-color params) fg))
251 0 : (when (stringp bg)
252 0 : (setf (alist-get 'background-color params) bg))
253 0 : (x-show-tip (propertize text 'face 'tooltip)
254 0 : (selected-frame)
255 0 : params
256 0 : tooltip-hide-delay
257 0 : tooltip-x-offset
258 0 : tooltip-y-offset))
259 : (error
260 0 : (message "Error while displaying tooltip: %s" error)
261 0 : (sit-for 1)
262 0 : (message "%s" text)))))
263 :
264 : (declare-function x-hide-tip "xfns.c" ())
265 :
266 : (defun tooltip-hide (&optional _ignored-arg)
267 : "Hide a tooltip, if one is displayed.
268 : Value is non-nil if tooltip was open."
269 0 : (tooltip-cancel-delayed-tip)
270 0 : (when (x-hide-tip)
271 0 : (setq tooltip-hide-time (float-time))))
272 :
273 :
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 0 : (save-excursion
281 0 : (goto-char point)
282 0 : (let* ((start (progn (skip-syntax-backward "w_") (point)))
283 0 : (pstate (syntax-ppss)))
284 0 : (unless (or (looking-at "[0-9]")
285 0 : (nth 3 pstate)
286 0 : (nth 4 pstate))
287 0 : (skip-syntax-forward "w_")
288 0 : (when (> (point) start)
289 0 : (buffer-substring start (point)))))))
290 :
291 : (defun tooltip-expr-to-print (event)
292 : "Return an expression that should be printed for EVENT.
293 : If a region is active and the mouse is inside the region, print
294 : the region. Otherwise, figure out the identifier around the point
295 : where the mouse is."
296 0 : (with-current-buffer (tooltip-event-buffer event)
297 0 : (let ((point (posn-point (event-end event))))
298 0 : (if (use-region-p)
299 0 : (when (and (<= (region-beginning) point) (<= point (region-end)))
300 0 : (buffer-substring (region-beginning) (region-end)))
301 0 : (tooltip-identifier-from-point point)))))
302 :
303 : (defun tooltip-process-prompt-regexp (process)
304 : "Return regexp matching the prompt of PROCESS at the end of a string.
305 : The prompt is taken from the value of `comint-prompt-regexp' in
306 : the buffer of PROCESS."
307 0 : (let ((prompt-regexp (with-current-buffer (process-buffer process)
308 0 : comint-prompt-regexp)))
309 0 : (concat "\n*"
310 : ;; Most start with `^' but the one for `sdb' cannot be easily
311 : ;; stripped. Code the prompt for `sdb' fixed here.
312 0 : (if (= (aref prompt-regexp 0) ?^)
313 0 : (substring prompt-regexp 1)
314 0 : "\\*")
315 0 : "$")))
316 :
317 : (defun tooltip-strip-prompt (process output)
318 : "Return OUTPUT with any prompt of PROCESS stripped from its end."
319 0 : (save-match-data
320 0 : (if (string-match (tooltip-process-prompt-regexp process) output)
321 0 : (substring output 0 (match-beginning 0))
322 0 : output)))
323 :
324 :
325 : ;;; Tooltip help.
326 :
327 : (defvar tooltip-help-message nil
328 : "The last help message received via `show-help-function'.
329 : This is used by `tooltip-show-help' and
330 : `tooltip-show-help-non-mode'.")
331 :
332 : (defvar tooltip-previous-message nil
333 : "The previous content of the echo area.")
334 :
335 : (defun tooltip-show-help-non-mode (help)
336 : "Function installed as `show-help-function' when Tooltip mode is off.
337 : It is also called if Tooltip mode is on, for text-only displays."
338 0 : (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents.
339 0 : (not cursor-in-echo-area)) ;Don't overwrite a prompt.
340 0 : (cond
341 0 : ((stringp help)
342 0 : (setq help (replace-regexp-in-string "\n" ", " help))
343 0 : (unless (or tooltip-previous-message
344 0 : (equal-including-properties help (current-message))
345 0 : (and (stringp tooltip-help-message)
346 0 : (equal-including-properties tooltip-help-message
347 0 : (current-message))))
348 0 : (setq tooltip-previous-message (current-message)))
349 0 : (setq tooltip-help-message help)
350 0 : (let ((message-truncate-lines t)
351 : (message-log-max nil))
352 0 : (message "%s" help)))
353 0 : ((stringp tooltip-previous-message)
354 0 : (let ((message-log-max nil))
355 0 : (message "%s" tooltip-previous-message)
356 0 : (setq tooltip-previous-message nil)))
357 : (t
358 0 : (message nil)))))
359 :
360 : (defun tooltip-show-help (msg)
361 : "Function installed as `show-help-function'.
362 : MSG is either a help string to display, or nil to cancel the display."
363 0 : (if (display-graphic-p)
364 0 : (let ((previous-help tooltip-help-message))
365 0 : (setq tooltip-help-message msg)
366 0 : (cond ((null msg)
367 : ;; Cancel display. This also cancels a delayed tip, if
368 : ;; there is one.
369 0 : (tooltip-hide))
370 0 : ((equal-including-properties previous-help msg)
371 : ;; Same help as before (but possibly the mouse has moved).
372 : ;; Keep what we have.
373 : )
374 : (t
375 : ;; A different help. Remove a previous tooltip, and
376 : ;; display a new one, with some delay.
377 0 : (tooltip-hide)
378 0 : (tooltip-start-delayed-tip))))
379 : ;; On text-only displays, try `tooltip-show-help-non-mode'.
380 0 : (tooltip-show-help-non-mode msg)))
381 :
382 : (defun tooltip-help-tips (_event)
383 : "Hook function to display a help tooltip.
384 : This is installed on the hook `tooltip-functions', which
385 : is run when the timer with id `tooltip-timeout-id' fires.
386 : Value is non-nil if this function handled the tip."
387 0 : (when (stringp tooltip-help-message)
388 0 : (tooltip-show tooltip-help-message tooltip-use-echo-area)
389 0 : t))
390 :
391 : (provide 'tooltip)
392 :
393 : ;;; tooltip.el ends here
|