XEmacs 21.4.9 "Informed Management".

[chise/xemacs-chise.git.1] / lisp / wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 4507542..aaa80ca 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -480,14 +480,22 @@ Suitable for use with `map-extents'."
       (let* ((glyph-widget (extent-property extent 'glyph-widget))
             (up-glyph (widget-get glyph-widget :glyph-up))
             (inactive-glyph (widget-get glyph-widget :glyph-inactive))
+            (instantiator (widget-get glyph-widget :glyph-instantiator))
             (new-glyph (if activate-p up-glyph inactive-glyph)))
+       (cond
+        ;; Assume that an instantiator means a native widget.
+        (instantiator
+         (setq instantiator
+               (set-instantiator-property instantiator :active activate-p))
+         (widget-put glyph-widget :glyph-instantiator instantiator)
+         (set-glyph-image up-glyph instantiator))
         ;; Check that the new glyph exists, and differs from the
         ;; default one.
-       (and up-glyph inactive-glyph (not (eq up-glyph inactive-glyph))
-            ;; Check if the glyph is already installed.
-            (not (eq (extent-end-glyph extent) new-glyph))
-            ;; Change it.
-            (set-extent-end-glyph extent new-glyph)))))
+        ((and up-glyph inactive-glyph (not (eq up-glyph inactive-glyph))
+              ;; Check if the glyph is already installed.
+              (not (eq (extent-end-glyph extent) new-glyph)))
+         ;; Change it.
+         (set-extent-end-glyph extent new-glyph))))))
   nil)
 
 (defun widget-specify-inactive (widget from to)
@@ -512,14 +520,16 @@ Suitable for use with `map-extents'."
 
 (defun widget-specify-active (widget)
   "Make WIDGET active for user modifications."
-  (let ((inactive (widget-get widget :inactive)))
+  (let ((inactive (widget-get widget :inactive))
+        (from (widget-get widget :from))
+        (to (widget-get widget :to)))
     (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)
+                   nil from to :activate nil 'button-or-field)
       ;; Reactivate the glyphs.
       (map-extents 'widget-activation-glyph-mapper
-                  inactive nil nil :activate nil 'end-glyph)
+                   nil from to :activate nil 'end-glyph)
       (delete-extent inactive)
       (widget-put widget :inactive nil))))
 
@@ -566,7 +576,7 @@ Otherwise, just return the value."
       value)))
 
 (defun widget-member (widget property)
-  "Non-nil iff there is a definition in WIDGET for PROPERTY."
+  "Return t if there is a definition in WIDGET for PROPERTY."
   (cond ((widget-plist-member (cdr widget) property)
         t)
        ((car widget)
@@ -783,10 +793,12 @@ only because of compatibility."
       (insert tag))
     glyph))
 
-(defun widget-glyph-insert-glyph (widget glyph &optional down inactive)
+(defun widget-glyph-insert-glyph (widget glyph &optional down inactive
+                                        instantiator)
   "In WIDGET, insert GLYPH.
 If optional arguments DOWN and INACTIVE are given, they should be
-glyphs used when the widget is pushed and inactive, respectively."
+glyphs used when the widget is pushed and inactive, respectively.
+INSTANTIATOR is the vector used to create the glyph."
   (insert "*")
   (let ((extent (make-extent (point) (1- (point))))
        (help-echo (and widget (widget-get widget :help-echo)))
@@ -808,6 +820,7 @@ glyphs used when the widget is pushed and inactive, respectively."
   (when widget
     (widget-put widget :glyph-up glyph)
     (when down (widget-put widget :glyph-down down))
+    (when instantiator (widget-put widget :glyph-instantiator instantiator))
     (when inactive (widget-put widget :glyph-inactive inactive))))
 
 \f
@@ -1041,7 +1054,7 @@ Recommended as a parent keymap for modes using widgets.")
 
 
 (defun widget-field-activate (pos &optional event)
-  "Invoke the ediable field at point."
+  "Invoke the editable field at point."
   (interactive "@d")
   (let ((field (widget-field-find pos)))
     (if field
@@ -1348,7 +1361,7 @@ With optional ARG, move across that many fields."
          (t
           (when (and (null arg)
                      (= last-non-space (point)))
-            (forward-char -1))
+            (backward-char 1))
           (transpose-chars arg)))))
 
 (defcustom widget-complete-field (lookup-key global-map "\M-\t")
@@ -1922,7 +1935,7 @@ If END is omitted, it defaults to the length of LIST."
         (tag-glyph (widget-get widget :tag-glyph))
         (text (concat widget-push-button-prefix
                       tag widget-push-button-suffix))
-        gui)
+        gui inst)
     (cond (tag-glyph
           (widget-glyph-insert widget text tag-glyph))
          ;; We must check for console-on-window-system-p here,
@@ -1931,9 +1944,9 @@ If END is omitted, it defaults to the length of LIST."
          ((and widget-push-button-gui
                (console-on-window-system-p))
           (let* ((gui-button-shadow-thickness 1))
-            (setq gui (make-glyph 
-                       (make-gui-button tag 'widget-gui-action widget))))
-          (widget-glyph-insert-glyph widget gui))
+            (setq inst (make-gui-button tag 'widget-gui-action widget))
+            (setq gui (make-glyph inst)))
+          (widget-glyph-insert-glyph widget gui nil nil inst))
          (t
           (insert text)))))
 
@@ -1986,8 +1999,8 @@ If END is omitted, it defaults to the length of LIST."
 
 (defun widget-url-link-action (widget &optional event)
   "Open the url specified by WIDGET."
-  (if (boundp 'browse-url-browser-function)
-      (funcall browse-url-browser-function (widget-value widget))
+  (if (fboundp 'browse-url)
+      (browse-url (widget-value widget))
     (error "Cannot follow URLs in this XEmacs")))
 
 ;;; The `function-link' Widget.