]> code.delx.au - gnu-emacs/blobdiff - lisp/cus-edit.el
(dired-view-command-alist): New variable.
[gnu-emacs] / lisp / cus-edit.el
index c78bce11aadbe4fbbe025240cff53d6cbbf7d602..eb7fe0472a5aad16d493a5272885ec6ee2312e22 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
 ;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
@@ -431,6 +431,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
 (defcustom custom-unlispify-remove-prefixes nil
   "Non-nil means remove group prefixes from option names in buffer."
   :group 'custom-menu
+  :group 'custom-buffer
   :type 'boolean)
 
 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
@@ -748,7 +749,7 @@ it as the third element in the list."
 
 ;;;###autoload
 (defun customize-set-value (var val &optional comment)
-  "Set VARIABLE to VALUE.  VALUE is a Lisp object.
+  "Set VARIABLE to VALUE, and return VALUE.  VALUE is a Lisp object.
 
 If VARIABLE has a `variable-interactive' property, that is used as if
 it were the arg to `interactive' (which see) to interactively read the value.
@@ -761,15 +762,16 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
                                       "Set %s to value: "
                                       current-prefix-arg))
    
-  (set var val)
   (cond ((string= comment "")
         (put var 'variable-comment nil))
        (comment
-        (put var 'variable-comment comment))))
+        (put var 'variable-comment comment)))
+  (set var val))
 
 ;;;###autoload
 (defun customize-set-variable (variable value &optional comment)
-  "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.
+  "Set the default for VARIABLE to VALUE, and return VALUE.
+VALUE is a Lisp object.
 
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
@@ -787,6 +789,7 @@ 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))
+  (custom-load-symbol variable)
   (funcall (or (get variable 'custom-set) 'set-default) variable value)
   (put variable 'customized-value (list (custom-quote value)))
   (cond ((string= comment "")
@@ -794,11 +797,14 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
         (put variable 'customized-variable-comment nil))
        (comment
         (put variable 'variable-comment comment)
-        (put variable 'customized-variable-comment comment))))
+        (put variable 'customized-variable-comment comment)))
+  value)
 
 ;;;###autoload
 (defun customize-save-variable (var value &optional comment)
   "Set the default for VARIABLE to VALUE, and save it for future sessions.
+Return VALUE.
+
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
 
@@ -812,7 +818,7 @@ If VARIABLE has a `custom-type' property, it must be a widget and the
 `:prompt-value' property of that widget will be used for reading the value.
 
 If given a prefix (or a COMMENT argument), also prompt for a comment."
-  (interactive (custom-prompt-variable "Set and ave variable: "
+  (interactive (custom-prompt-variable "Set and save variable: "
                                       "Set and save value for %s as: "
                                       current-prefix-arg))
   (funcall (or (get var 'custom-set) 'set-default) var value)
@@ -823,7 +829,8 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
        (comment
         (put var 'variable-comment comment)
         (put var 'saved-variable-comment comment)))
-  (custom-save-all))
+  (custom-save-all)
+  value)
 
 ;;;###autoload
 (defun customize ()
@@ -1485,7 +1492,7 @@ item in another window.\n\n"))
 (defface custom-invalid-face '((((class color))
                                (:foreground "yellow" :background "red"))
                               (t
-                               (:bold t :italic t :underline t)))
+                               (:weight bold :slant italic :underline t)))
   "Face used when the customize item is invalid."
   :group 'custom-magic-faces)
 
@@ -1499,21 +1506,21 @@ item in another window.\n\n"))
 (defface custom-modified-face '((((class color))
                                 (:foreground "white" :background "blue"))
                                (t
-                                (:italic t :bold)))
+                                (:slant italic :bold)))
   "Face used when the customize item has been modified."
   :group 'custom-magic-faces)
 
 (defface custom-set-face '((((class color))
                                (:foreground "blue" :background "white"))
                               (t
-                               (:italic t)))
+                               (:slant italic)))
   "Face used when the customize item has been set."
   :group 'custom-magic-faces)
 
 (defface custom-changed-face '((((class color))
                                (:foreground "white" :background "blue"))
                               (t
-                               (:italic t)))
+                               (:slant italic)))
   "Face used when the customize item has been changed."
   :group 'custom-magic-faces)
 
@@ -1815,6 +1822,7 @@ and `face'."
 (defvar custom-load-recursion nil
   "Hack to avoid recursive dependencies.")
 
+;;;###autoload
 (defun custom-load-symbol (symbol)
   "Load all dependencies for SYMBOL."
   (unless custom-load-recursion
@@ -1958,7 +1966,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
                                 (background dark))
                                (:background "dim gray"))
                               (t
-                               (:italic t)))
+                               (:slant italic)))
   "Face used for comments on variables or faces"
   :version "21.1"
   :group 'custom-faces)
@@ -1968,10 +1976,10 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
   '((((class color) (background dark)) (:foreground "gray80"))
     (((class color) (background light)) (:foreground "blue4"))
     (((class grayscale) (background light))
-     (:foreground "DimGray" :bold t :italic t))
+     (:foreground "DimGray" :weight bold :slant italic))
     (((class grayscale) (background dark))
-     (:foreground "LightGray" :bold t :italic t))
-    (t (:bold t)))
+     (:foreground "LightGray" :weight bold :slant italic))
+    (t (:weight bold)))
   "Face used for variables or faces comment tags"
   :group 'custom-faces)
 
@@ -2016,15 +2024,15 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
 (defface custom-variable-tag-face
   `((((class color)
       (background dark))
-     (:foreground "light blue" :bold t :height 1.2 :inherit variable-pitch))
+     (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
     (((class color)
       (background light))
-     (:foreground "blue" :bold t :height 1.2 :inherit variable-pitch))
-    (t (:bold t)))
+     (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
+    (t (:weight bold)))
   "Face used for unpushable variable tags."
   :group 'custom-faces)
 
-(defface custom-variable-button-face '((t (:underline t :bold t)))
+(defface custom-variable-button-face '((t (:underline t :weight bold)))
   "Face used for pushable variable tags."
   :group 'custom-faces)
 
@@ -2476,7 +2484,6 @@ restoring it to the state of a variable that has never been customized."
   "Ignoring WIDGET, convert :bold and :italic in VALUE to new form."
   (let (result)
     (while value
-      (assert (cdr value))
       (let ((key (car value))
            (val (car (cdr value))))
        (cond ((eq key :italic)
@@ -2632,7 +2639,7 @@ Match frames with dark backgrounds.")
 ;;; The `custom-face' Widget.
 
 (defface custom-face-tag-face
-  `((t (:bold t :height 1.2 :inherit variable-pitch)))
+  `((t (:weight bold :height 1.2 :inherit variable-pitch)))
   "Face used for face tags."
   :group 'custom-faces)
 
@@ -3140,22 +3147,22 @@ and so forth.  The remaining group tags are shown with
 (defface custom-group-tag-face-1
   `((((class color)
       (background dark))
-     (:foreground "pink" :bold t :height 1.2 :inherit variable-pitch))
+     (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
     (((class color)
       (background light))
-     (:foreground "red" :bold t :height 1.2 :inherit variable-pitch))
-    (t (:bold t)))
+     (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch))
+    (t (:weight bold)))
   "Face used for group tags."
   :group 'custom-faces)
 
 (defface custom-group-tag-face
   `((((class color)
       (background dark))
-     (:foreground "light blue" :bold t :height 1.2))
+     (:foreground "light blue" :weight bold :height 1.2))
     (((class color)
       (background light))
-     (:foreground "blue" :bold t :height 1.2))
-    (t (:bold t)))
+     (:foreground "blue" :weight bold :height 1.2))
+    (t (:weight bold)))
   "Face used for low level group tags."
   :group 'custom-faces)
 
@@ -3743,7 +3750,62 @@ or (if there were none) at the end of the buffer."
     (save-excursion
       (let ((default-major-mode nil))
        (set-buffer (find-file-noselect (custom-file))))
-      (save-buffer))))
+      (let ((file-precious-flag t))
+       (save-buffer)))))
+
+;;;###autoload
+(defun customize-mark-to-save (symbol)
+  "Mark SYMBOL for later saving.
+
+If the default value of SYMBOL is different from the standard value, 
+set the `saved-value' property to a list whose car evaluates to the
+default value. Otherwise, set it til nil.
+
+To actually save the value, call `custom-save-all'.
+
+Return non-nil iff the `saved-value' property actually changed."
+  (let* ((get (or (get symbol 'custom-get) 'default-value))
+        (value (funcall get symbol))
+        (saved (get symbol 'saved-value))
+        (standard (get symbol 'standard-value))
+        (comment (get symbol 'customized-variable-comment)))
+    ;; Save default value iff different from standard value.
+    (if (or (null standard)
+           (not (equal value (condition-case nil
+                                 (eval (car standard))
+                               (error nil)))))
+       (put symbol 'saved-value (list (custom-quote value)))
+      (put symbol 'saved-value nil))
+    ;; Clear customized information (set, but not saved).
+    (put symbol 'customized-value nil)
+    ;; Save any comment that might have been set.
+    (when comment
+      (put symbol 'saved-variable-comment comment))
+    (not (equal saved (get symbol 'saved-value)))))
+
+;;;###autoload
+(defun customize-mark-as-set (symbol)
+  "Mark current value of SYMBOL as being set from customize.
+
+If the default value of SYMBOL is different from the saved value if any, 
+or else if it is different from the standard value, set the
+`customized-value' property to a list whose car evaluates to the 
+default value. Otherwise, set it til nil.
+
+Return non-nil iff the `customized-value' property actually changed."
+  (let* ((get (or (get symbol 'custom-get) 'default-value))
+        (value (funcall get symbol))
+        (customized (get symbol 'customized-value))
+        (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
+    ;; Mark default value as set iff different from old value.
+    (if (or (null old)
+           (not (equal value (condition-case nil 
+                                 (eval (car old))
+                               (error nil)))))
+       (put symbol 'customized-value (list (custom-quote value)))
+      (put symbol 'customized-value nil))
+    ;; Changed?
+    (not (equal customized (get symbol 'customized-value)))))
 
 ;;; The Customize Menu.