LCOV - code coverage report
Current view: top level - lisp - tooltip.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 105 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 16 0.0 %

          Line data    Source code
       1             : ;;; tooltip.el --- show tooltip windows
       2             : 
       3             : ;; Copyright (C) 1997, 1999-2017 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             : 
      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           0 :   (if (and tooltip-mode (fboundp 'x-show-tip))
      62           0 :       (progn
      63           0 :         (add-hook 'pre-command-hook 'tooltip-hide)
      64           0 :         (add-hook 'tooltip-functions 'tooltip-help-tips))
      65           0 :     (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
      66           0 :       (remove-hook 'pre-command-hook 'tooltip-hide))
      67           0 :     (remove-hook 'tooltip-functions 'tooltip-help-tips))
      68           0 :   (setq show-help-function
      69           0 :         (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode)))
      70             : 
      71             : 
      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             :     (no-special-glyphs . t))
     124             :   "Frame parameters used for tooltips.
     125             : 
     126             : If `left' or `top' parameters are included, they specify the absolute
     127             : position to pop up the tooltip.
     128             : 
     129             : Note that font and color parameters are ignored, and the attributes
     130             : of the `tooltip' face are used instead."
     131             :   :type '(repeat (cons :format "%v"
     132             :                        (symbol :tag "Parameter")
     133             :                        (sexp :tag "Value")))
     134             :   :group 'tooltip
     135             :   :version "26.1")
     136             : 
     137             : (defface tooltip
     138             :   '((((class color))
     139             :      :background "lightyellow"
     140             :      :foreground "black"
     141             :      :inherit variable-pitch)
     142             :     (t
     143             :      :inherit variable-pitch))
     144             :   "Face for tooltips."
     145             :   :group 'tooltip
     146             :   :group 'basic-faces)
     147             : 
     148             : (defcustom tooltip-use-echo-area nil
     149             :   "Use the echo area instead of tooltip frames for help and GUD tooltips.
     150             : This variable is obsolete; instead of setting it to t, disable
     151             : `tooltip-mode' (which has a similar effect)."
     152             :   :type 'boolean
     153             :   :group 'tooltip)
     154             : 
     155             : (make-obsolete-variable 'tooltip-use-echo-area
     156             :                         "disable Tooltip mode instead" "24.1" 'set)
     157             : 
     158             : 
     159             : ;;; Variables that are not customizable.
     160             : 
     161             : (define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
     162             : 
     163             : (defvar tooltip-functions nil
     164             :   "Functions to call to display tooltips.
     165             : Each function is called with one argument EVENT which is a copy
     166             : of the last mouse movement event that occurred.  If one of these
     167             : functions displays the tooltip, it should return non-nil and the
     168             : rest are not called.")
     169             : 
     170             : (defvar tooltip-timeout-id nil
     171             :   "The id of the timeout started when Emacs becomes idle.")
     172             : 
     173             : (defvar tooltip-last-mouse-motion-event nil
     174             :   "A copy of the last mouse motion event seen.")
     175             : 
     176             : (defvar tooltip-hide-time nil
     177             :   "Time when the last tooltip was hidden.")
     178             : 
     179             : (defvar gud-tooltip-mode) ;; Prevent warning.
     180             : 
     181             : ;;; Event accessors
     182             : 
     183             : (defun tooltip-event-buffer (event)
     184             :   "Return the buffer over which event EVENT occurred.
     185             : This might return nil if the event did not occur over a buffer."
     186           0 :   (let ((window (posn-window (event-end event))))
     187           0 :     (and window (window-buffer window))))
     188             : 
     189             : 
     190             : ;;; Timeout for tooltip display
     191             : 
     192             : (defun tooltip-delay ()
     193             :   "Return the delay in seconds for the next tooltip."
     194           0 :   (if (and tooltip-hide-time
     195           0 :            (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds))
     196           0 :       tooltip-short-delay
     197           0 :     tooltip-delay))
     198             : 
     199             : (defun tooltip-cancel-delayed-tip ()
     200             :   "Disable the tooltip timeout."
     201           0 :   (when tooltip-timeout-id
     202           0 :     (disable-timeout tooltip-timeout-id)
     203           0 :     (setq tooltip-timeout-id nil)))
     204             : 
     205             : (defun tooltip-start-delayed-tip ()
     206             :   "Add a one-shot timeout to call function `tooltip-timeout'."
     207           0 :   (setq tooltip-timeout-id
     208           0 :         (add-timeout (tooltip-delay) 'tooltip-timeout nil)))
     209             : 
     210             : (defun tooltip-timeout (_object)
     211             :   "Function called when timer with id `tooltip-timeout-id' fires."
     212           0 :   (run-hook-with-args-until-success 'tooltip-functions
     213           0 :                                     tooltip-last-mouse-motion-event))
     214             : 
     215             : 
     216             : ;;; Displaying tips
     217             : 
     218             : (defun tooltip-set-param (alist key value)
     219             :   "Change the value of KEY in alist ALIST to VALUE.
     220             : If there's no association for KEY in ALIST, add one, otherwise
     221             : change the existing association.  Value is the resulting alist."
     222             :   (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
     223           0 :   (setf (alist-get key alist) value)
     224           0 :   alist)
     225             : 
     226             : (declare-function x-show-tip "xfns.c"
     227             :                   (string &optional frame parms timeout dx dy))
     228             : 
     229             : (defun tooltip-show (text &optional use-echo-area)
     230             :   "Show a tooltip window displaying TEXT.
     231             : 
     232             : Text larger than `x-max-tooltip-size' is clipped.
     233             : 
     234             : If the alist in `tooltip-frame-parameters' includes `left' and `top'
     235             : parameters, they determine the x and y position where the tooltip
     236             : is displayed.  Otherwise, the tooltip pops at offsets specified by
     237             : `tooltip-x-offset' and `tooltip-y-offset' from the current mouse
     238             : position.
     239             : 
     240             : Optional second arg USE-ECHO-AREA non-nil means to show tooltip
     241             : in echo area."
     242           0 :   (if use-echo-area
     243           0 :       (tooltip-show-help-non-mode text)
     244           0 :     (condition-case error
     245           0 :         (let ((params (copy-sequence tooltip-frame-parameters))
     246           0 :               (fg (face-attribute 'tooltip :foreground))
     247           0 :               (bg (face-attribute 'tooltip :background)))
     248           0 :           (when (stringp fg)
     249           0 :             (setf (alist-get 'foreground-color params) fg)
     250           0 :             (setf (alist-get 'border-color params) fg))
     251           0 :           (when (stringp bg)
     252           0 :             (setf (alist-get 'background-color params) bg))
     253           0 :           (x-show-tip (propertize text 'face 'tooltip)
     254           0 :                       (selected-frame)
     255           0 :                       params
     256           0 :                       tooltip-hide-delay
     257           0 :                       tooltip-x-offset
     258           0 :                       tooltip-y-offset))
     259             :       (error
     260           0 :        (message "Error while displaying tooltip: %s" error)
     261           0 :        (sit-for 1)
     262           0 :        (message "%s" text)))))
     263             : 
     264             : (declare-function x-hide-tip "xfns.c" ())
     265             : 
     266             : (defun tooltip-hide (&optional _ignored-arg)
     267             :   "Hide a tooltip, if one is displayed.
     268             : Value is non-nil if tooltip was open."
     269           0 :   (tooltip-cancel-delayed-tip)
     270           0 :   (when (x-hide-tip)
     271           0 :     (setq tooltip-hide-time (float-time))))
     272             : 
     273             : 
     274             : ;;; Debugger-related functions
     275             : 
     276             : (defun tooltip-identifier-from-point (point)
     277             :   "Extract the identifier at POINT, if any.
     278             : Value is nil if no identifier exists at point.  Identifier extraction
     279             : is based on the current syntax table."
     280           0 :   (save-excursion
     281           0 :     (goto-char point)
     282           0 :     (let* ((start (progn (skip-syntax-backward "w_") (point)))
     283           0 :            (pstate (syntax-ppss)))
     284           0 :       (unless (or (looking-at "[0-9]")
     285           0 :                   (nth 3 pstate)
     286           0 :                   (nth 4 pstate))
     287           0 :         (skip-syntax-forward "w_")
     288           0 :         (when (> (point) start)
     289           0 :           (buffer-substring start (point)))))))
     290             : 
     291             : (defun tooltip-expr-to-print (event)
     292             :   "Return an expression that should be printed for EVENT.
     293             : If a region is active and the mouse is inside the region, print
     294             : the region.  Otherwise, figure out the identifier around the point
     295             : where the mouse is."
     296           0 :   (with-current-buffer (tooltip-event-buffer event)
     297           0 :     (let ((point (posn-point (event-end event))))
     298           0 :       (if (use-region-p)
     299           0 :           (when (and (<= (region-beginning) point) (<= point (region-end)))
     300           0 :             (buffer-substring (region-beginning) (region-end)))
     301           0 :         (tooltip-identifier-from-point point)))))
     302             : 
     303             : (defun tooltip-process-prompt-regexp (process)
     304             :   "Return regexp matching the prompt of PROCESS at the end of a string.
     305             : The prompt is taken from the value of `comint-prompt-regexp' in
     306             : the buffer of PROCESS."
     307           0 :   (let ((prompt-regexp (with-current-buffer (process-buffer process)
     308           0 :                          comint-prompt-regexp)))
     309           0 :     (concat "\n*"
     310             :             ;; Most start with `^' but the one for `sdb' cannot be easily
     311             :             ;; stripped.  Code the prompt for `sdb' fixed here.
     312           0 :             (if (= (aref prompt-regexp 0) ?^)
     313           0 :                 (substring prompt-regexp 1)
     314           0 :               "\\*")
     315           0 :             "$")))
     316             : 
     317             : (defun tooltip-strip-prompt (process output)
     318             :   "Return OUTPUT with any prompt of PROCESS stripped from its end."
     319           0 :   (save-match-data
     320           0 :     (if (string-match (tooltip-process-prompt-regexp process) output)
     321           0 :         (substring output 0 (match-beginning 0))
     322           0 :       output)))
     323             : 
     324             : 
     325             : ;;; Tooltip help.
     326             : 
     327             : (defvar tooltip-help-message nil
     328             :   "The last help message received via `show-help-function'.
     329             : This is used by `tooltip-show-help' and
     330             : `tooltip-show-help-non-mode'.")
     331             : 
     332             : (defvar tooltip-previous-message nil
     333             :   "The previous content of the echo area.")
     334             : 
     335             : (defun tooltip-show-help-non-mode (help)
     336             :   "Function installed as `show-help-function' when Tooltip mode is off.
     337             : It is also called if Tooltip mode is on, for text-only displays."
     338           0 :   (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents.
     339           0 :              (not cursor-in-echo-area))  ;Don't overwrite a prompt.
     340           0 :     (cond
     341           0 :      ((stringp help)
     342           0 :       (setq help (replace-regexp-in-string "\n" ", " help))
     343           0 :       (unless (or tooltip-previous-message
     344           0 :                   (equal-including-properties help (current-message))
     345           0 :                   (and (stringp tooltip-help-message)
     346           0 :                        (equal-including-properties tooltip-help-message
     347           0 :                                                    (current-message))))
     348           0 :         (setq tooltip-previous-message (current-message)))
     349           0 :       (setq tooltip-help-message help)
     350           0 :       (let ((message-truncate-lines t)
     351             :             (message-log-max nil))
     352           0 :         (message "%s" help)))
     353           0 :      ((stringp tooltip-previous-message)
     354           0 :       (let ((message-log-max nil))
     355           0 :         (message "%s" tooltip-previous-message)
     356           0 :         (setq tooltip-previous-message nil)))
     357             :      (t
     358           0 :       (message nil)))))
     359             : 
     360             : (defun tooltip-show-help (msg)
     361             :   "Function installed as `show-help-function'.
     362             : MSG is either a help string to display, or nil to cancel the display."
     363           0 :   (if (display-graphic-p)
     364           0 :       (let ((previous-help tooltip-help-message))
     365           0 :         (setq tooltip-help-message msg)
     366           0 :         (cond ((null msg)
     367             :                ;; Cancel display.  This also cancels a delayed tip, if
     368             :                ;; there is one.
     369           0 :                (tooltip-hide))
     370           0 :               ((equal-including-properties previous-help msg)
     371             :                ;; Same help as before (but possibly the mouse has moved).
     372             :                ;; Keep what we have.
     373             :                )
     374             :               (t
     375             :                ;; A different help.  Remove a previous tooltip, and
     376             :                ;; display a new one, with some delay.
     377           0 :                (tooltip-hide)
     378           0 :                (tooltip-start-delayed-tip))))
     379             :     ;; On text-only displays, try `tooltip-show-help-non-mode'.
     380           0 :     (tooltip-show-help-non-mode msg)))
     381             : 
     382             : (defun tooltip-help-tips (_event)
     383             :   "Hook function to display a help tooltip.
     384             : This is installed on the hook `tooltip-functions', which
     385             : is run when the timer with id `tooltip-timeout-id' fires.
     386             : Value is non-nil if this function handled the tip."
     387           0 :   (when (stringp tooltip-help-message)
     388           0 :     (tooltip-show tooltip-help-message tooltip-use-echo-area)
     389           0 :     t))
     390             : 
     391             : (provide 'tooltip)
     392             : 
     393             : ;;; tooltip.el ends here

Generated by: LCOV version 1.12