/[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.40 by kfstorm, Tue Feb 22 09:42:23 2005 UTC revision 1.41 by nickrob, Wed Mar 9 23:19:00 2005 UTC
# Line 1  Line 1 
1  ;;; tooltip.el --- show tooltip windows  ;;; tooltip.el --- show tooltip windows
2    
3  ;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004  ;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005
4  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
5    
6  ;; Author: Gerd Moellmann <gerd@acm.org>  ;; Author: Gerd Moellmann <gerd@acm.org>
# Line 41  Line 41 
41    :version "21.1"    :version "21.1"
42    :tag "Tool Tips")    :tag "Tool Tips")
43    
 (defvar tooltip-mode)  
   
44  (defcustom tooltip-delay 0.7  (defcustom tooltip-delay 0.7
45    "Seconds to wait before displaying a tooltip the first time."    "Seconds to wait before displaying a tooltip the first time."
46    :tag "Delay"    :tag "Delay"
# Line 122  position to pop up the tooltip." Line 120  position to pop up the tooltip."
120    "*Non-nil means show tooltips in GUD sessions."    "*Non-nil means show tooltips in GUD sessions."
121    :type 'boolean    :type 'boolean
122    :tag "GUD"    :tag "GUD"
   :set #'(lambda (symbol on)  
            (setq tooltip-gud-tips-p on))  
123    :group 'tooltip)    :group 'tooltip)
124    
125  (defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode)  (defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode fortran-mode)
126    "List of modes for which to enable GUD tips."    "List of modes for which to enable GUD tips."
127    :type 'sexp    :type 'sexp
128    :tag "GUD modes"    :tag "GUD modes"
# Line 187  This might return nil if the event did n Line 183  This might return nil if the event did n
183  ;; would be accompanied by a full redisplay.  ;; would be accompanied by a full redisplay.
184    
185  ;;;###autoload  ;;;###autoload
186  (defun tooltip-mode (&optional arg)  (define-minor-mode tooltip-mode
187    "Mode for tooltip display.    "Toggle Tooltip display.
188  With ARG, turn tooltip mode on if and only if ARG is positive."  With ARG, turn tooltip mode on if and only if ARG is positive."
189    (interactive "P")    :global t
190      :group 'tooltip
191    (unless (fboundp 'x-show-tip)    (unless (fboundp 'x-show-tip)
192      (error "Sorry, tooltips are not yet available on this system"))      (error "Sorry, tooltips are not yet available on this system"))
193    (let* ((on (if arg    (let ((hook-fn (if tooltip-mode 'add-hook 'remove-hook)))
                  (> (prefix-numeric-value arg) 0)  
                (not tooltip-mode)))  
          (hook-fn (if on 'add-hook 'remove-hook)))  
     (setq tooltip-mode on)  
194      (funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode)      (funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode)
195      (tooltip-activate-mouse-motions-if-enabled)      (tooltip-activate-mouse-motions-if-enabled)
196      (funcall hook-fn 'pre-command-hook 'tooltip-hide)      (funcall hook-fn 'pre-command-hook 'tooltip-hide)
197      (funcall hook-fn 'tooltip-hook 'tooltip-gud-tips)      (funcall hook-fn 'tooltip-hook 'tooltip-gud-tips)
198      (funcall hook-fn 'tooltip-hook 'tooltip-help-tips)      (funcall hook-fn 'tooltip-hook 'tooltip-help-tips)
199      (setq show-help-function (if on 'tooltip-show-help-function nil))      (setq show-help-function (if tooltip-mode 'tooltip-show-help-function nil))
200      ;; `ignore' is the default binding for mouse movements.      ;; `ignore' is the default binding for mouse movements.
201      (define-key global-map [mouse-movement]      (define-key global-map [mouse-movement]
202        (if on 'tooltip-mouse-motion 'ignore))))        (if tooltip-mode 'tooltip-mouse-motion 'ignore))))
203    
204    
205  ;;; Timeout for tooltip display  ;;; Timeout for tooltip display
# Line 246  With ARG, turn tooltip mode on if and on Line 239  With ARG, turn tooltip mode on if and on
239  (defun tooltip-activate-mouse-motions-if-enabled ()  (defun tooltip-activate-mouse-motions-if-enabled ()
240    "Reconsider for all buffers whether mouse motion events are desired."    "Reconsider for all buffers whether mouse motion events are desired."
241    (remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)    (remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)
242    (let ((buffers (buffer-list)))    (dolist (buffer (buffer-list))
243      (save-excursion      (save-excursion
244        (while buffers        (set-buffer buffer)
245          (set-buffer (car buffers))        (if (and tooltip-mode
246          (if (and tooltip-mode                 tooltip-gud-tips-p
247                   tooltip-gud-tips-p                 (memq major-mode tooltip-gud-modes))
248                   (memq major-mode tooltip-gud-modes))            (tooltip-activate-mouse-motions t)
249              (tooltip-activate-mouse-motions t)          (tooltip-activate-mouse-motions nil)))))
           (tooltip-activate-mouse-motions nil))  
         (setq buffers (cdr buffers))))))  
250    
251  (defvar tooltip-mouse-motions-active nil  (defvar tooltip-mouse-motions-active nil
252    "Locally t in a buffer if tooltip processing of mouse motion is enabled.")    "Locally t in a buffer if tooltip processing of mouse motion is enabled.")
# Line 441  region for the tip window to be shown. Line 432  region for the tip window to be shown.
432  add a `*' in front of the printed expression.  add a `*' in front of the printed expression.
433    
434  This function must return nil if it doesn't handle EVENT."  This function must return nil if it doesn't handle EVENT."
435    (let (gud-buffer process)    (let (process)
436      (when (and (eventp event)      (when (and (eventp event)
437                 tooltip-gud-tips-p                 tooltip-gud-tips-p
438                 (boundp 'gud-comint-buffer)                 (boundp 'gud-comint-buffer)
439                 (setq gud-buffer gud-comint-buffer)                 (setq process (get-buffer-process gud-comint-buffer))
                (setq process (get-buffer-process gud-buffer))  
440                 (posn-point (event-end event))                 (posn-point (event-end event))
441                 (progn (setq tooltip-gud-event event)                 (progn (setq tooltip-gud-event event)
442                        (eval (cons 'and tooltip-gud-display))))                        (eval (cons 'and tooltip-gud-display))))
# Line 464  This function must return nil if it does Line 454  This function must return nil if it does
454                      expr)))))))                      expr)))))))
455    
456  (defun gdb-tooltip-print ()  (defun gdb-tooltip-print ()
457    (tooltip-show    (tooltip-show
458     (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)     (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
459       (buffer-string))))       (let ((string (buffer-string)))
460           ;; remove newline for tooltip-use-echo-area
461           (substring string 0 (- (length string) 1))))))
462    
463    
464  ;;; Tooltip help.  ;;; Tooltip help.
# Line 520  Value is non-nil if this function handle Line 512  Value is non-nil if this function handle
512      (tooltip-show tooltip-help-message)      (tooltip-show tooltip-help-message)
513      t))      t))
514    
   
 ;;; Do this after all functions have been defined that are called from  
 ;;; `tooltip-mode'.  The actual default value of `tooltip-mode' is set  
 ;;; in startup.el.  
   
 ;;;###autoload  
 (defcustom tooltip-mode nil  
   "Non-nil if Tooltip mode is enabled.  
 Setting this variable directly does not take effect;  
 use either \\[customize] or the function `tooltip-mode'."  
   :set (lambda (symbol value)  
          (tooltip-mode (or value 0)))  
   :initialize 'custom-initialize-default  
   :type 'boolean  
   :require 'tooltip  
   :group 'tooltip)  
   
515  (provide 'tooltip)  (provide 'tooltip)
516    
517  ;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f  ;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.41

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