;;; tooltip.el --- show tooltip windows
;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar comint-prompt-regexp)
-;;; Customizable settings
-
(defgroup tooltip nil
"Customization group for the `tooltip' package."
:group 'help
:group 'tools
:version "21.1"
:tag "Tool Tips")
+\f
+;;; Switching tooltips on/off
+
+(define-minor-mode tooltip-mode
+ "Toggle Tooltip mode.
+With ARG, turn Tooltip mode on if and only if ARG is positive.
+When this minor mode is enabled, Emacs displays help text
+in a pop-up window for buttons and menu items that you put the mouse on.
+\(However, if `tooltip-use-echo-area' is non-nil, this and
+all pop-up help appears in the echo area.)
+
+When Tooltip mode is disabled, Emacs displays one line of
+the help text in the echo area, and does not make a pop-up window."
+ :global t
+ :init-value (not (or noninteractive
+ emacs-basic-display
+ (not (display-graphic-p))
+ (not (fboundp 'x-show-tip))))
+ :initialize 'custom-initialize-safe-default
+ :group 'tooltip
+ (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
+ (error "Sorry, tooltips are not yet available on this system"))
+ (if tooltip-mode
+ (progn
+ (add-hook 'pre-command-hook 'tooltip-hide)
+ (add-hook 'tooltip-hook 'tooltip-help-tips))
+ (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
+ (remove-hook 'pre-command-hook 'tooltip-hide))
+ (remove-hook 'tooltip-hook 'tooltip-help-tips))
+ (setq show-help-function
+ (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode)))
+
+\f
+;;; Customizable settings
(defcustom tooltip-delay 0.7
"Seconds to wait before displaying a tooltip the first time."
- :tag "Delay"
:type 'number
:group 'tooltip)
(defcustom tooltip-short-delay 0.1
"Seconds to wait between subsequent tooltips on different items."
- :tag "Short delay"
:type 'number
:group 'tooltip)
(defcustom tooltip-recent-seconds 1
"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
+(defcustom tooltip-x-offset 5
"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.
+The offset is the distance between the X position of the mouse and
+the left border of the tooltip window. It must be chosen so that the
+tooltip window doesn't contain the mouse when it pops up, or it may
+interfere with clicking where you wish.
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))
+ :type 'integer
:group 'tooltip)
-(defcustom tooltip-y-offset nil
+(defcustom tooltip-y-offset +20
"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.
+The offset is the distance between the Y position of the mouse and
+the top border of the tooltip window. It must be chosen so that the
+tooltip window doesn't contain the mouse when it pops up, or it may
+interfere with clicking where you wish.
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))
+ :type 'integer
:group 'tooltip)
(defcustom tooltip-frame-parameters
'((name . "tooltip")
- (internal-border-width . 5)
+ (internal-border-width . 2)
(border-width . 1))
"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
:group 'basic-faces)
(defcustom tooltip-use-echo-area nil
- "Use the echo area instead of tooltip frames for help and GUD tooltips."
+ "Use the echo area instead of tooltip frames for help and GUD tooltips.
+To display multi-line help text in the echo area, set this to t
+and enable `tooltip-mode'."
:type 'boolean
- :tag "Use echo area"
:group 'tooltip)
\f
(let ((window (posn-window (event-end event))))
(and window (window-buffer window))))
-;;; Switching tooltips on/off
-
-;; We don't set track-mouse globally because this is a big redisplay
-;; problem in buffers having a pre-command-hook or such installed,
-;; which does a set-buffer, like the summary buffer of Gnus. Calling
-;; set-buffer prevents redisplay optimizations, so every mouse motion
-;; would be accompanied by a full redisplay.
-
-(define-minor-mode tooltip-mode
- "Toggle Tooltip display.
-With ARG, turn tooltip mode on if and only if ARG is positive."
- :global t
- :init-value (not (or noninteractive
- emacs-basic-display
- (not (display-graphic-p))
- (not (fboundp 'x-show-tip))))
- :initialize 'custom-initialize-safe-default
- :group 'tooltip
- (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
- (error "Sorry, tooltips are not yet available on this system"))
- (if tooltip-mode
- (progn
- (add-hook 'pre-command-hook 'tooltip-hide)
- (add-hook 'tooltip-hook 'tooltip-help-tips))
- (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
- (remove-hook 'pre-command-hook 'tooltip-hide))
- (remove-hook 'tooltip-hook 'tooltip-help-tips))
- (setq show-help-function
- (if tooltip-mode 'tooltip-show-help nil)))
-
\f
;;; Timeout for tooltip display
(defun tooltip-delay ()
"Return the delay in seconds for the next tooltip."
- (let ((delay tooltip-delay)
- (now (float-time)))
- (when (and tooltip-hide-time
- (< (- now tooltip-hide-time) tooltip-recent-seconds))
- (setq delay tooltip-short-delay))
- delay))
+ (if (and tooltip-hide-time
+ (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds))
+ tooltip-short-delay
+ tooltip-delay))
(defun tooltip-cancel-delayed-tip ()
"Disable the tooltip timeout."
(push (cons key value) alist))
alist))
+(declare-function x-show-tip "xfns.c"
+ (string &optional frame parms timeout dx dy))
+
(defun tooltip-show (text &optional use-echo-area)
"Show a tooltip window displaying TEXT.
Optional second arg USE-ECHO-AREA non-nil means to show tooltip
in echo area."
(if use-echo-area
- (message "%s" text)
+ (tooltip-show-help-non-mode text)
(condition-case error
(let ((params (copy-sequence tooltip-frame-parameters))
(fg (face-attribute 'tooltip :foreground))
(sit-for 1)
(message "%s" text)))))
+(declare-function x-hide-tip "xfns.c" ())
+
(defun tooltip-hide (&optional ignored-arg)
"Hide a tooltip, if one is displayed.
Value is non-nil if tooltip was open."
(buffer-substring start (point)))))))
(defmacro tooltip-region-active-p ()
- "Value is non-nil if the region is currently active."
- (if (string-match "^GNU" (emacs-version))
- `(and transient-mark-mode mark-active)
- `(region-active-p)))
+ "Value is non-nil if the region should override command actions."
+ `(use-region-p))
(defun tooltip-expr-to-print (event)
"Return an expression that should be printed for EVENT.
If a region is active and the mouse is inside the region, print
the region. Otherwise, figure out the identifier around the point
where the mouse is."
- (save-excursion
- (set-buffer (tooltip-event-buffer event))
+ (with-current-buffer (tooltip-event-buffer event)
(let ((point (posn-point (event-end event))))
(if (tooltip-region-active-p)
(when (and (<= (region-beginning) point) (<= point (region-end)))
"Return regexp matching the prompt of PROCESS at the end of a string.
The prompt is taken from the value of `comint-prompt-regexp' in
the buffer of PROCESS."
- (let ((prompt-regexp (save-excursion
- (set-buffer (process-buffer process))
+ (let ((prompt-regexp (with-current-buffer (process-buffer process)
comint-prompt-regexp)))
- ;; Most start with `^' but the one for `sdb' cannot be easily
- ;; stripped. Code the prompt for `sdb' fixed here.
- (if (= (aref prompt-regexp 0) ?^)
- (setq prompt-regexp (substring prompt-regexp 1))
- (setq prompt-regexp "\\*"))
- (concat "\n*" prompt-regexp "$")))
+ (concat "\n*"
+ ;; Most start with `^' but the one for `sdb' cannot be easily
+ ;; stripped. Code the prompt for `sdb' fixed here.
+ (if (= (aref prompt-regexp 0) ?^)
+ (substring prompt-regexp 1)
+ "\\*")
+ "$")))
(defun tooltip-strip-prompt (process output)
"Return OUTPUT with any prompt of PROCESS stripped from its end."
- (let ((prompt-regexp (tooltip-process-prompt-regexp process)))
- (save-match-data
- (when (string-match prompt-regexp output)
- (setq output (substring output 0 (match-beginning 0)))))
- output))
+ (save-match-data
+ (if (string-match (tooltip-process-prompt-regexp process) output)
+ (substring output 0 (match-beginning 0))
+ output)))
\f
;;; Tooltip help.
(defvar tooltip-help-message nil
"The last help message received via `tooltip-show-help'.")
+(defvar tooltip-previous-message nil
+ "The previous content of the echo area.")
+
+(defun tooltip-show-help-non-mode (help)
+ "Function installed as `show-help-function' when tooltip is off."
+ (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents.
+ ;; Don't know how to reproduce it in Elisp:
+ ;; Don't overwrite a keystroke echo.
+ ;; (NILP (echo_message_buffer) || ok_to_overwrite_keystroke_echo)
+ (not cursor-in-echo-area)) ;Don't overwrite a prompt.
+ (cond
+ ((stringp help)
+ (unless tooltip-previous-message
+ (setq tooltip-previous-message (current-message)))
+ (let ((message-truncate-lines t)
+ (message-log-max nil))
+ (message "%s" (replace-regexp-in-string "\n" ", " help))))
+ ((stringp tooltip-previous-message)
+ (let ((message-log-max nil))
+ (message "%s" tooltip-previous-message)
+ (setq tooltip-previous-message nil)))
+ (t
+ (message nil)))))
+
+
(defun tooltip-show-help (msg)
"Function installed as `show-help-function'.
MSG is either a help string to display, or nil to cancel the display."