(U+95D8): Separated from M-45649'; moved from Ideograph-R191-Fight.el.

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

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index a21f19c..dfcdbe4 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,9 +1,9 @@
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;

-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.

 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>

-;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>

 ;; Keywords: extensions
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 ;; Keywords: extensions
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

@@ -512,14 +512,16 @@ Suitable for use with `map-extents'."
 
 (defun widget-specify-active (widget)
   "Make WIDGET active for user modifications."
 
 (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
     (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
       ;; 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))))
 
       (delete-extent inactive)
       (widget-put widget :inactive nil))))
 

@@ -566,7 +568,7 @@ Otherwise, just return the value."
       value)))
 
 (defun widget-member (widget property)
       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)
   (cond ((widget-plist-member (cdr widget) property)
         t)
        ((car widget)

@@ -601,7 +603,7 @@ ARGS are passed as extra arguments to the function."
   ;; In WIDGET, match the start of VALS.
   (cond ((widget-get widget :inline)
         (widget-apply widget :match-inline vals))
   ;; In WIDGET, match the start of VALS.
   (cond ((widget-get widget :inline)
         (widget-apply widget :match-inline vals))

-       ((and vals
+       ((and (listp vals)

              (widget-apply widget :match (car vals)))
         (cons (list (car vals)) (cdr vals)))
        (t nil)))
              (widget-apply widget :match (car vals)))
         (cons (list (car vals)) (cdr vals)))
        (t nil)))

@@ -1348,7 +1350,7 @@ With optional ARG, move across that many fields."
          (t
           (when (and (null arg)
                      (= last-non-space (point)))
          (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")
           (transpose-chars arg)))))
 
 (defcustom widget-complete-field (lookup-key global-map "\M-\t")

@@ -1898,9 +1900,6 @@ If END is omitted, it defaults to the length of LIST."
   :group 'widgets
   :type 'boolean)
 
   :group 'widgets
   :type 'boolean)
 

-;; Cache already created GUI objects.
-(defvar widget-push-button-cache nil)
-

 (defcustom widget-push-button-prefix "["
   "String used as prefix for buttons."
   :type 'string
 (defcustom widget-push-button-prefix "["
   "String used as prefix for buttons."
   :type 'string

@@ -1925,7 +1924,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))
         (tag-glyph (widget-get widget :tag-glyph))
         (text (concat widget-push-button-prefix
                       tag widget-push-button-suffix))

-        (gui-glyphs (lax-plist-get widget-push-button-cache tag)))
+        gui)

     (cond (tag-glyph
           (widget-glyph-insert widget text tag-glyph))
          ;; We must check for console-on-window-system-p here,
     (cond (tag-glyph
           (widget-glyph-insert widget text tag-glyph))
          ;; We must check for console-on-window-system-p here,

@@ -1933,18 +1932,10 @@ If END is omitted, it defaults to the length of LIST."
          ;; components for colors, and they are not known on TTYs).
          ((and widget-push-button-gui
                (console-on-window-system-p))
          ;; components for colors, and they are not known on TTYs).
          ((and widget-push-button-gui
                (console-on-window-system-p))

-          (unless gui-glyphs
-            (let* ((gui-button-shadow-thickness 1)
-                   (gui (make-gui-button tag 'widget-gui-action widget)))
-              (setq
-               gui-glyphs
-               (list
-                (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text]))
-                (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text]))
-                (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text]))))
-              (laxputf widget-push-button-cache tag gui-glyphs)))
-          (widget-glyph-insert-glyph
-           widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs)))
+          (let* ((gui-button-shadow-thickness 1))
+            (setq gui (make-glyph 
+                       (make-gui-button tag 'widget-gui-action widget))))
+          (widget-glyph-insert-glyph widget gui))

          (t
           (insert text)))))
 
          (t
           (insert text)))))
 

@@ -1997,8 +1988,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."
 
 (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.
     (error "Cannot follow URLs in this XEmacs")))
 
 ;;; The `function-link' Widget.

@@ -2532,7 +2523,7 @@ when he invoked the menu."
     found))
 
 (defun widget-checklist-match-up (args vals)
     found))
 
 (defun widget-checklist-match-up (args vals)

-  ;; Rerturn the first type from ARGS that matches VALS.
+  ;; Return the first type from ARGS that matches VALS.

   (let (current found)
     (while (and args (null found))
       (setq current (car args)
   (let (current found)
     (while (and args (null found))
       (setq current (car args)

@@ -2554,7 +2545,7 @@ when he invoked the menu."
     result))
 
 (defun widget-checklist-validate (widget)
     result))
 
 (defun widget-checklist-validate (widget)

-  ;; Ticked chilren must be valid.
+  ;; Ticked children must be valid.

   (let ((children (widget-get widget :children))
        child button found)
     (while (and children (not found))
   (let ((children (widget-get widget :children))
        child button found)
     (while (and children (not found))