/[emacs]/emacs/lisp/tooltip.el
ViewVC logotype

Diff of /emacs/lisp/tooltip.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by rms, Wed May 29 16:38:06 2002 UTC revision 1.24.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 29  Line 29 
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
# Line 53  Line 52 
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'."
# Line 68  Do so after `tooltip-short-delay'." Line 65  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
# Line 90  the value of `tooltip-x-offset' is ignor Line 85  the value of `tooltip-x-offset' is ignor
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
# Line 105  the value of `tooltip-y-offset' is ignor Line 99  the value of `tooltip-y-offset' is ignor
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)
# Line 118  position to pop up the tooltip." Line 111  position to pop up the tooltip."
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"))
# Line 126  position to pop up the tooltip." Line 118  position to pop up the tooltip."
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)))
# Line 155  only tooltips in the buffer containing t Line 143  only tooltips in the buffer containing t
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
# Line 172  turning off Tooltip mode." Line 159  turning off Tooltip mode."
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    
# Line 198  This might return nil if the event did n Line 177  This might return nil if the event did n
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    
# Line 228  With ARG, turn tooltip mode on if and on Line 206  With ARG, turn tooltip mode on if and on
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    
# Line 257  With ARG, turn tooltip mode on if and on Line 220  With ARG, turn tooltip mode on if and on
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    
# Line 284  With ARG, turn tooltip mode on if and on Line 243  With ARG, turn tooltip mode on if and on
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)
# Line 323  ACTIVATEP non-nil means activate mouse m Line 281  ACTIVATEP non-nil means activate mouse m
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)
# Line 337  change the existing association.  Value Line 294  change the existing association.  Value
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    
# Line 365  position." Line 321  position."
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."
# Line 378  Value is non-nil if tooltip was open." Line 333  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    
# Line 394  is based on the current syntax table." Line 348  is based on the current syntax table."
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
# Line 415  where the mouse is." Line 367  where the mouse is."
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
# Line 430  of PROCESS." Line 381  of PROCESS."
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)))
# Line 439  of PROCESS." Line 389  of 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)
# Line 469  This event can be examined by forms in T Line 411  This event can be examined by forms in T
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
# Line 508  This function must return nil if it does Line 454  This function must return nil if it does
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.
# Line 519  This function must return nil if it does Line 474  This function must return nil if it does
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."
# Line 534  MSG is either a help string to display, Line 488  MSG is either a help string to 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
# Line 549  Value is non-nil if this function handle Line 502  Value is non-nil if this function handle
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
# Line 567  use either \\[customize] or the function Line 519  use either \\[customize] or the function
519    :require 'tooltip    :require 'tooltip
520    :group 'tooltip)    :group 'tooltip)
521    
522    (provide 'tooltip)
523    
524  ;;; tooltip.el ends here  ;;; tooltip.el ends here

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.24.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26