master 3129fed4bec: Fix 'dictionary-tooltip-mode'

[Eli Zaretskii]

branch: master
commit 3129fed4bec1137b7bb377594766b61ee76cd268
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    Fix 'dictionary-tooltip-mode'
    
    * lisp/tooltip.el (tooltip-event-buffer): Make sure 'posn-window'
    returns a window before calling 'window-buffer'.
    
    * lisp/net/dictionary.el (dictionary-default-dictionary)
    (dictionary-tooltip-dictionary): Doc fixes.
    (dictionary-tooltip-dictionary): Change default value to t, which
    means the same dictionary as 'dictionary-default-dictionary'.
    (dictionary-do-search): If NOMATCHING is non-nil, do not insert
    anything into the current buffer, as that is unexpected when
    showing definitions in tooltips.
    (dictionary-word-at-mouse-event): Be defensive about the values
    returned by 'tooltip-event-buffer' and 'posn-point': they can be
    unexpected when the mouse pointer is on the tool bar or mode line
    etc.
    (dictionary-display-tooltip): Ignore errors in this function.
    (dictionary-tooltip-mode): Ignore mouse-movement events on tool
    bar and tab-bar.
    (dictionary-dictionaries): Decode the server response to present
    dictionaries in human-readable form.  Document in the doc string
    the format of the return value.
---
 lisp/net/dictionary.el | 95 ++++++++++++++++++++++++++++++++++++--------------
 lisp/tooltip.el        |  2 +-
 2 files changed, 69 insertions(+), 28 deletions(-)

diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index d4dfa33716c..313e825b4d8 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -105,7 +105,10 @@ This port is probably always 2628 so there should be no 
need to modify it."
   "*"
   "The dictionary which is used for searching definitions and matching.
 * and ! have a special meaning, * search all dictionaries, ! search until
-one dictionary yields matches."
+one dictionary yields matches.
+Otherwise, the value should be a string, the name of the dictionary to use.
+Dictionary names are generally specific to the servers, and are obtained
+via `dictionary-dictionaries'."
   :group 'dictionary
   :type 'string
   :version "28.1")
@@ -784,10 +787,10 @@ FUNCTION is the callback which is called for each search 
result."
 
 (defun dictionary-do-search (word dictionary function &optional nomatching)
   "Search for WORD in DICTIONARY and call FUNCTION for each result.
-Optional argument NOMATCHING controls whether to suppress the display
-of matching words."
-
-  (insert (format-message "Searching for `%s' in `%s'\n" word dictionary))
+Optional argument NOMATCHING, if non-nil, means suppress the display
+of the \"Searching\" report and of the matching words."
+  (unless nomatching
+    (insert (format-message "Searching for `%s' in `%s'\n" word dictionary)))
   (dictionary-send-command (concat "define "
                                   (dictionary-encode-charset dictionary "")
                                   " \""
@@ -1356,11 +1359,22 @@ prompt for DICTIONARY."
 (nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
 
 (defcustom dictionary-tooltip-dictionary
-  nil
-  "This dictionary to lookup words for tooltips."
+  t
+  "The dictionary to lookup words for `dictionary-tooltip-mode'.
+If this is nil, `dictionary-tooltip-mode' is effectively disabled: no tooltips
+will be shown.
+If the value is t, `dictionary-tooltip-mode' will use the same dictionary as
+specified by `dictionary-default-dictionary'.
+Otherwise, the value should be a string, the name of a dictionary to use, and
+can use the same special values * and ! as for `dictionary-default-dictionary',
+with the same meanings.
+Dictionary names are generally specific to the servers, and are obtained
+via `dictionary-dictionaries'."
   :group 'dictionary
-  :type '(choice (const :tag "None" nil) string)
-  :version "28.1")
+  :type '(choice (const :tag "None (disables Dictionary tooltips)" nil)
+                 (const :tag "Same as `dictionary-default-dictionary'" t)
+                 string)
+  :version "30.1")
 
 (defun dictionary-definition (word &optional dictionary)
   (unwind-protect
@@ -1377,14 +1391,20 @@ prompt for DICTIONARY."
   nil)
 
 (defun dictionary-word-at-mouse-event (event)
-  (with-current-buffer (tooltip-event-buffer event)
-    (let ((point (posn-point (event-end event))))
-      (if (use-region-p)
-         (when (and (<= (region-beginning) point) (<= point (region-end)))
-           (buffer-substring (region-beginning) (region-end)))
-        (save-excursion
-          (goto-char point)
-        (current-word))))))
+  (let ((buf (tooltip-event-buffer event)))
+    (when (bufferp buf)
+      (with-current-buffer buf
+        (let ((point (posn-point (event-end event))))
+          ;; posn-point can return something other than buffer position when
+          ;; the mouse pointer is over the menu bar or tool bar or tab-bar.
+          (when (number-or-marker-p point)
+            (if (use-region-p)
+               (when (and (<= (region-beginning) point)
+                           (<= point (region-end)))
+                 (buffer-substring (region-beginning) (region-end)))
+              (save-excursion
+                (goto-char point)
+                (current-word)))))))))
 
 (defvar dictionary-tooltip-mouse-event nil
   "Event that triggered the tooltip mode.")
@@ -1393,15 +1413,24 @@ prompt for DICTIONARY."
   "Search the current word in the `dictionary-tooltip-dictionary'."
   (interactive "e")
   (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary)
-      (let ((word (dictionary-word-at-mouse-event 
dictionary-tooltip-mouse-event)))
-        (if word
-            (let ((definition
-                    (dictionary-definition word 
dictionary-tooltip-dictionary)))
-              (if definition
-                  (tooltip-show (dictionary-decode-charset definition
-                                                           
dictionary-tooltip-dictionary)))))
-        t)
-    nil))
+      ;; This function runs from the tooltip timer.  We don't want to
+      ;; signal errors from the timer due to "Unknown server answers",
+      ;; we prefer not to show anything in that case.  FIXME: Perhaps
+      ;; use with-demoted-errors, to show the unknonw answers in the
+      ;; echo-area?
+      (ignore-errors
+        (let* ((word (dictionary-word-at-mouse-event
+                      dictionary-tooltip-mouse-event))
+               (dict (if (eq dictionary-tooltip-dictionary t)
+                         dictionary-default-dictionary
+                       dictionary-tooltip-dictionary)))
+          (if word
+              (let ((definition (dictionary-definition word dict)))
+                (if definition
+                    (tooltip-show (dictionary-decode-charset
+                                   definition dict)))))
+          t)
+        nil)))
 
 (defun dictionary-tooltip-track-mouse (event)
   "Called whenever a dictionary tooltip display is about to be triggered."
@@ -1443,6 +1472,11 @@ active it will overwrite that mode for the current 
buffer."
     (if on
         (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
       (local-set-key [mouse-movement] 'ignore))
+    ;; Unconditionally ignore mouse-movement events on the tool bar and
+    ;; tab-bar, since these are unrelated to the current buffer.
+    ;; FIXME: This disables help-echo for tab-bar and tool-bar buttons.
+    (local-set-key [tool-bar mouse-movement] 'ignore)
+    (local-set-key [tab-bar mouse-movement] 'ignore)
     on))
 
 ;;;###autoload
@@ -1536,11 +1570,18 @@ Further arguments are currently ignored."
                      nil t nil 'dictionary-word-history default t)))
 
 (defun dictionary-dictionaries ()
-  "Return the list of dictionaries the server supports."
+  "Return the list of dictionaries the server supports.
+The elements of the list have the form (NAME . DESCRIPTION),
+where NAME is the string that identifies the dictionary for
+the server, and DESCRIPTION is its more detailed description,
+which usually includes the languages it supports."
   (dictionary-send-command "show db")
   (when (and (= (read (dictionary-read-reply)) 110))
     (with-temp-buffer
       (insert (dictionary-read-answer))
+      ;; We query the server using 'raw-text', so decode now to present
+      ;; human-readable names to the user.
+      (decode-coding-region (point-min) (point-max) 'utf-8)
       (goto-char (point-min))
       (let ((result '(("!" . "First matching dictionary")
                       ("*" . "All dictionaries"))))
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 4537fdf8087..6c2fe36ed9d 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -178,7 +178,7 @@ rest are not called.")
   "Return the buffer over which event EVENT occurred.
 This might return nil if the event did not occur over a buffer."
   (let ((window (posn-window (event-end event))))
-    (and window (window-buffer window))))
+    (and (windowp window) (window-buffer window))))
 
 
 ;;; Timeout for tooltip display