diff lisp/wid-edit.el @ 276:6330739388db r21-0b36

Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents 966663fcf606
children 90d73dddcdc4
line wrap: on
line diff
--- a/lisp/wid-edit.el	Mon Aug 13 10:29:43 2007 +0200
+++ b/lisp/wid-edit.el	Mon Aug 13 10:30:37 2007 +0200
@@ -294,6 +294,23 @@
   :type 'boolean
   :group 'widgets)
 
+(defun widget-echo-this-extent (extent)
+  (let* ((widget (or (extent-property extent 'button)
+		     (extent-property extent 'field)
+		     (extent-property extent 'glyph-widget)))
+	 (help-echo (and widget (widget-get widget :help-echo))))
+    (and (functionp help-echo)
+	 (setq help-echo (funcall help-echo widget)))
+    (when (stringp help-echo)
+      (display-message 'help-echo help-echo))))
+
+(defsubst widget-handle-help-echo (extent help-echo)
+  (set-extent-property extent 'balloon-help help-echo)
+  (set-extent-property extent 'help-echo help-echo)
+  (when (functionp help-echo)
+    (set-extent-property extent 'balloon-help 'widget-echo-this-extent)
+    (set-extent-property extent 'help-echo 'widget-echo-this-extent)))
+
 (defun widget-specify-field (widget from to)
   "Specify editable button for WIDGET between FROM and TO."
   (save-excursion
@@ -321,8 +338,7 @@
     (set-extent-property extent 'button-or-field t)
     (set-extent-property extent 'keymap map)
     (set-extent-property extent 'face face)
-    (set-extent-property extent 'balloon-help help-echo)
-    (set-extent-property extent 'help-echo help-echo)))
+    (widget-handle-help-echo extent help-echo)))
 
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."
@@ -337,8 +353,7 @@
     (set-extent-property extent 'button widget)
     (set-extent-property extent 'button-or-field t)
     (set-extent-property extent 'mouse-face widget-mouse-face)
-    (set-extent-property extent 'balloon-help help-echo)
-    (set-extent-property extent 'help-echo help-echo)
+    (widget-handle-help-echo extent help-echo)
     (set-extent-property extent 'face face)
     (set-extent-property extent 'keymap map)))
 
@@ -412,6 +427,7 @@
 (defun widget-activation-widget-mapper (extent action)
   "Activate or deactivate EXTENT's widget (button or field).
 Suitable for use with `map-extents'."
+  (message "FUCK")
   (ecase action
     (:activate
      (decf (extent-property extent :inactive-count))
@@ -434,6 +450,7 @@
   nil)
 
 (defun widget-activation-glyph-mapper (extent action)
+  (message "FUCK")
   (let ((activate-p (if (eq action :activate) t nil)))
     (if activate-p
 	(decf (extent-property extent :inactive-count))
@@ -478,7 +495,7 @@
 (defun widget-specify-active (widget)
   "Make WIDGET active for user modifications."
   (let ((inactive (widget-get widget :inactive)))
-    (when inactive
+    (when (and inactive (not (extent-detached-p inactive)))
       ;; Reactivate the buttons and fields covered by the extent.
       (map-extents 'widget-activation-widget-mapper
 		   inactive nil nil :activate nil 'button-or-field)
@@ -764,8 +781,7 @@
     (unless (or (stringp help-echo) (null help-echo))
       (setq help-echo 'widget-mouse-help))
     (when help-echo
-      (set-extent-property extent 'balloon-help help-echo)
-      (set-extent-property extent 'help-echo help-echo)))
+      (widget-handle-help-echo extent help-echo)))
   (when widget
     (widget-put widget :glyph-up glyph)
     (when down (widget-put widget :glyph-down down))