Synched with version 1.97.

1 files changed, 98 insertions, 79 deletions

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 023592a88a9..da0f6166b91 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.90
+;; Version: 1.97
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -41,12 +41,6 @@
     (require 'cus-load)
   (error nil))
 
-(defun custom-face-display-set (face spec &optional frame)
-  (face-spec-set face spec frame))
-
-(defun custom-display-match-frame (display frame)
-  (face-spec-set-match-display display frame))
-
 (define-widget-keywords :custom-prefixes :custom-menu :custom-show
   :custom-magic :custom-state :custom-level :custom-form
   :custom-set :custom-save :custom-reset-current :custom-reset-saved 
@@ -198,6 +192,10 @@
   :group 'environment
   :group 'editing)
 
+(defgroup x nil
+  "The X Window system."
+  :group 'environment)
+
 (defgroup frames nil
   "Support for Emacs frames and window systems."
   :group 'environment)
@@ -318,7 +316,7 @@
 
 (defgroup windows nil
   "Windows within a frame."
-  :group 'processes)
+  :group 'environment)
 
 ;;; Utilities.
 
@@ -360,7 +358,7 @@ Return a list suitable for use in `interactive'."
          val)
      (setq val (completing-read 
                 (if v
-                    (format "Customize variable (default %s): " v)
+                    (format "Customize variable: (default %s) " v)
                   "Customize variable: ")
                 obarray (lambda (symbol)
                           (and (boundp symbol)
@@ -669,7 +667,9 @@ are shown; the contents of those subgroups are initially hidden."
     (if (string-equal "" group)
         (setq group 'emacs)
       (setq group (intern group))))
-  (custom-buffer-create (list (list group 'custom-group))))
+  (custom-buffer-create (list (list group 'custom-group))
+                        (format "*Customize Group: %s*"
+                                (custom-unlispify-tag-name group))))
 
 ;;;###autoload
 (defun customize-other-window (symbol)
@@ -684,20 +684,26 @@ are shown; the contents of those subgroups are initially hidden."
     (if (string-equal "" symbol)
         (setq symbol 'emacs)
       (setq symbol (intern symbol))))
-  (custom-buffer-create-other-window (list (list symbol 'custom-group))))
+  (custom-buffer-create-other-window
+   (list (list symbol 'custom-group))
+   (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
 
 ;;;###autoload
 (defun customize-variable (symbol)
   "Customize SYMBOL, which must be a variable."
   (interactive (custom-variable-prompt))
-  (custom-buffer-create (list (list symbol 'custom-variable))))
+  (custom-buffer-create (list (list symbol 'custom-variable))
+                        (format "*Customize Variable: %s*"
+                                (custom-unlispify-tag-name symbol))))
 
 ;;;###autoload
 (defun customize-variable-other-window (symbol)
   "Customize SYMBOL, which must be a variable.
 Show the buffer in another window, but don't select it."
   (interactive (custom-variable-prompt))
-  (custom-buffer-create-other-window (list (list symbol 'custom-variable))))
+  (custom-buffer-create-other-window
+   (list (list symbol 'custom-variable))
+   (format "*Customize Variable: %s*" (custom-unlispify-tag-name symbol))))
 
 ;;;###autoload
 (defun customize-face (&optional symbol)
@@ -714,12 +720,14 @@ If SYMBOL is nil, customize all faces."
                                   (sort (mapcar 'symbol-name (face-list))
                                         'string<))))
                         
-        (custom-buffer-create found))
+        (custom-buffer-create found "*Customize Faces*"))
     (if (stringp symbol)
         (setq symbol (intern symbol)))
     (unless (symbolp symbol)
       (error "Should be a symbol %S" symbol))
-    (custom-buffer-create (list (list symbol 'custom-face)))))
+    (custom-buffer-create (list (list symbol 'custom-face))
+                          (format "*Customize Face: %s*"
+                                  (custom-unlispify-tag-name symbol)))))
 
 ;;;###autoload
 (defun customize-face-other-window (&optional symbol)
@@ -732,7 +740,9 @@ If SYMBOL is nil, customize all faces."
         (setq symbol (intern symbol)))
     (unless (symbolp symbol)
       (error "Should be a symbol %S" symbol))
-    (custom-buffer-create-other-window (list (list symbol 'custom-face)))))
+    (custom-buffer-create-other-window 
+     (list (list symbol 'custom-face))
+     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
 
 ;;;###autoload
 (defun customize-customized ()
@@ -748,7 +758,7 @@ If SYMBOL is nil, customize all faces."
                      (setq found
                            (cons (list symbol 'custom-variable) found)))))
     (if found 
-        (custom-buffer-create found)
+        (custom-buffer-create found "*Customize Customized*")
       (error "No customized user options"))))
 
 ;;;###autoload
@@ -765,7 +775,7 @@ If SYMBOL is nil, customize all faces."
                      (setq found
                            (cons (list symbol 'custom-variable) found)))))
     (if found 
-        (custom-buffer-create found)
+        (custom-buffer-create found "*Customize Saved*")
       (error "No saved user options"))))
 
 ;;;###autoload
@@ -790,30 +800,34 @@ user-settable."
                     (setq found
                           (cons (list symbol 'custom-variable) found))))))
     (if found 
-        (custom-buffer-create found)
+        (custom-buffer-create found "*Customize Apropos*")
       (error "No matches"))))
 
 ;;; Buffer.
 
 ;;;###autoload
-(defun custom-buffer-create (options)
+(defun custom-buffer-create (options &optional name)
   "Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
 SYMBOL is a customization option, and WIDGET is a widget for editing
 that option."
-  (kill-buffer (get-buffer-create "*Customization*"))
-  (switch-to-buffer (get-buffer-create "*Customization*"))
+  (unless name (setq name "*Customization*"))
+  (kill-buffer (get-buffer-create name))
+  (switch-to-buffer (get-buffer-create name))
   (custom-buffer-create-internal options))
 
 ;;;###autoload
-(defun custom-buffer-create-other-window (options)
+(defun custom-buffer-create-other-window (options &optional name)
   "Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
 SYMBOL is a customization option, and WIDGET is a widget for editing
 that option."
-  (kill-buffer (get-buffer-create "*Customization*"))
+  (unless name (setq name "*Customization*"))
+  (kill-buffer (get-buffer-create name))
   (let ((window (selected-window)))
-    (switch-to-buffer-other-window (get-buffer-create "*Customization*"))
+    (switch-to-buffer-other-window (get-buffer-create name))
     (custom-buffer-create-internal options)
     (select-window window)))
   
@@ -882,22 +896,19 @@ Make the modifications default for future sessions."
                  :tag "Done"
                  :help-echo "Bury the buffer."
                  :action (lambda (widget &optional event)
-                           (bury-buffer)
-                           ;; Steal button release event.
-                           (if (and (fboundp 'button-press-event-p)
-                                    (fboundp 'next-command-event))
-                               ;; XEmacs
-                               (and event
-                                    (button-press-event-p event)
-                                    (next-command-event))
-                             ;; Emacs
-                             (when (memq 'down (event-modifiers event))
-                               (read-event)))))
+                           (bury-buffer)))
   (widget-insert "\n")
   (message "Creating customization setup...")
   (widget-setup)
   (goto-char (point-min))
-  (forward-line 3)                      ;Kludge: bob is writable in XEmacs.
+  (when (fboundp 'map-extents)  
+    ;; This horrible kludge should make bob and eob read-only in XEmacs.
+    (map-extents (lambda (extent &rest junk)
+                   (set-extent-property extent 'start-closed t))
+                 nil (point-min) (1+ (point-min)))
+    (map-extents (lambda (extent &rest junk)
+                   (set-extent-property extent 'end-closed t))
+                 nil (1- (point-max)) (point-max)))
   (message "Creating customization buffer...done"))
 
 ;;; Modification of Basic Widgets.
@@ -1180,30 +1191,36 @@ The list should be sorted most significant first."
 (define-widget 'custom-magic 'default
   "Show and manipulate state for a customization option."
   :format "%v"
-  :action 'widget-choice-item-action
+  :action 'widget-parent-action
   :notify 'ignore
   :value-get 'ignore
   :value-create 'custom-magic-value-create
   :value-delete 'widget-children-value-delete)
 
+(defun widget-magic-mouse-down-action (widget &optional event)
+  ;; Non-nil unless hidden.
+  (not (eq (widget-get (widget-get (widget-get widget :parent) :parent) 
+                       :custom-state)
+           'hidden)))
+
 (defun custom-magic-value-create (widget)
   ;; Create compact status report for WIDGET.
   (let* ((parent (widget-get widget :parent))
          (state (widget-get parent :custom-state))
-         (entry (assq state (if (eq (car parent) 'custom-group)
-                                custom-group-magic-alist
-                              custom-magic-alist)))
+         (entry (assq state custom-magic-alist))
          (magic (nth 1 entry))
          (face (nth 2 entry))
          (text (nth 3 entry))
          (lisp (eq (widget-get parent :custom-form) 'lisp))
          children)
     (when custom-magic-show
-      (push (widget-create-child-and-convert widget 'choice-item 
-                                             :help-echo "\
+      (push (widget-create-child-and-convert 
+             widget 'choice-item 
+             :help-echo "\
 Change the state of this item."
-                                             :format "%[%t%]"
-                                             :tag "State")
+             :format "%[%t%]"
+             :mouse-down-action 'widget-magic-mouse-down-action
+             :tag "State")
             children)
       (insert ": ")
       (if (eq custom-magic-show 'long)
@@ -1217,13 +1234,15 @@ Change the state of this item."
         (let ((indent (widget-get parent :indent)))
           (when indent
             (insert-char ?  indent))))
-      (push (widget-create-child-and-convert widget 'choice-item 
-                                             :button-face face
-                                             :help-echo "Change the state."
-                                             :format "%[%t%]"
-                                             :tag (if lisp 
-                                                      (concat "(" magic ")")
-                                                    (concat "[" magic "]")))
+      (push (widget-create-child-and-convert 
+             widget 'choice-item 
+             :mouse-down-action 'widget-magic-mouse-down-action
+             :button-face face
+             :help-echo "Change the state."
+             :format "%[%t%]"
+             :tag (if lisp 
+                      (concat "(" magic ")")
+                    (concat "[" magic "]")))
             children)
       (insert " "))
     (widget-put widget :children children)))
@@ -1258,8 +1277,8 @@ Change the state of this item."
   :documentation-property 'widget-subclass-responsibility
   :value-create 'widget-subclass-responsibility
   :value-delete 'widget-children-value-delete
-  :value-get 'widget-item-value-get
-  :validate 'widget-editable-list-validate
+  :value-get 'widget-value-value-get
+  :validate 'widget-children-validate
   :match (lambda (widget value) (symbolp value)))
 
 (defun custom-convert-widget (widget)
@@ -1342,7 +1361,9 @@ Change the state of this item."
     (when (and (>= pos from) (<= pos to))
       (condition-case nil
           (progn 
-            (goto-line line)
+            (if (> column 0)
+                (goto-line line)
+              (goto-line (1+ line)))
             (move-to-column column))
         (error nil)))))
 
@@ -1458,7 +1479,6 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
          (type (custom-variable-type symbol))
          (conv (widget-convert type))
          (get (or (get symbol 'custom-get) 'default-value))
-         (set (or (get symbol 'custom-set) 'set-default))
          (value (if (default-boundp symbol)
                     (funcall get symbol)
                   (widget-get conv :value))))
@@ -1567,7 +1587,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
     ("Reset to Current" custom-redraw
      (lambda (widget)
        (and (default-boundp (widget-value widget))
-            (memq (widget-get widget :custom-state) '(modified)))))
+            (memq (widget-get widget :custom-state) '(modified changed)))))
     ("Reset to Saved" custom-variable-reset-saved
      (lambda (widget)
        (and (get (widget-value widget) 'saved-value)
@@ -1590,6 +1610,9 @@ widget. If FILTER is nil, ACTION is always valid.")
 Optional EVENT is the location for the menu."
   (if (eq (widget-get widget :custom-state) 'hidden)
       (custom-toggle-hide widget)
+    (unless (eq (widget-get widget :custom-state) 'modified)
+      (custom-variable-state-set widget))
+    (custom-redraw-magic widget)
     (let* ((completion-ignore-case t)
            (answer (widget-choose (custom-unlispify-tag-name
                                    (widget-get widget :value))
@@ -1834,7 +1857,7 @@ Match frames with dark backgrounds.")
 
 (defun custom-display-unselected-match (widget value)
   "Non-nil if VALUE is an unselected display specification."
-  (not (custom-display-match-frame value (selected-frame))))
+  (not (face-spec-set-match-display value (selected-frame))))
 
 (define-widget 'custom-face-selected 'group 
   "Edit the attributes of the selected display in a face specification."
@@ -1858,7 +1881,7 @@ Match frames with dark backgrounds.")
     (custom-load-widget widget)
     (let* ((symbol (widget-value widget))
            (spec (or (get symbol 'saved-face)
-                     (get symbol 'factory-face)
+                     (get symbol 'face-defface-spec)
                      ;; Attempt to construct it.
                      (list (list t (custom-face-attributes-get 
                                     symbol (selected-frame))))))
@@ -1901,7 +1924,7 @@ Match frames with dark backgrounds.")
        (get (widget-value widget) 'saved-face)))
     ("Reset to Standard Setting" custom-face-reset-factory
      (lambda (widget)
-       (get (widget-value widget) 'factory-face))))
+       (get (widget-value widget) 'face-defface-spec))))
   "Alist of actions for the `custom-face' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -1934,7 +1957,7 @@ widget. If FILTER is nil, ACTION is always valid.")
                                             'set)
                                            ((get symbol 'saved-face)
                                             'saved)
-                                           ((get symbol 'factory-face)
+                                           ((get symbol 'face-defface-spec)
                                             'factory)
                                            (t 
                                             'rogue)))))
@@ -1991,7 +2014,7 @@ Optional EVENT is the location for the menu."
   "Restore WIDGET to the face's standard settings."
   (let* ((symbol (widget-value widget))
          (child (car (widget-get widget :children)))
-         (value (get symbol 'factory-face)))
+         (value (get symbol 'face-defface-spec)))
     (unless value
       (error "No standard setting for this face"))
     (put symbol 'customized-face nil)
@@ -2007,14 +2030,14 @@ Optional EVENT is the location for the menu."
 
 (define-widget 'face 'default
   "Select and customize a face."
-  :convert-widget 'widget-item-convert-widget
+  :convert-widget 'widget-value-convert-widget
   :format "%[%t%]: %v"
   :tag "Face"
   :value 'default
   :value-create 'widget-face-value-create
   :value-delete 'widget-face-value-delete
-  :value-get 'widget-item-value-get
-  :validate 'widget-editable-list-validate
+  :value-get 'widget-value-value-get
+  :validate 'widget-children-validate
   :action 'widget-face-action
   :match '(lambda (widget value) (symbolp value)))
 
@@ -2173,16 +2196,13 @@ and so forth.  The remaining group tags are shown with
        (memq (widget-get widget :custom-state) '(modified set))))
     ("Reset to Current" custom-group-reset-current
      (lambda (widget)
-       (and (default-boundp (widget-value widget))
-            (memq (widget-get widget :custom-state) '(modified)))))
+       (memq (widget-get widget :custom-state) '(modified))))
     ("Reset to Saved" custom-group-reset-saved
      (lambda (widget)
-       (and (get (widget-value widget) 'saved-value)
-            (memq (widget-get widget :custom-state) '(modified set)))))
-    ("Reset to Standard Settings" custom-group-reset-factory
+       (memq (widget-get widget :custom-state) '(modified set))))
+    ("Reset to standard setting" custom-group-reset-factory
      (lambda (widget)
-       (and (get (widget-value widget) 'factory-value)
-            (memq (widget-get widget :custom-state) '(modified set saved))))))
+       (memq (widget-get widget :custom-state) '(modified set saved)))))
   "Alist of actions for the `custom-group' widget.
 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
 the menu entry, ACTION is the function to call on the widget when the
@@ -2337,7 +2357,7 @@ Leave point at the location of the call, or after the last expression."
         (when value
           (princ "\n '(default ")
           (prin1 value)
-          (if (or (get 'default 'factory-face)
+          (if (or (get 'default 'face-defface-spec)
                   (and (not (custom-facep 'default))
                        (not (get 'default 'force-face))))
               (princ ")")
@@ -2351,7 +2371,7 @@ Leave point at the location of the call, or after the last expression."
                       (princ symbol)
                       (princ " ")
                       (prin1 value)
-                      (if (or (get symbol 'factory-face)
+                      (if (or (get symbol 'face-defface-spec)
                               (and (not (custom-facep symbol))
                                    (not (get symbol 'force-face))))
                           (princ ")")
@@ -2428,7 +2448,7 @@ Leave point at the location of the call, or after the last expression."
 (defun custom-face-menu-create (widget symbol)
   "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
   (vector (custom-unlispify-menu-entry symbol)
-          `(custom-buffer-create '((,symbol custom-face)))
+          `(customize-face ',symbol)
           t))
 
 (defun custom-variable-menu-create (widget symbol)
@@ -2439,15 +2459,14 @@ Leave point at the location of the call, or after the last expression."
     (if (and type (widget-get type :custom-menu))
         (widget-apply type :custom-menu symbol)
       (vector (custom-unlispify-menu-entry symbol)
-              `(custom-buffer-create '((,symbol custom-variable)))
+              `(customize-variable ',symbol)
               t))))
 
 ;; Add checkboxes to boolean variable entries.
 (widget-put (get 'boolean 'widget-type)
             :custom-menu (lambda (widget symbol)
                            (vector (custom-unlispify-menu-entry symbol)
-                                   `(custom-buffer-create
-                                     '((,symbol custom-variable)))
+                                   `(customize-variable ',symbol)
                                    ':style 'toggle
                                    ':selected symbol)))
 
@@ -2470,7 +2489,7 @@ Leave point at the location of the call, or after the last expression."
   "Create menu for customization group SYMBOL.
 The menu is in a format applicable to `easy-menu-define'."
   (let* ((item (vector (custom-unlispify-menu-entry symbol)
-                       `(custom-buffer-create '((,symbol custom-group)))
+                       `(customize-group ',symbol)
                        t)))
     (if (and (or (not (boundp 'custom-menu-nesting))
                  (>= custom-menu-nesting 0))