-;;; tooltip.el --- Show tooltip windows
+;;; tooltip.el --- show tooltip windows
-;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
;;; Commentary:
-;; Put into your `.emacs'
-
-;; (require 'tooltip)
-;; (tooltip-mode 1)
-
-
-\f
;;; Code:
(eval-when-compile
(defgroup tooltip nil
"Customization group for the `tooltip' package."
:group 'help
- :group 'c
+ :group 'gud
:group 'mouse
:group 'tools
+ :version "21.1"
:tag "Tool Tips")
+(defvar tooltip-mode)
-(defcustom tooltip-delay 1.0
+(defcustom tooltip-delay 0.7
"Seconds to wait before displaying a tooltip the first time."
:tag "Delay"
:type 'number
(defcustom tooltip-recent-seconds 1
- "Display tooltips after `tooltip-short-delay' if changing tip items
-within this many seconds."
+ "Display tooltips if changing tip items within this many seconds.
+Do so after `tooltip-short-delay'."
:tag "Recent seconds"
:type 'number
:group 'tooltip)
+(defcustom tooltip-hide-delay 10
+ "Hide tooltips automatically after this many seconds."
+ :tag "Hide delay"
+ :type 'number
+ :group 'tooltip)
+
+
+(defcustom tooltip-x-offset nil
+ "Specify an X offset, in pixels, for the display of tooltips.
+The offset is relative to the position of the mouse. It must
+be chosen so that the tooltip window doesn't contain the mouse
+when it pops up. If the value is nil, the default offset is 5
+pixels.
+
+If `tooltip-frame-parameters' includes the `left' parameter,
+the value of `tooltip-x-offset' is ignored."
+ :tag "X offset"
+ :type '(choice (const :tag "Default" nil)
+ (integer :tag "Offset" :value 1))
+ :group 'tooltip)
+
+
+(defcustom tooltip-y-offset nil
+ "Specify a Y offset, in pixels, for the display of tooltips.
+The offset is relative to the position of the mouse. It must
+be chosen so that the tooltip window doesn't contain the mouse
+when it pops up. If the value is nil, the default offset is -10
+pixels.
+
+If `tooltip-frame-parameters' includes the `top' parameter,
+the value of `tooltip-y-offset' is ignored."
+ :tag "Y offset"
+ :type '(choice (const :tag "Default" nil)
+ (integer :tag "Offset" :value 1))
+ :group 'tooltip)
+
+
(defcustom tooltip-frame-parameters
'((name . "tooltip")
- (foreground-color . "black")
- (background-color . "lightyellow")
(internal-border-width . 5)
- (border-color . "lightyellow")
(border-width . 1))
- "Frame parameters used for tooltips."
+ "Frame parameters used for tooltips.
+
+If `left' or `top' parameters are included, they specify the absolute
+position to pop up the tooltip."
:type 'sexp
:tag "Frame Parameters"
:group 'tooltip)
+(defface tooltip
+ '((((class color))
+ (:background "lightyellow" :foreground "black"))
+ (t ()))
+ "Face for tooltips."
+ :group 'tooltip)
+
+
(defcustom tooltip-gud-tips-p nil
- "Non-nil means show tooltips in GUD sessions."
+ "*Non-nil means show tooltips in GUD sessions."
:type 'boolean
:tag "GUD"
+ :set #'(lambda (symbol on)
+ (setq tooltip-gud-tips-p on)
+ (if on (tooltip-gud-tips-setup)))
:group 'tooltip)
:tag "GUD modes"
:group 'tooltip)
-
+
(defcustom tooltip-gud-display
'((eq (tooltip-event-buffer tooltip-gud-event)
(marker-buffer overlay-arrow-position)))
:group 'tooltip)
+(defcustom tooltip-use-echo-area nil
+ "Use the echo area instead of tooltip frames.
+This is only relevant GUD display, since otherwise it is equivalent to
+turning off Tooltip mode."
+ :type 'boolean
+ :tag "Use echo area"
+ :group 'tooltip)
+
\f
;;; Variables that are not customizable.
"Time when the last tooltip was hidden.")
-(defvar tooltip-mode nil
- "Non-nil means tooltip mode is on.")
-
-
(defvar tooltip-gud-debugger nil
"The debugger for which we show tooltips.")
"Mode for tooltip display.
With ARG, turn tooltip mode on if and only if ARG is positive."
(interactive "P")
+ (unless (fboundp 'x-show-tip)
+ (error "Sorry, tooltips are not yet available on this system"))
(let* ((on (if arg
(> (prefix-numeric-value arg) 0)
(not tooltip-mode)))
;; `ignore' is the default binding for mouse movements.
(define-key global-map [mouse-movement]
(if on 'tooltip-mouse-motion 'ignore))
- (when (and on 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))))))
-
-
+ (tooltip-gud-tips-setup)))
+
+(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)))))
\f
;;; Timeout for tooltip display
-(defun tooltip-float-time ()
- "Return the values of `current-time' as a float."
- (let ((now (current-time)))
- (+ (* 65536.0 (nth 0 now))
- (nth 1 now)
- (/ (nth 2 now) 1000000.0))))
-
-
(defun tooltip-delay ()
"Return the delay in seconds for the next tooltip."
(let ((delay tooltip-delay)
- (now (tooltip-float-time)))
+ (now (float-time)))
(when (and tooltip-hide-time
(< (- now tooltip-hide-time) tooltip-recent-seconds))
(setq delay tooltip-short-delay))
delay))
-(defun tooltip-disable-timeout ()
+(defun tooltip-cancel-delayed-tip ()
"Disable the tooltip timeout."
(when tooltip-timeout-id
(disable-timeout tooltip-timeout-id)
(setq tooltip-timeout-id nil)))
-(defun tooltip-add-timeout ()
+(defun tooltip-start-delayed-tip ()
"Add a one-shot timeout to call function tooltip-timeout."
(setq tooltip-timeout-id
(add-timeout (tooltip-delay) 'tooltip-timeout nil)))
(tooltip-hide)
(when (car (mouse-pixel-position))
(setq tooltip-last-mouse-motion-event (copy-sequence event))
- (tooltip-add-timeout)))
+ (tooltip-start-delayed-tip)))
\f
;;; Displaying tips
+(defun tooltip-set-param (alist key value)
+ "Change the value of KEY in alist ALIST to VALUE.
+If there's no association for KEY in ALIST, add one, otherwise
+change the existing association. Value is the resulting alist."
+ (let ((param (assq key alist)))
+ (if (consp param)
+ (setcdr param value)
+ (push (cons key value) alist))
+ alist))
+
+
(defun tooltip-show (text)
- "Show a tooltip window at the current mouse position displaying TEXT."
- (x-show-tip text (selected-frame) tooltip-frame-parameters))
+ "Show a tooltip window displaying TEXT.
+
+Text larger than `x-max-tooltip-size' (which see) is clipped.
+
+If the alist in `tooltip-frame-parameters' includes `left' and `top'
+parameters, they determine the x and y position where the tooltip
+is displayed. Otherwise, the tooltip pops at offsets specified by
+`tooltip-x-offset' and `tooltip-y-offset' from the current mouse
+position."
+ (if tooltip-use-echo-area
+ (message "%s" text)
+ (condition-case error
+ (let ((params (copy-sequence tooltip-frame-parameters))
+ (fg (face-attribute 'tooltip :foreground))
+ (bg (face-attribute 'tooltip :background)))
+ (when (stringp fg)
+ (setq params (tooltip-set-param params 'foreground-color fg))
+ (setq params (tooltip-set-param params 'border-color fg)))
+ (when (stringp bg)
+ (setq params (tooltip-set-param params 'background-color bg)))
+ (x-show-tip (propertize text 'face 'tooltip)
+ (selected-frame)
+ params
+ tooltip-hide-delay
+ tooltip-x-offset
+ tooltip-y-offset))
+ (error
+ (message "Error while displaying tooltip: %s" error)
+ (sit-for 1)
+ (message "%s" text)))))
(defun tooltip-hide (&optional ignored-arg)
"Hide a tooltip, if one is displayed.
Value is non-nil if tooltip was open."
- (tooltip-disable-timeout)
+ (tooltip-cancel-delayed-tip)
(when (x-hide-tip)
- (setq tooltip-hide-time (tooltip-float-time))))
+ (setq tooltip-hide-time (float-time))))
\f
(defun tooltip-gud-toggle-dereference ()
- "Toggle whether tooltips should show `* exor' or `expr'."
+ "Toggle whether tooltips should show `* expr' or `expr'."
(interactive)
(setq tooltip-gud-dereference (not tooltip-gud-dereference))
(when (interactive-p)
(xdb (concat "p " expr))
(sdb (concat expr "/"))
(perldb expr)))
-
+
(defun tooltip-gud-tips (event)
- "Show tip for identifier or selection under the mouse. The mouse
-must either point at an identifier or inside a selected region for the
-tip window to be shown. If tooltip-gud-dereference is t, add a `*' in
-front of the printed expression.
+ "Show tip for identifier or selection under the mouse.
+The mouse must either point at an identifier or inside a selected
+region for the tip window to be shown. If tooltip-gud-dereference is t,
+add a `*' in front of the printed expression.
This function must return nil if it doesn't handle EVENT."
(let (gud-buffer process)
(eval (cons 'and tooltip-gud-display))))
(let ((expr (tooltip-expr-to-print event)))
(when expr
- (setq tooltip-gud-original-filter (process-filter process))
- (set-process-filter process 'tooltip-gud-process-output)
- (process-send-string
- process (concat (tooltip-gud-print-command expr) "\n"))
- expr)))))
-
+ (let ((cmd (tooltip-gud-print-command expr)))
+ (unless (null cmd) ; CMD can be nil if unknown debugger
+ (setq tooltip-gud-original-filter (process-filter process))
+ (set-process-filter process 'tooltip-gud-process-output)
+ (gud-basic-call cmd)
+ expr)))))))
\f
;;; Tooltip help.
(let ((previous-help tooltip-help-message))
(setq tooltip-help-message msg)
(cond ((null msg)
+ ;; Cancel display. This also cancels a delayed tip, if
+ ;; there is one.
(tooltip-hide))
- ((or (not (stringp previous-help))
- (not (string= msg previous-help)))
- (tooltip-hide)
- (tooltip-add-timeout))
+ ((equal previous-help msg)
+ ;; Same help as before (but possibly the mouse has moved).
+ ;; Keep what we have.
+ )
(t
- (tooltip-disable-timeout)
- (tooltip-add-timeout)))))
+ ;; A different help. Remove a previous tooltip, and
+ ;; display a new one, with some delay.
+ (tooltip-hide)
+ (tooltip-start-delayed-tip)))))
(defun tooltip-help-tips (event)
"Hook function to display a help tooltip.
+This is installed on the hook `tooltip-hook', which is run when
+the timer with ID `tooltip-timeout-id' fires.
Value is non-nil if this function handled the tip."
(when (stringp tooltip-help-message)
(tooltip-show tooltip-help-message)
- (setq tooltip-help-message nil)
t))
\f
-;;; Do this after all functions have been defined that are called
-;;; from `tooltip-mode'.
+;;; 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.
-(defcustom tooltip-active nil
- "*Non-nil means tooltips are active."
- :tag "Activate tooltips"
+;;;###autoload
+(defcustom tooltip-mode nil
+ "Toggle tooltip-mode.
+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
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (tooltip-mode (or value 0)))
:require 'tooltip
:group 'tooltip)
HCoop / bpt / emacs.git / blobdiff