XEmacs 21.2.43 "Terspichore".
[chise/xemacs-chise.git.1] / lisp / cus-edit.el
index 5851776..b27db59 100644 (file)
@@ -1,9 +1,9 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
 ;; Keywords: help, faces
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -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)))))
@@ -399,7 +401,7 @@ This only has an effect when `custom-unlispify-tag-names' or
     (custom-unlispify-menu-entry symbol t)))
 
 (defun custom-prefix-add (symbol prefixes)
-  ;; Addd SYMBOL to list of ignored PREFIXES.
+  ;; Add SYMBOL to list of ignored PREFIXES.
   (cons (or (get symbol 'custom-prefix)
            (concat (symbol-name symbol) "-"))
        prefixes))
@@ -681,8 +683,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 +702,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 +731,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
@@ -1033,7 +1035,6 @@ This works by calling the function specified by
   (widget-insert "\nOperate on everything in this buffer:\n ")
   (widget-create 'push-button
                 :tag "Set"
-                :tag-glyph '("set-up" "set-down")
                 :help-echo "\
 Make your editing in this buffer take effect for this session"
                 :action (lambda (widget &optional event)
@@ -1041,7 +1042,6 @@ Make your editing in this buffer take effect for this session"
   (widget-insert " ")
   (widget-create 'push-button
                 :tag "Save"
-                :tag-glyph '("save-up" "save-down")
                 :help-echo "\
 Make your editing in this buffer take effect for future Emacs sessions"
                 :action (lambda (widget &optional event)
@@ -1077,7 +1077,6 @@ Reset all values in this buffer to their standard settings"
   (widget-insert "  ")
   (widget-create 'push-button
                 :tag "Done"
-                :tag-glyph '("done-up" "done-down")
                 :help-echo "Remove the buffer"
                 :action (lambda (widget &optional event)
                           (Custom-buffer-done)))
@@ -1250,7 +1249,7 @@ item in another window.\n\n"))
 
 (defun custom-browse-insert-prefix (prefix)
   "Insert PREFIX.  On XEmacs convert it to line graphics."
-  ;; ### Unfinished.
+  ;; #### Unfinished.
   (if nil ; (string-match "XEmacs" emacs-version)
       (progn
        (insert "*")
@@ -1988,9 +1987,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
        (widget-put widget :custom-magic magic)
        (push magic buttons))
       ;; Insert documentation.
-      ;; ### NOTE: this is ugly!!!! I need to do update the :buttons property
+      ;; #### 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)
@@ -2228,7 +2227,6 @@ Optional EVENT is the location for the menu."
   "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)
@@ -2247,8 +2245,7 @@ Optional EVENT is the location for the menu."
 (defun custom-variable-reset-standard (widget)
   "Restore the standard setting 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)))
+        (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)))
@@ -2275,7 +2272,7 @@ Optional EVENT is the location for the menu."
   :format "%t: %v"
   :tag "Attributes"
   :extra-offset 12
-  :button-args '(:help-echo "Control whether this attribute have any effect")
+  :button-args '(:help-echo "Control whether this attribute has any effect")
   :args (mapcar (lambda (att)
                  (list 'group
                        :inline t
@@ -2311,19 +2308,33 @@ OS/2 Presentation Manager")
                                           pm)
                                    (const :format "MSWindows "
                                           :sibling-args (:help-echo "\
-Windows NT/95/97")
+Microsoft Windows, displays")
                                           mswindows)
-                                   (const :format "DOS "
+                                   (const :format "MSPrinter "
                                           :sibling-args (:help-echo "\
-Plain MS-DOS")
-                                          pc)
+Microsoft Windows, printers")
+                                          msprinter)
                                    (const :format "TTY%n"
                                           :sibling-args (:help-echo "\
 Plain text terminals")
                                           tty)))
                  (group :sibling-args (:help-echo "\
+Only match display or printer devices")
+                        (const :format "Output: "
+                               class)
+                        (checklist :inline t
+                                   :offset 0
+                                   (const :format "Display "
+                                          :sibling-args (:help-echo "\
+Match display devices")
+                                          display)
+                                   (const :format "Printer%n"
+                                          :sibling-args (:help-echo "\
+Match printer devices")
+                                          printer)))
+                 (group :sibling-args (:help-echo "\
 Only match the frames with the specified color support")
-                        (const :format "Class: "
+                        (const :format "Color support: "
                                class)
                         (checklist :inline t
                                    :offset 0
@@ -2759,7 +2770,7 @@ Optional EVENT is the location for the menu."
   :tag "Hook")
 
 (defun custom-hook-convert-widget (widget)
-  ;; Handle `:custom-options'.
+  ;; Handle `:options'.
   (let* ((options (widget-get widget :options))
         (other `(editable-list :inline t
                                :entry-format "%i %d%v"
@@ -3228,15 +3239,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."
@@ -3269,7 +3271,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)
@@ -3280,9 +3282,9 @@ Leave point at the location of the call, or after the last expression."
                    (when (or (and spec (eq (car spec) 'user)
                               (eq (second spec) 'set)) comment)
                      (princ "\n '(")
-                     (princ symbol)
+                     (prin1 symbol)
                      (princ " ")
-                     ;; This comment stuf is in the way ####
+                     ;; This comment stuff is in the way ####
                      ;; Is (eq (third spec) (car saved-value)) ????
                      ;; (prin1 (third spec))
                      (prin1 (car (get symbol 'saved-value)))
@@ -3313,7 +3315,7 @@ Leave point at the location of the call, or after the last expression."
               (eq (car theme-spec) 'user)
               (eq (second theme-spec) 'set)) comment)
       (princ "\n '(")
-      (princ symbol)
+      (prin1 symbol)
       (princ " ")
       (prin1 (get symbol 'saved-face))
       (if (or comment now)
@@ -3343,7 +3345,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)))))
@@ -3358,7 +3361,7 @@ Leave point at the location of the call, or after the last expression."
                        (princ "(")
                        (princ (quote ,setter))
                        (princ "\n '(")
-                       (princ object)
+                       (prin1 object)
                        (princ " ")
                        (prin1 (third spec))
                        (princ ")")))))))
@@ -3366,8 +3369,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)))
@@ -3378,7 +3382,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 ()
@@ -3583,6 +3587,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)