From d358aa106d66961f4750337f3a5b3048a44e4069 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Mon, 2 Jan 2006 15:11:14 +0000 Subject: * custom.el: Move Custom Themes commentary to start of theme code. (custom-known-themes): Rename `standard' theme to `changed'. (custom-push-theme): Caller no longer specifies what theme to use when doing `reset'---the setting is simply removed from the theme. Delete MODE from `theme-value' and `theme-settings' properties. (custom-declare-theme): Ignore &rest args since we don't use them. (custom-loaded-themes): Delete variable. (custom-theme-load-themes, custom-theme-loaded-p) (custom-theme-value): Delete functions. (custom-declare-theme): Signal error on invalid theme names. (provide-theme): custom-loaded-themes was deleted. (load-theme): Load the file unconditionally. (enable-theme): Call `load-theme' if theme is undefined. (custom-enabled-themes): Only update value for successful loads. (disable-theme): Complete from enabled themes when interactive. (custom-variable-theme-value): Calculate theme value directly. (custom-theme-reset-variables, custom-reset-variables): Mark as XEmacs compatibility functions. We don't actually use these. * cus-edit.el (custom-variable-state-set): Use custom-variable-theme-value instead of custom-theme-value. (custom-face-state-set): Rename `standard' theme to `changed'. (custom-save-variables, custom-save-faces): Delete unneeded references to custom-reset-variables. (custom-save-resets): Delete function. (custom-save-variables, custom-save-faces): MODE argument deleted. (custom-save-variables, custom-save-faces): Ignore theme values. * cus-face.el (custom-theme-reset-faces): Mark as XEmacs compatibility function. --- lisp/ChangeLog | 36 +++++ lisp/cus-edit.el | 67 +++------ lisp/cus-face.el | 9 +- lisp/custom.el | 413 +++++++++++++++++++++---------------------------------- 4 files changed, 217 insertions(+), 308 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1050d3deb8..8f01e68d61 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,39 @@ +2006-01-01 Chong Yidong + + * custom.el: Move Custom Themes commentary to start of theme code. + (custom-known-themes): Rename `standard' theme to `changed'. + (custom-push-theme): Caller no longer specifies what theme to use + when doing `reset'---the setting is simply removed from the theme. + Delete MODE from `theme-value' and `theme-settings' properties. + (custom-declare-theme): Ignore &rest args since we don't use them. + + (custom-loaded-themes): Delete variable. + (custom-theme-load-themes, custom-theme-loaded-p) + (custom-theme-value): Delete functions. + + (custom-declare-theme): Signal error on invalid theme names. + (provide-theme): custom-loaded-themes was deleted. + (load-theme): Load the file unconditionally. + (enable-theme): Call `load-theme' if theme is undefined. + (custom-enabled-themes): Only update value for successful loads. + (disable-theme): Complete from enabled themes when interactive. + (custom-variable-theme-value): Calculate theme value directly. + + (custom-theme-reset-variables, custom-reset-variables): Mark as + XEmacs compatibility functions. We don't actually use these. + + * cus-edit.el (custom-variable-state-set): Use + custom-variable-theme-value instead of custom-theme-value. + (custom-face-state-set): Rename `standard' theme to `changed'. + (custom-save-variables, custom-save-faces): Delete unneeded + references to custom-reset-variables. + (custom-save-resets): Delete function. + (custom-save-variables, custom-save-faces): MODE argument deleted. + (custom-save-variables, custom-save-faces): Ignore theme values. + + * cus-face.el (custom-theme-reset-faces): Mark as XEmacs + compatibility function. + 2006-01-01 Richard M. Stallman * cus-edit.el (Custom-set, Custom-save): Ask for confirmation. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4c92034eaa..5e9c98c725 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2578,15 +2578,13 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (if (condition-case nil (and (equal comment temp) (equal value - (eval (car - (custom-theme-value - (caar tmp) tmp))))) + (eval + (car (custom-variable-theme-value + symbol))))) (error nil)) (cond - ((eq 'user (caar (get symbol 'theme-value))) - 'saved) - ((eq 'standard (caar (get symbol 'theme-value))) - 'changed) + ((eq (caar tmp) 'user) 'saved) + ((eq (caar tmp) 'changed) 'changed) (t 'themed)) 'changed)) ((setq tmp (get symbol 'standard-value)) @@ -2772,7 +2770,7 @@ becomes the backup value, so you can get it again." (cond ((or value comment) (put symbol 'variable-comment comment) (custom-variable-backup-value widget) - (custom-push-theme 'theme-value symbol 'user 'set value) + (custom-push-theme 'theme-value symbol 'user 'set (car-safe value)) (condition-case nil (funcall set symbol (eval (car value))) (error nil))) @@ -2790,15 +2788,14 @@ This operation eliminates any saved setting for the variable, restoring it to the state of a variable that has never been customized. The value that was current before this operation becomes the backup value, so you can get it again." - (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) + (let* ((symbol (widget-value widget))) (if (get symbol 'standard-value) (custom-variable-backup-value widget) (error "No standard setting known for %S" symbol)) (put symbol 'variable-comment nil) (put symbol 'customized-value nil) (put symbol 'customized-variable-comment nil) - (custom-push-theme 'theme-value symbol 'user 'reset nil) + (custom-push-theme 'theme-value symbol 'user 'reset) (custom-theme-recalc-variable symbol) (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) (put symbol 'saved-value nil) @@ -3345,7 +3342,7 @@ widget. If FILTER is nil, ACTION is always valid.") (cond ((eq 'user (caar (get symbol 'theme-face))) 'saved) - ((eq 'standard (caar (get symbol 'theme-face))) + ((eq 'changed (caar (get symbol 'theme-face))) 'changed) (t 'themed)) 'changed)) @@ -3467,7 +3464,7 @@ restoring it to the state of a face that has never been customized." (error "No standard setting for this face")) (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) - (custom-push-theme 'theme-face symbol 'user 'reset nil) + (custom-push-theme 'theme-face symbol 'user 'reset) (custom-theme-recalc-face symbol) (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) @@ -4123,16 +4120,15 @@ This function does not save the buffer." (defun custom-save-variables () "Save all customized variables in `custom-file'." (save-excursion - (custom-save-delete 'custom-reset-variables) (custom-save-delete 'custom-set-variables) - (custom-save-resets 'theme-value 'custom-reset-variables nil) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) sort-fold-case) ;; First create a sorted list of saved variables. (mapatoms (lambda (symbol) - (if (get symbol 'saved-value) + (if (and (get symbol 'saved-value) + (eq 'user (car (car-safe (get symbol 'theme-value))))) (nconc saved-list (list symbol))))) (setq saved-list (sort (cdr saved-list) 'string<)) (unless (bolp) @@ -4156,9 +4152,7 @@ This function does not save the buffer." (when (and (symbolp request) (not (featurep request))) (message "Unknown requested feature: %s" request) (setq requests (delq request requests)))) - (when (or (and spec - (eq (nth 0 spec) 'user) - (eq (nth 1 spec) 'set)) + (when (or (and spec (eq (car spec) 'user)) comment (and (null spec) (get symbol 'saved-value))) (unless (bolp) @@ -4183,46 +4177,19 @@ This function does not save the buffer." (unless (looking-at "\n") (princ "\n"))))) -(defun custom-save-resets (property setter special) - (let (started-writing ignored-special) - ;; (custom-save-delete setter) Done by caller - (let ((standard-output (current-buffer)) - (mapper `(lambda (object) - (let ((spec (car-safe (get object (quote ,property))))) - (when (and (not (memq object ignored-special)) - (eq (nth 0 spec) 'user) - (eq (nth 1 spec) 'reset)) - ;; Do not write reset statements unless necessary. - (unless started-writing - (setq started-writing t) - (unless (bolp) - (princ "\n")) - (princ "(") - (princ (quote ,setter)) - (princ "\n '(") - (prin1 object) - (princ " ") - (prin1 (nth 3 spec)) - (princ ")"))))))) - (mapc mapper special) - (setq ignored-special special) - (mapatoms mapper) - (when started-writing - (princ ")\n"))))) - (defun custom-save-faces () "Save all customized faces in `custom-file'." (save-excursion (custom-save-delete 'custom-reset-faces) (custom-save-delete 'custom-set-faces) - (custom-save-resets 'theme-face 'custom-reset-faces '(default)) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) sort-fold-case) ;; First create a sorted list of saved faces. (mapatoms (lambda (symbol) - (if (get symbol 'saved-face) + (if (and (get symbol 'saved-face) + (eq 'user (car (car-safe (get symbol 'theme-face))))) (nconc saved-list (list symbol))))) (setq saved-list (sort (cdr saved-list) 'string<)) ;; The default face must be first, since it affects the others. @@ -4242,9 +4209,7 @@ This function does not save the buffer." (and (not (custom-facep symbol)) (not (get symbol 'force-face)))))) (comment (get symbol 'saved-face-comment))) - (when (or (and spec - (eq (nth 0 spec) 'user) - (eq (nth 1 spec) 'set)) + (when (or (and spec (eq (nth 0 spec) 'user)) comment (and (null spec) (get symbol 'saved-face))) ;; Don't print default face here. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 66713c2866..ba8e21c8a4 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -350,17 +350,20 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (custom-push-theme 'theme-face face theme 'set spec)) (setq args (cdr (cdr args)))))))) +;; XEmacs compability function. In XEmacs, when you reset a Custom +;; Theme, you have to specify the theme to reset it to. We just apply +;; the next theme. ;;;###autoload (defun custom-theme-reset-faces (theme &rest args) "Reset the specs in THEME of some faces to their specs in other themes. Each of the arguments ARGS has this form: - (FACE FROM-THEME) + (FACE IGNORED) -This means reset FACE to its value in FROM-THEME." +This means reset FACE. The argument IGNORED is ignored." (custom-check-theme theme) (dolist (arg args) - (custom-push-theme 'theme-face (car arg) theme 'reset (cadr arg)))) + (custom-push-theme 'theme-face (car arg) theme 'reset))) ;;;###autoload (defun custom-reset-faces (&rest args) diff --git a/lisp/custom.el b/lisp/custom.el index 18d79a6af2..7741ce2e93 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -599,9 +599,56 @@ This recursively follows aliases." ((equal load "cus-edit")) (t (condition-case nil (load load) (error nil)))))))) -(defvar custom-known-themes '(user standard) +;;; Custom Themes + +;; Custom themes are collections of settings that can be enabled or +;; disabled as a unit. + +;; Each Custom theme is defined by a symbol, called the theme name. +;; The `theme-settings' property of the theme name records the +;; variable and face settings of the theme. This property is a list +;; of elements, each of the form +;; +;; (PROP SYMBOL THEME VALUE) +;; +;; - PROP is either `theme-value' or `theme-face' +;; - SYMBOL is the face or variable name +;; - THEME is the theme name (redundant, but simplifies the code) +;; - VALUE is an expression that gives the theme's setting for SYMBOL. +;; +;; The theme name also has a `theme-feature' property, whose value is +;; specified when the theme is defined (see `custom-declare-theme'). +;; Usually, this is just a symbol named THEME-theme. This lets +;; external libraries call (require 'foo-theme). + +;; In addition, each symbol (either a variable or a face) affected by +;; an *enabled* theme has a `theme-value' or `theme-face' property, +;; which is a list of elements each of the form +;; +;; (THEME VALUE) +;; +;; which have the same meanings as in `theme-settings'. +;; +;; The `theme-value' and `theme-face' lists are ordered by decreasing +;; theme precedence. Thus, the first element is always the one that +;; is in effect. + +;; Each theme is stored in a theme file, with filename THEME-theme.el. +;; Loading a theme basically involves calling (load "THEME-theme") +;; This is done by the function `load-theme'. Loading a theme +;; automatically enables it. +;; +;; When a theme is enabled, the `theme-value' and `theme-face' +;; properties for the affected symbols are set. When a theme is +;; disabled, its settings are removed from the `theme-value' and +;; `theme-face' properties, but the theme's own `theme-settings' +;; property remains unchanged. + +;;; Defining themes + +(defvar custom-known-themes '(user changed) "Themes that have been defined with `deftheme'. -The default value is the list (user standard). The theme `standard' +The default value is the list (user changed). The theme `changed' contains the settings before custom themes are applied. The theme `user' contains all the settings the user customized and saved. Additional themes declared with the `deftheme' macro will be added to @@ -616,44 +663,22 @@ the front of this list.") (unless (custom-theme-p theme) (error "Unknown theme `%s'" theme))) -;;; Initializing. - -(defun custom-push-theme (prop symbol theme mode value) - "Record a value for face or variable SYMBOL in custom theme THEME. -PROP is`theme-face' for a face, `theme-value' for a variable. -The value is specified by (THEME MODE VALUE), which is interpreted -by `custom-theme-value'. +(defun custom-push-theme (prop symbol theme mode &optional value) + "Record VALUE for face or variable SYMBOL in custom theme THEME. +PROP is `theme-face' for a face, `theme-value' for a variable. MODE can be either the symbol `set' or the symbol `reset'. If it is the symbol `set', then VALUE is the value to use. If it is the symbol -`reset', then VALUE is either another theme, which means to use the -value defined by that theme; or nil, which means to remove SYMBOL from -THEME entirely. - -In the following example, the variable `goto-address-url-face' has been -set by three different themes. Its `theme-value' property is: - - \((subtle-hacker reset gnome2) - \(jonadab set underline) - \(gnome2 set info-xref) - -The theme value defined by `subtle-hacker' is in effect, because -that theme currently has the highest precedence. The theme -`subtle-hacker' says to use the same value for the variable as -the theme `gnome2'. Therefore, the theme value of the variable -is `info-xref'. To change the precedence of the themes, use -`enable-theme'. - -The user has not customized the variable; had he done that, the -list would contain an entry for the `user' theme, too. +`reset', then SYMBOL will be removed from THEME (VALUE is ignored). See `custom-known-themes' for a list of known themes." (unless (memq prop '(theme-value theme-face)) (error "Unknown theme property")) (let* ((old (get symbol prop)) - (setting (assq theme old)) - (theme-settings (get theme 'theme-settings))) - (if (and (eq mode 'reset) (null value)) + (setting (assq theme old)) ; '(theme value) + (theme-settings ; '(prop symbol theme value) + (get theme 'theme-settings))) + (if (eq mode 'reset) ;; Remove a setting. (when setting (let (res) @@ -671,13 +696,12 @@ See `custom-known-themes' for a list of known themes." (eq (cadr theme-setting) symbol)) (setq res theme-setting))) (put theme 'theme-settings - (cons (list prop symbol theme mode value) + (cons (list prop symbol theme value) (delq res theme-settings))) - (setcar (cdr setting) mode) - (setcar (cddr setting) value)) + (setcar (cdr setting) value)) ;; Add a new setting. ;; If the user changed the value outside of Customize, we - ;; first save the current value to a fake theme, `standard'. + ;; 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. (if (null old) @@ -686,13 +710,13 @@ See `custom-known-themes' for a list of known themes." (or (null (get symbol 'standard-value)) (not (equal (eval (car (get symbol 'standard-value))) (symbol-value symbol))))) - (setq old (list (list 'standard 'set (symbol-value symbol)))) + (setq old (list (list 'changed (symbol-value symbol)))) (if (facep symbol) - (setq old (list (list 'standard 'set (list + (setq old (list (list 'changed (list (append '(t) (custom-face-attributes-get symbol nil))))))))) - (put symbol prop (cons (list theme mode value) old)) + (put symbol prop (cons (list theme value) old)) (put theme 'theme-settings - (cons (list prop symbol theme mode value) + (cons (list prop symbol theme value) theme-settings)))))) (defvar custom-local-buffer nil @@ -904,43 +928,31 @@ Return non-nil iff the `customized-value' property actually changed." ;;; Defining themes. -;; deftheme is used at the beginning of the file that records a theme. +;; A theme file should be named `THEME-theme.el' (where THEME is the theme +;; name), and found in either `custom-theme-directory' or the load path. +;; It has the following format: +;; +;; (deftheme THEME +;; DOCSTRING) +;; +;; (custom-theme-set-variables +;; 'THEME +;; [THEME-VARIABLES]) +;; +;; (custom-theme-set-faces +;; 'THEME +;; [THEME-FACES]) +;; +;; (provide-theme 'THEME) -(defmacro deftheme (theme &optional doc &rest args) - "Declare custom theme THEME. -The optional argument DOC is a doc string describing the theme. -The remaining arguments should have the form - [KEYWORD VALUE]... +;; The IGNORED arguments to deftheme come from the XEmacs theme code, where +;; they were used to supply keyword-value pairs like `:immediate', +;; `:variable-reset-string', etc. We don't use any of these, so ignore them. -The following KEYWORD's are defined: - -:short-description - VALUE is a short (one line) description of the theme. If not - given, DOC is used. -:immediate - If VALUE is non-nil, variables specified in this theme are set - immediately when loading the theme. -:variable-set-string - VALUE is a string used to indicate that a variable takes its - setting from this theme. It is passed to FORMAT with the name - of the theme as an additional argument. If not given, a - generic description is used. -:variable-reset-string - VALUE is a string used in the case a variable has been forced - to its value in this theme. It is passed to FORMAT with the - name of the theme as an additional argument. If not given, a - generic description is used. -:face-set-string - VALUE is a string used to indicate that a face takes its - setting from this theme. It is passed to FORMAT with the name - of the theme as an additional argument. If not given, a - generic description is used. -:face-reset-string - VALUE is a string used in the case a face has been forced to - its value in this theme. It is passed to FORMAT with the name - of the theme as an additional argument. If not given, a - generic description is used. +(defmacro deftheme (theme &optional doc &rest ignored) + "Declare THEME to be a Custom theme. +The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." @@ -948,42 +960,17 @@ see `custom-make-theme-feature' 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-theme - (list 'quote theme) - (list 'quote feature) - doc) - args))) + (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) -(defun custom-declare-theme (theme feature &optional doc &rest args) +(defun custom-declare-theme (theme feature &optional doc &rest ignored) "Like `deftheme', but THEME is evaluated as a normal argument. -FEATURE is the feature this theme provides. This symbol is created -from THEME by `custom-make-theme-feature'." +FEATURE is the feature this theme provides. Normally, this is a symbol +created from THEME by `custom-make-theme-feature'." + (if (memq theme '(user changed)) + (error "Custom theme cannot be named %S" theme)) (add-to-list 'custom-known-themes theme) (put theme 'theme-feature feature) - (when doc - (put theme 'theme-documentation doc)) - (while args - (let ((arg (car args))) - (setq args (cdr args)) - (unless (symbolp arg) - (error "Junk in args %S" args)) - (let ((keyword arg) - (value (car args))) - (unless args - (error "Keyword %s is missing an argument" keyword)) - (setq args (cdr args)) - (cond ((eq keyword :short-description) - (put theme 'theme-short-description value)) - ((eq keyword :immediate) - (put theme 'theme-immediate value)) - ((eq keyword :variable-set-string) - (put theme 'theme-variable-set-string value)) - ((eq keyword :variable-reset-string) - (put theme 'theme-variable-reset-string value)) - ((eq keyword :face-set-string) - (put theme 'theme-face-set-string value)) - ((eq keyword :face-reset-string) - (put theme 'theme-face-reset-string value))))))) + (when doc (put theme 'theme-documentation doc))) (defun custom-make-theme-feature (theme) "Given a symbol THEME, create a new symbol by appending \"-theme\". @@ -998,38 +985,6 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\". ;;; Loading themes. -;; The variable and face settings of a theme are recorded in -;; the `theme-settings' property of the theme name. -;; This property's value is a list of elements, each of the form -;; (PROP SYMBOL THEME MODE VALUE), where PROP is `theme-value' or `theme-face' -;; and SYMBOL is the face or variable name. -;; THEME is the theme name itself; that's redundant, but simplifies things. -;; MODE is `set' or `reset'. -;; If MODE is `set', then VALUE is an expression that specifies the -;; theme's setting for SYMBOL. -;; If MODE is `reset', then VALUE is another theme, -;; and it means to use the value from that theme. - -;; Each variable has a `theme-value' property that describes all the -;; settings of enabled themes that apply to it. -;; Each face name has a `theme-face' property that describes all the -;; settings of enabled themes that apply to it. -;; The property value is a list of settings, each with the form -;; (THEME MODE VALUE). THEME, MODE and VALUE are as above. -;; Each of these lists is ordered by decreasing theme precedence. -;; Thus, the first element is always the one that is in effect. - -;; Disabling a theme removes its settings from the `theme-value' and -;; `theme-face' properties, but the theme's own `theme-settings' -;; property remains unchanged. - -;; Loading a theme implicitly enables it. Enabling a theme adds its -;; settings to the symbols' `theme-value' and `theme-face' properties, -;; or moves them to the front of those lists if they're already present. - -(defvar custom-loaded-themes nil - "Custom themes that have been loaded.") - (defcustom custom-theme-directory (if (eq system-type 'ms-dos) ;; MS-DOS cannot have initial dot. @@ -1043,76 +998,33 @@ into this directory." :group 'customize :version "22.1") -(defun custom-theme-loaded-p (theme) - "Return non-nil if THEME has been loaded." - (memq theme custom-loaded-themes)) - (defun provide-theme (theme) - "Indicate that this file provides THEME, and mark it as enabled. -Add THEME to `custom-loaded-themes' and `custom-enabled-themes', -and `provide' the feature name stored in THEME's property `theme-feature'. - -Usually the `theme-feature' property contains a symbol created -by `custom-make-theme-feature'." - (if (eq theme 'user) - (error "Custom theme cannot be named `user'")) + "Indicate that this file provides THEME. +This calls `provide' to provide the feature name stored in THEME's +property `theme-feature' (which is usually a symbol created by +`custom-make-theme-feature')." + (if (memq theme '(user changed)) + (error "Custom theme cannot be named %S" theme)) (custom-check-theme theme) (provide (get theme 'theme-feature)) - (push theme custom-loaded-themes) - ;; Loading a theme also installs its settings, - ;; so mark it as "enabled". + ;; 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.) - (enable-theme 'user)) + (let ((custom-enabling-themes t)) + (enable-theme 'user))) (defun load-theme (theme) "Try to load a theme's settings from its file. This also enables the theme; use `disable-theme' to disable it." - - ;; THEME's feature is stored in THEME's `theme-feature' property. - ;; Usually the `theme-feature' property contains a symbol created - ;; by `custom-make-theme-feature'. - ;; Note we do no check for validity of the theme here. ;; This allows to pull in themes by a file-name convention (interactive "SCustom theme name: ") (let ((load-path (if (file-directory-p custom-theme-directory) (cons custom-theme-directory load-path) load-path))) - (require (or (get theme 'theme-feature) - (custom-make-theme-feature theme))))) - -;;; How to load and enable various themes as part of `user'. - -(defun custom-theme-load-themes (by-theme &rest body) - "Load the themes specified by BODY. -Record them as required by theme BY-THEME. - -BODY is a sequence of either - -THEME - Load THEME and enable it. -\(reset THEME) - Undo all the settings made by THEME -\(hidden THEME) - Load THEME but do not enable it. - -All the themes loaded for BY-THEME are recorded in BY-THEME's property -`theme-loads-themes'." - (custom-check-theme by-theme) - (let ((themes-loaded (get by-theme 'theme-loads-themes))) - (dolist (theme body) - (cond ((and (consp theme) (eq (car theme) 'reset)) - (disable-theme (cadr theme))) - ((and (consp theme) (eq (car theme) 'hidden)) - (load-theme (cadr theme)) - (disable-theme (cadr theme))) - (t - (load-theme theme))) - (push theme themes-loaded)) - (put by-theme 'theme-loads-themes themes-loaded))) + (load (symbol-name (custom-make-theme-feature theme))))) ;;; Enabling and disabling loaded themes. @@ -1123,25 +1035,26 @@ All the themes loaded for BY-THEME are recorded in BY-THEME's property The newly enabled theme gets the highest precedence (after `user'). If it is already enabled, just give it highest precedence (after `user'). -This signals an error if THEME does not specify any theme -settings. Theme settings are set using `load-theme'." +If THEME does not specify any theme settings, this tries to load +the theme from its theme file, by calling `load-theme'." (interactive "SEnable Custom theme: ") - (unless (or (eq theme 'user) (memq theme custom-loaded-themes)) - (error "Theme %s not defined" (symbol-name theme))) - (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)))) + (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))))) (defcustom custom-enabled-themes nil "List of enabled Custom Themes, highest precedence first. @@ -1155,28 +1068,36 @@ and always takes precedence over other Custom Themes." ;; 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)) + (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)) - (if (or (custom-theme-loaded-p theme) (eq theme 'user)) + (condition-case nil (enable-theme theme) - (load-theme theme))) + (error (progn (push theme failures) + (setq themes (delq theme themes)))))) (enable-theme 'user) - (custom-set-default symbol themes))))) + (custom-set-default symbol themes) + (if failures + (message "Failed to enable themes: %s" + (mapconcat 'symbol-name failures " "))))))) -(defun custom-theme-enabled-p (theme) +(defsubst custom-theme-enabled-p (theme) "Return non-nil if THEME is enabled." (memq theme custom-enabled-themes)) (defun disable-theme (theme) "Disable all variable and face settings defined by THEME. See `custom-enabled-themes' for a list of enabled themes." - (interactive "SDisable Custom theme: ") - (when (memq theme custom-enabled-themes) + (interactive (list (intern + (completing-read + "Disable Custom theme: " + (mapcar 'symbol-name custom-enabled-themes) + nil t)))) + (when (custom-theme-enabled-p theme) (let ((settings (get theme 'theme-settings))) (dolist (s settings) (let* ((prop (car s)) @@ -1189,28 +1110,6 @@ See `custom-enabled-themes' for a list of enabled themes." (setq custom-enabled-themes (delq theme custom-enabled-themes)))) -(defun custom-theme-value (theme setting-list) - "Determine the value specified for THEME according to SETTING-LIST. -Returns a list whose car is the specified value, if we -find one; nil otherwise. - -SETTING-LIST is an alist with themes as its key. -Each element has the form: - - \(THEME MODE VALUE) - -MODE is either the symbol `set' or the symbol `reset'. See -`custom-push-theme' for more information on the format of -SETTING-LIST." - ;; Note we do _NOT_ signal an error if the theme is unknown - ;; it might have gone away without the user knowing. - (let ((elt (cdr (assoc theme setting-list)))) - (if elt - (if (eq (car elt) 'set) - (cdr elt) - ;; `reset' means refer to another theme's value in the same alist. - (custom-theme-value (cadr elt) setting-list))))) - (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 @@ -1219,47 +1118,53 @@ currently enabled custom themes. This function returns nil if no custom theme specifies a value for VARIABLE." (let* ((theme-value (get variable 'theme-value))) (if theme-value - (custom-theme-value (car (car theme-value)) theme-value)))) + (cdr (car theme-value))))) (defun custom-theme-recalc-variable (variable) "Set VARIABLE according to currently enabled custom themes." (let ((valspec (custom-variable-theme-value variable))) - (when valspec - (put variable 'saved-value valspec)) - (unless valspec + (if valspec + (put variable 'saved-value valspec) (setq valspec (get variable 'standard-value))) - (when valspec - (if (or (get 'force-value variable) (default-boundp variable)) - (funcall (or (get variable 'custom-set) 'set-default) variable - (eval (car valspec))))))) + (if (and valspec + (or (get variable 'force-value) + (default-boundp variable))) + (funcall (or (get variable 'custom-set) 'set-default) variable + (eval (car valspec)))))) (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." (if (facep face) (let ((theme-faces (reverse (get face 'theme-face)))) (dolist (spec theme-faces) - (face-spec-set face (car (cddr spec))))))) + (face-spec-set face (cadr spec)))))) +;;; XEmacs compability 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 +;; just ignore the IGNORED arguments. + (defun custom-theme-reset-variables (theme &rest args) - "Reset the specs in THEME of some variables to their values in other themes. + "Reset some variable settings in THEME to their values in other themes. Each of the arguments ARGS has this form: - (VARIABLE FROM-THEME) + (VARIABLE IGNORED) -This means reset VARIABLE to its value in FROM-THEME." +This means reset VARIABLE. (The argument IGNORED is ignored." (custom-check-theme theme) (dolist (arg args) - (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg)))) + (custom-push-theme 'theme-value (car arg) theme 'reset))) (defun custom-reset-variables (&rest args) - "Reset the specs of some variables to their values in certain themes. + "Reset the specs of some variables to their values in other themes. This creates settings in the `user' theme. Each of the arguments ARGS has this form: - (VARIABLE FROM-THEME) + (VARIABLE IGNORED) -This means reset VARIABLE to its value in FROM-THEME." +This means reset VARIABLE. (The argument IGNORED is ignored." (apply 'custom-theme-reset-variables 'user args)) ;;; The End. -- cgit v1.2.3