XEmacs 21.4.5 "Civil Service".
[chise/xemacs-chise.git.1] / lisp / cus-edit.el
index 30b0c86..38b437f 100644 (file)
@@ -55,6 +55,7 @@
 
 (require 'cus-load)
 (require 'cus-start)
+(require 'cus-file)
 
 ;; Huh?  This looks dirty!
 (put 'custom-define-hook 'custom-type 'hook)
@@ -303,7 +304,8 @@ Return a list suitable for use in `interactive'."
                obarray (lambda (symbol)
                          (and (boundp symbol)
                               (or (get symbol 'custom-type)
-                                  (user-variable-p symbol)))) t))
+                                  (user-variable-p symbol)))) 
+                t nil nil (and v (symbol-name v))))
      (list (if (equal val "")
               (if (symbolp v) v nil)
             (intern val)))))
@@ -560,14 +562,24 @@ groups after non-groups, if nil do not order groups at all."
          children)))
 
 (defun Custom-save ()
-  "Set all modified group members and save them."
+  "Set all modified options and save them."
   (interactive)
-  (let ((children custom-options))
+  (let ((all-children custom-options)
+        children)
     (mapc (lambda (child)
            (when (memq (widget-get child :custom-state) '(modified set))
-             (widget-apply child :custom-save)))
-         children))
-  (custom-save-all))
+              (push child children)))
+          all-children)
+    (let ((the-children children)
+          child)
+      (while (setq child (pop the-children))
+        (widget-apply child :custom-pre-save)))
+    (custom-save-all)
+    (let ((the-children children)
+          child)
+      (while (setq child (pop the-children))
+        (widget-apply child :custom-post-save)))
+    ))
 
 (defvar custom-reset-menu
   '(("Current" . Custom-reset-current)
@@ -608,11 +620,23 @@ when the action is chosen.")
 (defun Custom-reset-standard (&rest ignore)
   "Reset all modified, set, or saved group members to their standard settings."
   (interactive)
-  (let ((children custom-options))
+  (let ((all-children custom-options)
+        children must-save)
     (mapc (lambda (child)
-           (when (eq (widget-get child :custom-state) 'modified)
-             (widget-apply child :custom-reset-standard)))
-         children)))
+           (when (memq (widget-get child :custom-state) '(modified set saved))
+              (push child children)))
+          all-children)
+    (let ((the-children children)
+          child)
+      (while (setq child (pop the-children))
+        (and (widget-apply child :custom-pre-reset-standard)
+             (setq must-save t))))
+    (and must-save (custom-save-all))
+    (let ((the-children children)
+          child)
+      (while (setq child (pop the-children))
+        (widget-apply child :custom-post-reset-standard)))
+    ))
 
 \f
 ;;; The Customize Commands
@@ -681,8 +705,8 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
         (put var 'variable-comment comment))))
 
 ;;;###autoload
-(defun customize-set-variable (var val &optional comment)
-  "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.
+(defun customize-set-variable (variable value &optional comment)
+  "Set the default for VARIABLE to VALUE.  VALUE is any Lisp object.
 
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
@@ -700,18 +724,18 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
   (interactive (custom-prompt-variable "Set variable: "
                                       "Set customized value for %s to: "
                                       current-prefix-arg))
-  (funcall (or (get var 'custom-set) 'set-default) var val)
-  (put var 'customized-value (list (custom-quote val)))
+  (funcall (or (get variable 'custom-set) 'set-default) variable value)
+  (put variable 'customized-value (list (custom-quote value)))
   (cond ((string= comment "")
-        (put var 'variable-comment nil)
-        (put var 'customized-variable-comment nil))
+        (put variable 'variable-comment nil)
+        (put variable 'customized-variable-comment nil))
        (comment
-        (put var 'variable-comment comment)
-        (put var 'customized-variable-comment comment))))
+        (put variable 'variable-comment comment)
+        (put variable 'customized-variable-comment comment))))
 
 
 ;;;###autoload
-(defun customize-save-variable (var val &optional comment)
+(defun customize-save-variable (variable value &optional comment)
   "Set the default for VARIABLE to VALUE, and save it for future sessions.
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
@@ -729,15 +753,15 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
   (interactive (custom-prompt-variable "Set and ave variable: "
                                       "Set and save value for %s as: "
                                       current-prefix-arg))
-  (funcall (or (get var 'custom-set) 'set-default) var val)
-  (put var 'saved-value (list (custom-quote val)))
-  (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val)))
+  (funcall (or (get variable 'custom-set) 'set-default) variable value)
+  (put variable 'saved-value (list (custom-quote value)))
+  (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
   (cond ((string= comment "")
-        (put var 'variable-comment nil)
-        (put var 'saved-variable-comment nil))
+        (put variable 'variable-comment nil)
+        (put variable 'saved-variable-comment nil))
        (comment
-        (put var 'variable-comment comment)
-        (put var 'saved-variable-comment comment)))
+        (put variable 'variable-comment comment)
+        (put variable 'saved-variable-comment comment)))
   (custom-save-all))
 
 ;;;###autoload
@@ -1846,10 +1870,14 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
   :value-create 'custom-variable-value-create
   :action 'custom-variable-action
   :custom-set 'custom-variable-set
+  :custom-pre-save 'custom-variable-pre-save
   :custom-save 'custom-variable-save
+  :custom-post-save 'custom-variable-post-save
   :custom-reset-current 'custom-redraw
   :custom-reset-saved 'custom-variable-reset-saved
-  :custom-reset-standard 'custom-variable-reset-standard)
+  :custom-pre-reset-standard 'custom-variable-pre-reset-standard
+  :custom-reset-standard 'custom-variable-reset-standard
+  :custom-post-reset-standard 'custom-variable-post-reset-standard)
 
 (defun custom-variable-type (symbol)
   "Return a widget suitable for editing the value of SYMBOL.
@@ -1987,7 +2015,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
       ;; Insert documentation.
       ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property
       ;; before the call to `widget-default-format-handler'. Otherwise, I
-      ;; loose my current `buttons'. This function shouldn't be called like
+      ;; lose my current `buttons'. This function shouldn't be called like
       ;; this anyway. The doc string widget should be added like the others.
       ;; --dv
       (widget-put widget :buttons buttons)
@@ -2173,8 +2201,8 @@ Optional EVENT is the location for the menu."
     (custom-variable-state-set widget)
     (custom-redraw-magic widget)))
 
-(defun custom-variable-save (widget)
-  "Set and save the value for the variable being edited by WIDGET."
+(defun custom-variable-pre-save (widget)
+  "Prepare for saving the value for the variable being edited by WIDGET."
   (let* ((form (widget-get widget :custom-form))
         (state (widget-get widget :custom-state))
         (child (car (widget-get widget :children)))
@@ -2217,15 +2245,23 @@ Optional EVENT is the location for the menu."
           (put symbol 'saved-variable-comment comment)))
     (put symbol 'customized-value nil)
     (put symbol 'customized-variable-comment nil)
-    (custom-save-all)
-    (custom-variable-state-set widget)
-    (custom-redraw-magic widget)))
+    ))
+
+(defun custom-variable-post-save (widget)
+  "Finish saving the variable being edited by WIDGET."
+  (custom-variable-state-set widget)
+  (custom-redraw-magic widget))
+
+(defun custom-variable-save (widget)
+  "Set and save the value for the variable being edited by WIDGET."
+  (custom-variable-pre-save widget)
+  (custom-save-all)
+  (custom-variable-post-save widget))
 
 (defun custom-variable-reset-saved (widget)
   "Restore the saved value for the variable being edited by WIDGET."
   (let* ((symbol (widget-value widget))
         (set (or (get symbol 'custom-set) 'set-default))
-        (comment-widget (widget-get widget :comment-widget))
         (value (get symbol 'saved-value))
         (comment (get symbol 'saved-variable-comment)))
     (cond ((or value comment)
@@ -2241,11 +2277,12 @@ Optional EVENT is the location for the menu."
     ;; This call will possibly make the comment invisible
     (custom-redraw widget)))
 
-(defun custom-variable-reset-standard (widget)
-  "Restore the standard setting for the variable being edited by WIDGET."
+;; This function returns non nil if we need to re-save the options --dv.
+(defun custom-variable-pre-reset-standard (widget)
+  "Prepare for restoring the variable being edited by WIDGET to its
+standard setting."
   (let* ((symbol (widget-value widget))
-        (set (or (get symbol 'custom-set) 'set-default))
-        (comment-widget (widget-get widget :comment-widget)))
+        (set (or (get symbol 'custom-set) 'set-default)))
     (if (get symbol 'standard-value)
        (funcall set symbol (eval (car (get symbol 'standard-value))))
       (signal 'error (list "No standard setting known for variable" symbol)))
@@ -2260,10 +2297,21 @@ Optional EVENT is the location for the menu."
       (if (null (cdr (get symbol 'theme-value)))
          (put symbol 'theme-value nil))
       (put symbol 'saved-variable-comment nil)
-      (custom-save-all))
-    (widget-put widget :custom-state 'unknown)
-    ;; This call will possibly make the comment invisible
-    (custom-redraw widget)))
+      widget)
+    ))
+
+(defun custom-variable-post-reset-standard (widget)
+  "Finish resetting the variable being edited by WIDGET to its standard
+value."
+  (widget-put widget :custom-state 'unknown)
+  ;; This call will possibly make the comment invisible
+  (custom-redraw widget))
+
+(defun custom-variable-reset-standard (widget)
+  "Restore the standard setting for the variable being edited by WIDGET."
+  (when (custom-variable-pre-reset-standard widget)
+    (custom-save-all))
+  (custom-variable-post-reset-standard widget))
 
 ;;; The `custom-face-edit' Widget.
 
@@ -2302,6 +2350,10 @@ Only match the specified window systems")
                                           :sibling-args (:help-echo "\
 The X11 Window System")
                                           x)
+                                   (const :format "GTK "
+                                          :sibling-args (:help-echo "\
+The GTK Window System")
+                                          gtk)
                                    (const :format "PM "
                                           :sibling-args (:help-echo "\
 OS/2 Presentation Manager")
@@ -2390,10 +2442,14 @@ Match frames with dark backgrounds")
   :custom-category 'face
   :custom-form nil ; defaults to value of `custom-face-default-form'
   :custom-set 'custom-face-set
+  :custom-pre-save 'custom-face-pre-save
   :custom-save 'custom-face-save
+  :custom-post-save 'custom-face-post-save
   :custom-reset-current 'custom-redraw
   :custom-reset-saved 'custom-face-reset-saved
+  :custom-pre-reset-standard 'custom-face-pre-reset-standard
   :custom-reset-standard 'custom-face-reset-standard
+  :custom-post-reset-standard 'custom-face-post-reset-standard
   :custom-menu 'custom-face-menu-create)
 
 (define-widget 'custom-face-all 'editable-list
@@ -2636,8 +2692,8 @@ Optional EVENT is the location for the menu."
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
-(defun custom-face-save (widget)
-  "Make the face attributes in WIDGET default."
+(defun custom-face-pre-save (widget)
+  "Prepare for saving the face being edited by WIDGET."
   (let* ((symbol (widget-value widget))
         (child (car (widget-get widget :children)))
         (value (widget-value child))
@@ -2655,12 +2711,21 @@ Optional EVENT is the location for the menu."
     (put symbol 'face-comment comment)
     (put symbol 'customized-face-comment nil)
     (put symbol 'saved-face-comment comment)
-    (custom-save-all)
-    (custom-face-state-set widget)
-    (custom-redraw-magic widget)))
+    ))
+
+(defun custom-face-post-save (widget)
+  "Finish saving the face being edited by WIDGET."
+  (custom-face-state-set widget)
+  (custom-redraw-magic widget))
+
+(defun custom-face-save (widget)
+  "Save the face being edited by WIDGET."
+  (custom-face-pre-save widget)
+  (custom-save-all)
+  (custom-face-post-save widget))
 
 (defun custom-face-reset-saved (widget)
-  "Restore WIDGET to the face's default attributes."
+  "Reset the face being edited by WIDGET to its saved value."
   (let* ((symbol (widget-value widget))
         (child (car (widget-get widget :children)))
         (value (get symbol 'saved-face))
@@ -2678,12 +2743,12 @@ Optional EVENT is the location for the menu."
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
-(defun custom-face-reset-standard (widget)
-  "Restore WIDGET to the face's standard settings."
+;; This function returns non nil if we need to re-save the options --dv.
+(defun custom-face-pre-reset-standard (widget)
+  "Prepare for restoring the face edited by WIDGET to its standard
+settings."
   (let* ((symbol (widget-value widget))
-        (child (car (widget-get widget :children)))
-        (value (get symbol 'face-defface-spec))
-        (comment-widget (widget-get widget :comment-widget)))
+        (value (get symbol 'face-defface-spec)))
     (unless value
       (signal 'error (list "No standard setting for this face" symbol)))
     (put symbol 'customized-face nil)
@@ -2695,14 +2760,30 @@ Optional EVENT is the location for the menu."
       (if (null (cdr (get symbol 'theme-face)))
          (put symbol  'theme-face nil))
       (put symbol 'saved-face-comment nil)
-      (custom-save-all))
+      widget)
+    ))
+
+(defun custom-face-post-reset-standard (widget)
+  "Finish restoring the face edited by WIDGET to its standard settings."
+  (let* ((symbol (widget-value widget))
+         (child (car (widget-get widget :children)))
+         (value (get symbol 'face-defface-spec))
+         (comment-widget (widget-get widget :comment-widget)))
     (face-spec-set symbol value nil '(custom))
     (put symbol 'face-comment nil)
     (widget-value-set child value)
     ;; This call manages the comment visibility
     (widget-value-set comment-widget "")
     (custom-face-state-set widget)
-    (custom-redraw-magic widget)))
+    (custom-redraw-magic widget)
+    ))
+
+(defun custom-face-reset-standard (widget)
+  "Restore the face edited by WIDGET to its standard settings."
+  (when (custom-face-pre-reset-standard widget)
+    (custom-save-all))
+  (custom-face-post-reset-standard widget))
+
 
 ;;; The `face' Widget.
 
@@ -2875,10 +2956,14 @@ and so forth.  The remaining group tags are shown with
   :action 'custom-group-action
   :custom-category 'group
   :custom-set 'custom-group-set
+  :custom-pre-save 'custom-group-pre-save
   :custom-save 'custom-group-save
+  :custom-post-save 'custom-group-post-save
   :custom-reset-current 'custom-group-reset-current
   :custom-reset-saved 'custom-group-reset-saved
+  :custom-pre-reset-standard 'custom-group-pre-reset-standard
   :custom-reset-standard 'custom-group-reset-standard
+  :custom-post-reset-standard 'custom-group-post-reset-standard
   :custom-menu 'custom-group-menu-create)
 
 (defun custom-group-sample-face-get (widget)
@@ -3187,14 +3272,28 @@ Optional EVENT is the location for the menu."
              (widget-apply child :custom-set)))
          children)))
 
-(defun custom-group-save (widget)
+(defun custom-group-pre-save (widget)
+  "Prepare for saving all modified group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+            (when (memq (widget-get child :custom-state) '(modified set))
+              (widget-apply child :custom-pre-save)))
+          children)))
+
+(defun custom-group-post-save (widget)
   "Save all modified group members."
   (let ((children (widget-get widget :children)))
     (mapc (lambda (child)
            (when (memq (widget-get child :custom-state) '(modified set))
-             (widget-apply child :custom-save)))
+             (widget-apply child :custom-post-save)))
          children)))
 
+(defun custom-group-save (widget)
+  "Save all modified group members."
+  (custom-group-pre-save widget)
+  (custom-save-all)
+  (custom-group-post-save widget))
+
 (defun custom-group-reset-current (widget)
   "Reset all modified group members."
   (let ((children (widget-get widget :children)))
@@ -3211,15 +3310,35 @@ Optional EVENT is the location for the menu."
              (widget-apply child :custom-reset-saved)))
          children)))
 
-(defun custom-group-reset-standard (widget)
-  "Reset all modified, set, or saved group members."
+;; This function returns non nil when we need to re-save the options --dv.
+(defun custom-group-pre-reset-standard (widget)
+  "Prepare for resetting all modified, set, or saved group members."
+  (let ((children (widget-get widget :children))
+        must-save)
+    (mapc (lambda (child)
+            (when (memq (widget-get child :custom-state)
+                        '(modified set saved))
+              (and (widget-apply child :custom-pre-reset-standard)
+                   (setq must-save t))))
+          children)
+    must-save
+    ))
+
+(defun custom-group-post-reset-standard (widget)
+  "Finish resetting all modified, set, or saved group members."
   (let ((children (widget-get widget :children)))
     (mapc (lambda (child)
            (when (memq (widget-get child :custom-state)
                        '(modified set saved))
-             (widget-apply child :custom-reset-standard)))
+             (widget-apply child :custom-post-reset-standard)))
          children)))
 
+(defun custom-group-reset-standard (widget)
+  "Reset all modified, set, or saved group members."
+  (when (custom-group-pre-reset-standard widget)
+    (custom-save-all))
+  (custom-group-post-reset-standard widget))
+
 (defun custom-group-state-update (widget)
   "Update magic."
   (unless (eq (widget-get widget :custom-state) 'hidden)
@@ -3239,15 +3358,6 @@ Optional EVENT is the location for the menu."
       (widget-put widget :custom-state found)))
   (custom-magic-reset widget))
 
-;;; The `custom-save-all' Function.
-;;;###autoload
-(defcustom custom-file "~/.emacs"
-  "File used for storing customization information.
-If you change this from the default \"~/.emacs\" you need to
-explicitly load that file for the settings to take effect."
-  :type 'file
-  :group 'customize)
-
 (defun custom-save-delete (symbol)
   "Delete the call to SYMBOL form in `custom-file'.
 Leave point at the location of the call, or after the last expression."
@@ -3280,7 +3390,7 @@ Leave point at the location of the call, or after the last expression."
        (unless (bolp)
        (princ "\n"))
        (princ "(custom-set-variables")
-       (mapatoms (lambda (symbol)               
+       (mapatoms (lambda (symbol)
                  (let ((spec (car-safe (get symbol 'theme-value)))
                        (requests (get symbol 'custom-requests))
                        (now (not (or (get symbol 'standard-value)
@@ -3354,7 +3464,8 @@ Leave point at the location of the call, or after the last expression."
 
 (defun custom-save-resets (property setter special)
   (let (started-writing ignored-special)
-    ;; (custom-save-delete setter) Done by caller 
+    (setq ignored-special ignored-special) ;; suppress byte-compiler warning
+    ;; (custom-save-delete setter) Done by caller
     (let ((standard-output (current-buffer))
          (mapper `(lambda (object)
                    (let ((spec (car-safe (get object (quote ,property)))))
@@ -3377,8 +3488,9 @@ Leave point at the location of the call, or after the last expression."
       (setq ignored-special special)
       (mapatoms mapper)
       (when started-writing
-       (princ ")\n")))))
-                       
+       (princ ")\n"))))
+    )
+
 
 (defun custom-save-loaded-themes ()
   (let ((themes (reverse (get 'user 'theme-loads-themes)))
@@ -3389,7 +3501,7 @@ Leave point at the location of the call, or after the last expression."
       (mapc (lambda (theme)
              (princ "\n   '")
              (prin1 theme)) themes)
-      (princ " )\n"))))         
+      (princ " )\n"))))
 
 ;;;###autoload
 (defun customize-save-customized ()
@@ -3594,6 +3706,19 @@ if that value is non-nil."
   (run-hooks 'custom-mode-hook))
 
 \f
+;;;###autoload
+(defun custom-migrate-custom-file (new-custom-file-name)
+  "Migrate custom file from home directory."
+  (mapc 'custom-save-delete
+       '(custom-load-themes custom-reset-variables
+                            custom-set-variables
+                            custom-set-faces
+                            custom-reset-faces))
+  (with-current-buffer (find-file-noselect custom-file)
+    (save-buffer))
+  (setq custom-file new-custom-file-name)
+  (custom-save-all))
+\f
 ;;; The End.
 
 (provide 'cus-edit)