Improve the custom type of some user options.

[gnu-emacs] / lisp / tooltip.el

diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 76ae62d88e2de4b23ce4d2c548b67f0a1d339061..60eabec8b43ff8795ff074c8383211d9366d1a86 100644 (file)
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -1,6 +1,6 @@
 ;;; tooltip.el --- show tooltip windows
 
 ;;; tooltip.el --- show tooltip windows
 

-;; Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2016 Free Software Foundation, Inc.

 
 ;; Author: Gerd Moellmann <gerd@acm.org>
 ;; Keywords: help c mouse tools
 
 ;; Author: Gerd Moellmann <gerd@acm.org>
 ;; Keywords: help c mouse tools


@@ -25,6 +25,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'syntax)
+

 (defvar comint-prompt-regexp)
 
 (defgroup tooltip nil
 (defvar comint-prompt-regexp)
 
 (defgroup tooltip nil


@@ -39,27 +41,24 @@
 ;;; Switching tooltips on/off
 
 (define-minor-mode tooltip-mode
 ;;; Switching tooltips on/off
 
 (define-minor-mode tooltip-mode

-  "Toggle use of graphical tooltips (Tooltip mode).
-With a prefix argument ARG, enable Tooltip mode if ARG is
-positive, and disable it otherwise.  If called from Lisp, enable
-it if ARG is omitted or nil.
-
-When Tooltip 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."
+  "Toggle Tooltip mode.
+With a prefix argument ARG, enable Tooltip mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+When this global minor mode is enabled, Emacs displays help
+text (e.g. for buttons and menu items that you put the mouse on)
+in a pop-up window.
+
+When Tooltip mode is disabled, Emacs displays help text in the
+echo area, instead of making a pop-up window."

   :global t
   ;; Even if we start on a text-only terminal, make this non-nil by
   ;; default because we can open a graphical frame later (multi-tty).
   :init-value t
   :initialize 'custom-initialize-delay
   :group 'tooltip
   :global t
   ;; Even if we start on a text-only terminal, make this non-nil by
   ;; default because we can open a graphical frame later (multi-tty).
   :init-value t
   :initialize 'custom-initialize-delay
   :group 'tooltip

-  (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
-    (error "Sorry, tooltips are not yet available on this system"))
-  (if tooltip-mode
+  (if (and tooltip-mode (fboundp 'x-show-tip))

       (progn
        (add-hook 'pre-command-hook 'tooltip-hide)
        (add-hook 'tooltip-functions 'tooltip-help-tips))
       (progn
        (add-hook 'pre-command-hook 'tooltip-hide)
        (add-hook 'tooltip-functions 'tooltip-help-tips))


@@ -128,7 +127,9 @@ position to pop up the tooltip.
 
 Note that font and color parameters are ignored, and the attributes
 of the `tooltip' face are used instead."
 
 Note that font and color parameters are ignored, and the attributes
 of the `tooltip' face are used instead."

-  :type 'sexp
+  :type '(repeat (cons :format "%v"
+                      (symbol :tag "Parameter")
+                      (sexp :tag "Value")))

   :group 'tooltip)
 
 (defface tooltip
   :group 'tooltip)
 
 (defface tooltip


@@ -144,14 +145,19 @@ of the `tooltip' face are used instead."
 
 (defcustom tooltip-use-echo-area nil
   "Use the echo area instead of tooltip frames for help and GUD tooltips.
 
 (defcustom tooltip-use-echo-area nil
   "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'."
+This variable is obsolete; instead of setting it to t, disable
+`tooltip-mode' (which has a similar effect)."

   :type 'boolean
   :group 'tooltip)
 
   :type 'boolean
   :group 'tooltip)
 

+(make-obsolete-variable 'tooltip-use-echo-area
+                       "disable Tooltip mode instead" "24.1" 'set)
+

 \f
 ;;; Variables that are not customizable.
 
 \f
 ;;; Variables that are not customizable.
 

+(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
+

 (defvar tooltip-functions nil
   "Functions to call to display tooltips.
 Each function is called with one argument EVENT which is a copy
 (defvar tooltip-functions nil
   "Functions to call to display tooltips.
 Each function is called with one argument EVENT which is a copy


@@ -159,8 +165,6 @@ of the last mouse movement event that occurred.  If one of these
 functions displays the tooltip, it should return non-nil and the
 rest are not called.")
 
 functions displays the tooltip, it should return non-nil and the
 rest are not called.")
 

-(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
-

 (defvar tooltip-timeout-id nil
   "The id of the timeout started when Emacs becomes idle.")
 
 (defvar tooltip-timeout-id nil
   "The id of the timeout started when Emacs becomes idle.")
 


@@ -213,11 +217,9 @@ This might return nil if the event did not occur over a buffer."
   "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."
   "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))
+  (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
+  (setf (alist-get key alist) value)
+  alist)

 
 (declare-function x-show-tip "xfns.c"
                  (string &optional frame parms timeout dx dy))
 
 (declare-function x-show-tip "xfns.c"
                  (string &optional frame parms timeout dx dy))


@@ -242,10 +244,10 @@ in echo area."
              (fg (face-attribute 'tooltip :foreground))
              (bg (face-attribute 'tooltip :background)))
          (when (stringp fg)
              (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)))
+           (setf (alist-get 'foreground-color params) fg)
+           (setf (alist-get 'border-color params) fg))

          (when (stringp bg)
          (when (stringp bg)

-           (setq params (tooltip-set-param params 'background-color bg)))
+           (setf (alist-get 'background-color params) bg))

          (x-show-tip (propertize text 'face 'tooltip)
                      (selected-frame)
                      params
          (x-show-tip (propertize text 'face 'tooltip)
                      (selected-frame)
                      params


@@ -275,16 +277,15 @@ Value is nil if no identifier exists at point.  Identifier extraction
 is based on the current syntax table."
   (save-excursion
     (goto-char point)
 is based on the current syntax table."
   (save-excursion
     (goto-char point)

-    (let ((start (progn (skip-syntax-backward "w_") (point))))
-      (unless (looking-at "[0-9]")
+    (let* ((start (progn (skip-syntax-backward "w_") (point)))
+          (pstate (syntax-ppss)))
+      (unless (or (looking-at "[0-9]")
+                 (nth 3 pstate)
+                 (nth 4 pstate))

        (skip-syntax-forward "w_")
        (when (> (point) start)
          (buffer-substring start (point)))))))
 
        (skip-syntax-forward "w_")
        (when (> (point) start)
          (buffer-substring start (point)))))))
 

-(defmacro tooltip-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
 (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


@@ -292,7 +293,7 @@ the region.  Otherwise, figure out the identifier around the point
 where the mouse is."
   (with-current-buffer (tooltip-event-buffer event)
     (let ((point (posn-point (event-end event))))
 where the mouse is."
   (with-current-buffer (tooltip-event-buffer event)
     (let ((point (posn-point (event-end event))))

-      (if (tooltip-region-active-p)
+      (if (use-region-p)

          (when (and (<= (region-beginning) point) (<= point (region-end)))
            (buffer-substring (region-beginning) (region-end)))
        (tooltip-identifier-from-point point)))))
          (when (and (<= (region-beginning) point) (<= point (region-end)))
            (buffer-substring (region-beginning) (region-end)))
        (tooltip-identifier-from-point point)))))


@@ -338,10 +339,10 @@ It is also called if Tooltip mode is on, for text-only displays."
      ((stringp help)
       (setq help (replace-regexp-in-string "\n" ", " help))
       (unless (or tooltip-previous-message
      ((stringp help)
       (setq help (replace-regexp-in-string "\n" ", " help))
       (unless (or tooltip-previous-message

-                 (string-equal help (current-message))
+                 (equal-including-properties help (current-message))

                  (and (stringp tooltip-help-message)
                  (and (stringp tooltip-help-message)

-                      (string-equal tooltip-help-message
-                                    (current-message))))
+                      (equal-including-properties tooltip-help-message
+                                                  (current-message))))

         (setq tooltip-previous-message (current-message)))
       (setq tooltip-help-message help)
       (let ((message-truncate-lines t)
         (setq tooltip-previous-message (current-message)))
       (setq tooltip-help-message help)
       (let ((message-truncate-lines t)


@@ -364,7 +365,7 @@ MSG is either a help string to display, or nil to cancel the display."
               ;; Cancel display.  This also cancels a delayed tip, if
               ;; there is one.
               (tooltip-hide))
               ;; Cancel display.  This also cancels a delayed tip, if
               ;; there is one.
               (tooltip-hide))

-             ((equal previous-help msg)
+             ((equal-including-properties previous-help msg)

               ;; Same help as before (but possibly the mouse has moved).
               ;; Keep what we have.
               )
               ;; Same help as before (but possibly the mouse has moved).
               ;; Keep what we have.
               )