(widget-specify-field, widget-specify-button): If

:help-echo is a function, set help-echo of overlay to
widget-mouse-help.
(widget-mouse-help): New function.
(widget-echo-help): Rewritten for :help-echo functions only taking
a widget arg.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 30e1f118cff2c53f510718c0be2457315ce87b32..0e27169961ec00cda3f77dc3f1073793b73d4baf 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2000-11-15  Dave Love  <fx@gnu.org>
 
+       * wid-edit.el (widget-specify-field, widget-specify-button): If
+       :help-echo is a function, set help-echo of overlay to
+       widget-mouse-help.
+       (widget-mouse-help): New function.
+       (widget-echo-help): Rewritten for :help-echo functions only taking
+       a widget arg.
+
        * net/eudc-bob.el (eudc-bob-can-display-inline-images): Use
        display-graphic-p.
        (eudc-bob-display-jpeg) <!eudc-xemacs-p>: Test create-image bound

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 355d3da64199eaa3ffdf68e0c4adcbd40fcc5596..dc43f76700cca11dc1446698592e4b868378973f 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -323,6 +323,8 @@ new value.")
        (help-echo (widget-get widget :help-echo))
        (rear-sticky
         (or (not widget-field-add-space) (widget-get widget :size))))
+    (if (functionp help-echo)
+      (setq help-echo 'widget-mouse-help))    
     (when (= (char-before to) ?\n)
       ;; When the last character in the field is a newline, we want to
       ;; give it a `field' char-property of `boundary', which helps the
@@ -367,15 +369,27 @@ new value.")
 
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."
-  (let ((overlay (make-overlay from to nil t nil)))
+  (let ((overlay (make-overlay from to nil t nil))
+       (help-echo (widget-get widget :help-echo)))
     (widget-put widget :button-overlay overlay)
+    (if (functionp help-echo)
+      (setq help-echo 'widget-mouse-help))
     (overlay-put overlay 'button widget)
     (overlay-put overlay 'keymap (widget-get widget :keymap))
     ;; We want to avoid the face with image buttons.
     (unless (widget-get widget :suppress-face)
       (overlay-put overlay 'face (widget-apply widget :button-face-get))
       (overlay-put overlay 'mouse-face widget-mouse-face))
-    (overlay-put overlay 'help-echo (widget-get widget :help-echo))))
+    (overlay-put overlay 'help-echo help-echo)))
+
+(defun widget-mouse-help (window overlay point)
+  "Help-echo callback for widgets whose :help-echo is a function."
+  (with-current-buffer (overlay-buffer overlay)
+    (let* ((widget (widget-at (overlay-start overlay)))
+          (help-echo (if widget (widget-get widget :help-echo))))
+      (if (functionp help-echo)
+         (funcall help-echo widget)
+       help-echo))))
 
 (defun widget-specify-sample (widget from to)
   "Specify sample for WIDGET between FROM and TO."
@@ -3389,26 +3403,12 @@ To use this type, you must define :match or :match-alternatives."
 ;;; The Help Echo
 
 (defun widget-echo-help (pos)
-  "Display the help echo for widget at POS."
+  "Display help-echo text for widget at POS."
   (let* ((widget (widget-at pos))
         (help-echo (and widget (widget-get widget :help-echo))))
-    (if (or (stringp help-echo)
-           (and (functionp help-echo)
-                ;; Kluge: help-echo originally could be a function of
-                ;; one arg -- the widget.  It is more useful in Emacs
-                ;; 21 to have it as a function usable also as a
-                ;; help-echo property, when it can sort out its own
-                ;; widget if necessary.  Try both calling sequences
-                ;; (rather than messing around to get the function's
-                ;; arity).
-                (stringp
-                 (setq help-echo
-                       (condition-case nil
-                           (funcall help-echo
-                                    (selected-window) (current-buffer)
-                                    (point))
-                         (error (funcall help-echo widget))))))
-           (stringp (eval help-echo)))
+    (if (functionp help-echo)
+       (setq help-echo (funcall help-echo widget)))
+    (if (stringp help-echo)
        (message "%s" help-echo))))
 
 ;;; The End: