comparison lisp/tooltip.el @ 25003:bb68fe3c72f8

New file.
author Gerd Moellmann <gerd@gnu.org>
date Wed, 21 Jul 1999 21:43:52 +0000
parents
children c09e05be2f4b
comparison
equal deleted inserted replaced
25002:28d5af43eeb6 25003:bb68fe3c72f8
1 ;;; tooltip.el --- Show tooltip windows
2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4
5 ;; Author: Gerd Moellmann <gerd@acm.org>
6 ;; Keywords: help c mouse tools
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;; Put into your `.emacs'
28
29 ;; (require 'tooltip)
30 ;; (tooltip-mode 1)
31
32
33
34 ;;; Code:
35
36 (eval-when-compile
37 (require 'cl)
38 (require 'comint)
39 (require 'gud))
40
41 (provide 'tooltip)
42
43
44 ;;; Customizable settings
45
46 (defgroup tooltip nil
47 "Customization group for the `tooltip' package."
48 :group 'help
49 :group 'c
50 :group 'mouse
51 :group 'tools
52 :tag "Tool Tips")
53
54
55 (defcustom tooltip-delay 1.0
56 "Seconds to wait before displaying a tooltip the first time."
57 :tag "Delay"
58 :type 'number
59 :group 'tooltip)
60
61
62 (defcustom tooltip-short-delay 0.1
63 "Seconds to wait between subsequent tooltips on different items."
64 :tag "Short delay"
65 :type 'number
66 :group 'tooltip)
67
68
69 (defcustom tooltip-recent-seconds 1
70 "Display tooltips after `tooltip-short-delay' if changing tip items
71 within this many seconds."
72 :tag "Recent seconds"
73 :type 'number
74 :group 'tooltip)
75
76
77 (defcustom tooltip-frame-parameters
78 '((name . "tooltip")
79 (foreground-color . "black")
80 (background-color . "lightyellow")
81 (internal-border-width . 5)
82 (border-color . "lightyellow")
83 (border-width . 1))
84 "Frame parameters used for tooltips."
85 :type 'sexp
86 :tag "Frame Parameters"
87 :group 'tooltip)
88
89
90 (defcustom tooltip-gud-tips-p nil
91 "Non-nil means show tooltips in GUD sessions."
92 :type 'boolean
93 :tag "GUD"
94 :group 'tooltip)
95
96
97 (defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode)
98 "List of modes for which to enable GUD tips."
99 :type 'sexp
100 :tag "GUD modes"
101 :group 'tooltip)
102
103
104 (defcustom tooltip-gud-display
105 '((eq (tooltip-event-buffer tooltip-gud-event)
106 (marker-buffer overlay-arrow-position)))
107 "List of forms determining where GUD tooltips are displayed.
108
109 Forms in the list are combined with AND. The default is to display
110 only tooltips in the buffer containing the overlay arrow."
111 :type 'sexp
112 :tag "GUD buffers predicate"
113 :group 'tooltip)
114
115
116
117 ;;; Variables that are not customizable.
118
119 (defvar tooltip-hook nil
120 "Functions to call to display tooltips.
121 Each function is called with one argument EVENT which is a copy of
122 the last mouse movement event that occurred.")
123
124
125 (defvar tooltip-timeout-id nil
126 "The id of the timeout started when Emacs becomes idle.")
127
128
129 (defvar tooltip-last-mouse-motion-event nil
130 "A copy of the last mouse motion event seen.")
131
132
133 (defvar tooltip-hide-time nil
134 "Time when the last tooltip was hidden.")
135
136
137 (defvar tooltip-mode nil
138 "Non-nil means tooltip mode is on.")
139
140
141 (defvar tooltip-gud-debugger nil
142 "The debugger for which we show tooltips.")
143
144
145
146 ;;; Event accessors
147
148 (defun tooltip-event-buffer (event)
149 "Return the buffer over which event EVENT occurred.
150 This might return nil if the event did not occur over a buffer."
151 (let ((window (posn-window (event-end event))))
152 (and window (window-buffer window))))
153
154
155
156 ;;; Switching tooltips on/off
157
158 ;; We don't set track-mouse globally because this is a big redisplay
159 ;; problem in buffers having a pre-command-hook or such installed,
160 ;; which does a set-buffer, like the summary buffer of Gnus. Calling
161 ;; set-buffer prevents redisplay optimizations, so every mouse motion
162 ;; would be accompanied by a full redisplay.
163
164 ;;;###autoload
165 (defun tooltip-mode (&optional arg)
166 "Mode for tooltip display.
167 With ARG, turn tooltip mode on if and only if ARG is positive."
168 (interactive "P")
169 (let* ((on (if arg
170 (> (prefix-numeric-value arg) 0)
171 (not tooltip-mode)))
172 (hook-fn (if on 'add-hook 'remove-hook)))
173 (setq tooltip-mode on)
174 (funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode)
175 (tooltip-activate-mouse-motions-if-enabled)
176 (funcall hook-fn 'pre-command-hook 'tooltip-hide)
177 (funcall hook-fn 'tooltip-hook 'tooltip-gud-tips)
178 (funcall hook-fn 'tooltip-hook 'tooltip-help-tips)
179 (setq show-help-function (if on 'tooltip-show-help-function nil))
180 ;; `ignore' is the default binding for mouse movements.
181 (define-key global-map [mouse-movement]
182 (if on 'tooltip-mouse-motion 'ignore))
183 (when (and on tooltip-gud-tips-p)
184 (global-set-key [S-mouse-3] 'tooltip-gud-toggle-dereference)
185 (add-hook 'gdb-mode-hook
186 #'(lambda () (setq tooltip-gud-debugger 'gdb)))
187 (add-hook 'sdb-mode-hook
188 #'(lambda () (setq tooltip-gud-debugger 'sdb)))
189 (add-hook 'dbx-mode-hook
190 #'(lambda () (setq tooltip-gud-debugger 'dbx)))
191 (add-hook 'xdb-mode-hook
192 #'(lambda () (setq tooltip-gud-debugger 'xdb)))
193 (add-hook 'perldb-mode-hook
194 #'(lambda () (setq tooltip-gud-debugger 'perldb))))))
195
196
197
198 ;;; Timeout for tooltip display
199
200 (defun tooltip-float-time ()
201 "Return the values of `current-time' as a float."
202 (let ((now (current-time)))
203 (+ (* 65536.0 (nth 0 now))
204 (nth 1 now)
205 (/ (nth 2 now) 1000000.0))))
206
207
208 (defun tooltip-delay ()
209 "Return the delay in seconds for the next tooltip."
210 (let ((delay tooltip-delay)
211 (now (tooltip-float-time)))
212 (when (and tooltip-hide-time
213 (< (- now tooltip-hide-time) tooltip-recent-seconds))
214 (setq delay tooltip-short-delay))
215 delay))
216
217
218 (defun tooltip-disable-timeout ()
219 "Disable the tooltip timeout."
220 (when tooltip-timeout-id
221 (disable-timeout tooltip-timeout-id)
222 (setq tooltip-timeout-id nil)))
223
224
225 (defun tooltip-add-timeout ()
226 "Add a one-shot timeout to call function tooltip-timeout."
227 (setq tooltip-timeout-id
228 (add-timeout (tooltip-delay) 'tooltip-timeout nil)))
229
230
231 (defun tooltip-timeout (object)
232 "Function called when timer with id tooltip-timeout-id fires."
233 (run-hook-with-args-until-success 'tooltip-hook
234 tooltip-last-mouse-motion-event))
235
236
237
238 ;;; Reacting on mouse movements
239
240 (defun tooltip-change-major-mode ()
241 "Function added to `change-major-mode-hook' when tooltip mode is on."
242 (add-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled))
243
244
245 (defun tooltip-activate-mouse-motions-if-enabled ()
246 "Reconsider for all buffers whether mouse motion events are desired."
247 (remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)
248 (let ((buffers (buffer-list)))
249 (save-excursion
250 (while buffers
251 (set-buffer (car buffers))
252 (if (and tooltip-mode
253 tooltip-gud-tips-p
254 (memq major-mode tooltip-gud-modes))
255 (tooltip-activate-mouse-motions t)
256 (tooltip-activate-mouse-motions nil))
257 (setq buffers (cdr buffers))))))
258
259
260 (defun tooltip-activate-mouse-motions (activatep)
261 "Activate/deactivate mouse motion events for the current buffer.
262 ACTIVATEP non-nil means activate mouse motion events."
263 (if activatep
264 (progn
265 (make-local-variable 'track-mouse)
266 (setq track-mouse t))
267 (kill-local-variable 'track-mouse)))
268
269
270 (defun tooltip-mouse-motion (event)
271 "Command handler for mouse movement events in `global-map'."
272 (interactive "e")
273 (tooltip-hide)
274 (when (car (mouse-pixel-position))
275 (setq tooltip-last-mouse-motion-event (copy-sequence event))
276 (tooltip-add-timeout)))
277
278
279
280 ;;; Displaying tips
281
282 (defun tooltip-show (text)
283 "Show a tooltip window at the current mouse position displaying TEXT."
284 (x-show-tip text (selected-frame) tooltip-frame-parameters))
285
286
287 (defun tooltip-hide (&optional ignored-arg)
288 "Hide a tooltip, if one is displayed.
289 Value is non-nil if tooltip was open."
290 (tooltip-disable-timeout)
291 (when (x-hide-tip)
292 (setq tooltip-hide-time (tooltip-float-time))))
293
294
295
296 ;;; Debugger-related functions
297
298 (defun tooltip-identifier-from-point (point)
299 "Extract the identifier at POINT, if any.
300 Value is nil if no identifier exists at point. Identifier extraction
301 is based on the current syntax table."
302 (save-excursion
303 (goto-char point)
304 (let ((start (progn (skip-syntax-backward "w_") (point))))
305 (unless (looking-at "[0-9]")
306 (skip-syntax-forward "w_")
307 (when (> (point) start)
308 (buffer-substring start (point)))))))
309
310
311 (defmacro tooltip-region-active-p ()
312 "Value is non-nil if the region is currently active."
313 (if (string-match "^GNU" (emacs-version))
314 `(and transient-mark-mode mark-active)
315 `(region-active-p)))
316
317
318 (defun tooltip-expr-to-print (event)
319 "Return an expression that should be printed for EVENT.
320 If a region is active and the mouse is inside the region, print
321 the region. Otherwise, figure out the identifier around the point
322 where the mouse is."
323 (save-excursion
324 (set-buffer (tooltip-event-buffer event))
325 (let ((point (posn-point (event-end event))))
326 (if (tooltip-region-active-p)
327 (when (and (<= (region-beginning) point) (<= point (region-end)))
328 (buffer-substring (region-beginning) (region-end)))
329 (tooltip-identifier-from-point point)))))
330
331
332 (defun tooltip-process-prompt-regexp (process)
333 "Return regexp matching the prompt of PROCESS at the end of a string.
334 The prompt is taken from the value of COMINT-PROMPT-REGEXP in the buffer
335 of PROCESS."
336 (let ((prompt-regexp (save-excursion
337 (set-buffer (process-buffer process))
338 comint-prompt-regexp)))
339 ;; Most start with `^' but the one for `sdb' cannot be easily
340 ;; stripped. Code the prompt for `sdb' fixed here.
341 (if (= (aref prompt-regexp 0) ?^)
342 (setq prompt-regexp (substring prompt-regexp 1))
343 (setq prompt-regexp "\\*"))
344 (concat "\n*" prompt-regexp "$")))
345
346
347 (defun tooltip-strip-prompt (process output)
348 "Return OUTPUT with any prompt of PROCESS stripped from its end."
349 (let ((prompt-regexp (tooltip-process-prompt-regexp process)))
350 (save-match-data
351 (when (string-match prompt-regexp output)
352 (setq output (substring output 0 (match-beginning 0)))))
353 output))
354
355
356
357 ;;; Tips for `gud'
358
359 (defvar tooltip-gud-original-filter nil
360 "Process filter to restore after GUD output has been received.")
361
362
363 (defvar tooltip-gud-dereference nil
364 "Non-nil means print expressions with a `*' in front of them.
365 For C this would dereference a pointer expression.")
366
367
368 (defvar tooltip-gud-event nil
369 "The mouse movement event that led to a tooltip display.
370 This event can be examined by forms in TOOLTIP-GUD-DISPLAY.")
371
372
373 (defvar tooltip-gud-debugger nil
374 "A symbol describing the debugger running under GUD.")
375
376
377 (defun tooltip-gud-toggle-dereference ()
378 "Toggle whether tooltips should show `* exor' or `expr'."
379 (interactive)
380 (setq tooltip-gud-dereference (not tooltip-gud-dereference))
381 (when (interactive-p)
382 (message "Dereferencing is now %s."
383 (if tooltip-gud-dereference "on" "off"))))
384
385
386 (defun tooltip-gud-process-output (process output)
387 "Process debugger output and show it in a tooltip window."
388 (set-process-filter process tooltip-gud-original-filter)
389 (tooltip-show (tooltip-strip-prompt process output)))
390
391
392 (defun tooltip-gud-print-command (expr)
393 "Return a suitable command to print the expression EXPR.
394 If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to EXPR."
395 (when tooltip-gud-dereference
396 (setq expr (concat "*" expr)))
397 (case tooltip-gud-debugger
398 ((gdb dbx) (concat "print " expr))
399 (xdb (concat "p " expr))
400 (sdb (concat expr "/"))
401 (perldb expr)))
402
403
404 (defun tooltip-gud-tips (event)
405 "Show tip for identifier or selection under the mouse. The mouse
406 must either point at an identifier or inside a selected region for the
407 tip window to be shown. If tooltip-gud-dereference is t, add a `*' in
408 front of the printed expression.
409
410 This function must return nil if it doesn't handle EVENT."
411 (let (gud-buffer process)
412 (when (and (eventp event)
413 tooltip-gud-tips-p
414 (boundp 'gud-comint-buffer)
415 (setq gud-buffer gud-comint-buffer)
416 (setq process (get-buffer-process gud-buffer))
417 (posn-point (event-end event))
418 (progn (setq tooltip-gud-event event)
419 (eval (cons 'and tooltip-gud-display))))
420 (let ((expr (tooltip-expr-to-print event)))
421 (when expr
422 (setq tooltip-gud-original-filter (process-filter process))
423 (set-process-filter process 'tooltip-gud-process-output)
424 (process-send-string
425 process (concat (tooltip-gud-print-command expr) "\n"))
426 expr)))))
427
428
429
430 ;;; Tooltip help.
431
432 (defvar tooltip-help-message nil
433 "The last help message received via `tooltip-show-help-function'.")
434
435
436 (defun tooltip-show-help-function (msg)
437 "Function installed as `show-help-function'.
438 MSG is either a help string to display, or nil to cancel the display."
439 (let ((previous-help tooltip-help-message))
440 (setq tooltip-help-message msg)
441 (cond ((null msg)
442 (tooltip-hide))
443 ((or (not (stringp previous-help))
444 (not (string= msg previous-help)))
445 (tooltip-hide)
446 (tooltip-add-timeout))
447 (t
448 (tooltip-disable-timeout)
449 (tooltip-add-timeout)))))
450
451
452 (defun tooltip-help-tips (event)
453 "Hook function to display a help tooltip.
454 Value is non-nil if this function handled the tip."
455 (when (stringp tooltip-help-message)
456 (tooltip-show tooltip-help-message)
457 (setq tooltip-help-message nil)
458 t))
459
460
461
462 ;;; Do this after all functions have been defined that are called
463 ;;; from `tooltip-mode'.
464
465 (defcustom tooltip-active nil
466 "*Non-nil means tooltips are active."
467 :tag "Activate tooltips"
468 :type 'boolean
469 :set #'(lambda (symbol value)
470 (set-default symbol value)
471 (tooltip-mode (or value 0)))
472 :require 'tooltip
473 :group 'tooltip)
474
475
476 ;;; tooltip.el ends here