| 1 | ;;; tooltip.el --- show tooltip windows |
| 2 | |
| 3 | ;; Copyright (C) 1997, 1999-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Gerd Moellmann <gerd@acm.org> |
| 6 | ;; Keywords: help c mouse tools |
| 7 | ;; Package: emacs |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;;; Code: |
| 27 | |
| 28 | (require 'syntax) |
| 29 | |
| 30 | (defvar comint-prompt-regexp) |
| 31 | |
| 32 | (defgroup tooltip nil |
| 33 | "Customization group for the `tooltip' package." |
| 34 | :group 'help |
| 35 | :group 'gud |
| 36 | :group 'mouse |
| 37 | :group 'tools |
| 38 | :version "21.1" |
| 39 | :tag "Tool Tips") |
| 40 | \f |
| 41 | ;;; Switching tooltips on/off |
| 42 | |
| 43 | (define-minor-mode tooltip-mode |
| 44 | "Toggle Tooltip mode. |
| 45 | With a prefix argument ARG, enable Tooltip mode if ARG is positive, |
| 46 | and disable it otherwise. If called from Lisp, enable the mode |
| 47 | if ARG is omitted or nil. |
| 48 | |
| 49 | When this global minor mode is enabled, Emacs displays help |
| 50 | text (e.g. for buttons and menu items that you put the mouse on) |
| 51 | in a pop-up window. |
| 52 | |
| 53 | When Tooltip mode is disabled, Emacs displays help text in the |
| 54 | echo area, instead of making a pop-up window." |
| 55 | :global t |
| 56 | ;; Even if we start on a text-only terminal, make this non-nil by |
| 57 | ;; default because we can open a graphical frame later (multi-tty). |
| 58 | :init-value t |
| 59 | :initialize 'custom-initialize-delay |
| 60 | :group 'tooltip |
| 61 | (if (and tooltip-mode (fboundp 'x-show-tip)) |
| 62 | (progn |
| 63 | (add-hook 'pre-command-hook 'tooltip-hide) |
| 64 | (add-hook 'tooltip-functions 'tooltip-help-tips)) |
| 65 | (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) |
| 66 | (remove-hook 'pre-command-hook 'tooltip-hide)) |
| 67 | (remove-hook 'tooltip-functions 'tooltip-help-tips)) |
| 68 | (setq show-help-function |
| 69 | (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) |
| 70 | |
| 71 | \f |
| 72 | ;;; Customizable settings |
| 73 | |
| 74 | (defcustom tooltip-delay 0.7 |
| 75 | "Seconds to wait before displaying a tooltip the first time." |
| 76 | :type 'number |
| 77 | :group 'tooltip) |
| 78 | |
| 79 | (defcustom tooltip-short-delay 0.1 |
| 80 | "Seconds to wait between subsequent tooltips on different items." |
| 81 | :type 'number |
| 82 | :group 'tooltip) |
| 83 | |
| 84 | (defcustom tooltip-recent-seconds 1 |
| 85 | "Display tooltips if changing tip items within this many seconds. |
| 86 | Do so after `tooltip-short-delay'." |
| 87 | :type 'number |
| 88 | :group 'tooltip) |
| 89 | |
| 90 | (defcustom tooltip-hide-delay 10 |
| 91 | "Hide tooltips automatically after this many seconds." |
| 92 | :type 'number |
| 93 | :group 'tooltip) |
| 94 | |
| 95 | (defcustom tooltip-x-offset 5 |
| 96 | "X offset, in pixels, for the display of tooltips. |
| 97 | The offset is the distance between the X position of the mouse and |
| 98 | the left border of the tooltip window. It must be chosen so that the |
| 99 | tooltip window doesn't contain the mouse when it pops up, or it may |
| 100 | interfere with clicking where you wish. |
| 101 | |
| 102 | If `tooltip-frame-parameters' includes the `left' parameter, |
| 103 | the value of `tooltip-x-offset' is ignored." |
| 104 | :type 'integer |
| 105 | :group 'tooltip) |
| 106 | |
| 107 | (defcustom tooltip-y-offset +20 |
| 108 | "Y offset, in pixels, for the display of tooltips. |
| 109 | The offset is the distance between the Y position of the mouse and |
| 110 | the top border of the tooltip window. It must be chosen so that the |
| 111 | tooltip window doesn't contain the mouse when it pops up, or it may |
| 112 | interfere with clicking where you wish. |
| 113 | |
| 114 | If `tooltip-frame-parameters' includes the `top' parameter, |
| 115 | the value of `tooltip-y-offset' is ignored." |
| 116 | :type 'integer |
| 117 | :group 'tooltip) |
| 118 | |
| 119 | (defcustom tooltip-frame-parameters |
| 120 | '((name . "tooltip") |
| 121 | (internal-border-width . 2) |
| 122 | (border-width . 1)) |
| 123 | "Frame parameters used for tooltips. |
| 124 | |
| 125 | If `left' or `top' parameters are included, they specify the absolute |
| 126 | position to pop up the tooltip. |
| 127 | |
| 128 | Note that font and color parameters are ignored, and the attributes |
| 129 | of the `tooltip' face are used instead." |
| 130 | :type 'sexp |
| 131 | :group 'tooltip) |
| 132 | |
| 133 | (defface tooltip |
| 134 | '((((class color)) |
| 135 | :background "lightyellow" |
| 136 | :foreground "black" |
| 137 | :inherit variable-pitch) |
| 138 | (t |
| 139 | :inherit variable-pitch)) |
| 140 | "Face for tooltips." |
| 141 | :group 'tooltip |
| 142 | :group 'basic-faces) |
| 143 | |
| 144 | (defcustom tooltip-use-echo-area nil |
| 145 | "Use the echo area instead of tooltip frames for help and GUD tooltips. |
| 146 | This variable is obsolete; instead of setting it to t, disable |
| 147 | `tooltip-mode' (which has a similar effect)." |
| 148 | :type 'boolean |
| 149 | :group 'tooltip) |
| 150 | |
| 151 | (make-obsolete-variable 'tooltip-use-echo-area |
| 152 | "disable Tooltip mode instead" "24.1" 'set) |
| 153 | |
| 154 | \f |
| 155 | ;;; Variables that are not customizable. |
| 156 | |
| 157 | (define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1") |
| 158 | |
| 159 | (defvar tooltip-functions nil |
| 160 | "Functions to call to display tooltips. |
| 161 | Each function is called with one argument EVENT which is a copy |
| 162 | of the last mouse movement event that occurred. If one of these |
| 163 | functions displays the tooltip, it should return non-nil and the |
| 164 | rest are not called.") |
| 165 | |
| 166 | (defvar tooltip-timeout-id nil |
| 167 | "The id of the timeout started when Emacs becomes idle.") |
| 168 | |
| 169 | (defvar tooltip-last-mouse-motion-event nil |
| 170 | "A copy of the last mouse motion event seen.") |
| 171 | |
| 172 | (defvar tooltip-hide-time nil |
| 173 | "Time when the last tooltip was hidden.") |
| 174 | |
| 175 | (defvar gud-tooltip-mode) ;; Prevent warning. |
| 176 | |
| 177 | ;;; Event accessors |
| 178 | |
| 179 | (defun tooltip-event-buffer (event) |
| 180 | "Return the buffer over which event EVENT occurred. |
| 181 | This might return nil if the event did not occur over a buffer." |
| 182 | (let ((window (posn-window (event-end event)))) |
| 183 | (and window (window-buffer window)))) |
| 184 | |
| 185 | \f |
| 186 | ;;; Timeout for tooltip display |
| 187 | |
| 188 | (defun tooltip-delay () |
| 189 | "Return the delay in seconds for the next tooltip." |
| 190 | (if (and tooltip-hide-time |
| 191 | (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds)) |
| 192 | tooltip-short-delay |
| 193 | tooltip-delay)) |
| 194 | |
| 195 | (defun tooltip-cancel-delayed-tip () |
| 196 | "Disable the tooltip timeout." |
| 197 | (when tooltip-timeout-id |
| 198 | (disable-timeout tooltip-timeout-id) |
| 199 | (setq tooltip-timeout-id nil))) |
| 200 | |
| 201 | (defun tooltip-start-delayed-tip () |
| 202 | "Add a one-shot timeout to call function `tooltip-timeout'." |
| 203 | (setq tooltip-timeout-id |
| 204 | (add-timeout (tooltip-delay) 'tooltip-timeout nil))) |
| 205 | |
| 206 | (defun tooltip-timeout (_object) |
| 207 | "Function called when timer with id `tooltip-timeout-id' fires." |
| 208 | (run-hook-with-args-until-success 'tooltip-functions |
| 209 | tooltip-last-mouse-motion-event)) |
| 210 | |
| 211 | \f |
| 212 | ;;; Displaying tips |
| 213 | |
| 214 | (defun tooltip-set-param (alist key value) |
| 215 | "Change the value of KEY in alist ALIST to VALUE. |
| 216 | If there's no association for KEY in ALIST, add one, otherwise |
| 217 | change the existing association. Value is the resulting alist." |
| 218 | (let ((param (assq key alist))) |
| 219 | (if (consp param) |
| 220 | (setcdr param value) |
| 221 | (push (cons key value) alist)) |
| 222 | alist)) |
| 223 | |
| 224 | (declare-function x-show-tip "xfns.c" |
| 225 | (string &optional frame parms timeout dx dy)) |
| 226 | |
| 227 | (defun tooltip-show (text &optional use-echo-area) |
| 228 | "Show a tooltip window displaying TEXT. |
| 229 | |
| 230 | Text larger than `x-max-tooltip-size' is clipped. |
| 231 | |
| 232 | If the alist in `tooltip-frame-parameters' includes `left' and `top' |
| 233 | parameters, they determine the x and y position where the tooltip |
| 234 | is displayed. Otherwise, the tooltip pops at offsets specified by |
| 235 | `tooltip-x-offset' and `tooltip-y-offset' from the current mouse |
| 236 | position. |
| 237 | |
| 238 | Optional second arg USE-ECHO-AREA non-nil means to show tooltip |
| 239 | in echo area." |
| 240 | (if use-echo-area |
| 241 | (tooltip-show-help-non-mode text) |
| 242 | (condition-case error |
| 243 | (let ((params (copy-sequence tooltip-frame-parameters)) |
| 244 | (fg (face-attribute 'tooltip :foreground)) |
| 245 | (bg (face-attribute 'tooltip :background))) |
| 246 | (when (stringp fg) |
| 247 | (setq params (tooltip-set-param params 'foreground-color fg)) |
| 248 | (setq params (tooltip-set-param params 'border-color fg))) |
| 249 | (when (stringp bg) |
| 250 | (setq params (tooltip-set-param params 'background-color bg))) |
| 251 | (x-show-tip (propertize text 'face 'tooltip) |
| 252 | (selected-frame) |
| 253 | params |
| 254 | tooltip-hide-delay |
| 255 | tooltip-x-offset |
| 256 | tooltip-y-offset)) |
| 257 | (error |
| 258 | (message "Error while displaying tooltip: %s" error) |
| 259 | (sit-for 1) |
| 260 | (message "%s" text))))) |
| 261 | |
| 262 | (declare-function x-hide-tip "xfns.c" ()) |
| 263 | |
| 264 | (defun tooltip-hide (&optional _ignored-arg) |
| 265 | "Hide a tooltip, if one is displayed. |
| 266 | Value is non-nil if tooltip was open." |
| 267 | (tooltip-cancel-delayed-tip) |
| 268 | (when (x-hide-tip) |
| 269 | (setq tooltip-hide-time (float-time)))) |
| 270 | |
| 271 | \f |
| 272 | ;;; Debugger-related functions |
| 273 | |
| 274 | (defun tooltip-identifier-from-point (point) |
| 275 | "Extract the identifier at POINT, if any. |
| 276 | Value is nil if no identifier exists at point. Identifier extraction |
| 277 | is based on the current syntax table." |
| 278 | (save-excursion |
| 279 | (goto-char point) |
| 280 | (let* ((start (progn (skip-syntax-backward "w_") (point))) |
| 281 | (pstate (syntax-ppss))) |
| 282 | (unless (or (looking-at "[0-9]") |
| 283 | (nth 3 pstate) |
| 284 | (nth 4 pstate)) |
| 285 | (skip-syntax-forward "w_") |
| 286 | (when (> (point) start) |
| 287 | (buffer-substring start (point))))))) |
| 288 | |
| 289 | (defmacro tooltip-region-active-p () |
| 290 | "Value is non-nil if the region should override command actions." |
| 291 | `(use-region-p)) |
| 292 | |
| 293 | (defun tooltip-expr-to-print (event) |
| 294 | "Return an expression that should be printed for EVENT. |
| 295 | If a region is active and the mouse is inside the region, print |
| 296 | the region. Otherwise, figure out the identifier around the point |
| 297 | where the mouse is." |
| 298 | (with-current-buffer (tooltip-event-buffer event) |
| 299 | (let ((point (posn-point (event-end event)))) |
| 300 | (if (tooltip-region-active-p) |
| 301 | (when (and (<= (region-beginning) point) (<= point (region-end))) |
| 302 | (buffer-substring (region-beginning) (region-end))) |
| 303 | (tooltip-identifier-from-point point))))) |
| 304 | |
| 305 | (defun tooltip-process-prompt-regexp (process) |
| 306 | "Return regexp matching the prompt of PROCESS at the end of a string. |
| 307 | The prompt is taken from the value of `comint-prompt-regexp' in |
| 308 | the buffer of PROCESS." |
| 309 | (let ((prompt-regexp (with-current-buffer (process-buffer process) |
| 310 | comint-prompt-regexp))) |
| 311 | (concat "\n*" |
| 312 | ;; Most start with `^' but the one for `sdb' cannot be easily |
| 313 | ;; stripped. Code the prompt for `sdb' fixed here. |
| 314 | (if (= (aref prompt-regexp 0) ?^) |
| 315 | (substring prompt-regexp 1) |
| 316 | "\\*") |
| 317 | "$"))) |
| 318 | |
| 319 | (defun tooltip-strip-prompt (process output) |
| 320 | "Return OUTPUT with any prompt of PROCESS stripped from its end." |
| 321 | (save-match-data |
| 322 | (if (string-match (tooltip-process-prompt-regexp process) output) |
| 323 | (substring output 0 (match-beginning 0)) |
| 324 | output))) |
| 325 | |
| 326 | \f |
| 327 | ;;; Tooltip help. |
| 328 | |
| 329 | (defvar tooltip-help-message nil |
| 330 | "The last help message received via `show-help-function'. |
| 331 | This is used by `tooltip-show-help' and |
| 332 | `tooltip-show-help-non-mode'.") |
| 333 | |
| 334 | (defvar tooltip-previous-message nil |
| 335 | "The previous content of the echo area.") |
| 336 | |
| 337 | (defun tooltip-show-help-non-mode (help) |
| 338 | "Function installed as `show-help-function' when Tooltip mode is off. |
| 339 | It is also called if Tooltip mode is on, for text-only displays." |
| 340 | (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents. |
| 341 | (not cursor-in-echo-area)) ;Don't overwrite a prompt. |
| 342 | (cond |
| 343 | ((stringp help) |
| 344 | (setq help (replace-regexp-in-string "\n" ", " help)) |
| 345 | (unless (or tooltip-previous-message |
| 346 | (equal-including-properties help (current-message)) |
| 347 | (and (stringp tooltip-help-message) |
| 348 | (equal-including-properties tooltip-help-message |
| 349 | (current-message)))) |
| 350 | (setq tooltip-previous-message (current-message))) |
| 351 | (setq tooltip-help-message help) |
| 352 | (let ((message-truncate-lines t) |
| 353 | (message-log-max nil)) |
| 354 | (message "%s" help))) |
| 355 | ((stringp tooltip-previous-message) |
| 356 | (let ((message-log-max nil)) |
| 357 | (message "%s" tooltip-previous-message) |
| 358 | (setq tooltip-previous-message nil))) |
| 359 | (t |
| 360 | (message nil))))) |
| 361 | |
| 362 | (defun tooltip-show-help (msg) |
| 363 | "Function installed as `show-help-function'. |
| 364 | MSG is either a help string to display, or nil to cancel the display." |
| 365 | (if (display-graphic-p) |
| 366 | (let ((previous-help tooltip-help-message)) |
| 367 | (setq tooltip-help-message msg) |
| 368 | (cond ((null msg) |
| 369 | ;; Cancel display. This also cancels a delayed tip, if |
| 370 | ;; there is one. |
| 371 | (tooltip-hide)) |
| 372 | ((equal-including-properties previous-help msg) |
| 373 | ;; Same help as before (but possibly the mouse has moved). |
| 374 | ;; Keep what we have. |
| 375 | ) |
| 376 | (t |
| 377 | ;; A different help. Remove a previous tooltip, and |
| 378 | ;; display a new one, with some delay. |
| 379 | (tooltip-hide) |
| 380 | (tooltip-start-delayed-tip)))) |
| 381 | ;; On text-only displays, try `tooltip-show-help-non-mode'. |
| 382 | (tooltip-show-help-non-mode msg))) |
| 383 | |
| 384 | (defun tooltip-help-tips (_event) |
| 385 | "Hook function to display a help tooltip. |
| 386 | This is installed on the hook `tooltip-functions', which |
| 387 | is run when the timer with id `tooltip-timeout-id' fires. |
| 388 | Value is non-nil if this function handled the tip." |
| 389 | (when (stringp tooltip-help-message) |
| 390 | (tooltip-show tooltip-help-message tooltip-use-echo-area) |
| 391 | t)) |
| 392 | |
| 393 | (provide 'tooltip) |
| 394 | |
| 395 | ;;; tooltip.el ends here |