Commit b16f0801 authored by Basil L. Contovounesios's avatar Basil L. Contovounesios Committed by Stefan Monnier

Minor custom.el simplifications

* lisp/custom.el (custom-quote): Duplicate macroexp-quote.
(custom-load-symbol, customize-mark-to-save, customize-mark-as-set)
(custom-theme-name-valid-p, enable-theme, custom-enabled-themes)
(disable-theme): Simplify logic.
parent feb6863e
...@@ -630,14 +630,12 @@ The result is that the change is treated as having been made through Custom." ...@@ -630,14 +630,12 @@ The result is that the change is treated as having been made through Custom."
(let ((custom-load-recursion t)) (let ((custom-load-recursion t))
;; Load these files if not already done, ;; Load these files if not already done,
;; to make sure we know all the dependencies of SYMBOL. ;; to make sure we know all the dependencies of SYMBOL.
(condition-case nil (ignore-errors
(require 'cus-load) (require 'cus-load))
(error nil)) (ignore-errors
(condition-case nil (require 'cus-start))
(require 'cus-start)
(error nil))
(dolist (load (get symbol 'custom-loads)) (dolist (load (get symbol 'custom-loads))
(cond ((symbolp load) (condition-case nil (require load) (error nil))) (cond ((symbolp load) (ignore-errors (require load)))
;; This is subsumed by the test below, but it's much faster. ;; This is subsumed by the test below, but it's much faster.
((assoc load load-history)) ((assoc load load-history))
;; This was just (assoc (locate-library load) load-history) ;; This was just (assoc (locate-library load) load-history)
...@@ -655,7 +653,7 @@ The result is that the change is treated as having been made through Custom." ...@@ -655,7 +653,7 @@ The result is that the change is treated as having been made through Custom."
;; We are still loading it when we call this, ;; We are still loading it when we call this,
;; and it is not in load-history yet. ;; and it is not in load-history yet.
((equal load "cus-edit")) ((equal load "cus-edit"))
(t (condition-case nil (load load) (error nil)))))))) (t (ignore-errors (load load))))))))
(defvar custom-local-buffer nil (defvar custom-local-buffer nil
"Non-nil, in a Customization buffer, means customize a specific buffer. "Non-nil, in a Customization buffer, means customize a specific buffer.
...@@ -688,16 +686,12 @@ this sets the local binding in that buffer instead." ...@@ -688,16 +686,12 @@ this sets the local binding in that buffer instead."
(defun custom-quote (sexp) (defun custom-quote (sexp)
"Quote SEXP if it is not self quoting." "Quote SEXP if it is not self quoting."
(if (or (memq sexp '(t nil)) ;; Can't use `macroexp-quote' because it is loaded after `custom.el'
(keywordp sexp) ;; during bootstrap. See `loadup.el'.
(and (listp sexp) (if (and (not (consp sexp))
(memq (car sexp) '(lambda))) (or (keywordp sexp)
(stringp sexp) (not (symbolp sexp))
(numberp sexp) (booleanp sexp)))
(vectorp sexp)
;;; (and (fboundp 'characterp)
;;; (characterp sexp))
)
sexp sexp
(list 'quote sexp))) (list 'quote sexp)))
...@@ -718,12 +712,10 @@ Return non-nil if the `saved-value' property actually changed." ...@@ -718,12 +712,10 @@ Return non-nil if the `saved-value' property actually changed."
(standard (get symbol 'standard-value)) (standard (get symbol 'standard-value))
(comment (get symbol 'customized-variable-comment))) (comment (get symbol 'customized-variable-comment)))
;; Save default value if different from standard value. ;; Save default value if different from standard value.
(if (or (null standard) (put symbol 'saved-value
(not (equal value (condition-case nil (unless (and standard
(eval (car standard)) (equal value (ignore-errors (eval (car standard)))))
(error nil))))) (list (custom-quote value))))
(put symbol 'saved-value (list (custom-quote value)))
(put symbol 'saved-value nil))
;; Clear customized information (set, but not saved). ;; Clear customized information (set, but not saved).
(put symbol 'customized-value nil) (put symbol 'customized-value nil)
;; Save any comment that might have been set. ;; Save any comment that might have been set.
...@@ -747,9 +739,8 @@ Return non-nil if the `customized-value' property actually changed." ...@@ -747,9 +739,8 @@ Return non-nil if the `customized-value' property actually changed."
(old (or (get symbol 'saved-value) (get symbol 'standard-value)))) (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
;; Mark default value as set if different from old value. ;; Mark default value as set if different from old value.
(if (not (and old (if (not (and old
(equal value (condition-case nil (equal value (ignore-errors
(eval (car old)) (eval (car old))))))
(error nil)))))
(progn (put symbol 'customized-value (list (custom-quote value))) (progn (put symbol 'customized-value (list (custom-quote value)))
(custom-push-theme 'theme-value symbol 'user 'set (custom-push-theme 'theme-value symbol 'user 'set
(custom-quote value))) (custom-quote value)))
...@@ -1296,11 +1287,9 @@ query also about adding HASH to `custom-safe-themes'." ...@@ -1296,11 +1287,9 @@ query also about adding HASH to `custom-safe-themes'."
(defun custom-theme-name-valid-p (name) (defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise. "Return t if NAME is a valid name for a Custom theme, nil otherwise.
NAME should be a symbol." NAME should be a symbol."
(and (symbolp name) (and (not (memq name '(nil user changed)))
name (symbolp name)
(not (or (zerop (length (symbol-name name))) (not (string= "" (symbol-name name)))))
(eq name 'user)
(eq name 'changed)))))
(defun custom-available-themes () (defun custom-available-themes ()
"Return a list of Custom themes available for loading. "Return a list of Custom themes available for loading.
...@@ -1356,8 +1345,8 @@ function runs. To disable other themes, use `disable-theme'." ...@@ -1356,8 +1345,8 @@ function runs. To disable other themes, use `disable-theme'."
(completing-read (completing-read
"Enable custom theme: " "Enable custom theme: "
obarray (lambda (sym) (get sym 'theme-settings)) t)))) obarray (lambda (sym) (get sym 'theme-settings)) t))))
(if (not (custom-theme-p theme)) (unless (custom-theme-p theme)
(error "Undefined Custom theme %s" theme)) (error "Undefined Custom theme %s" theme))
(let ((settings (get theme 'theme-settings))) (let ((settings (get theme 'theme-settings)))
;; Loop through theme settings, recalculating vars/faces. ;; Loop through theme settings, recalculating vars/faces.
(dolist (s settings) (dolist (s settings)
...@@ -1397,18 +1386,18 @@ Setting this variable through Customize calls `enable-theme' or ...@@ -1397,18 +1386,18 @@ Setting this variable through Customize calls `enable-theme' or
(let (failures) (let (failures)
(setq themes (delq 'user (delete-dups themes))) (setq themes (delq 'user (delete-dups themes)))
;; Disable all themes not in THEMES. ;; Disable all themes not in THEMES.
(if (boundp symbol) (dolist (theme (and (boundp symbol)
(dolist (theme (symbol-value symbol)) (symbol-value symbol)))
(if (not (memq theme themes)) (unless (memq theme themes)
(disable-theme theme)))) (disable-theme theme)))
;; Call `enable-theme' or `load-theme' on each of THEMES. ;; Call `enable-theme' or `load-theme' on each of THEMES.
(dolist (theme (reverse themes)) (dolist (theme (reverse themes))
(condition-case nil (condition-case nil
(if (custom-theme-p theme) (if (custom-theme-p theme)
(enable-theme theme) (enable-theme theme)
(load-theme theme)) (load-theme theme))
(error (setq failures (cons theme failures) (error (push theme failures)
themes (delq theme themes))))) (setq themes (delq theme themes)))))
(enable-theme 'user) (enable-theme 'user)
(custom-set-default symbol themes) (custom-set-default symbol themes)
(when failures (when failures
...@@ -1441,23 +1430,23 @@ See `custom-enabled-themes' for a list of enabled themes." ...@@ -1441,23 +1430,23 @@ See `custom-enabled-themes' for a list of enabled themes."
;; If the face spec specified by this theme is in the ;; If the face spec specified by this theme is in the
;; saved-face property, reset that property. ;; saved-face property, reset that property.
(when (equal (nth 3 s) (get symbol 'saved-face)) (when (equal (nth 3 s) (get symbol 'saved-face))
(put symbol 'saved-face (and val (cadr (car val))))))))) (put symbol 'saved-face (cadar val))))))))
;; Recompute faces on all frames. ;; Recompute faces on all frames.
(dolist (frame (frame-list)) (dolist (frame (frame-list))
;; We must reset the fg and bg color frame parameters, or ;; We must reset the fg and bg color frame parameters, or
;; `face-set-after-frame-default' will use the existing ;; `face-set-after-frame-default' will use the existing
;; parameters, which could be from the disabled theme. ;; parameters, which could be from the disabled theme.
(set-frame-parameter frame 'background-color (set-frame-parameter frame 'background-color
(custom--frame-color-default (custom--frame-color-default
frame :background "background" "Background" frame :background "background" "Background"
"unspecified-bg" "white")) "unspecified-bg" "white"))
(set-frame-parameter frame 'foreground-color (set-frame-parameter frame 'foreground-color
(custom--frame-color-default (custom--frame-color-default
frame :foreground "foreground" "Foreground" frame :foreground "foreground" "Foreground"
"unspecified-fg" "black")) "unspecified-fg" "black"))
(face-set-after-frame-default frame)) (face-set-after-frame-default frame))
(setq custom-enabled-themes (setq custom-enabled-themes
(delq theme custom-enabled-themes))))) (delq theme custom-enabled-themes))))
;; Only used if window-system not null. ;; Only used if window-system not null.
(declare-function x-get-resource "frame.c" (declare-function x-get-resource "frame.c"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment