Mercurial > hg > xemacs-beta
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))