diff options
| author | Richard M. Stallman | 2005-07-11 00:57:23 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2005-07-11 00:57:23 +0000 |
| commit | 46ce5febbd8abb72c2c14f7fce8f54564420ae7b (patch) | |
| tree | 6e732834d319b621d478cc59d395675ce6863098 | |
| parent | 2c9e973fc7304585e9f94dcdb7e6d5cb7e3568e1 (diff) | |
| download | emacs-46ce5febbd8abb72c2c14f7fce8f54564420ae7b.tar.gz emacs-46ce5febbd8abb72c2c14f7fce8f54564420ae7b.zip | |
(custom-push-theme): Maintain list of the settings
of a given theme in its theme-settings property.
Maintain position of old settings in the theme-value or theme-face property.
(custom-enabled-themes): New variable.
(custom-theme-enabled-p): New function.
(provide-theme): Update custom-enabled-themes.
Disable and reenable the `user' theme.
(require-theme): Doc fix.
(custom-do-theme-reset, custom-remove-theme): Functions deleted.
(custom-theme-value, custom-theme-variable-value): Likewise.
(custom-theme-reset-internal): Likewise.
(custom-theme-load-themes): Fix bugs and use custom-disable-theme.
(custom-enable-theme, custom-disable-theme): New functions.
(custom-variable-theme-value, custom-face-theme-value): Likewise.
(custom-theme-recalc-variable, custom-theme-recalc-face): Likewise.
(custom-theme-reset-variables): Simplify.
(deftheme, custom-declare-theme, custom-make-theme-feature):
Definitions moved.
| -rw-r--r-- | lisp/custom.el | 503 |
1 files changed, 284 insertions, 219 deletions
diff --git a/lisp/custom.el b/lisp/custom.el index 3f8608361c6..be65c865f06 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -584,7 +584,7 @@ This recursively follows aliases." | |||
| 584 | ;; and it is not in load-history yet. | 584 | ;; and it is not in load-history yet. |
| 585 | ((equal load "cus-edit")) | 585 | ((equal load "cus-edit")) |
| 586 | (t (condition-case nil (load load) (error nil)))))))) | 586 | (t (condition-case nil (load load) (error nil)))))))) |
| 587 | 587 | ||
| 588 | (defvar custom-known-themes '(user standard) | 588 | (defvar custom-known-themes '(user standard) |
| 589 | "Themes that have been defined with `deftheme'. | 589 | "Themes that have been defined with `deftheme'. |
| 590 | The default value is the list (user standard). The theme `standard' | 590 | The default value is the list (user standard). The theme `standard' |
| @@ -593,95 +593,6 @@ theme `user' contains all the the settings the user customized and saved. | |||
| 593 | Additional themes declared with the `deftheme' macro will be added to | 593 | Additional themes declared with the `deftheme' macro will be added to |
| 594 | the front of this list.") | 594 | the front of this list.") |
| 595 | 595 | ||
| 596 | (defun custom-declare-theme (theme feature &optional doc &rest args) | ||
| 597 | "Like `deftheme', but THEME is evaluated as a normal argument. | ||
| 598 | FEATURE is the feature this theme provides. This symbol is created | ||
| 599 | from THEME by `custom-make-theme-feature'." | ||
| 600 | (add-to-list 'custom-known-themes theme) | ||
| 601 | (put theme 'theme-feature feature) | ||
| 602 | (when doc | ||
| 603 | (put theme 'theme-documentation doc)) | ||
| 604 | (while args | ||
| 605 | (let ((arg (car args))) | ||
| 606 | (setq args (cdr args)) | ||
| 607 | (unless (symbolp arg) | ||
| 608 | (error "Junk in args %S" args)) | ||
| 609 | (let ((keyword arg) | ||
| 610 | (value (car args))) | ||
| 611 | (unless args | ||
| 612 | (error "Keyword %s is missing an argument" keyword)) | ||
| 613 | (setq args (cdr args)) | ||
| 614 | (cond ((eq keyword :short-description) | ||
| 615 | (put theme 'theme-short-description value)) | ||
| 616 | ((eq keyword :immediate) | ||
| 617 | (put theme 'theme-immediate value)) | ||
| 618 | ((eq keyword :variable-set-string) | ||
| 619 | (put theme 'theme-variable-set-string value)) | ||
| 620 | ((eq keyword :variable-reset-string) | ||
| 621 | (put theme 'theme-variable-reset-string value)) | ||
| 622 | ((eq keyword :face-set-string) | ||
| 623 | (put theme 'theme-face-set-string value)) | ||
| 624 | ((eq keyword :face-reset-string) | ||
| 625 | (put theme 'theme-face-reset-string value))))))) | ||
| 626 | |||
| 627 | (defmacro deftheme (theme &optional doc &rest args) | ||
| 628 | "Declare custom theme THEME. | ||
| 629 | The optional argument DOC is a doc string describing the theme. | ||
| 630 | The remaining arguments should have the form | ||
| 631 | |||
| 632 | [KEYWORD VALUE]... | ||
| 633 | |||
| 634 | The following KEYWORD's are defined: | ||
| 635 | |||
| 636 | :short-description | ||
| 637 | VALUE is a short (one line) description of the theme. If not | ||
| 638 | given, DOC is used. | ||
| 639 | :immediate | ||
| 640 | If VALUE is non-nil, variables specified in this theme are set | ||
| 641 | immediately when loading the theme. | ||
| 642 | :variable-set-string | ||
| 643 | VALUE is a string used to indicate that a variable takes its | ||
| 644 | setting from this theme. It is passed to FORMAT with the name | ||
| 645 | of the theme as an additional argument. If not given, a | ||
| 646 | generic description is used. | ||
| 647 | :variable-reset-string | ||
| 648 | VALUE is a string used in the case a variable has been forced | ||
| 649 | to its value in this theme. It is passed to FORMAT with the | ||
| 650 | name of the theme as an additional argument. If not given, a | ||
| 651 | generic description is used. | ||
| 652 | :face-set-string | ||
| 653 | VALUE is a string used to indicate that a face takes its | ||
| 654 | setting from this theme. It is passed to FORMAT with the name | ||
| 655 | of the theme as an additional argument. If not given, a | ||
| 656 | generic description is used. | ||
| 657 | :face-reset-string | ||
| 658 | VALUE is a string used in the case a face has been forced to | ||
| 659 | its value in this theme. It is passed to FORMAT with the name | ||
| 660 | of the theme as an additional argument. If not given, a | ||
| 661 | generic description is used. | ||
| 662 | |||
| 663 | Any theme `foo' should be defined in a file called `foo-theme.el'; | ||
| 664 | see `custom-make-theme-feature' for more information." | ||
| 665 | (let ((feature (custom-make-theme-feature theme))) | ||
| 666 | ;; It is better not to use backquote in this file, | ||
| 667 | ;; because that makes a bootstrapping problem | ||
| 668 | ;; if you need to recompile all the Lisp files using interpreted code. | ||
| 669 | (nconc (list 'custom-declare-theme | ||
| 670 | (list 'quote theme) | ||
| 671 | (list 'quote feature) | ||
| 672 | doc) args))) | ||
| 673 | |||
| 674 | (defun custom-make-theme-feature (theme) | ||
| 675 | "Given a symbol THEME, create a new symbol by appending \"-theme\". | ||
| 676 | Store this symbol in the `theme-feature' property of THEME. | ||
| 677 | Calling `provide-theme' to provide THEME actually puts `THEME-theme' | ||
| 678 | into `features'. | ||
| 679 | |||
| 680 | This allows for a file-name convention for autoloading themes: | ||
| 681 | Every theme X has a property `provide-theme' whose value is \"X-theme\". | ||
| 682 | \(require-theme X) then attempts to load the file `X-theme.el'." | ||
| 683 | (intern (concat (symbol-name theme) "-theme"))) | ||
| 684 | |||
| 685 | (defsubst custom-theme-p (theme) | 596 | (defsubst custom-theme-p (theme) |
| 686 | "Non-nil when THEME has been defined." | 597 | "Non-nil when THEME has been defined." |
| 687 | (memq theme custom-known-themes)) | 598 | (memq theme custom-known-themes)) |
| @@ -694,13 +605,15 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\". | |||
| 694 | ;;; Initializing. | 605 | ;;; Initializing. |
| 695 | 606 | ||
| 696 | (defun custom-push-theme (prop symbol theme mode value) | 607 | (defun custom-push-theme (prop symbol theme mode value) |
| 697 | "Add (THEME MODE VALUE) to the list in property PROP of SYMBOL. | 608 | "Record a value for face or variable SYMBOL in custom theme THEME. |
| 698 | If the first element in that list is already (THEME ...), | 609 | PROP is`theme-face' for a face, `theme-value' for a variable. |
| 699 | discard it first. | 610 | The value is specified by (THEME MODE VALUE), which is interpreted |
| 611 | by `custom-theme-value'. | ||
| 700 | 612 | ||
| 701 | MODE can be either the symbol `set' or the symbol `reset'. If it is the | 613 | MODE can be either the symbol `set' or the symbol `reset'. If it is the |
| 702 | symbol `set', then VALUE is the value to use. If it is the symbol | 614 | symbol `set', then VALUE is the value to use. If it is the symbol |
| 703 | `reset', then VALUE is the mode to query instead. | 615 | `reset', then VALUE is another theme, whose value for this face or |
| 616 | variable should be used. | ||
| 704 | 617 | ||
| 705 | In the following example for the variable `goto-address-url-face', the | 618 | In the following example for the variable `goto-address-url-face', the |
| 706 | theme `subtle-hacker' uses the same value for the variable as the theme | 619 | theme `subtle-hacker' uses the same value for the variable as the theme |
| @@ -733,11 +646,20 @@ This records values for the `standard' and the `gnome2' themes. | |||
| 733 | The user has not customized the face; had he done that, | 646 | The user has not customized the face; had he done that, |
| 734 | the list would contain an entry for the `user' theme, too. | 647 | the list would contain an entry for the `user' theme, too. |
| 735 | See `custom-known-themes' for a list of known themes." | 648 | See `custom-known-themes' for a list of known themes." |
| 736 | (let ((old (get symbol prop))) | 649 | (let* ((old (get symbol prop)) |
| 737 | (if (eq (car-safe (car-safe old)) theme) | 650 | (setting (assq theme old))) |
| 738 | (setq old (cdr old))) | 651 | ;; Alter an existing theme-setting for the symbol, |
| 739 | (put symbol prop (cons (list theme mode value) old)))) | 652 | ;; or add a new one. |
| 740 | 653 | (if setting | |
| 654 | (progn | ||
| 655 | (setcar (cdr setting) mode) | ||
| 656 | (setcar (cddr setting) value)) | ||
| 657 | (put symbol prop (cons (list theme mode value) old))) | ||
| 658 | ;; Record, for each theme, all its settings. | ||
| 659 | (put theme 'theme-settings | ||
| 660 | (cons (list prop symbol theme mode value) | ||
| 661 | (get theme 'theme-settings))))) | ||
| 662 | |||
| 741 | (defvar custom-local-buffer nil | 663 | (defvar custom-local-buffer nil |
| 742 | "Non-nil, in a Customization buffer, means customize a specific buffer. | 664 | "Non-nil, in a Customization buffer, means customize a specific buffer. |
| 743 | If this variable is non-nil, it should be a buffer, | 665 | If this variable is non-nil, it should be a buffer, |
| @@ -946,11 +868,128 @@ Return non-nil iff the `customized-value' property actually changed." | |||
| 946 | (put symbol 'customized-value nil)) | 868 | (put symbol 'customized-value nil)) |
| 947 | ;; Changed? | 869 | ;; Changed? |
| 948 | (not (equal customized (get symbol 'customized-value))))) | 870 | (not (equal customized (get symbol 'customized-value))))) |
| 871 | |||
| 872 | ;;; Defining themes. | ||
| 873 | |||
| 874 | ;; deftheme is used at the beginning of the file that records a theme. | ||
| 875 | |||
| 876 | (defmacro deftheme (theme &optional doc &rest args) | ||
| 877 | "Declare custom theme THEME. | ||
| 878 | The optional argument DOC is a doc string describing the theme. | ||
| 879 | The remaining arguments should have the form | ||
| 880 | |||
| 881 | [KEYWORD VALUE]... | ||
| 949 | 882 | ||
| 950 | ;;; Theme Manipulation | 883 | The following KEYWORD's are defined: |
| 884 | |||
| 885 | :short-description | ||
| 886 | VALUE is a short (one line) description of the theme. If not | ||
| 887 | given, DOC is used. | ||
| 888 | :immediate | ||
| 889 | If VALUE is non-nil, variables specified in this theme are set | ||
| 890 | immediately when loading the theme. | ||
| 891 | :variable-set-string | ||
| 892 | VALUE is a string used to indicate that a variable takes its | ||
| 893 | setting from this theme. It is passed to FORMAT with the name | ||
| 894 | of the theme as an additional argument. If not given, a | ||
| 895 | generic description is used. | ||
| 896 | :variable-reset-string | ||
| 897 | VALUE is a string used in the case a variable has been forced | ||
| 898 | to its value in this theme. It is passed to FORMAT with the | ||
| 899 | name of the theme as an additional argument. If not given, a | ||
| 900 | generic description is used. | ||
| 901 | :face-set-string | ||
| 902 | VALUE is a string used to indicate that a face takes its | ||
| 903 | setting from this theme. It is passed to FORMAT with the name | ||
| 904 | of the theme as an additional argument. If not given, a | ||
| 905 | generic description is used. | ||
| 906 | :face-reset-string | ||
| 907 | VALUE is a string used in the case a face has been forced to | ||
| 908 | its value in this theme. It is passed to FORMAT with the name | ||
| 909 | of the theme as an additional argument. If not given, a | ||
| 910 | generic description is used. | ||
| 911 | |||
| 912 | Any theme `foo' should be defined in a file called `foo-theme.el'; | ||
| 913 | see `custom-make-theme-feature' for more information." | ||
| 914 | (let ((feature (custom-make-theme-feature theme))) | ||
| 915 | ;; It is better not to use backquote in this file, | ||
| 916 | ;; because that makes a bootstrapping problem | ||
| 917 | ;; if you need to recompile all the Lisp files using interpreted code. | ||
| 918 | (nconc (list 'custom-declare-theme | ||
| 919 | (list 'quote theme) | ||
| 920 | (list 'quote feature) | ||
| 921 | doc) | ||
| 922 | args))) | ||
| 923 | |||
| 924 | (defun custom-declare-theme (theme feature &optional doc &rest args) | ||
| 925 | "Like `deftheme', but THEME is evaluated as a normal argument. | ||
| 926 | FEATURE is the feature this theme provides. This symbol is created | ||
| 927 | from THEME by `custom-make-theme-feature'." | ||
| 928 | (add-to-list 'custom-known-themes theme) | ||
| 929 | (put theme 'theme-feature feature) | ||
| 930 | (when doc | ||
| 931 | (put theme 'theme-documentation doc)) | ||
| 932 | (while args | ||
| 933 | (let ((arg (car args))) | ||
| 934 | (setq args (cdr args)) | ||
| 935 | (unless (symbolp arg) | ||
| 936 | (error "Junk in args %S" args)) | ||
| 937 | (let ((keyword arg) | ||
| 938 | (value (car args))) | ||
| 939 | (unless args | ||
| 940 | (error "Keyword %s is missing an argument" keyword)) | ||
| 941 | (setq args (cdr args)) | ||
| 942 | (cond ((eq keyword :short-description) | ||
| 943 | (put theme 'theme-short-description value)) | ||
| 944 | ((eq keyword :immediate) | ||
| 945 | (put theme 'theme-immediate value)) | ||
| 946 | ((eq keyword :variable-set-string) | ||
| 947 | (put theme 'theme-variable-set-string value)) | ||
| 948 | ((eq keyword :variable-reset-string) | ||
| 949 | (put theme 'theme-variable-reset-string value)) | ||
| 950 | ((eq keyword :face-set-string) | ||
| 951 | (put theme 'theme-face-set-string value)) | ||
| 952 | ((eq keyword :face-reset-string) | ||
| 953 | (put theme 'theme-face-reset-string value))))))) | ||
| 954 | |||
| 955 | (defun custom-make-theme-feature (theme) | ||
| 956 | "Given a symbol THEME, create a new symbol by appending \"-theme\". | ||
| 957 | Store this symbol in the `theme-feature' property of THEME. | ||
| 958 | Calling `provide-theme' to provide THEME actually puts `THEME-theme' | ||
| 959 | into `features'. | ||
| 960 | |||
| 961 | This allows for a file-name convention for autoloading themes: | ||
| 962 | Every theme X has a property `provide-theme' whose value is \"X-theme\". | ||
| 963 | \(require-theme X) then attempts to load the file `X-theme.el'." | ||
| 964 | (intern (concat (symbol-name theme) "-theme"))) | ||
| 965 | |||
| 966 | ;;; Loading themes. | ||
| 967 | |||
| 968 | ;; The variable and face settings of a theme are recorded in | ||
| 969 | ;; the `theme-settings' property of the theme name. | ||
| 970 | ;; This property's value is a list of elements, each of the form | ||
| 971 | ;; (PROP SYMBOL THEME MODE VALUE), where PROP is `theme-value' or `theme-face' | ||
| 972 | ;; and SYMBOL is the face or variable name. | ||
| 973 | ;; THEME is the theme name itself; that's redundant, but simplifies things. | ||
| 974 | ;; MODE is `set' or `reset'. | ||
| 975 | ;; If MODE is `set', then VALUE is an expression that specifies the | ||
| 976 | ;; theme's setting for SYMBOL. | ||
| 977 | ;; If MODE is `reset', then VALUE is another theme, | ||
| 978 | ;; and it means to use the value from that theme. | ||
| 979 | |||
| 980 | ;; Each variable has a `theme-value' property that describes all the | ||
| 981 | ;; settings of enabled themes that apply to it. | ||
| 982 | ;; Each face name has a `theme-face' property that describes all the | ||
| 983 | ;; settings of enabled themes that apply to it. | ||
| 984 | ;; The property value is a list of settings, each with the form | ||
| 985 | ;; (THEME MODE VALUE). THEME, MODE and VALUE are as above. | ||
| 986 | |||
| 987 | ;; When a theme is disabled, its settings are removed from the | ||
| 988 | ;; `theme-value' and `theme-face' properties, but the | ||
| 989 | ;; theme's own `theme-settings' property remains unchanged. | ||
| 951 | 990 | ||
| 952 | (defvar custom-loaded-themes nil | 991 | (defvar custom-loaded-themes nil |
| 953 | "Themes in the order they are loaded.") | 992 | "Custom themes that have been loaded.") |
| 954 | 993 | ||
| 955 | (defcustom custom-theme-directory | 994 | (defcustom custom-theme-directory |
| 956 | (if (eq system-type 'ms-dos) | 995 | (if (eq system-type 'ms-dos) |
| @@ -966,26 +1005,43 @@ into this directory." | |||
| 966 | :version "22.1") | 1005 | :version "22.1") |
| 967 | 1006 | ||
| 968 | (defun custom-theme-loaded-p (theme) | 1007 | (defun custom-theme-loaded-p (theme) |
| 969 | "Return non-nil when THEME has been loaded." | 1008 | "Return non-nil if THEME has been loaded." |
| 970 | (memq theme custom-loaded-themes)) | 1009 | (memq theme custom-loaded-themes)) |
| 971 | 1010 | ||
| 1011 | (defvar custom-enabled-themes '(user) | ||
| 1012 | "Custom themes currently enabled, highest precedence first. | ||
| 1013 | The first one is always `user'.") | ||
| 1014 | |||
| 1015 | (defun custom-theme-enabled-p (theme) | ||
| 1016 | "Return non-nil if THEME is enabled." | ||
| 1017 | (memq theme custom-enabled-themes)) | ||
| 1018 | |||
| 972 | (defun provide-theme (theme) | 1019 | (defun provide-theme (theme) |
| 973 | "Indicate that this file provides THEME. | 1020 | "Indicate that this file provides THEME. |
| 974 | Add THEME to `custom-loaded-themes' and `provide' whatever | 1021 | Add THEME to `custom-loaded-themes', and `provide' whatever |
| 975 | is stored in THEME's property `theme-feature'. | 1022 | feature name is stored in THEME's property `theme-feature'. |
| 976 | 1023 | ||
| 977 | Usually the theme-feature property contains a symbol created | 1024 | Usually the `theme-feature' property contains a symbol created |
| 978 | by `custom-make-theme-feature'." | 1025 | by `custom-make-theme-feature'." |
| 979 | (custom-check-theme theme) | 1026 | (custom-check-theme theme) |
| 980 | (provide (get theme 'theme-feature)) | 1027 | (provide (get theme 'theme-feature)) |
| 981 | (setq custom-loaded-themes (nconc (list theme) custom-loaded-themes))) | 1028 | (push theme custom-loaded-themes) |
| 1029 | ;; Loading a theme also installs its settings, | ||
| 1030 | ;; so mark it as "enabled". | ||
| 1031 | (push theme custom-enabled-themes) | ||
| 1032 | ;; `user' must always be the highest-precedence enabled theme. | ||
| 1033 | ;; Make that remain true. (This has the effect of making user settings | ||
| 1034 | ;; override the ones just loaded, too.) | ||
| 1035 | (custom-enable-theme 'user)) | ||
| 982 | 1036 | ||
| 983 | (defun require-theme (theme) | 1037 | (defun require-theme (theme) |
| 984 | "Try to load a theme by requiring its feature. | 1038 | "Try to load a theme's settings from its file. |
| 985 | THEME's feature is stored in THEME's `theme-feature' property. | 1039 | This also enables the theme; use `custom-disable-theme' to disable it." |
| 1040 | |||
| 1041 | ;; THEME's feature is stored in THEME's `theme-feature' property. | ||
| 1042 | ;; Usually the `theme-feature' property contains a symbol created | ||
| 1043 | ;; by `custom-make-theme-feature'. | ||
| 986 | 1044 | ||
| 987 | Usually the `theme-feature' property contains a symbol created | ||
| 988 | by `custom-make-theme-feature'." | ||
| 989 | ;; Note we do no check for validity of the theme here. | 1045 | ;; Note we do no check for validity of the theme here. |
| 990 | ;; This allows to pull in themes by a file-name convention | 1046 | ;; This allows to pull in themes by a file-name convention |
| 991 | (let ((load-path (if (file-directory-p custom-theme-directory) | 1047 | (let ((load-path (if (file-directory-p custom-theme-directory) |
| @@ -993,70 +1049,35 @@ by `custom-make-theme-feature'." | |||
| 993 | load-path))) | 1049 | load-path))) |
| 994 | (require (or (get theme 'theme-feature) | 1050 | (require (or (get theme 'theme-feature) |
| 995 | (custom-make-theme-feature theme))))) | 1051 | (custom-make-theme-feature theme))))) |
| 996 | 1052 | ||
| 997 | (defun custom-remove-theme (spec-alist theme) | 1053 | ;;; How to load and enable various themes as part of `user'. |
| 998 | "Delete all elements from SPEC-ALIST whose car is THEME." | ||
| 999 | (let ((elt (assoc theme spec-alist))) | ||
| 1000 | (while elt | ||
| 1001 | (setq spec-alist (delete elt spec-alist) | ||
| 1002 | elt (assoc theme spec-alist)))) | ||
| 1003 | spec-alist) | ||
| 1004 | |||
| 1005 | (defun custom-do-theme-reset (theme) | ||
| 1006 | "Undo all settings defined by THEME. | ||
| 1007 | |||
| 1008 | A variable remains unchanged if its property `theme-value' does not | ||
| 1009 | contain a value for THEME. A face remains unchanged if its property | ||
| 1010 | `theme-face' does not contain a value for THEME. In either case, all | ||
| 1011 | settings for THEME are removed from the property and the variable or | ||
| 1012 | face is set to the `user' theme. | ||
| 1013 | |||
| 1014 | See `custom-known-themes' for a list of known themes." | ||
| 1015 | (let (spec-list) | ||
| 1016 | (mapatoms (lambda (symbol) | ||
| 1017 | ;; This works even if symbol is both a variable and a | ||
| 1018 | ;; face. | ||
| 1019 | (setq spec-list (get symbol 'theme-value)) | ||
| 1020 | (when spec-list | ||
| 1021 | (put symbol 'theme-value (custom-remove-theme spec-list theme)) | ||
| 1022 | (custom-theme-reset-internal symbol 'user)) | ||
| 1023 | (setq spec-list (get symbol 'theme-face)) | ||
| 1024 | (when spec-list | ||
| 1025 | (put symbol 'theme-face (custom-remove-theme spec-list theme)) | ||
| 1026 | (custom-theme-reset-internal-face symbol 'user)))))) | ||
| 1027 | 1054 | ||
| 1028 | (defun custom-theme-load-themes (by-theme &rest body) | 1055 | (defun custom-theme-load-themes (by-theme &rest body) |
| 1029 | "Load the themes specified by BODY. | 1056 | "Load the themes specified by BODY. |
| 1030 | Record them as required by theme BY-THEME. BODY is a sequence of either | 1057 | Record them as required by theme BY-THEME. |
| 1058 | |||
| 1059 | BODY is a sequence of either | ||
| 1031 | 1060 | ||
| 1032 | THEME | 1061 | THEME |
| 1033 | BY-THEME requires THEME | 1062 | Load THEME and enable it. |
| 1034 | \(reset THEME) | 1063 | \(reset THEME) |
| 1035 | Undo all the settings made by THEME | 1064 | Undo all the settings made by THEME |
| 1036 | \(hidden THEME) | 1065 | \(hidden THEME) |
| 1037 | Require THEME but hide it from the user | 1066 | Load THEME but do not enable it. |
| 1038 | 1067 | ||
| 1039 | All the themes loaded for BY-THEME are recorded in BY-THEME's property | 1068 | All the themes loaded for BY-THEME are recorded in BY-THEME's property |
| 1040 | `theme-loads-themes'. Any theme loaded with the hidden predicate will | 1069 | `theme-loads-themes'." |
| 1041 | be given the property `theme-hidden' unless it has been loaded before. | ||
| 1042 | Whether a theme has been loaded before is determined by the function | ||
| 1043 | `custom-theme-loaded-p'." | ||
| 1044 | (custom-check-theme by-theme) | 1070 | (custom-check-theme by-theme) |
| 1045 | (let ((theme) | 1071 | (let ((themes-loaded (get by-theme 'theme-loads-themes))) |
| 1046 | (themes-loaded (get by-theme 'theme-loads-themes))) | 1072 | (dolist (theme body) |
| 1047 | (while theme | ||
| 1048 | (setq theme (car body) | ||
| 1049 | body (cdr body)) | ||
| 1050 | (cond ((and (consp theme) (eq (car theme) 'reset)) | 1073 | (cond ((and (consp theme) (eq (car theme) 'reset)) |
| 1051 | (custom-do-theme-reset (cadr theme))) | 1074 | (custom-disable-theme (cadr theme))) |
| 1052 | ((and (consp theme) (eq (car theme) 'hidden)) | 1075 | ((and (consp theme) (eq (car theme) 'hidden)) |
| 1053 | (require-theme (cadr theme)) | 1076 | (require-theme (cadr theme)) |
| 1054 | (unless (custom-theme-loaded-p (cadr theme)) | 1077 | (custom-disable-theme (cadr theme))) |
| 1055 | (put (cadr theme) 'theme-hidden t))) | ||
| 1056 | (t | 1078 | (t |
| 1057 | (require-theme theme) | 1079 | (require-theme theme))) |
| 1058 | (put theme 'theme-hidden nil))) | 1080 | (push theme themes-loaded)) |
| 1059 | (setq themes-loaded (nconc (list theme) themes-loaded))) | ||
| 1060 | (put by-theme 'theme-loads-themes themes-loaded))) | 1081 | (put by-theme 'theme-loads-themes themes-loaded))) |
| 1061 | 1082 | ||
| 1062 | (defun custom-load-themes (&rest body) | 1083 | (defun custom-load-themes (&rest body) |
| @@ -1064,82 +1085,126 @@ Whether a theme has been loaded before is determined by the function | |||
| 1064 | 1085 | ||
| 1065 | See `custom-theme-load-themes' for more information on BODY." | 1086 | See `custom-theme-load-themes' for more information on BODY." |
| 1066 | (apply 'custom-theme-load-themes 'user body)) | 1087 | (apply 'custom-theme-load-themes 'user body)) |
| 1067 | 1088 | ||
| 1068 | ; (defsubst copy-upto-last (elt list) | 1089 | ;;; Enabling and disabling loaded themes. |
| 1069 | ; "Copy all the elements of the list upto the last occurence of elt" | 1090 | |
| 1070 | ; ;; Is it faster to do more work in C than to do less in elisp? | 1091 | (defun custom-enable-theme (theme) |
| 1071 | ; (nreverse (cdr (member elt (reverse list))))) | 1092 | "Reenable all variable and face settings defined by THEME. |
| 1072 | 1093 | The newly enabled theme gets the highest precedence (after `user'). | |
| 1073 | (defun custom-theme-value (theme theme-spec-list) | 1094 | If it is already enabled, just give it highest precedence (after `user')." |
| 1074 | "Determine the value for THEME defined by THEME-SPEC-LIST. | 1095 | (let ((settings (get theme 'theme-settings))) |
| 1075 | Returns a list with the original value if found; nil otherwise. | 1096 | (dolist (s settings) |
| 1076 | 1097 | (let* ((prop (car s)) | |
| 1077 | THEME-SPEC-LIST is an alist with themes as its key. As new themes are | 1098 | (symbol (cadr s)) |
| 1078 | installed, these are added to the front of THEME-SPEC-LIST. | 1099 | (spec-list (get symbol prop))) |
| 1079 | Each element has the form | 1100 | (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) |
| 1101 | (if (eq prop 'theme-value) | ||
| 1102 | (custom-theme-recalc-variable symbol) | ||
| 1103 | (custom-theme-recalc-face symbol))))) | ||
| 1104 | (push theme custom-enabled-themes) | ||
| 1105 | ;; `user' must always be the highest-precedence enabled theme. | ||
| 1106 | (unless (eq theme 'user) | ||
| 1107 | (custom-enable-theme 'user))) | ||
| 1108 | |||
| 1109 | (defun custom-disable-theme (theme) | ||
| 1110 | "Disable all variable and face settings defined by THEME. | ||
| 1111 | See `custom-known-themes' for a list of known themes." | ||
| 1112 | (let ((settings (get theme 'theme-settings))) | ||
| 1113 | (dolist (s settings) | ||
| 1114 | (let* ((prop (car s)) | ||
| 1115 | (symbol (cadr s)) | ||
| 1116 | (spec-list (get symbol prop))) | ||
| 1117 | (put symbol 'theme-value (assq-delete-all theme spec-list)) | ||
| 1118 | (if (eq prop 'theme-value) | ||
| 1119 | (custom-theme-recalc-variable symbol) | ||
| 1120 | (custom-theme-recalc-face symbol))))) | ||
| 1121 | (setq custom-enabled-themes | ||
| 1122 | (delq theme custom-enabled-themes))) | ||
| 1123 | |||
| 1124 | (defun custom-theme-value (theme setting-list) | ||
| 1125 | "Determine the value specified for THEME according to SETTING-LIST. | ||
| 1126 | Returns a list whose car is the specified value, if we | ||
| 1127 | find one; nil otherwise. | ||
| 1128 | |||
| 1129 | SETTING-LIST is an alist with themes as its key. | ||
| 1130 | Each element has the form: | ||
| 1080 | 1131 | ||
| 1081 | \(THEME MODE VALUE) | 1132 | \(THEME MODE VALUE) |
| 1082 | 1133 | ||
| 1083 | MODE is either the symbol `set' or the symbol `reset'. See | 1134 | MODE is either the symbol `set' or the symbol `reset'. See |
| 1084 | `custom-push-theme' for more information on the format of | 1135 | `custom-push-theme' for more information on the format of |
| 1085 | THEME-SPEC-LIST." | 1136 | SETTING-LIST." |
| 1086 | ;; Note we do _NOT_ signal an error if the theme is unknown | 1137 | ;; Note we do _NOT_ signal an error if the theme is unknown |
| 1087 | ;; it might have gone away without the user knowing. | 1138 | ;; it might have gone away without the user knowing. |
| 1088 | (let ((value (cdr (assoc theme theme-spec-list)))) | 1139 | (let ((elt (cdr (assoc theme setting-list)))) |
| 1089 | (if value | 1140 | (if elt |
| 1090 | (if (eq (car value) 'set) | 1141 | (if (eq (car elt) 'set) |
| 1091 | (cdr value) | 1142 | (cdr elt) |
| 1092 | (custom-theme-value (cadr value) theme-spec-list))))) | 1143 | ;; `reset' means refer to another theme's value in the same alist. |
| 1093 | 1144 | (custom-theme-value (cadr elt) setting-list))))) | |
| 1094 | (defun custom-theme-variable-value (variable theme) | 1145 | |
| 1095 | "Return (list value) indicating value of VARIABLE in THEME. | 1146 | (defun custom-variable-theme-value (variable) |
| 1096 | If THEME does not define a value for VARIABLE, return nil. The value | 1147 | "Return (list VALUE) indicating the custom theme value of VARIABLE. |
| 1097 | definitions per theme are stored in VARIABLE's property `theme-value'. | 1148 | That is to say, it specifies what the value should be according to |
| 1098 | The actual work is done by function `custom-theme-value', which see. | 1149 | currently enabled custom themes. |
| 1099 | See `custom-push-theme' for more information on how these definitions | 1150 | |
| 1100 | are stored." | 1151 | This function returns nil if no custom theme specifies a value for VARIABLE." |
| 1101 | (custom-theme-value theme (get variable 'theme-value))) | 1152 | (let* ((theme-value (get variable 'theme-value))) |
| 1102 | 1153 | (if theme-value | |
| 1103 | (defun custom-theme-reset-internal (symbol to-theme) | 1154 | (custom-theme-value (car (car theme-value)) theme-value)))) |
| 1104 | "Reset SYMBOL to the value defined by TO-THEME. | 1155 | |
| 1105 | If SYMBOL is not defined in TO-THEME, reset SYMBOL to the standard | 1156 | (defun custom-face-theme-value (face) |
| 1106 | value. See `custom-theme-variable-value'. The standard value is | 1157 | "Return the face spec of FACE according to currently enabled custom themes. |
| 1107 | stored in SYMBOL's property `standard-value'." | 1158 | This function returns nil if no custom theme specifies anything for FACE." |
| 1108 | (let ((value (custom-theme-variable-value symbol to-theme)) | 1159 | (let* ((theme-value (get face 'theme-face))) |
| 1109 | was-in-theme) | 1160 | (if theme-value |
| 1110 | (setq was-in-theme value) | 1161 | (custom-theme-value (car (car theme-value)) theme-value)))) |
| 1111 | (setq value (or value (get symbol 'standard-value))) | 1162 | |
| 1112 | (when value | 1163 | (defun custom-theme-recalc-variable (variable) |
| 1113 | (put symbol 'saved-value was-in-theme) | 1164 | "Set VARIABLE according to currently enabled custom themes." |
| 1114 | (if (or (get 'force-value symbol) (default-boundp symbol)) | 1165 | (let ((valspec (custom-variable-theme-value variable))) |
| 1115 | (funcall (or (get symbol 'custom-set) 'set-default) symbol | 1166 | (when valspec |
| 1116 | (eval (car value))))) | 1167 | (put variable 'saved-value valspec)) |
| 1117 | value)) | 1168 | (unless valspec |
| 1118 | 1169 | (setq valspec (get variable 'standard-value))) | |
| 1170 | (when valspec | ||
| 1171 | (if (or (get 'force-value variable) (default-boundp variable)) | ||
| 1172 | (funcall (or (get variable 'custom-set) 'set-default) variable | ||
| 1173 | (eval (car valspec))))))) | ||
| 1174 | |||
| 1175 | (defun custom-theme-recalc-face (face) | ||
| 1176 | "Set FACE according to currently enabled custom themes." | ||
| 1177 | (let ((spec (custom-face-theme-value face))) | ||
| 1178 | (when spec | ||
| 1179 | (put face 'save-face spec)) | ||
| 1180 | (unless spec | ||
| 1181 | (setq spec (get face 'face-defface-spec))) | ||
| 1182 | (when spec | ||
| 1183 | (when (or (get face 'force-face) (facep face)) | ||
| 1184 | (unless (facep face) | ||
| 1185 | (make-empty-face face)) | ||
| 1186 | (face-spec-set face spec))))) | ||
| 1187 | |||
| 1119 | (defun custom-theme-reset-variables (theme &rest args) | 1188 | (defun custom-theme-reset-variables (theme &rest args) |
| 1120 | "Reset the value of the variables to values previously defined. | 1189 | "Reset the specs in THEME of some variables to their values in other themes. |
| 1121 | Associate this setting with THEME. | 1190 | Each of the arguments ARGS has this form: |
| 1122 | |||
| 1123 | ARGS is a list of lists of the form | ||
| 1124 | 1191 | ||
| 1125 | (VARIABLE TO-THEME) | 1192 | (VARIABLE FROM-THEME) |
| 1126 | 1193 | ||
| 1127 | This means reset VARIABLE to its value in TO-THEME." | 1194 | This means reset VARIABLE to its value in FROM-THEME." |
| 1128 | (custom-check-theme theme) | 1195 | (custom-check-theme theme) |
| 1129 | (mapcar '(lambda (arg) | 1196 | (dolist (arg args) |
| 1130 | (apply 'custom-theme-reset-internal arg) | 1197 | (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg)))) |
| 1131 | (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) | ||
| 1132 | args)) | ||
| 1133 | 1198 | ||
| 1134 | (defun custom-reset-variables (&rest args) | 1199 | (defun custom-reset-variables (&rest args) |
| 1135 | "Reset the value of the variables to values previously saved. | 1200 | "Reset the specs of some variables to their values in certain themes. |
| 1136 | This is the setting associated the `user' theme. | 1201 | This creates settings in the `user' theme. |
| 1137 | 1202 | ||
| 1138 | ARGS is a list of lists of the form | 1203 | Each of the arguments ARGS has this form: |
| 1139 | 1204 | ||
| 1140 | (VARIABLE TO-THEME) | 1205 | (VARIABLE FROM-THEME) |
| 1141 | 1206 | ||
| 1142 | This means reset VARIABLE to its value in TO-THEME." | 1207 | This means reset VARIABLE to its value in FROM-THEME." |
| 1143 | (apply 'custom-theme-reset-variables 'user args)) | 1208 | (apply 'custom-theme-reset-variables 'user args)) |
| 1144 | 1209 | ||
| 1145 | ;;; The End. | 1210 | ;;; The End. |