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