29 |
(eval-when-compile |
(eval-when-compile |
30 |
(require 'cl) |
(require 'cl) |
31 |
(require 'comint) |
(require 'comint) |
32 |
(require 'gud)) |
(require 'gud) |
33 |
|
(require 'gdb-ui)) |
|
(provide 'tooltip) |
|
34 |
|
|
35 |
|
|
36 |
;;; Customizable settings |
;;; Customizable settings |
52 |
:type 'number |
:type 'number |
53 |
:group 'tooltip) |
:group 'tooltip) |
54 |
|
|
|
|
|
55 |
(defcustom tooltip-short-delay 0.1 |
(defcustom tooltip-short-delay 0.1 |
56 |
"Seconds to wait between subsequent tooltips on different items." |
"Seconds to wait between subsequent tooltips on different items." |
57 |
:tag "Short delay" |
:tag "Short delay" |
58 |
:type 'number |
:type 'number |
59 |
:group 'tooltip) |
:group 'tooltip) |
60 |
|
|
|
|
|
61 |
(defcustom tooltip-recent-seconds 1 |
(defcustom tooltip-recent-seconds 1 |
62 |
"Display tooltips if changing tip items within this many seconds. |
"Display tooltips if changing tip items within this many seconds. |
63 |
Do so after `tooltip-short-delay'." |
Do so after `tooltip-short-delay'." |
65 |
:type 'number |
:type 'number |
66 |
:group 'tooltip) |
:group 'tooltip) |
67 |
|
|
|
|
|
68 |
(defcustom tooltip-hide-delay 10 |
(defcustom tooltip-hide-delay 10 |
69 |
"Hide tooltips automatically after this many seconds." |
"Hide tooltips automatically after this many seconds." |
70 |
:tag "Hide delay" |
:tag "Hide delay" |
71 |
:type 'number |
:type 'number |
72 |
:group 'tooltip) |
:group 'tooltip) |
73 |
|
|
|
|
|
74 |
(defcustom tooltip-x-offset nil |
(defcustom tooltip-x-offset nil |
75 |
"Specify an X offset, in pixels, for the display of tooltips. |
"X offset, in pixels, for the display of tooltips. |
76 |
The offset is relative to the position of the mouse. It must |
The offset is relative to the position of the mouse. It must |
77 |
be chosen so that the tooltip window doesn't contain the mouse |
be chosen so that the tooltip window doesn't contain the mouse |
78 |
when it pops up. If the value is nil, the default offset is 5 |
when it pops up. If the value is nil, the default offset is 5 |
85 |
(integer :tag "Offset" :value 1)) |
(integer :tag "Offset" :value 1)) |
86 |
:group 'tooltip) |
:group 'tooltip) |
87 |
|
|
|
|
|
88 |
(defcustom tooltip-y-offset nil |
(defcustom tooltip-y-offset nil |
89 |
"Specify a Y offset, in pixels, for the display of tooltips. |
"Y offset, in pixels, for the display of tooltips. |
90 |
The offset is relative to the position of the mouse. It must |
The offset is relative to the position of the mouse. It must |
91 |
be chosen so that the tooltip window doesn't contain the mouse |
be chosen so that the tooltip window doesn't contain the mouse |
92 |
when it pops up. If the value is nil, the default offset is -10 |
when it pops up. If the value is nil, the default offset is -10 |
99 |
(integer :tag "Offset" :value 1)) |
(integer :tag "Offset" :value 1)) |
100 |
:group 'tooltip) |
:group 'tooltip) |
101 |
|
|
|
|
|
102 |
(defcustom tooltip-frame-parameters |
(defcustom tooltip-frame-parameters |
103 |
'((name . "tooltip") |
'((name . "tooltip") |
104 |
(internal-border-width . 5) |
(internal-border-width . 5) |
111 |
:tag "Frame Parameters" |
:tag "Frame Parameters" |
112 |
:group 'tooltip) |
:group 'tooltip) |
113 |
|
|
|
|
|
114 |
(defface tooltip |
(defface tooltip |
115 |
'((((class color)) |
'((((class color)) |
116 |
(:background "lightyellow" :foreground "black")) |
(:background "lightyellow" :foreground "black")) |
118 |
"Face for tooltips." |
"Face for tooltips." |
119 |
:group 'tooltip) |
:group 'tooltip) |
120 |
|
|
|
|
|
121 |
(defcustom tooltip-gud-tips-p nil |
(defcustom tooltip-gud-tips-p nil |
122 |
"*Non-nil means show tooltips in GUD sessions." |
"*Non-nil means show tooltips in GUD sessions." |
123 |
:type 'boolean |
:type 'boolean |
124 |
:tag "GUD" |
:tag "GUD" |
125 |
:set #'(lambda (symbol on) |
:set #'(lambda (symbol on) |
126 |
(setq tooltip-gud-tips-p on) |
(setq tooltip-gud-tips-p on)) |
|
(if on (tooltip-gud-tips-setup))) |
|
127 |
:group 'tooltip) |
:group 'tooltip) |
128 |
|
|
|
|
|
129 |
(defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode) |
(defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode) |
130 |
"List of modes for which to enable GUD tips." |
"List of modes for which to enable GUD tips." |
131 |
:type 'sexp |
:type 'sexp |
132 |
:tag "GUD modes" |
:tag "GUD modes" |
133 |
:group 'tooltip) |
:group 'tooltip) |
134 |
|
|
|
|
|
135 |
(defcustom tooltip-gud-display |
(defcustom tooltip-gud-display |
136 |
'((eq (tooltip-event-buffer tooltip-gud-event) |
'((eq (tooltip-event-buffer tooltip-gud-event) |
137 |
(marker-buffer overlay-arrow-position))) |
(marker-buffer overlay-arrow-position))) |
143 |
:tag "GUD buffers predicate" |
:tag "GUD buffers predicate" |
144 |
:group 'tooltip) |
:group 'tooltip) |
145 |
|
|
|
|
|
146 |
(defcustom tooltip-use-echo-area nil |
(defcustom tooltip-use-echo-area nil |
147 |
"Use the echo area instead of tooltip frames. |
"Use the echo area instead of tooltip frames. |
148 |
This is only relevant GUD display, since otherwise it is equivalent to |
This is only relevant GUD display, since otherwise it is equivalent to |
159 |
Each function is called with one argument EVENT which is a copy of |
Each function is called with one argument EVENT which is a copy of |
160 |
the last mouse movement event that occurred.") |
the last mouse movement event that occurred.") |
161 |
|
|
|
|
|
162 |
(defvar tooltip-timeout-id nil |
(defvar tooltip-timeout-id nil |
163 |
"The id of the timeout started when Emacs becomes idle.") |
"The id of the timeout started when Emacs becomes idle.") |
164 |
|
|
|
|
|
165 |
(defvar tooltip-last-mouse-motion-event nil |
(defvar tooltip-last-mouse-motion-event nil |
166 |
"A copy of the last mouse motion event seen.") |
"A copy of the last mouse motion event seen.") |
167 |
|
|
|
|
|
168 |
(defvar tooltip-hide-time nil |
(defvar tooltip-hide-time nil |
169 |
"Time when the last tooltip was hidden.") |
"Time when the last tooltip was hidden.") |
170 |
|
|
|
|
|
|
(defvar tooltip-gud-debugger nil |
|
|
"The debugger for which we show tooltips.") |
|
|
|
|
|
|
|
171 |
|
|
172 |
;;; Event accessors |
;;; Event accessors |
173 |
|
|
177 |
(let ((window (posn-window (event-end event)))) |
(let ((window (posn-window (event-end event)))) |
178 |
(and window (window-buffer window)))) |
(and window (window-buffer window)))) |
179 |
|
|
|
|
|
180 |
|
|
181 |
;;; Switching tooltips on/off |
;;; Switching tooltips on/off |
182 |
|
|
206 |
(setq show-help-function (if on 'tooltip-show-help-function nil)) |
(setq show-help-function (if on 'tooltip-show-help-function nil)) |
207 |
;; `ignore' is the default binding for mouse movements. |
;; `ignore' is the default binding for mouse movements. |
208 |
(define-key global-map [mouse-movement] |
(define-key global-map [mouse-movement] |
209 |
(if on 'tooltip-mouse-motion 'ignore)) |
(if on 'tooltip-mouse-motion 'ignore)))) |
|
(tooltip-gud-tips-setup))) |
|
210 |
|
|
|
(defun tooltip-gud-tips-setup () |
|
|
"Setup debugger mode-hooks for tooltips." |
|
|
(when (and tooltip-mode tooltip-gud-tips-p) |
|
|
(global-set-key [S-mouse-3] 'tooltip-gud-toggle-dereference) |
|
|
(add-hook 'gdb-mode-hook |
|
|
#'(lambda () (setq tooltip-gud-debugger 'gdb))) |
|
|
(add-hook 'sdb-mode-hook |
|
|
#'(lambda () (setq tooltip-gud-debugger 'sdb))) |
|
|
(add-hook 'dbx-mode-hook |
|
|
#'(lambda () (setq tooltip-gud-debugger 'dbx))) |
|
|
(add-hook 'xdb-mode-hook |
|
|
#'(lambda () (setq tooltip-gud-debugger 'xdb))) |
|
|
(add-hook 'perldb-mode-hook |
|
|
#'(lambda () (setq tooltip-gud-debugger 'perldb))))) |
|
211 |
|
|
212 |
;;; Timeout for tooltip display |
;;; Timeout for tooltip display |
213 |
|
|
220 |
(setq delay tooltip-short-delay)) |
(setq delay tooltip-short-delay)) |
221 |
delay)) |
delay)) |
222 |
|
|
|
|
|
223 |
(defun tooltip-cancel-delayed-tip () |
(defun tooltip-cancel-delayed-tip () |
224 |
"Disable the tooltip timeout." |
"Disable the tooltip timeout." |
225 |
(when tooltip-timeout-id |
(when tooltip-timeout-id |
226 |
(disable-timeout tooltip-timeout-id) |
(disable-timeout tooltip-timeout-id) |
227 |
(setq tooltip-timeout-id nil))) |
(setq tooltip-timeout-id nil))) |
228 |
|
|
|
|
|
229 |
(defun tooltip-start-delayed-tip () |
(defun tooltip-start-delayed-tip () |
230 |
"Add a one-shot timeout to call function tooltip-timeout." |
"Add a one-shot timeout to call function tooltip-timeout." |
231 |
(setq tooltip-timeout-id |
(setq tooltip-timeout-id |
232 |
(add-timeout (tooltip-delay) 'tooltip-timeout nil))) |
(add-timeout (tooltip-delay) 'tooltip-timeout nil))) |
233 |
|
|
|
|
|
234 |
(defun tooltip-timeout (object) |
(defun tooltip-timeout (object) |
235 |
"Function called when timer with id tooltip-timeout-id fires." |
"Function called when timer with id tooltip-timeout-id fires." |
236 |
(run-hook-with-args-until-success 'tooltip-hook |
(run-hook-with-args-until-success 'tooltip-hook |
237 |
tooltip-last-mouse-motion-event)) |
tooltip-last-mouse-motion-event)) |
238 |
|
|
|
|
|
239 |
|
|
240 |
;;; Reacting on mouse movements |
;;; Reacting on mouse movements |
241 |
|
|
243 |
"Function added to `change-major-mode-hook' when tooltip mode is on." |
"Function added to `change-major-mode-hook' when tooltip mode is on." |
244 |
(add-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)) |
(add-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)) |
245 |
|
|
|
|
|
246 |
(defun tooltip-activate-mouse-motions-if-enabled () |
(defun tooltip-activate-mouse-motions-if-enabled () |
247 |
"Reconsider for all buffers whether mouse motion events are desired." |
"Reconsider for all buffers whether mouse motion events are desired." |
248 |
(remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled) |
(remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled) |
281 |
(setq tooltip-last-mouse-motion-event (copy-sequence event)) |
(setq tooltip-last-mouse-motion-event (copy-sequence event)) |
282 |
(tooltip-start-delayed-tip))) |
(tooltip-start-delayed-tip))) |
283 |
|
|
|
|
|
284 |
|
|
285 |
;;; Displaying tips |
;;; Displaying tips |
286 |
|
|
287 |
(defun tooltip-set-param (alist key value) |
(defun tooltip-set-param (alist key value) |
288 |
"Change the value of KEY in alist ALIST to VALUE. |
"Change the value of KEY in alist ALIST to VALUE. |
289 |
If there's no association for KEY in ALIST, add one, otherwise |
If there's no association for KEY in ALIST, add one, otherwise |
290 |
change the existing association. Value is the resulting alist." |
change the existing association. Value is the resulting alist." |
291 |
(let ((param (assq key alist))) |
(let ((param (assq key alist))) |
292 |
(if (consp param) |
(if (consp param) |
294 |
(push (cons key value) alist)) |
(push (cons key value) alist)) |
295 |
alist)) |
alist)) |
296 |
|
|
|
|
|
297 |
(defun tooltip-show (text) |
(defun tooltip-show (text) |
298 |
"Show a tooltip window displaying TEXT. |
"Show a tooltip window displaying TEXT. |
299 |
|
|
321 |
tooltip-hide-delay |
tooltip-hide-delay |
322 |
tooltip-x-offset |
tooltip-x-offset |
323 |
tooltip-y-offset)) |
tooltip-y-offset)) |
324 |
(error |
(error |
325 |
(message "Error while displaying tooltip: %s" error) |
(message "Error while displaying tooltip: %s" error) |
326 |
(sit-for 1) |
(sit-for 1) |
327 |
(message "%s" text))))) |
(message "%s" text))))) |
328 |
|
|
|
|
|
329 |
(defun tooltip-hide (&optional ignored-arg) |
(defun tooltip-hide (&optional ignored-arg) |
330 |
"Hide a tooltip, if one is displayed. |
"Hide a tooltip, if one is displayed. |
331 |
Value is non-nil if tooltip was open." |
Value is non-nil if tooltip was open." |
333 |
(when (x-hide-tip) |
(when (x-hide-tip) |
334 |
(setq tooltip-hide-time (float-time)))) |
(setq tooltip-hide-time (float-time)))) |
335 |
|
|
|
|
|
336 |
|
|
337 |
;;; Debugger-related functions |
;;; Debugger-related functions |
338 |
|
|
348 |
(when (> (point) start) |
(when (> (point) start) |
349 |
(buffer-substring start (point))))))) |
(buffer-substring start (point))))))) |
350 |
|
|
|
|
|
351 |
(defmacro tooltip-region-active-p () |
(defmacro tooltip-region-active-p () |
352 |
"Value is non-nil if the region is currently active." |
"Value is non-nil if the region is currently active." |
353 |
(if (string-match "^GNU" (emacs-version)) |
(if (string-match "^GNU" (emacs-version)) |
354 |
`(and transient-mark-mode mark-active) |
`(and transient-mark-mode mark-active) |
355 |
`(region-active-p))) |
`(region-active-p))) |
356 |
|
|
|
|
|
357 |
(defun tooltip-expr-to-print (event) |
(defun tooltip-expr-to-print (event) |
358 |
"Return an expression that should be printed for EVENT. |
"Return an expression that should be printed for EVENT. |
359 |
If a region is active and the mouse is inside the region, print |
If a region is active and the mouse is inside the region, print |
367 |
(buffer-substring (region-beginning) (region-end))) |
(buffer-substring (region-beginning) (region-end))) |
368 |
(tooltip-identifier-from-point point))))) |
(tooltip-identifier-from-point point))))) |
369 |
|
|
|
|
|
370 |
(defun tooltip-process-prompt-regexp (process) |
(defun tooltip-process-prompt-regexp (process) |
371 |
"Return regexp matching the prompt of PROCESS at the end of a string. |
"Return regexp matching the prompt of PROCESS at the end of a string. |
372 |
The prompt is taken from the value of COMINT-PROMPT-REGEXP in the buffer |
The prompt is taken from the value of COMINT-PROMPT-REGEXP in the buffer |
381 |
(setq prompt-regexp "\\*")) |
(setq prompt-regexp "\\*")) |
382 |
(concat "\n*" prompt-regexp "$"))) |
(concat "\n*" prompt-regexp "$"))) |
383 |
|
|
|
|
|
384 |
(defun tooltip-strip-prompt (process output) |
(defun tooltip-strip-prompt (process output) |
385 |
"Return OUTPUT with any prompt of PROCESS stripped from its end." |
"Return OUTPUT with any prompt of PROCESS stripped from its end." |
386 |
(let ((prompt-regexp (tooltip-process-prompt-regexp process))) |
(let ((prompt-regexp (tooltip-process-prompt-regexp process))) |
389 |
(setq output (substring output 0 (match-beginning 0))))) |
(setq output (substring output 0 (match-beginning 0))))) |
390 |
output)) |
output)) |
391 |
|
|
|
|
|
392 |
|
|
393 |
;;; Tips for `gud' |
;;; Tips for `gud' |
394 |
|
|
395 |
(defvar tooltip-gud-original-filter nil |
(defvar tooltip-gud-original-filter nil |
396 |
"Process filter to restore after GUD output has been received.") |
"Process filter to restore after GUD output has been received.") |
397 |
|
|
|
|
|
398 |
(defvar tooltip-gud-dereference nil |
(defvar tooltip-gud-dereference nil |
399 |
"Non-nil means print expressions with a `*' in front of them. |
"Non-nil means print expressions with a `*' in front of them. |
400 |
For C this would dereference a pointer expression.") |
For C this would dereference a pointer expression.") |
401 |
|
|
|
|
|
402 |
(defvar tooltip-gud-event nil |
(defvar tooltip-gud-event nil |
403 |
"The mouse movement event that led to a tooltip display. |
"The mouse movement event that led to a tooltip display. |
404 |
This event can be examined by forms in TOOLTIP-GUD-DISPLAY.") |
This event can be examined by forms in TOOLTIP-GUD-DISPLAY.") |
405 |
|
|
|
|
|
|
(defvar tooltip-gud-debugger nil |
|
|
"A symbol describing the debugger running under GUD.") |
|
|
|
|
|
|
|
406 |
(defun tooltip-gud-toggle-dereference () |
(defun tooltip-gud-toggle-dereference () |
407 |
"Toggle whether tooltips should show `* expr' or `expr'." |
"Toggle whether tooltips should show `* expr' or `expr'." |
408 |
(interactive) |
(interactive) |
411 |
(message "Dereferencing is now %s." |
(message "Dereferencing is now %s." |
412 |
(if tooltip-gud-dereference "on" "off")))) |
(if tooltip-gud-dereference "on" "off")))) |
413 |
|
|
414 |
|
; This will only display data that comes in one chunk. |
415 |
|
; Larger arrays (say 400 elements) are displayed in |
416 |
|
; the tootip incompletely and spill over into the gud buffer. |
417 |
|
; Switching the process-filter creates timing problems and |
418 |
|
; it may be difficult to do better. gdba in gdb-ui.el |
419 |
|
; gets round this problem. |
420 |
(defun tooltip-gud-process-output (process output) |
(defun tooltip-gud-process-output (process output) |
421 |
"Process debugger output and show it in a tooltip window." |
"Process debugger output and show it in a tooltip window." |
422 |
(set-process-filter process tooltip-gud-original-filter) |
(set-process-filter process tooltip-gud-original-filter) |
423 |
(tooltip-show (tooltip-strip-prompt process output))) |
(tooltip-show (tooltip-strip-prompt process output))) |
424 |
|
|
|
|
|
425 |
(defun tooltip-gud-print-command (expr) |
(defun tooltip-gud-print-command (expr) |
426 |
"Return a suitable command to print the expression EXPR. |
"Return a suitable command to print the expression EXPR. |
427 |
If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to EXPR." |
If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to EXPR." |
428 |
(when tooltip-gud-dereference |
(when tooltip-gud-dereference |
429 |
(setq expr (concat "*" expr))) |
(setq expr (concat "*" expr))) |
430 |
(case tooltip-gud-debugger |
(case gud-minor-mode |
431 |
((gdb dbx) (concat "print " expr)) |
((gdb gdba) (concat "server print " expr)) |
432 |
|
(dbx (concat "print " expr)) |
433 |
(xdb (concat "p " expr)) |
(xdb (concat "p " expr)) |
434 |
(sdb (concat expr "/")) |
(sdb (concat expr "/")) |
435 |
(perldb expr))) |
(perldb expr))) |
436 |
|
|
|
|
|
437 |
(defun tooltip-gud-tips (event) |
(defun tooltip-gud-tips (event) |
438 |
"Show tip for identifier or selection under the mouse. |
"Show tip for identifier or selection under the mouse. |
439 |
The mouse must either point at an identifier or inside a selected |
The mouse must either point at an identifier or inside a selected |
454 |
(when expr |
(when expr |
455 |
(let ((cmd (tooltip-gud-print-command expr))) |
(let ((cmd (tooltip-gud-print-command expr))) |
456 |
(unless (null cmd) ; CMD can be nil if unknown debugger |
(unless (null cmd) ; CMD can be nil if unknown debugger |
457 |
(setq tooltip-gud-original-filter (process-filter process)) |
(case gud-minor-mode |
458 |
(set-process-filter process 'tooltip-gud-process-output) |
(gdba (gdb-enqueue-input |
459 |
(gud-basic-call cmd) |
(list (concat cmd "\n") 'gdb-tooltip-print))) |
460 |
expr))))))) |
(t |
461 |
|
(setq tooltip-gud-original-filter (process-filter process)) |
462 |
|
(set-process-filter process 'tooltip-gud-process-output) |
463 |
|
(gud-basic-call cmd))) |
464 |
|
expr))))))) |
465 |
|
|
466 |
|
(defun gdb-tooltip-print () |
467 |
|
(tooltip-show |
468 |
|
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) |
469 |
|
(buffer-string)))) |
470 |
|
|
471 |
|
|
472 |
;;; Tooltip help. |
;;; Tooltip help. |
474 |
(defvar tooltip-help-message nil |
(defvar tooltip-help-message nil |
475 |
"The last help message received via `tooltip-show-help-function'.") |
"The last help message received via `tooltip-show-help-function'.") |
476 |
|
|
|
|
|
477 |
(defun tooltip-show-help-function (msg) |
(defun tooltip-show-help-function (msg) |
478 |
"Function installed as `show-help-function'. |
"Function installed as `show-help-function'. |
479 |
MSG is either a help string to display, or nil to cancel the display." |
MSG is either a help string to display, or nil to cancel the display." |
488 |
;; Keep what we have. |
;; Keep what we have. |
489 |
) |
) |
490 |
(t |
(t |
491 |
;; A different help. Remove a previous tooltip, and |
;; A different help. Remove a previous tooltip, and |
492 |
;; display a new one, with some delay. |
;; display a new one, with some delay. |
493 |
(tooltip-hide) |
(tooltip-hide) |
494 |
(tooltip-start-delayed-tip))))) |
(tooltip-start-delayed-tip))))) |
495 |
|
|
|
|
|
496 |
(defun tooltip-help-tips (event) |
(defun tooltip-help-tips (event) |
497 |
"Hook function to display a help tooltip. |
"Hook function to display a help tooltip. |
498 |
This is installed on the hook `tooltip-hook', which is run when |
This is installed on the hook `tooltip-hook', which is run when |
502 |
(tooltip-show tooltip-help-message) |
(tooltip-show tooltip-help-message) |
503 |
t)) |
t)) |
504 |
|
|
|
|
|
505 |
|
|
506 |
;;; Do this after all functions have been defined that are called from |
;;; Do this after all functions have been defined that are called from |
507 |
;;; `tooltip-mode'. The actual default value of `tooltip-mode' is set |
;;; `tooltip-mode'. The actual default value of `tooltip-mode' is set |
519 |
:require 'tooltip |
:require 'tooltip |
520 |
:group 'tooltip) |
:group 'tooltip) |
521 |
|
|
522 |
|
(provide 'tooltip) |
523 |
|
|
524 |
;;; tooltip.el ends here |
;;; tooltip.el ends here |