# HG changeset patch # User Richard M. Stallman # Date 1040668855 0 # Node ID d77bc55dd27b94fda7d4afbe7b8c8bade48eb6c3 # Parent 8ccf8576bbc12065c965ce0edc70b538eb5d8eb8 (custom-known-themes): New variable. (custom-declare-theme): New function. (deftheme): New macro. (custom-make-theme-feature): New function. (custom-theme-p): New function. (custom-check-theme): New function. (custom-push-theme): New function. (custom-theme-set-variables): Take themes into account. (custom-loaded-themes): New variable. (custom-theme-loaded-p): New function. (provide-theme): New function. (require-theme): New function. (custom-remove-theme): New function. (custom-do-theme-reset): New function. (custom-theme-load-themes): New function. (custom-load-themes): New function. (custom-theme-value): New function. (custom-theme-variable-value): New function. (custom-theme-reset-internal): New function. (custom-theme-reset-variables): New function. (custom-reset-variables): New function. diff -r 8ccf8576bbc1 -r d77bc55dd27b lisp/custom.el --- a/lisp/custom.el Mon Dec 23 18:40:38 2002 +0000 +++ b/lisp/custom.el Mon Dec 23 18:40:55 2002 +0000 @@ -112,8 +112,16 @@ (defun custom-declare-variable (symbol default doc &rest args) "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. DEFAULT should be an expression to evaluate to compute the default value, -not the default value itself." - ;; Remember the standard setting. +not the default value itself. + +DEFAULT is stored as SYMBOL's value in the standard theme. See +`custom-known-themes' for a list of known themes. For backwards +compatibility, DEFAULT is also stored in SYMBOL's property +`standard-value'. At the same time, SYMBOL's property `force-value' is +set to nil, as the value is no longer rogue." + ;; Remember the standard setting. The value should be in the standard + ;; theme, not in this property. However, his would require changeing + ;; the C source of defvar and others as well... (put symbol 'standard-value (list default)) ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) @@ -446,7 +454,7 @@ (setq value (cdr value)))) (unless (eq deps new-deps) (put symbol 'custom-dependencies new-deps)))) - + (defun custom-add-option (symbol option) "To the variable SYMBOL add OPTION. @@ -504,8 +512,159 @@ ((equal load "cus-edit")) (t (condition-case nil (load load) (error nil)))))))) +(defvar custom-known-themes '(user standard) + "Themes that have been define with `deftheme'. +The default value is the list (user standard). The theme `standard' +contains the Emacs standard settings from the original Lisp files. The +theme `user' contains all the the settings the user customized and saved. +Additional themes declared with the `deftheme' macro will be added to +the front of this list.") + +(defun custom-declare-theme (theme feature &optional doc &rest args) + "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'." + (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 short-description)) + ((eq keyword :immediate) + (put theme 'theme-immediate immediate)) + ((eq keyword :variable-set-string) + (put theme 'theme-variable-set-string variable-set-string)) + ((eq keyword :variable-reset-string) + (put theme 'theme-variable-reset-string variable-reset-string)) + ((eq keyword :face-set-string) + (put theme 'theme-face-set-string face-set-string)) + ((eq keyword :face-reset-string) + (put theme 'theme-face-reset-string face-reset-string))))))) + +(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 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. + +Any theme `foo' should be defined in a file called `foo-theme.el'; +see `custom-make-theme-feature' for more information." + (let ((feature (custom-make-theme-feature theme))) + ;; 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))) + +(defun custom-make-theme-feature (theme) + "Given a symbol THEME, create a new symbol by appending \"-theme\". +Store this symbol in the `theme-feature' property of THEME. +Calling `provide-theme' to provide THEME actually puts `THEME-theme' +into `features'. + +This allows for a file-name convention for autoloading themes: +Every theme X has a property `provide-theme' whose value is \"X-theme\". +\(require-theme X) then attempts to load the file `X-theme.el'." + (intern (concat (symbol-name theme) "-theme"))) + +(defsubst custom-theme-p (theme) + "Non-nil when THEME has been defined." + (memq theme custom-known-themes)) + +(defsubst custom-check-theme (theme) + "Check whether THEME is valid, and signal an error if it is not." + (unless (custom-theme-p theme) + (error "Unknown theme `%s'" theme))) + ;;; Initializing. +(defun custom-push-theme (prop symbol theme mode value) + "Add (THEME MODE VALUE) to the list in property PROP of SYMBOL. +If the first element in that list is already (THEME ...), +discard it first. + +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 the mode to query instead. + +In the following example for the variable `goto-address-url-face', the +theme `subtle-hacker' uses the same value for the variable as the theme +`gnome2': + + \((standard set bold) + \(gnome2 set info-xref) + \(jonadab set underline) + \(subtle-hacker reset gnome2)) + + +If a value has been stored for themes A B and C, and a new value +is to be stored for theme C, then the old value of C is discarded. +If a new value is to be stored for theme B, however, the old value +of B is not discarded because B is not the car of the list. + +For variables, list property PROP is `theme-value'. +For faces, list property PROP is `theme-face'. +This is used in `custom-do-theme-reset', for example. + +The list looks the same in any case; the examples shows a possible +value of the `theme-face' property for the face `region': + + \((gnome2 set ((t (:foreground \"cyan\" :background \"dark cyan\")))) + \(standard set ((((class color) (background dark)) + \(:background \"blue\")) + \(t (:background \"gray\"))))) + +This records values for the `standard' and the `gnome2' themes. +The user has not customized the face; had he done that, +the list would contain an entry for the `user' theme, too. +See `custom-known-themes' for a list of known themes." + (let ((old (get symbol prop))) + (if (eq (car-safe (car-safe old)) theme) + (setq old (cdr old))) + (put symbol prop (cons (list theme mode value) old)))) + (defvar custom-local-buffer nil "Non-nil, in a Customization buffer, means customize a specific buffer. If this variable is non-nil, it should be a buffer, @@ -516,7 +675,7 @@ (defun custom-set-variables (&rest args) "Initialize variables according to user preferences. - +The settings are registered as theme `user'. The arguments should each be a list of the form: (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) @@ -524,45 +683,75 @@ The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as the default value for the SYMBOL. -REQUEST is a list of features we must require for SYMBOL. + +REQUEST is a list of features we must 'require for SYMBOL. COMMENT is a comment string about SYMBOL." - (setq args - (sort args - (lambda (a1 a2) - (let* ((sym1 (car a1)) - (sym2 (car a2)) - (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) - (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) - (cond ((and 1-then-2 2-then-1) - (error "Circular custom dependency between `%s' and `%s'" - sym1 sym2)) - (1-then-2 t) - (2-then-1 nil) - ;; Put symbols with :require last. The macro - ;; define-minor-mode generates a defcustom - ;; with a :require and a :set, where the - ;; setter function calls the mode function. - ;; Putting symbols with :require last ensures - ;; that the mode function will see other - ;; customized values rather than default - ;; values. - (t (nth 3 a2))))))) - (while args - (let ((entry (car args))) - (if (listp entry) - (let* ((symbol (nth 0 entry)) - (value (nth 1 entry)) - (now (nth 2 entry)) - (requests (nth 3 entry)) - (comment (nth 4 entry)) - set) - (when requests - (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq set (or (get symbol 'custom-set) 'custom-set-default)) - (put symbol 'saved-value (list value)) - (put symbol 'saved-variable-comment comment) - ;; Allow for errors in the case where the setter has + (apply 'custom-theme-set-variables 'user args)) + +(defun custom-theme-set-variables (theme &rest args) + "Initialize variables according to settings specified by args. +Records the settings as belonging to THEME. + +The arguments should be a list where each entry has the form: + + (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) + +The unevaluated VALUE is stored as the saved value for SYMBOL. +If NOW is present and non-nil, VALUE is also evaluated and bound as +the default value for the SYMBOL. +REQUEST is a list of features we must 'require for SYMBOL. +COMMENT is a comment string about SYMBOL. + +Several properties of THEME and SYMBOL are used in the process: + +If THEME property `theme-immediate' is non-nil, this is equivalent of +providing the NOW argument to all symbols in the argument list: SYMBOL +is bound to the evaluated VALUE. The only difference is SYMBOL property +`force-value': if NOW is non-nil, SYMBOL's property `force-value' is set to +the symbol `rogue', else if THEME's property `theme-immediate' is non-nil, +FACE's property `force-face' is set to the symbol `immediate'. + +VALUE itself is saved unevaluated as SYMBOL property `saved-value' and +in SYMBOL's list property `theme-value' \(using `custom-push-theme')." + (custom-check-theme theme) + (let ((immediate (get theme 'theme-immediate))) + (setq args + (sort args + (lambda (a1 a2) + (let* ((sym1 (car a1)) + (sym2 (car a2)) + (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) + (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) + (cond ((and 1-then-2 2-then-1) + (error "Circular custom dependency between `%s' and `%s'" + sym1 sym2)) + (2-then-1 nil) + ;; Put symbols with :require last. The macro + ;; define-minor-mode generates a defcustom + ;; with a :require and a :set, where the + ;; setter function calls the mode function. + ;; Putting symbols with :require last ensures + ;; that the mode function will see other + ;; customized values rather than default + ;; values. + (t (nth 3 a2))))))) + (while args + (let ((entry (car args))) + (if (listp entry) + (let* ((symbol (nth 0 entry)) + (value (nth 1 entry)) + (now (nth 2 entry)) + (requests (nth 3 entry)) + (comment (nth 4 entry)) + set) + (when requests + (put symbol 'custom-requests requests) + (mapc 'require requests)) + (setq set (or (get symbol 'custom-set) 'custom-set-default)) + (put symbol 'saved-value (list value)) + (put symbol 'saved-variable-comment comment) + (custom-push-theme 'theme-value symbol theme 'set value) + ;; Allow for errors in the case where the setter has ;; changed between versions, say, but let the user know. (condition-case data (cond (now @@ -574,17 +763,18 @@ (funcall set symbol (eval value)))) (error (message "Error setting %s: %s" symbol data))) - (setq args (cdr args)) - (and (or now (default-boundp symbol)) - (put symbol 'variable-comment comment))) - ;; Old format, a plist of SYMBOL VALUE pairs. - (message "Warning: old format `custom-set-variables'") - (ding) - (sit-for 2) - (let ((symbol (nth 0 args)) - (value (nth 1 args))) - (put symbol 'saved-value (list value))) - (setq args (cdr (cdr args))))))) + (setq args (cdr args)) + (and (or now (default-boundp symbol)) + (put symbol 'variable-comment comment))) + ;; Old format, a plist of SYMBOL VALUE pairs. + (message "Warning: old format `custom-set-variables'") + (ding) + (sit-for 2) + (let ((symbol (nth 0 args)) + (value (nth 1 args))) + (put symbol 'saved-value (list value)) + (custom-push-theme 'theme-value symbol theme 'set value)) + (setq args (cdr (cdr args)))))))) (defun custom-set-default (variable value) "Default :set function for a customizable variable. @@ -663,6 +853,185 @@ ;; Changed? (not (equal customized (get symbol 'customized-value))))) +;;; Theme Manipulation + +(defvar custom-loaded-themes nil + "Themes in the order they are loaded.") + +(defun custom-theme-loaded-p (theme) + "Return non-nil when THEME has been loaded." + (memq theme custom-loaded-themes)) + +(defun provide-theme (theme) + "Indicate that this file provides THEME. +Add THEME to `custom-loaded-themes' and `provide' whatever +is stored in THEME's property `theme-feature'. + +Usually the theme-feature property contains a symbol created +by `custom-make-theme-feature'." + (custom-check-theme theme) + (provide (get theme 'theme-feature)) + (setq custom-loaded-themes (nconc (list theme) custom-loaded-themes))) + +(defun require-theme (theme) + "Try to load a theme by requiring its feature. +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 + (require (or (get theme 'theme-feature) + (custom-make-theme-feature theme)))) + +(defun custom-remove-theme (spec-alist theme) + "Detelete all elements from SPEC-ALIST whose car is THEME." + (let ((elt (assoc theme spec-alist))) + (while elt + (setq spec-alist (delete elt spec-alist) + elt (assoc theme spec-alist)))) + spec-alist) + +(defun custom-do-theme-reset (theme) + "Undo all settings defined by THEME. + +A variable remains unchanged if its property `theme-value' does not +contain a value for THEME. A face remains unchanged if its property +`theme-face' does not contain a value for THEME. In either case, all +settings for THEME are removed from the property and the variable or +face is set to the `user' theme. + +See `custom-known-themes' for a list of known themes." + (let (spec-list) + (mapatoms (lambda (symbol) + ;; This works even if symbol is both a variable and a + ;; face. + (setq spec-list (get symbol 'theme-value)) + (when spec-list + (put symbol 'theme-value (custom-remove-theme spec-list theme)) + (custom-theme-reset-internal symbol 'user)) + (setq spec-list (get symbol 'theme-face)) + (when spec-list + (put symbol 'theme-face (custom-remove-theme spec-list theme)) + (custom-theme-reset-internal-face symbol '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 + BY-THEME requires THEME +\(reset THEME) + Undo all the settings made by THEME +\(hidden THEME) + Require THEME but hide it from the user + +All the themes loaded for BY-THEME are recorded in BY-THEME's property +`theme-loads-themes'. Any theme loaded with the hidden predicate will +be given the property `theme-hidden' unless it has been loaded before. +Whether a theme has been loaded before is determined by the function +`custom-theme-loaded-p'." + (custom-check-theme by-theme) + (let ((theme) + (themes-loaded (get by-theme 'theme-loads-themes))) + (while theme + (setq theme (car body) + body (cdr body)) + (cond ((and (consp theme) (eq (car theme) 'reset)) + (custom-do-theme-reset (cadr theme))) + ((and (consp theme) (eq (car theme) 'hidden)) + (require-theme (cadr theme)) + (unless (custom-theme-loaded-p (cadr theme)) + (put (cadr theme) 'theme-hidden t))) + (t + (require-theme theme) + (put theme 'theme-hidden nil))) + (setq themes-loaded (nconc (list theme) themes-loaded))) + (put by-theme 'theme-loads-themes themes-loaded))) + +(defun custom-load-themes (&rest body) + "Load themes for the USER theme as specified by BODY. + +See `custom-theme-load-themes' for more information on BODY." + (apply 'custom-theme-load-themes 'user body)) + +; (defsubst copy-upto-last (elt list) +; "Copy all the elements of the list upto the last occurence of elt" +; ;; Is it faster to do more work in C than to do less in elisp? +; (nreverse (cdr (member elt (reverse list))))) + +(defun custom-theme-value (theme theme-spec-list) + "Determine the value for THEME defined by THEME-SPEC-LIST. +Returns a list with the original value if found; nil otherwise. + +THEME-SPEC-LIST is an alist with themes as its key. As new themes are +installed, these are added to the front of THEME-SPEC-LIST. +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 +THEME-SPEC-LIST." + ;; Note we do _NOT_ signal an error if the theme is unknown + ;; it might have gone away without the user knowing. + (let ((value (cdr (assoc theme theme-spec-list)))) + (if value + (if (eq (car value) 'set) + (cdr value) + (custom-theme-value (cadr value) theme-spec-list))))) + +(defun custom-theme-variable-value (variable theme) + "Return (list value) indicating value of VARIABLE in THEME. +If THEME does not define a value for VARIABLE, return nil. The value +definitions per theme are stored in VARIABLE's property `theme-value'. +The actual work is done by function `custom-theme-value', which see. +See `custom-push-theme' for more information on how these definitions +are stored." + (custom-theme-value theme (get variable 'theme-value))) + +(defun custom-theme-reset-internal (symbol to-theme) + "Reset SYMBOL to the value defined by TO-THEME. +If SYMBOL is not defined in TO-THEME, reset SYMBOL to the standard +value. See `custom-theme-variable-value'. The standard value is +stored in SYMBOL's property `standard-value'." + (let ((value (custom-theme-variable-value symbol to-theme)) + was-in-theme) + (setq was-in-theme value) + (setq value (or value (get symbol 'standard-value))) + (when value + (put symbol 'saved-value was-in-theme) + (if (or (get 'force-value symbol) (default-boundp symbol)) + (funcall (or (get symbol 'custom-set) 'set-default) symbol + (eval (car value))))) + value)) + +(defun custom-theme-reset-variables (theme &rest args) + "Reset the value of the variables to values previously defined. +Associate this setting with THEME. + +ARGS is a list of lists of the form + + (VARIABLE TO-THEME) + +This means reset VARIABLE to its value in TO-THEME." + (custom-check-theme theme) + (mapcar '(lambda (arg) + (apply 'custom-theme-reset-internal arg) + (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) + args)) + +(defun custom-reset-variables (&rest args) + "Reset the value of the variables to values previously saved. +This is the setting associated the `user' theme. + +ARGS is a list of lists of the form + + (VARIABLE TO-THEME) + +This means reset VARIABLE to its value in TO-THEME." + (apply 'custom-theme-reset-variables 'user args)) + ;;; The End. ;; Process the defcustoms for variables loaded before this file.