declare smobs in alloc.c

[bpt/emacs.git] / lisp / custom.el

diff --git a/lisp/custom.el b/lisp/custom.el
index 4cf9609..c30ad7c 100644 (file)
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,10 +1,10 @@
 ;;; custom.el --- tools for declaring and initializing options
 ;;
 ;;; custom.el --- tools for declaring and initializing options
 ;;

-;; Copyright (C) 1996-1997, 1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1996-1997, 1999, 2001-2014 Free Software Foundation,

 ;; Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>

-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org

 ;; Keywords: help, faces
 ;; Package: emacs
 
 ;; Keywords: help, faces
 ;; Package: emacs
 


@@ -49,63 +49,66 @@ Users should not set it.")
 
 ;;; The `defcustom' Macro.
 
 
 ;;; The `defcustom' Macro.
 

-(defun custom-initialize-default (symbol value)
-  "Initialize SYMBOL with VALUE.
+(defun custom-initialize-default (symbol exp)
+  "Initialize SYMBOL with EXP.

 This will do nothing if symbol already has a default binding.
 Otherwise, if symbol has a `saved-value' property, it will evaluate
 the car of that and use it as the default binding for symbol.
 This will do nothing if symbol already has a default binding.
 Otherwise, if symbol has a `saved-value' property, it will evaluate
 the car of that and use it as the default binding for symbol.

-Otherwise, VALUE will be evaluated and used as the default binding for
+Otherwise, EXP will be evaluated and used as the default binding for

 symbol."
 symbol."

-  (eval `(defvar ,symbol ,(if (get symbol 'saved-value)
-                              (car (get symbol 'saved-value))
-                            value))))
+  (eval `(defvar ,symbol ,(let ((sv (get symbol 'saved-value)))
+                            (if sv (car sv) exp)))))

 
 

-(defun custom-initialize-set (symbol value)
-  "Initialize SYMBOL based on VALUE.
+(defun custom-initialize-set (symbol exp)
+  "Initialize SYMBOL based on EXP.

 If the symbol doesn't have a default binding already,
 then set it using its `:set' function (or `set-default' if it has none).
 The value is either the value in the symbol's `saved-value' property,
 If the symbol doesn't have a default binding already,
 then set it using its `:set' function (or `set-default' if it has none).
 The value is either the value in the symbol's `saved-value' property,

-if any, or VALUE."
-  (unless (default-boundp symbol)
-    (funcall (or (get symbol 'custom-set) 'set-default)
-            symbol
-            (eval (if (get symbol 'saved-value)
-                       (car (get symbol 'saved-value))
-                     value)))))
-
-(defun custom-initialize-reset (symbol value)
-  "Initialize SYMBOL based on VALUE.
+if any, or the value of EXP."
+  (condition-case nil
+      (default-toplevel-value symbol)
+    (error
+     (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
+              symbol
+              (eval (let ((sv (get symbol 'saved-value)))
+                      (if sv (car sv) exp)))))))
+
+(defun custom-initialize-reset (symbol exp)
+  "Initialize SYMBOL based on EXP.

 Set the symbol, using its `:set' function (or `set-default' if it has none).
 The value is either the symbol's current value
 Set the symbol, using its `:set' function (or `set-default' if it has none).
 The value is either the symbol's current value

- \(as obtained using the `:get' function), if any,
+ (as obtained using the `:get' function), if any,

 or the value in the symbol's `saved-value' property if any,
 or the value in the symbol's `saved-value' property if any,

-or (last of all) VALUE."
-  (funcall (or (get symbol 'custom-set) 'set-default)
+or (last of all) the value of EXP."
+  (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)

            symbol
            symbol

-           (cond ((default-boundp symbol)
-                  (funcall (or (get symbol 'custom-get) 'default-value)
-                           symbol))
-                 ((get symbol 'saved-value)
-                  (eval (car (get symbol 'saved-value))))
-                 (t
-                  (eval value)))))
-
-(defun custom-initialize-changed (symbol value)
-  "Initialize SYMBOL with VALUE.
+           (condition-case nil
+               (let ((def (default-toplevel-value symbol))
+                     (getter (get symbol 'custom-get)))
+                 (if getter (funcall getter symbol) def))
+             (error
+              (eval (let ((sv (get symbol 'saved-value)))
+                      (if sv (car sv) exp)))))))
+
+(defun custom-initialize-changed (symbol exp)
+  "Initialize SYMBOL with EXP.

 Like `custom-initialize-reset', but only use the `:set' function if
 not using the standard setting.
 For the standard setting, use `set-default'."
 Like `custom-initialize-reset', but only use the `:set' function if
 not using the standard setting.
 For the standard setting, use `set-default'."

-  (cond ((default-boundp symbol)
-        (funcall (or (get symbol 'custom-set) 'set-default)
-                 symbol
-                 (funcall (or (get symbol 'custom-get) 'default-value)
-                          symbol)))
-       ((get symbol 'saved-value)
-        (funcall (or (get symbol 'custom-set) 'set-default)
-                 symbol
-                 (eval (car (get symbol 'saved-value)))))
-       (t
-        (set-default symbol (eval value)))))
+  (condition-case nil
+      (let ((def (default-toplevel-value symbol)))
+        (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
+                 symbol
+                 (let ((getter (get symbol 'custom-get)))
+                   (if getter (funcall getter symbol) def))))
+    (error
+     (cond
+      ((get symbol 'saved-value)
+       (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
+                symbol
+                (eval (car (get symbol 'saved-value)))))
+      (t
+       (set-default symbol (eval exp)))))))

 
 (defvar custom-delayed-init-variables nil
   "List of variables whose initialization is pending.")
 
 (defvar custom-delayed-init-variables nil
   "List of variables whose initialization is pending.")


@@ -229,9 +232,10 @@ The following keywords are meaningful:
        given in the `defcustom' call.  The default is
        `custom-initialize-reset'.
 :set   VALUE should be a function to set the value of the symbol
        given in the `defcustom' call.  The default is
        `custom-initialize-reset'.
 :set   VALUE should be a function to set the value of the symbol

-        when using the Customize user interface.
-       It takes two arguments, the symbol to set and the value to
-       give it.  The default choice of function is `set-default'.
+       when using the Customize user interface.  It takes two arguments,
+       the symbol to set and the value to give it.  The function should
+       not modify its value argument destructively.  The default choice
+       of function is `set-default'.

 :get   VALUE should be a function to extract the value of symbol.
        The function takes one argument, a symbol, and should return
        the current value for that symbol.  The default choice of function
 :get   VALUE should be a function to extract the value of symbol.
        The function takes one argument, a symbol, and should return
        the current value for that symbol.  The default choice of function


@@ -319,7 +323,7 @@ If SYMBOL has a local binding, then this form affects the local
 binding.  This is normally not what you want.  Thus, if you need
 to load a file defining variables with this form, or with
 `defvar' or `defconst', you should always load that file
 binding.  This is normally not what you want.  Thus, if you need
 to load a file defining variables with this form, or with
 `defvar' or `defconst', you should always load that file

-_outside_ any bindings for these variables.  \(`defvar' and
+_outside_ any bindings for these variables.  (`defvar' and

 `defconst' behave similarly in this respect.)
 
 See Info node `(elisp) Customization' in the Emacs Lisp manual
 `defconst' behave similarly in this respect.)
 
 See Info node `(elisp) Customization' in the Emacs Lisp manual


@@ -351,7 +355,7 @@ FACE does not need to be quoted.
 
 Third argument DOC is the face documentation.
 
 
 Third argument DOC is the face documentation.
 

-If FACE has been set with `custom-set-faces', set the face
+If FACE has been set with `custom-theme-set-faces', set the face

 attributes as specified by that function, otherwise set the face
 attributes according to SPEC.
 
 attributes as specified by that function, otherwise set the face
 attributes according to SPEC.
 


@@ -359,7 +363,7 @@ The remaining arguments should have the form [KEYWORD VALUE]...
 For a list of valid keywords, see the common keywords listed in
 `defcustom'.
 
 For a list of valid keywords, see the common keywords listed in
 `defcustom'.
 

-SPEC should be an alist of the form
+SPEC should be a \"face spec\", i.e., an alist of the form

 
    ((DISPLAY . ATTS)...)
 
 
    ((DISPLAY . ATTS)...)
 


@@ -541,8 +545,8 @@ Fourth argument TYPE is the custom option type."
 (defun custom-add-dependencies (symbol value)
   "To the custom option SYMBOL, add dependencies specified by VALUE.
 VALUE should be a list of symbols.  For each symbol in that list,
 (defun custom-add-dependencies (symbol value)
   "To the custom option SYMBOL, add dependencies specified by VALUE.
 VALUE should be a list of symbols.  For each symbol in that list,

-this specifies that SYMBOL should be set after the specified symbol, if
-both appear in constructs like `custom-set-variables'."
+this specifies that SYMBOL should be set after the specified symbol,
+if both appear in constructs like `custom-set-variables'."

   (unless (listp value)
     (error "Invalid custom dependency `%s'" value))
   (let* ((deps (get symbol 'custom-dependencies))
   (unless (listp value)
     (error "Invalid custom dependency `%s'" value))
   (let* ((deps (get symbol 'custom-dependencies))


@@ -647,7 +651,7 @@ The result is that the change is treated as having been made through Custom."
                     (found nil))
                 (dolist (loaded load-history)
                   (and (stringp (car loaded))
                     (found nil))
                 (dolist (loaded load-history)
                   (and (stringp (car loaded))

-                       (string-match regexp (car loaded))
+                       (string-match-p regexp (car loaded))

                        (setq found t)))
                 found))
              ;; Without this, we would load cus-edit recursively.
                        (setq found t)))
                 found))
              ;; Without this, we would load cus-edit recursively.


@@ -867,20 +871,21 @@ See `custom-known-themes' for a list of known themes."
        (setcar (cdr setting) value)))
      ;; Add a new setting:
      (t
        (setcar (cdr setting) value)))
      ;; Add a new setting:
      (t

-      (unless old
-       ;; If the user changed a variable outside of Customize, save
-       ;; the value to a fake theme, `changed'.  If the theme is
-       ;; later disabled, we use this to bring back the old value.
-       ;;
-       ;; For faces, we just use `face-new-frame-defaults' to
-       ;; recompute when the theme is disabled.
-       (when (and (eq prop 'theme-value)
-                  (boundp symbol))
-         (let ((sv  (get symbol 'standard-value))
-               (val (symbol-value symbol)))
-           (unless (and sv (equal (eval (car sv)) val))
-             (setq old `((changed ,(custom-quote val))))))))
-      (put symbol prop (cons (list theme value) old))
+      (unless custom--inhibit-theme-enable
+       (unless old
+         ;; If the user changed a variable outside of Customize, save
+         ;; the value to a fake theme, `changed'.  If the theme is
+         ;; later disabled, we use this to bring back the old value.
+         ;;
+         ;; For faces, we just use `face-new-frame-defaults' to
+         ;; recompute when the theme is disabled.
+         (when (and (eq prop 'theme-value)
+                    (boundp symbol))
+           (let ((sv  (get symbol 'standard-value))
+                 (val (symbol-value symbol)))
+             (unless (and sv (equal (eval (car sv)) val))
+               (setq old `((changed ,(custom-quote val))))))))
+       (put symbol prop (cons (list theme value) old)))

       (put theme 'theme-settings
           (cons (list prop symbol theme value) theme-settings))))))
 
       (put theme 'theme-settings
           (cons (list prop symbol theme value) theme-settings))))))
 


@@ -937,7 +942,7 @@ SYMBOL is the variable name, and EXP is an expression which
 evaluates to the customized value.  EXP will also be stored,
 without evaluating it, in SYMBOL's `saved-value' property, so
 that it can be restored via the Customize interface.  It is also
 evaluates to the customized value.  EXP will also be stored,
 without evaluating it, in SYMBOL's `saved-value' property, so
 that it can be restored via the Customize interface.  It is also

-added to the alist in SYMBOL's `theme-value' property \(by
+added to the alist in SYMBOL's `theme-value' property (by

 calling `custom-push-theme').
 
 NOW, if present and non-nil, means to install the variable's
 calling `custom-push-theme').
 
 NOW, if present and non-nil, means to install the variable's


@@ -1274,7 +1279,14 @@ NAME should be a symbol."
                (eq name 'changed)))))
 
 (defun custom-available-themes ()
                (eq name 'changed)))))
 
 (defun custom-available-themes ()

-  "Return a list of available Custom themes (symbols)."
+  "Return a list of Custom themes available for loading.
+Search the directories specified by `custom-theme-load-path' for
+files named FOO-theme.el, and return a list of FOO symbols.
+
+The returned symbols may not correspond to themes that have been
+loaded, and no effort is made to check that the files contain
+valid Custom themes.  For a list of loaded themes, check the
+variable `custom-known-themes'."

   (let (sym themes)
     (dolist (dir (custom-theme--load-path))
       (when (file-directory-p dir)
   (let (sym themes)
     (dolist (dir (custom-theme--load-path))
       (when (file-directory-p dir)


@@ -1413,6 +1425,10 @@ See `custom-enabled-themes' for a list of enabled themes."
       (setq custom-enabled-themes
            (delq theme custom-enabled-themes)))))
 
       (setq custom-enabled-themes
            (delq theme custom-enabled-themes)))))
 

+;; Only used if window-system not null.
+(declare-function x-get-resource "frame.c"
+                 (attribute class &optional component subclass))
+

 (defun custom--frame-color-default (frame attribute resource-attr resource-class
                                          tty-default x-default)
   (let ((col (face-attribute 'default attribute t)))
 (defun custom--frame-color-default (frame attribute resource-attr resource-class
                                          tty-default x-default)
   (let ((col (face-attribute 'default attribute t)))


@@ -1445,12 +1461,15 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
                 (eval (car valspec))))))
 
 (defun custom-theme-recalc-face (face)
                 (eval (car valspec))))))
 
 (defun custom-theme-recalc-face (face)

-  "Set FACE according to currently enabled custom themes."
+  "Set FACE according to currently enabled custom themes.
+If FACE is not initialized as a face, do nothing; otherwise call
+`face-spec-recalc' to recalculate the face on all frames."

   (if (get face 'face-alias)
       (setq face (get face 'face-alias)))
   (if (get face 'face-alias)
       (setq face (get face 'face-alias)))

-  ;; Reset the faces for each frame.
-  (dolist (frame (frame-list))
-    (face-spec-recalc face frame)))
+  (if (facep face)
+      ;; Reset the faces for each frame.
+      (dolist (frame (frame-list))
+       (face-spec-recalc face frame))))

 
 \f
 ;;; XEmacs compatibility functions
 
 \f
 ;;; XEmacs compatibility functions


@@ -1483,11 +1502,6 @@ This means reset VARIABLE.  (The argument IGNORED is ignored)."
 
 ;;; The End.
 
 
 ;;; The End.
 

-;; Process the defcustoms for variables loaded before this file.
-(while custom-declare-variable-list
-  (apply 'custom-declare-variable (car custom-declare-variable-list))
-  (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
-

 (provide 'custom)
 
 ;;; custom.el ends here
 (provide 'custom)
 
 ;;; custom.el ends here