(map_over_uint8_byte_table): Change arguments; add new argument `ccs'.
[chise/xemacs-chise.git-] / lisp / cus-edit.el
index 897dd49..b6317b3 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
 ;;; 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@xemacs.org>
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
@@ -55,6 +55,7 @@
 
 (require 'cus-load)
 (require 'cus-start)
 
 (require 'cus-load)
 (require 'cus-start)
+(require 'cus-file)
 
 ;; Huh?  This looks dirty!
 (put 'custom-define-hook 'custom-type 'hook)
 
 ;; Huh?  This looks dirty!
 (put 'custom-define-hook 'custom-type 'hook)
@@ -399,7 +400,7 @@ This only has an effect when `custom-unlispify-tag-names' or
     (custom-unlispify-menu-entry symbol t)))
 
 (defun custom-prefix-add (symbol prefixes)
     (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))
   (cons (or (get symbol 'custom-prefix)
            (concat (symbol-name symbol) "-"))
        prefixes))
@@ -681,8 +682,8 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
         (put var 'variable-comment comment))))
 
 ;;;###autoload
         (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.
 
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
@@ -700,18 +701,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))
   (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 "")
   (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
        (comment
-        (put var 'variable-comment comment)
-        (put var 'customized-variable-comment comment))))
+        (put variable 'variable-comment comment)
+        (put variable 'customized-variable-comment comment))))
 
 
 ;;;###autoload
 
 
 ;;;###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.
   "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 +730,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))
   (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 "")
   (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
        (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
   (custom-save-all))
 
 ;;;###autoload
@@ -1033,7 +1034,6 @@ This works by calling the function specified by
   (widget-insert "\nOperate on everything in this buffer:\n ")
   (widget-create 'push-button
                 :tag "Set"
   (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)
                 :help-echo "\
 Make your editing in this buffer take effect for this session"
                 :action (lambda (widget &optional event)
@@ -1041,7 +1041,6 @@ Make your editing in this buffer take effect for this session"
   (widget-insert " ")
   (widget-create 'push-button
                 :tag "Save"
   (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)
                 :help-echo "\
 Make your editing in this buffer take effect for future Emacs sessions"
                 :action (lambda (widget &optional event)
@@ -1077,7 +1076,6 @@ Reset all values in this buffer to their standard settings"
   (widget-insert "  ")
   (widget-create 'push-button
                 :tag "Done"
   (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)))
                 :help-echo "Remove the buffer"
                 :action (lambda (widget &optional event)
                           (Custom-buffer-done)))
@@ -1250,7 +1248,7 @@ item in another window.\n\n"))
 
 (defun custom-browse-insert-prefix (prefix)
   "Insert PREFIX.  On XEmacs convert it to line graphics."
 
 (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 "*")
   (if nil ; (string-match "XEmacs" emacs-version)
       (progn
        (insert "*")
@@ -1988,9 +1986,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
        (widget-put widget :custom-magic magic)
        (push magic buttons))
       ;; Insert documentation.
        (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
       ;; 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)
       ;; this anyway. The doc string widget should be added like the others.
       ;; --dv
       (widget-put widget :buttons buttons)
@@ -2228,7 +2226,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))
   "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)
         (value (get symbol 'saved-value))
         (comment (get symbol 'saved-variable-comment)))
     (cond ((or value comment)
@@ -2247,8 +2244,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))
 (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)))
     (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 +2271,7 @@ Optional EVENT is the location for the menu."
   :format "%t: %v"
   :tag "Attributes"
   :extra-offset 12
   :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
   :args (mapcar (lambda (att)
                  (list 'group
                        :inline t
@@ -2311,19 +2307,33 @@ OS/2 Presentation Manager")
                                           pm)
                                    (const :format "MSWindows "
                                           :sibling-args (:help-echo "\
                                           pm)
                                    (const :format "MSWindows "
                                           :sibling-args (:help-echo "\
-Windows NT/95/97")
+Microsoft Windows, displays")
                                           mswindows)
                                           mswindows)
-                                   (const :format "DOS "
+                                   (const :format "MSPrinter "
                                           :sibling-args (:help-echo "\
                                           :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 "\
                                    (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")
 Only match the frames with the specified color support")
-                        (const :format "Class: "
+                        (const :format "Color support: "
                                class)
                         (checklist :inline t
                                    :offset 0
                                class)
                         (checklist :inline t
                                    :offset 0
@@ -2759,7 +2769,7 @@ Optional EVENT is the location for the menu."
   :tag "Hook")
 
 (defun custom-hook-convert-widget (widget)
   :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"
   (let* ((options (widget-get widget :options))
         (other `(editable-list :inline t
                                :entry-format "%i %d%v"
@@ -3228,15 +3238,6 @@ Optional EVENT is the location for the menu."
       (widget-put widget :custom-state found)))
   (custom-magic-reset widget))
 
       (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."
 (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 +3270,7 @@ Leave point at the location of the call, or after the last expression."
        (unless (bolp)
        (princ "\n"))
        (princ "(custom-set-variables")
        (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)
                  (let ((spec (car-safe (get symbol 'theme-value)))
                        (requests (get symbol 'custom-requests))
                        (now (not (or (get symbol 'standard-value)
@@ -3282,7 +3283,7 @@ Leave point at the location of the call, or after the last expression."
                      (princ "\n '(")
                      (prin1 symbol)
                      (princ " ")
                      (princ "\n '(")
                      (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)))
                      ;; Is (eq (third spec) (car saved-value)) ????
                      ;; (prin1 (third spec))
                      (prin1 (car (get symbol 'saved-value)))
@@ -3343,7 +3344,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)
 
 (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)))))
     (let ((standard-output (current-buffer))
          (mapper `(lambda (object)
                    (let ((spec (car-safe (get object (quote ,property)))))
@@ -3366,8 +3368,9 @@ Leave point at the location of the call, or after the last expression."
       (setq ignored-special special)
       (mapatoms mapper)
       (when started-writing
       (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)))
 
 (defun custom-save-loaded-themes ()
   (let ((themes (reverse (get 'user 'theme-loads-themes)))
@@ -3378,7 +3381,7 @@ Leave point at the location of the call, or after the last expression."
       (mapc (lambda (theme)
              (princ "\n   '")
              (prin1 theme)) themes)
       (mapc (lambda (theme)
              (princ "\n   '")
              (prin1 theme)) themes)
-      (princ " )\n"))))         
+      (princ " )\n"))))
 
 ;;;###autoload
 (defun customize-save-customized ()
 
 ;;;###autoload
 (defun customize-save-customized ()
@@ -3583,6 +3586,19 @@ if that value is non-nil."
   (run-hooks 'custom-mode-hook))
 
 \f
   (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)
 ;;; The End.
 
 (provide 'cus-edit)