]> code.delx.au - gnu-emacs/blobdiff - lisp/custom.el
Improve Edebug error for attempting to instrument built-in functions.
[gnu-emacs] / lisp / custom.el
index cf06fe27f4deb949fd01abdf33beee420e3e6bd4..4f69c7414684cd0dcebf0bd7002a8e5904486f92 100644 (file)
@@ -55,11 +55,9 @@ 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
 symbol."
-  (unless (default-boundp symbol)
-    ;; Use the saved value if it exists, otherwise the standard setting.
-    (set-default symbol (eval (if (get symbol 'saved-value)
-                                  (car (get symbol 'saved-value))
-                                value)))))
+  (eval `(defvar ,symbol ,(if (get symbol 'saved-value)
+                              (car (get symbol 'saved-value))
+                            value))))
 
 (defun custom-initialize-set (symbol value)
   "Initialize SYMBOL based on VALUE.
@@ -81,15 +79,15 @@ The value is either the symbol's current value
  \(as obtained using the `:get' function), 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)
-            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)))))
+  (funcall (or (get symbol 'custom-set) 'set-default)
+           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.
@@ -111,7 +109,7 @@ For the standard setting, use `set-default'."
 (defvar custom-delayed-init-variables nil
   "List of variables whose initialization is pending.")
 
-(defun custom-initialize-delay (symbol value)
+(defun custom-initialize-delay (symbol _value)
   "Delay initialization of SYMBOL to the next Emacs start.
 This is used in files that are preloaded (or for autoloaded
 variables), so that the initialization is done in the run-time
@@ -122,8 +120,10 @@ the :set function.
 For variables in preloaded files, you can simply use this
 function for the :initialize property.  For autoloaded variables,
 you will also need to add an autoload stanza calling this
-function, and another one setting the standard-value property.
-See `send-mail-function' in sendmail.el for an example."
+function, and another one setting the standard-value property."
+  ;; No longer true:
+  ;; "See `send-mail-function' in sendmail.el for an example."
+
   ;; Until the var is actually initialized, it is kept unbound.
   ;; This seemed to be at least as good as setting it to an arbitrary
   ;; value like nil (evaluating `value' is not an option because it
@@ -142,10 +142,8 @@ set to nil, as the value is no longer rogue."
   ;; Maybe this option was rogue in an earlier version.  It no longer is.
   (when (get symbol 'force-value)
     (put symbol 'force-value nil))
-  (when doc
-    (if (keywordp doc)
-       (error "Doc string is missing")
-      (put symbol 'variable-documentation doc)))
+  (if (keywordp doc)
+      (error "Doc string is missing"))
   (let ((initialize 'custom-initialize-reset)
        (requests nil))
     (unless (memq :group args)
@@ -189,6 +187,13 @@ set to nil, as the value is no longer rogue."
     ;; Do the actual initialization.
     (unless custom-dont-initialize
       (funcall initialize symbol default)))
+  ;; Use defvar to set the docstring as well as the special-variable-p flag.
+  ;; FIXME: We should reproduce more of `defvar's behavior, such as the warning
+  ;; when the var is currently let-bound.
+  (if (not (default-boundp symbol))
+      ;; Don't use defvar to avoid setting a default-value when undesired.
+      (when doc (put symbol 'variable-documentation doc))
+    (eval `(defvar ,symbol nil ,@(when doc (list doc)))))
   (push symbol current-load-list)
   (run-hooks 'custom-define-hook)
   symbol)
@@ -212,7 +217,8 @@ The following keywords are meaningful:
        variable.  It takes two arguments, the symbol and value
        given in the `defcustom' call.  The default is
        `custom-initialize-reset'.
-:set   VALUE should be a function to set the value of the symbol.
+: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'.
 :get   VALUE should be a function to extract the value of symbol.
@@ -310,11 +316,19 @@ for more information."
   ;; It is better not to use backquote in this file,
   ;; because that makes a bootstrapping problem
   ;; if you need to recompile all the Lisp files using interpreted code.
-  (nconc (list 'custom-declare-variable
-              (list 'quote symbol)
-              (list 'quote value)
-              doc)
-        args))
+  `(custom-declare-variable
+    ',symbol
+    ,(if lexical-binding    ;FIXME: This is not reliable, but is all we have.
+         ;; The `default' arg should be an expression that evaluates to
+         ;; the value to use.  The use of `eval' for it is spread over
+         ;; many different places and hence difficult to eliminate, yet
+         ;; we want to make sure that the `value' expression is checked by the
+         ;; byte-compiler, and that lexical-binding is obeyed, so quote the
+         ;; expression with `lambda' rather than with `quote'.
+         `(list (lambda () ,value))
+       `',value)
+    ,doc
+    ,@args))
 
 ;;; The `defface' Macro.
 
@@ -843,25 +857,18 @@ See `custom-known-themes' for a list of known themes."
      ;; Add a new setting:
      (t
       (unless old
-       ;; If the user changed the value outside of Customize, we
-       ;; first save the current value to a fake theme, `changed'.
-       ;; This ensures that the user-set value comes back if the
-       ;; theme is later disabled.
-       (cond ((and (eq prop 'theme-value)
-                   (boundp symbol))
-              (let ((sv (get symbol 'standard-value)))
-                (unless (and sv
-                             (equal (eval (car sv)) (symbol-value symbol)))
-                  (setq old (list (list 'changed (symbol-value symbol)))))))
-             ((and (facep symbol)
-                   (not (face-attr-match-p
-                         symbol
-                         (custom-fix-face-spec
-                          (face-spec-choose
-                           (get symbol 'face-defface-spec))))))
-              (setq old `((changed
-                           (,(append '(t) (custom-face-attributes-get
-                                           symbol nil)))))))))
+       ;; 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))))))
@@ -1081,10 +1088,10 @@ name."
   :version "24.1")
 
 (defvar custom--inhibit-theme-enable nil
-  "If non-nil, loading a theme does not enable it.
-This internal variable is set by `load-theme' when its NO-ENABLE
-argument is non-nil, and it affects `custom-theme-set-variables',
-`custom-theme-set-faces', and `provide-theme'." )
+  "Whether the custom-theme-set-* functions act immediately.
+If nil, `custom-theme-set-variables' and `custom-theme-set-faces'
+change the current values of the given variable or face.  If
+non-nil, they just make a record of the theme settings.")
 
 (defun provide-theme (theme)
   "Indicate that this file provides THEME.
@@ -1094,15 +1101,7 @@ property `theme-feature' (which is usually a symbol created by
   (unless (custom-theme-name-valid-p theme)
     (error "Custom theme cannot be named %S" theme))
   (custom-check-theme theme)
-  (provide (get theme 'theme-feature))
-  (unless custom--inhibit-theme-enable
-    ;; By default, loading a theme also enables it.
-    (push theme custom-enabled-themes)
-    ;; `user' must always be the highest-precedence enabled theme.
-    ;; Make that remain true.  (This has the effect of making user
-    ;; settings override the ones just loaded, too.)
-    (let ((custom-enabling-themes t))
-      (enable-theme 'user))))
+  (provide (get theme 'theme-feature)))
 
 (defcustom custom-safe-themes '(default)
   "List of themes that are considered safe to load.
@@ -1116,20 +1115,29 @@ Emacs theme directory (a directory named \"themes\" in
   :risky t
   :version "24.1")
 
-(defun load-theme (theme &optional no-enable)
+(defun load-theme (theme &optional no-confirm no-enable)
   "Load Custom theme named THEME from its file.
-Normally, this also enables THEME.  If optional arg NO-ENABLE is
-non-nil, load THEME but don't enable it.
-
 The theme file is named THEME-theme.el, in one of the directories
 specified by `custom-theme-load-path'.
 
+If THEME is not in `custom-safe-themes', prompt the user for
+confirmation, unless optional arg NO-CONFIRM is non-nil.
+
+Normally, this function also enables THEME; if optional arg
+NO-ENABLE is non-nil, load the theme but don't enable it.
+
+This function is normally called through Customize when setting
+`custom-enabled-themes'.  If used directly in your init file, it
+should be called with a non-nil NO-CONFIRM argument, or after
+`custom-safe-themes' has been loaded.
+
 Return t if THEME was successfully loaded, nil otherwise."
   (interactive
    (list
     (intern (completing-read "Load custom theme: "
                             (mapcar 'symbol-name
-                                    (custom-available-themes))))))
+                                    (custom-available-themes))))
+    nil nil))
   (unless (custom-theme-name-valid-p theme)
     (error "Invalid theme name `%s'" theme))
   ;; If reloading, clear out the old theme settings.
@@ -1149,14 +1157,31 @@ Return t if THEME was successfully loaded, nil otherwise."
       (setq hash (sha1 (current-buffer)))
       ;; Check file safety with `custom-safe-themes', prompting the
       ;; user if necessary.
-      (when (or (and (memq 'default custom-safe-themes)
+      (when (or no-confirm
+               (and (memq 'default custom-safe-themes)
                     (equal (file-name-directory fn)
                            (expand-file-name "themes/" data-directory)))
                (member hash custom-safe-themes)
                (custom-theme-load-confirm hash))
-       (let ((custom--inhibit-theme-enable no-enable))
-         (eval-buffer)
-         t)))))
+       (let ((custom--inhibit-theme-enable t))
+         (eval-buffer))
+       ;; Optimization: if the theme changes the `default' face, put that
+       ;; entry first.  This avoids some `frame-set-background-mode' rigmarole
+       ;; by assigning the new background immediately.
+       (let* ((settings (get theme 'theme-settings))
+              (tail settings)
+              found)
+         (while (and tail (not found))
+           (and (eq (nth 0 (car tail)) 'theme-face)
+                (eq (nth 1 (car tail)) 'default)
+                (setq found (car tail)))
+           (setq tail (cdr tail)))
+         (if found
+             (put theme 'theme-settings (cons found (delq found settings)))))
+       ;; Finally, enable the theme.
+       (unless no-enable
+         (enable-theme theme))
+       t))))
 
 (defun custom-theme-load-confirm (hash)
   "Query the user about loading a Custom theme that may not be safe.
@@ -1192,10 +1217,7 @@ query also about adding HASH to `custom-safe-themes'."
          ;; Offer to save to `custom-safe-themes'.
          (and (or custom-file user-init-file)
               (y-or-n-p "Treat this theme as safe in future sessions? ")
-              (let ((coding-system-for-read nil))
-                (push hash custom-safe-themes)
-                (customize-save-variable 'custom-safe-themes
-                                         custom-safe-themes)))
+              (customize-push-and-save 'custom-safe-themes (list hash)))
          t)))))
 
 (defun custom-theme-name-valid-p (name)
@@ -1235,68 +1257,73 @@ NAME should be a symbol."
 \f
 ;;; Enabling and disabling loaded themes.
 
-(defvar custom-enabling-themes nil)
-
 (defun enable-theme (theme)
   "Reenable all variable and face settings defined by THEME.
-The newly enabled theme gets the highest precedence (after `user').
-If it is already enabled, just give it highest precedence (after `user').
-
-If THEME does not specify any theme settings, this tries to load
-the theme from its theme file, by calling `load-theme'."
+THEME should be either `user', or a theme loaded via `load-theme'.
+After this function completes, THEME will have the highest
+precedence (after `user')."
   (interactive (list (intern
                      (completing-read
                       "Enable custom theme: "
-                      obarray (lambda (sym) (get sym 'theme-settings))))))
+                      obarray (lambda (sym) (get sym 'theme-settings)) t))))
   (if (not (custom-theme-p theme))
-      (load-theme theme)
-    ;; This could use a bit of optimization -- cyd
-    (let ((settings (get theme 'theme-settings)))
-      (dolist (s settings)
-       (let* ((prop (car s))
-              (symbol (cadr s))
-              (spec-list (get symbol prop)))
-         (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
-         (if (eq prop 'theme-value)
-             (custom-theme-recalc-variable symbol)
-           (custom-theme-recalc-face symbol)))))
-    (unless (eq theme 'user)
-      (setq custom-enabled-themes
-           (cons theme (delq theme custom-enabled-themes)))
-      (unless custom-enabling-themes
-       (enable-theme 'user)))))
+      (error "Undefined Custom theme %s" theme))
+  (let ((settings (get theme 'theme-settings)))
+    ;; Loop through theme settings, recalculating vars/faces.
+    (dolist (s settings)
+      (let* ((prop (car s))
+            (symbol (cadr s))
+            (spec-list (get symbol prop)))
+       (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
+       (cond
+        ((eq prop 'theme-face)
+         (custom-theme-recalc-face symbol))
+        ((eq prop 'theme-value)
+         ;; Don't change `custom-enabled-themes'; that's special.
+         (unless (eq symbol 'custom-enabled-themes)
+           (custom-theme-recalc-variable symbol)))))))
+  (unless (eq theme 'user)
+    (setq custom-enabled-themes
+         (cons theme (delq theme custom-enabled-themes)))
+    ;; Give the `user' theme the highest priority.
+    (enable-theme 'user)))
 
 (defcustom custom-enabled-themes nil
   "List of enabled Custom Themes, highest precedence first.
+This list does not include the `user' theme, which is set by
+Customize and always takes precedence over other Custom Themes.
+
+This variable cannot be defined inside a Custom theme; there, it
+is simply ignored.
 
-This does not include the `user' theme, which is set by Customize,
-and always takes precedence over other Custom Themes."
+Setting this variable through Customize calls `enable-theme' or
+`load-theme' for each theme in the list."
   :group 'customize
   :type  '(repeat symbol)
   :set-after '(custom-theme-directory custom-theme-load-path
                                      custom-safe-themes)
   :risky t
   :set (lambda (symbol themes)
-        ;; Avoid an infinite loop when custom-enabled-themes is
-        ;; defined in a theme (e.g. `user').  Enabling the theme sets
-        ;; custom-enabled-themes, which enables the theme...
-        (unless custom-enabling-themes
-          (let ((custom-enabling-themes t) failures)
-            (setq themes (delq 'user (delete-dups themes)))
-            (if (boundp symbol)
-                (dolist (theme (symbol-value symbol))
-                  (if (not (memq theme themes))
-                      (disable-theme theme))))
-            (dolist (theme (reverse themes))
-              (condition-case nil
-                  (enable-theme theme)
-                (error (progn (push theme failures)
-                              (setq themes (delq theme themes))))))
-            (enable-theme 'user)
-            (custom-set-default symbol themes)
-            (if failures
-                (message "Failed to enable themes: %s"
-                         (mapconcat 'symbol-name failures " ")))))))
+        (let (failures)
+          (setq themes (delq 'user (delete-dups themes)))
+          ;; Disable all themes not in THEMES.
+          (if (boundp symbol)
+              (dolist (theme (symbol-value symbol))
+                (if (not (memq theme themes))
+                    (disable-theme theme))))
+          ;; Call `enable-theme' or `load-theme' on each of THEMES.
+          (dolist (theme (reverse themes))
+            (condition-case nil
+                (if (custom-theme-p theme)
+                    (enable-theme theme)
+                  (load-theme theme))
+              (error (setq failures (cons theme failures)
+                           themes (delq theme themes)))))
+          (enable-theme 'user)
+          (custom-set-default symbol themes)
+          (if failures
+              (message "Failed to enable theme: %s"
+                       (mapconcat 'symbol-name failures ", "))))))
 
 (defsubst custom-theme-enabled-p (theme)
   "Return non-nil if THEME is enabled."
@@ -1324,11 +1351,33 @@ See `custom-enabled-themes' for a list of enabled themes."
            ;; If the face spec specified by this theme is in the
            ;; saved-face property, reset that property.
            (when (equal (nth 3 s) (get symbol 'saved-face))
-             (put symbol 'saved-face (and val (cadr (car val)))))
-           (custom-theme-recalc-face symbol)))))
+             (put symbol 'saved-face (and val (cadr (car val)))))))))
+      ;; Recompute faces on all frames.
+      (dolist (frame (frame-list))
+       ;; We must reset the fg and bg color frame parameters, or
+       ;; `face-set-after-frame-default' will use the existing
+       ;; parameters, which could be from the disabled theme.
+       (set-frame-parameter frame 'background-color
+                            (custom--frame-color-default
+                             frame :background "background" "Background"
+                             "unspecified-bg" "white"))
+       (set-frame-parameter frame 'foreground-color
+                            (custom--frame-color-default
+                             frame :foreground "foreground" "Foreground"
+                             "unspecified-fg" "black"))
+       (face-set-after-frame-default frame))
       (setq custom-enabled-themes
            (delq theme custom-enabled-themes)))))
 
+(defun custom--frame-color-default (frame attribute resource-attr resource-class
+                                         tty-default x-default)
+  (let ((col (face-attribute 'default attribute t)))
+    (cond
+     ((and col (not (eq col 'unspecified))) col)
+     ((null (window-system frame)) tty-default)
+     ((setq col (x-get-resource resource-attr resource-class)) col)
+     (t x-default))))
+
 (defun custom-variable-theme-value (variable)
   "Return (list VALUE) indicating the custom theme value of VARIABLE.
 That is to say, it specifies what the value should be according to
@@ -1360,7 +1409,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
     (face-spec-recalc face frame)))
 
 \f
-;;; XEmacs compability functions
+;;; XEmacs compatibility functions
 
 ;; In XEmacs, when you reset a Custom Theme, you have to specify the
 ;; theme to reset it to.  We just apply the next available theme, so