25 |
|
|
26 |
;;; Commentary: |
;;; Commentary: |
27 |
;; |
;; |
28 |
;; This file only contain the code needed to declare and initialize |
;; This file only contains the code needed to declare and initialize |
29 |
;; user options. The code to customize options is autoloaded from |
;; user options. The code to customize options is autoloaded from |
30 |
;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual. |
;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual. |
31 |
|
|
32 |
;; The code implementing face declarations is in `cus-face.el' |
;; The code implementing face declarations is in `cus-face.el'. |
33 |
|
|
34 |
;;; Code: |
;;; Code: |
35 |
|
|
39 |
;; Customize information for this option is in `cus-edit.el'. |
;; Customize information for this option is in `cus-edit.el'. |
40 |
"Hook called after defining each customize option.") |
"Hook called after defining each customize option.") |
41 |
|
|
42 |
|
(defvar custom-dont-initialize nil |
43 |
|
"Non-nil means `defcustom' should not initialize the variable. |
44 |
|
That is used for the sake of `custom-make-dependencies'. |
45 |
|
Users should not set it.") |
46 |
|
|
47 |
(defvar custom-current-group-alist nil |
(defvar custom-current-group-alist nil |
48 |
"Alist of (FILE . GROUP) indicating the current group to use for FILE.") |
"Alist of (FILE . GROUP) indicating the current group to use for FILE.") |
49 |
|
|
112 |
(defun custom-declare-variable (symbol default doc &rest args) |
(defun custom-declare-variable (symbol default doc &rest args) |
113 |
"Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. |
"Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. |
114 |
DEFAULT should be an expression to evaluate to compute the default value, |
DEFAULT should be an expression to evaluate to compute the default value, |
115 |
not the default value itself." |
not the default value itself. |
116 |
;; Remember the standard setting. |
|
117 |
|
DEFAULT is stored as SYMBOL's value in the standard theme. See |
118 |
|
`custom-known-themes' for a list of known themes. For backwards |
119 |
|
compatibility, DEFAULT is also stored in SYMBOL's property |
120 |
|
`standard-value'. At the same time, SYMBOL's property `force-value' is |
121 |
|
set to nil, as the value is no longer rogue." |
122 |
|
;; Remember the standard setting. The value should be in the standard |
123 |
|
;; theme, not in this property. However, his would require changeing |
124 |
|
;; the C source of defvar and others as well... |
125 |
(put symbol 'standard-value (list default)) |
(put symbol 'standard-value (list default)) |
126 |
;; Maybe this option was rogue in an earlier version. It no longer is. |
;; Maybe this option was rogue in an earlier version. It no longer is. |
127 |
(when (get symbol 'force-value) |
(when (get symbol 'force-value) |
149 |
((eq keyword :get) |
((eq keyword :get) |
150 |
(put symbol 'custom-get value)) |
(put symbol 'custom-get value)) |
151 |
((eq keyword :require) |
((eq keyword :require) |
152 |
(setq requests (cons value requests))) |
(push value requests)) |
153 |
((eq keyword :type) |
((eq keyword :type) |
154 |
(put symbol 'custom-type (purecopy value))) |
(put symbol 'custom-type (purecopy value))) |
155 |
((eq keyword :options) |
((eq keyword :options) |
157 |
;; Slow safe code to avoid duplicates. |
;; Slow safe code to avoid duplicates. |
158 |
(mapc (lambda (option) |
(mapc (lambda (option) |
159 |
(custom-add-option symbol option)) |
(custom-add-option symbol option)) |
160 |
value) |
value) |
161 |
;; Fast code for the common case. |
;; Fast code for the common case. |
162 |
(put symbol 'custom-options (copy-sequence value)))) |
(put symbol 'custom-options (copy-sequence value)))) |
163 |
(t |
(t |
165 |
'custom-variable)))))) |
'custom-variable)))))) |
166 |
(put symbol 'custom-requests requests) |
(put symbol 'custom-requests requests) |
167 |
;; Do the actual initialization. |
;; Do the actual initialization. |
168 |
(funcall initialize symbol default)) |
(unless custom-dont-initialize |
169 |
(setq current-load-list (cons symbol current-load-list)) |
(funcall initialize symbol default))) |
170 |
|
(push (cons 'defvar symbol) current-load-list) |
171 |
(run-hooks 'custom-define-hook) |
(run-hooks 'custom-define-hook) |
172 |
symbol) |
symbol) |
173 |
|
|
183 |
|
|
184 |
The following keywords are meaningful: |
The following keywords are meaningful: |
185 |
|
|
186 |
:type VALUE should be a widget type for editing the symbols value. |
:type VALUE should be a widget type for editing the symbol's value. |
187 |
:options VALUE should be a list of valid members of the widget type. |
:options VALUE should be a list of valid members of the widget type. |
188 |
:group VALUE should be a customization group. |
:group VALUE should be a customization group. |
189 |
Add SYMBOL to that group. |
Add SYMBOL to that group. |
191 |
Include an external link after the documentation string for this |
Include an external link after the documentation string for this |
192 |
item. This is a sentence containing an active field which |
item. This is a sentence containing an active field which |
193 |
references some other documentation. |
references some other documentation. |
194 |
|
|
195 |
There are three alternatives you can use for LINK-DATA: |
There are three alternatives you can use for LINK-DATA: |
196 |
|
|
197 |
(custom-manual INFO-NODE) |
(custom-manual INFO-NODE) |
198 |
Link to an Info node; INFO-NODE is a string which specifies |
Link to an Info node; INFO-NODE is a string which specifies |
199 |
the node name, as in \"(emacs)Top\". The link appears as |
the node name, as in \"(emacs)Top\". The link appears as |
200 |
`[manual]' in the customization buffer. |
`[manual]' in the customization buffer. |
201 |
|
|
202 |
(info-link INFO-NODE) |
(info-link INFO-NODE) |
203 |
Like `custom-manual' except that the link appears in the |
Like `custom-manual' except that the link appears in the |
204 |
customization buffer with the Info node name. |
customization buffer with the Info node name. |
205 |
|
|
206 |
(url-link URL) |
(url-link URL) |
207 |
Link to a web page; URL is a string which specifies the URL. |
Link to a web page; URL is a string which specifies the URL. |
208 |
The link appears in the customization buffer as URL. |
The link appears in the customization buffer as URL. |
209 |
|
|
210 |
You can specify the text to use in the customization buffer by |
You can specify the text to use in the customization buffer by |
211 |
adding `:tag NAME' after the first element of the LINK-DATA; for |
adding `:tag NAME' after the first element of the LINK-DATA; for |
212 |
example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the |
example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the |
213 |
Emacs manual which appears in the buffer as `foo'. |
Emacs manual which appears in the buffer as `foo'. |
214 |
|
|
215 |
An item can have more than one external link; however, most items |
An item can have more than one external link; however, most items |
216 |
have none at all. |
have none at all. |
217 |
:initialize |
:initialize |
239 |
in customization menus and buffers. |
in customization menus and buffers. |
240 |
:load FILE |
:load FILE |
241 |
Load file FILE (a string) before displaying this customization |
Load file FILE (a string) before displaying this customization |
242 |
item. Loading is done with `load-library', and only if the file is |
item. Loading is done with `load', and only if the file is |
243 |
not already loaded. |
not already loaded. |
244 |
:set-after VARIABLE |
:set-after VARIABLES |
245 |
Specifies that SYMBOL should be set after VARIABLE when |
Specifies that SYMBOL should be set after the list of variables |
246 |
both have been customized. |
VARIABLES when both have been customized. |
247 |
|
|
248 |
Read the section about customization in the Emacs Lisp manual for more |
Read the section about customization in the Emacs Lisp manual for more |
249 |
information." |
information." |
323 |
(while members |
(while members |
324 |
(apply 'custom-add-to-group symbol (car members)) |
(apply 'custom-add-to-group symbol (car members)) |
325 |
(setq members (cdr members))) |
(setq members (cdr members))) |
|
(put symbol 'custom-group (nconc members (get symbol 'custom-group))) |
|
326 |
(when doc |
(when doc |
327 |
;; This text doesn't get into DOC. |
;; This text doesn't get into DOC. |
328 |
(put symbol 'group-documentation (purecopy doc))) |
(put symbol 'group-documentation (purecopy doc))) |
386 |
(unless (member entry members) |
(unless (member entry members) |
387 |
(put group 'custom-group (nconc members (list entry)))))) |
(put group 'custom-group (nconc members (list entry)))))) |
388 |
|
|
389 |
|
(defun custom-group-of-mode (mode) |
390 |
|
"Return the custom group corresponding to the major or minor MODE. |
391 |
|
If no such group is found, return nil." |
392 |
|
(or (get mode 'custom-mode-group) |
393 |
|
(if (or (get mode 'custom-group) |
394 |
|
(and (string-match "-mode\\'" (symbol-name mode)) |
395 |
|
(get (setq mode (intern (substring (symbol-name mode) |
396 |
|
0 (match-beginning 0)))) |
397 |
|
'custom-group))) |
398 |
|
mode))) |
399 |
|
|
400 |
;;; Properties. |
;;; Properties. |
401 |
|
|
402 |
(defun custom-handle-all-keywords (symbol args type) |
(defun custom-handle-all-keywords (symbol args type) |
403 |
"For customization option SYMBOL, handle keyword arguments ARGS. |
"For customization option SYMBOL, handle keyword arguments ARGS. |
404 |
Third argument TYPE is the custom option type." |
Third argument TYPE is the custom option type." |
405 |
(unless (memq :group args) |
(unless (memq :group args) |
406 |
(custom-add-to-group (custom-current-group) symbol 'custom-face)) |
(custom-add-to-group (custom-current-group) symbol type)) |
407 |
(while args |
(while args |
408 |
(let ((arg (car args))) |
(let ((arg (car args))) |
409 |
(setq args (cdr args)) |
(setq args (cdr args)) |
454 |
(setq value (cdr value)))) |
(setq value (cdr value)))) |
455 |
(unless (eq deps new-deps) |
(unless (eq deps new-deps) |
456 |
(put symbol 'custom-dependencies new-deps)))) |
(put symbol 'custom-dependencies new-deps)))) |
457 |
|
|
458 |
(defun custom-add-option (symbol option) |
(defun custom-add-option (symbol option) |
459 |
"To the variable SYMBOL add OPTION. |
"To the variable SYMBOL add OPTION. |
460 |
|
|
481 |
(unless (member load loads) |
(unless (member load loads) |
482 |
(put symbol 'custom-loads (cons (purecopy load) loads))))) |
(put symbol 'custom-loads (cons (purecopy load) loads))))) |
483 |
|
|
484 |
|
(defun custom-autoload (symbol load) |
485 |
|
"Mark SYMBOL as autoloaded custom variable and add dependency LOAD." |
486 |
|
(put symbol 'custom-autoload t) |
487 |
|
(custom-add-load symbol load)) |
488 |
|
|
489 |
|
;; This test is also in the C code of `user-variable-p'. |
490 |
|
(defun custom-variable-p (variable) |
491 |
|
"Return non-nil if VARIABLE is a custom variable." |
492 |
|
(or (get variable 'standard-value) |
493 |
|
(get variable 'custom-autoload))) |
494 |
|
|
495 |
;;; Loading files needed to customize a symbol. |
;;; Loading files needed to customize a symbol. |
496 |
;;; This is in custom.el because menu-bar.el needs it for toggle cmds. |
;;; This is in custom.el because menu-bar.el needs it for toggle cmds. |
497 |
|
|
501 |
(defun custom-load-symbol (symbol) |
(defun custom-load-symbol (symbol) |
502 |
"Load all dependencies for SYMBOL." |
"Load all dependencies for SYMBOL." |
503 |
(unless custom-load-recursion |
(unless custom-load-recursion |
504 |
(let ((custom-load-recursion t) |
(let ((custom-load-recursion t)) |
505 |
(loads (get symbol 'custom-loads)) |
(dolist (load (get symbol 'custom-loads)) |
506 |
load) |
(cond ((symbolp load) (condition-case nil (require load) (error nil))) |
507 |
(while loads |
;; This is subsumed by the test below, but it's much faster. |
|
(setq load (car loads) |
|
|
loads (cdr loads)) |
|
|
(cond ((symbolp load) |
|
|
(condition-case nil |
|
|
(require load) |
|
|
(error nil))) |
|
|
;; Don't reload a file already loaded. |
|
|
((and (boundp 'preloaded-file-list) |
|
|
(member load preloaded-file-list))) |
|
508 |
((assoc load load-history)) |
((assoc load load-history)) |
509 |
;; This was just (assoc (locate-library load) load-history) |
;; This was just (assoc (locate-library load) load-history) |
510 |
;; but has been optimized not to load locate-library |
;; but has been optimized not to load locate-library |
511 |
;; if not necessary. |
;; if not necessary. |
512 |
((let (found (regexp (regexp-quote load))) |
((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load) |
513 |
|
"\\(\\'\\|\\.\\)")) |
514 |
|
(found nil)) |
515 |
(dolist (loaded load-history) |
(dolist (loaded load-history) |
516 |
(and (stringp (car loaded)) |
(and (stringp (car loaded)) |
517 |
(string-match regexp (car loaded)) |
(string-match regexp (car loaded)) |
|
(eq (locate-library load) (car loaded)) |
|
518 |
(setq found t))) |
(setq found t))) |
519 |
found)) |
found)) |
520 |
;; Without this, we would load cus-edit recursively. |
;; Without this, we would load cus-edit recursively. |
521 |
;; We are still loading it when we call this, |
;; We are still loading it when we call this, |
522 |
;; and it is not in load-history yet. |
;; and it is not in load-history yet. |
523 |
((equal load "cus-edit")) |
((equal load "cus-edit")) |
524 |
(t |
(t (condition-case nil (load load) (error nil)))))))) |
525 |
(condition-case nil |
|
526 |
(load-library load) |
(defvar custom-known-themes '(user standard) |
527 |
(error nil)))))))) |
"Themes that have been define with `deftheme'. |
528 |
|
The default value is the list (user standard). The theme `standard' |
529 |
|
contains the Emacs standard settings from the original Lisp files. The |
530 |
|
theme `user' contains all the the settings the user customized and saved. |
531 |
|
Additional themes declared with the `deftheme' macro will be added to |
532 |
|
the front of this list.") |
533 |
|
|
534 |
|
(defun custom-declare-theme (theme feature &optional doc &rest args) |
535 |
|
"Like `deftheme', but THEME is evaluated as a normal argument. |
536 |
|
FEATURE is the feature this theme provides. This symbol is created |
537 |
|
from THEME by `custom-make-theme-feature'." |
538 |
|
(add-to-list 'custom-known-themes theme) |
539 |
|
(put theme 'theme-feature feature) |
540 |
|
(when doc |
541 |
|
(put theme 'theme-documentation doc)) |
542 |
|
(while args |
543 |
|
(let ((arg (car args))) |
544 |
|
(setq args (cdr args)) |
545 |
|
(unless (symbolp arg) |
546 |
|
(error "Junk in args %S" args)) |
547 |
|
(let ((keyword arg) |
548 |
|
(value (car args))) |
549 |
|
(unless args |
550 |
|
(error "Keyword %s is missing an argument" keyword)) |
551 |
|
(setq args (cdr args)) |
552 |
|
(cond ((eq keyword :short-description) |
553 |
|
(put theme 'theme-short-description short-description)) |
554 |
|
((eq keyword :immediate) |
555 |
|
(put theme 'theme-immediate immediate)) |
556 |
|
((eq keyword :variable-set-string) |
557 |
|
(put theme 'theme-variable-set-string variable-set-string)) |
558 |
|
((eq keyword :variable-reset-string) |
559 |
|
(put theme 'theme-variable-reset-string variable-reset-string)) |
560 |
|
((eq keyword :face-set-string) |
561 |
|
(put theme 'theme-face-set-string face-set-string)) |
562 |
|
((eq keyword :face-reset-string) |
563 |
|
(put theme 'theme-face-reset-string face-reset-string))))))) |
564 |
|
|
565 |
|
(defmacro deftheme (theme &optional doc &rest args) |
566 |
|
"Declare custom theme THEME. |
567 |
|
The optional argument DOC is a doc string describing the theme. |
568 |
|
The remaining arguments should have the form |
569 |
|
|
570 |
|
[KEYWORD VALUE]... |
571 |
|
|
572 |
|
The following KEYWORD's are defined: |
573 |
|
|
574 |
|
:short-description |
575 |
|
VALUE is a short (one line) description of the theme. If not |
576 |
|
given, DOC is used. |
577 |
|
:immediate |
578 |
|
If VALUE is non-nil, variables specified in this theme are set |
579 |
|
immediately when loading the theme. |
580 |
|
:variable-set-string |
581 |
|
VALUE is a string used to indicate that a variable takes its |
582 |
|
setting from this theme. It is passed to FORMAT with the name |
583 |
|
of the theme as an additional argument. If not given, a |
584 |
|
generic description is used. |
585 |
|
:variable-reset-string |
586 |
|
VALUE is a string used in the case a variable has been forced |
587 |
|
to its value in this theme. It is passed to FORMAT with the |
588 |
|
name of the theme as an additional argument. If not given, a |
589 |
|
generic description is used. |
590 |
|
:face-set-string |
591 |
|
VALUE is a string used to indicate that a face takes its |
592 |
|
setting from this theme. It is passed to FORMAT with the name |
593 |
|
of the theme as an additional argument. If not given, a |
594 |
|
generic description is used. |
595 |
|
:face-reset-string |
596 |
|
VALUE is a string used in the case a face has been forced to |
597 |
|
its value in this theme. It is passed to FORMAT with the name |
598 |
|
of the theme as an additional argument. If not given, a |
599 |
|
generic description is used. |
600 |
|
|
601 |
|
Any theme `foo' should be defined in a file called `foo-theme.el'; |
602 |
|
see `custom-make-theme-feature' for more information." |
603 |
|
(let ((feature (custom-make-theme-feature theme))) |
604 |
|
;; It is better not to use backquote in this file, |
605 |
|
;; because that makes a bootstrapping problem |
606 |
|
;; if you need to recompile all the Lisp files using interpreted code. |
607 |
|
(nconc (list 'custom-declare-theme |
608 |
|
(list 'quote theme) |
609 |
|
(list 'quote feature) |
610 |
|
doc) args))) |
611 |
|
|
612 |
|
(defun custom-make-theme-feature (theme) |
613 |
|
"Given a symbol THEME, create a new symbol by appending \"-theme\". |
614 |
|
Store this symbol in the `theme-feature' property of THEME. |
615 |
|
Calling `provide-theme' to provide THEME actually puts `THEME-theme' |
616 |
|
into `features'. |
617 |
|
|
618 |
|
This allows for a file-name convention for autoloading themes: |
619 |
|
Every theme X has a property `provide-theme' whose value is \"X-theme\". |
620 |
|
\(require-theme X) then attempts to load the file `X-theme.el'." |
621 |
|
(intern (concat (symbol-name theme) "-theme"))) |
622 |
|
|
623 |
|
(defsubst custom-theme-p (theme) |
624 |
|
"Non-nil when THEME has been defined." |
625 |
|
(memq theme custom-known-themes)) |
626 |
|
|
627 |
|
(defsubst custom-check-theme (theme) |
628 |
|
"Check whether THEME is valid, and signal an error if it is not." |
629 |
|
(unless (custom-theme-p theme) |
630 |
|
(error "Unknown theme `%s'" theme))) |
631 |
|
|
632 |
;;; Initializing. |
;;; Initializing. |
633 |
|
|
634 |
|
(defun custom-push-theme (prop symbol theme mode value) |
635 |
|
"Add (THEME MODE VALUE) to the list in property PROP of SYMBOL. |
636 |
|
If the first element in that list is already (THEME ...), |
637 |
|
discard it first. |
638 |
|
|
639 |
|
MODE can be either the symbol `set' or the symbol `reset'. If it is the |
640 |
|
symbol `set', then VALUE is the value to use. If it is the symbol |
641 |
|
`reset', then VALUE is the mode to query instead. |
642 |
|
|
643 |
|
In the following example for the variable `goto-address-url-face', the |
644 |
|
theme `subtle-hacker' uses the same value for the variable as the theme |
645 |
|
`gnome2': |
646 |
|
|
647 |
|
\((standard set bold) |
648 |
|
\(gnome2 set info-xref) |
649 |
|
\(jonadab set underline) |
650 |
|
\(subtle-hacker reset gnome2)) |
651 |
|
|
652 |
|
|
653 |
|
If a value has been stored for themes A B and C, and a new value |
654 |
|
is to be stored for theme C, then the old value of C is discarded. |
655 |
|
If a new value is to be stored for theme B, however, the old value |
656 |
|
of B is not discarded because B is not the car of the list. |
657 |
|
|
658 |
|
For variables, list property PROP is `theme-value'. |
659 |
|
For faces, list property PROP is `theme-face'. |
660 |
|
This is used in `custom-do-theme-reset', for example. |
661 |
|
|
662 |
|
The list looks the same in any case; the examples shows a possible |
663 |
|
value of the `theme-face' property for the face `region': |
664 |
|
|
665 |
|
\((gnome2 set ((t (:foreground \"cyan\" :background \"dark cyan\")))) |
666 |
|
\(standard set ((((class color) (background dark)) |
667 |
|
\(:background \"blue\")) |
668 |
|
\(t (:background \"gray\"))))) |
669 |
|
|
670 |
|
This records values for the `standard' and the `gnome2' themes. |
671 |
|
The user has not customized the face; had he done that, |
672 |
|
the list would contain an entry for the `user' theme, too. |
673 |
|
See `custom-known-themes' for a list of known themes." |
674 |
|
(let ((old (get symbol prop))) |
675 |
|
(if (eq (car-safe (car-safe old)) theme) |
676 |
|
(setq old (cdr old))) |
677 |
|
(put symbol prop (cons (list theme mode value) old)))) |
678 |
|
|
679 |
(defvar custom-local-buffer nil |
(defvar custom-local-buffer nil |
680 |
"Non-nil, in a Customization buffer, means customize a specific buffer. |
"Non-nil, in a Customization buffer, means customize a specific buffer. |
681 |
If this variable is non-nil, it should be a buffer, |
If this variable is non-nil, it should be a buffer, |
686 |
|
|
687 |
(defun custom-set-variables (&rest args) |
(defun custom-set-variables (&rest args) |
688 |
"Initialize variables according to user preferences. |
"Initialize variables according to user preferences. |
689 |
|
The settings are registered as theme `user'. |
690 |
|
The arguments should each be a list of the form: |
691 |
|
|
692 |
|
(SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) |
693 |
|
|
694 |
|
The unevaluated VALUE is stored as the saved value for SYMBOL. |
695 |
|
If NOW is present and non-nil, VALUE is also evaluated and bound as |
696 |
|
the default value for the SYMBOL. |
697 |
|
|
698 |
|
REQUEST is a list of features we must 'require for SYMBOL. |
699 |
|
COMMENT is a comment string about SYMBOL." |
700 |
|
(apply 'custom-theme-set-variables 'user args)) |
701 |
|
|
702 |
|
(defun custom-theme-set-variables (theme &rest args) |
703 |
|
"Initialize variables according to settings specified by args. |
704 |
|
Records the settings as belonging to THEME. |
705 |
|
|
706 |
The arguments should be a list where each entry has the form: |
The arguments should be a list where each entry has the form: |
707 |
|
|
710 |
The unevaluated VALUE is stored as the saved value for SYMBOL. |
The unevaluated VALUE is stored as the saved value for SYMBOL. |
711 |
If NOW is present and non-nil, VALUE is also evaluated and bound as |
If NOW is present and non-nil, VALUE is also evaluated and bound as |
712 |
the default value for the SYMBOL. |
the default value for the SYMBOL. |
713 |
REQUEST is a list of features we must require for SYMBOL. |
REQUEST is a list of features we must 'require for SYMBOL. |
714 |
COMMENT is a comment string about SYMBOL." |
COMMENT is a comment string about SYMBOL. |
715 |
(setq args |
|
716 |
(sort args |
Several properties of THEME and SYMBOL are used in the process: |
717 |
(lambda (a1 a2) |
|
718 |
(let* ((sym1 (car a1)) |
If THEME property `theme-immediate' is non-nil, this is equivalent of |
719 |
(sym2 (car a2)) |
providing the NOW argument to all symbols in the argument list: SYMBOL |
720 |
(1-then-2 (memq sym1 (get sym2 'custom-dependencies))) |
is bound to the evaluated VALUE. The only difference is SYMBOL property |
721 |
(2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) |
`force-value': if NOW is non-nil, SYMBOL's property `force-value' is set to |
722 |
(cond ((and 1-then-2 2-then-1) |
the symbol `rogue', else if THEME's property `theme-immediate' is non-nil, |
723 |
(error "Circular custom dependency between `%s' and `%s'" |
FACE's property `force-face' is set to the symbol `immediate'. |
724 |
sym1 sym2)) |
|
725 |
(1-then-2 t) |
VALUE itself is saved unevaluated as SYMBOL property `saved-value' and |
726 |
(2-then-1 nil) |
in SYMBOL's list property `theme-value' \(using `custom-push-theme')." |
727 |
;; Put symbols with :require last. The macro |
(custom-check-theme theme) |
728 |
;; define-minor-mode generates a defcustom |
(let ((immediate (get theme 'theme-immediate))) |
729 |
;; with a :require and a :set, where the |
(setq args |
730 |
;; setter function calls the mode function. |
(sort args |
731 |
;; Putting symbols with :require last ensures |
(lambda (a1 a2) |
732 |
;; that the mode function will see other |
(let* ((sym1 (car a1)) |
733 |
;; customized values rather than default |
(sym2 (car a2)) |
734 |
;; values. |
(1-then-2 (memq sym1 (get sym2 'custom-dependencies))) |
735 |
(t (nth 3 a2))))))) |
(2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) |
736 |
(while args |
(cond ((and 1-then-2 2-then-1) |
737 |
(let ((entry (car args))) |
(error "Circular custom dependency between `%s' and `%s'" |
738 |
(if (listp entry) |
sym1 sym2)) |
739 |
(let* ((symbol (nth 0 entry)) |
(2-then-1 nil) |
740 |
(value (nth 1 entry)) |
;; Put symbols with :require last. The macro |
741 |
(now (nth 2 entry)) |
;; define-minor-mode generates a defcustom |
742 |
(requests (nth 3 entry)) |
;; with a :require and a :set, where the |
743 |
(comment (nth 4 entry)) |
;; setter function calls the mode function. |
744 |
set) |
;; Putting symbols with :require last ensures |
745 |
(when requests |
;; that the mode function will see other |
746 |
(put symbol 'custom-requests requests) |
;; customized values rather than default |
747 |
(mapc 'require requests)) |
;; values. |
748 |
(setq set (or (get symbol 'custom-set) 'custom-set-default)) |
(t (nth 3 a2))))))) |
749 |
(put symbol 'saved-value (list value)) |
(while args |
750 |
(put symbol 'saved-variable-comment comment) |
(let ((entry (car args))) |
751 |
;; Allow for errors in the case where the setter has |
(if (listp entry) |
752 |
|
(let* ((symbol (nth 0 entry)) |
753 |
|
(value (nth 1 entry)) |
754 |
|
(now (nth 2 entry)) |
755 |
|
(requests (nth 3 entry)) |
756 |
|
(comment (nth 4 entry)) |
757 |
|
set) |
758 |
|
(when requests |
759 |
|
(put symbol 'custom-requests requests) |
760 |
|
(mapc 'require requests)) |
761 |
|
(setq set (or (get symbol 'custom-set) 'custom-set-default)) |
762 |
|
(put symbol 'saved-value (list value)) |
763 |
|
(put symbol 'saved-variable-comment comment) |
764 |
|
(custom-push-theme 'theme-value symbol theme 'set value) |
765 |
|
;; Allow for errors in the case where the setter has |
766 |
;; changed between versions, say, but let the user know. |
;; changed between versions, say, but let the user know. |
767 |
(condition-case data |
(condition-case data |
768 |
(cond (now |
(cond (now |
772 |
((default-boundp symbol) |
((default-boundp symbol) |
773 |
;; Something already set this, overwrite it. |
;; Something already set this, overwrite it. |
774 |
(funcall set symbol (eval value)))) |
(funcall set symbol (eval value)))) |
775 |
(error |
(error |
776 |
(message "Error setting %s: %s" symbol data))) |
(message "Error setting %s: %s" symbol data))) |
777 |
(setq args (cdr args)) |
(setq args (cdr args)) |
778 |
(and (or now (default-boundp symbol)) |
(and (or now (default-boundp symbol)) |
779 |
(put symbol 'variable-comment comment))) |
(put symbol 'variable-comment comment))) |
780 |
;; Old format, a plist of SYMBOL VALUE pairs. |
;; Old format, a plist of SYMBOL VALUE pairs. |
781 |
(message "Warning: old format `custom-set-variables'") |
(message "Warning: old format `custom-set-variables'") |
782 |
(ding) |
(ding) |
783 |
(sit-for 2) |
(sit-for 2) |
784 |
(let ((symbol (nth 0 args)) |
(let ((symbol (nth 0 args)) |
785 |
(value (nth 1 args))) |
(value (nth 1 args))) |
786 |
(put symbol 'saved-value (list value))) |
(put symbol 'saved-value (list value)) |
787 |
(setq args (cdr (cdr args))))))) |
(custom-push-theme 'theme-value symbol theme 'set value)) |
788 |
|
(setq args (cdr (cdr args)))))))) |
789 |
|
|
790 |
(defun custom-set-default (variable value) |
(defun custom-set-default (variable value) |
791 |
"Default :set function for a customizable variable. |
"Default :set function for a customizable variable. |
797 |
(set variable value)) |
(set variable value)) |
798 |
(set-default variable value))) |
(set-default variable value))) |
799 |
|
|
800 |
|
(defun custom-set-minor-mode (variable value) |
801 |
|
":set function for minor mode variables. |
802 |
|
Normally, this sets the default value of VARIABLE to nil if VALUE |
803 |
|
is nil and to t otherwise, |
804 |
|
but if `custom-local-buffer' is non-nil, |
805 |
|
this sets the local binding in that buffer instead." |
806 |
|
(if custom-local-buffer |
807 |
|
(with-current-buffer custom-local-buffer |
808 |
|
(funcall variable (or value 0))) |
809 |
|
(funcall variable (or value 0)))) |
810 |
|
|
811 |
(defun custom-quote (sexp) |
(defun custom-quote (sexp) |
812 |
"Quote SEXP iff it is not self quoting." |
"Quote SEXP iff it is not self quoting." |
813 |
(if (or (memq sexp '(t nil)) |
(if (or (memq sexp '(t nil)) |
826 |
(defun customize-mark-to-save (symbol) |
(defun customize-mark-to-save (symbol) |
827 |
"Mark SYMBOL for later saving. |
"Mark SYMBOL for later saving. |
828 |
|
|
829 |
If the default value of SYMBOL is different from the standard value, |
If the default value of SYMBOL is different from the standard value, |
830 |
set the `saved-value' property to a list whose car evaluates to the |
set the `saved-value' property to a list whose car evaluates to the |
831 |
default value. Otherwise, set it til nil. |
default value. Otherwise, set it to nil. |
832 |
|
|
833 |
To actually save the value, call `custom-save-all'. |
To actually save the value, call `custom-save-all'. |
834 |
|
|
855 |
(defun customize-mark-as-set (symbol) |
(defun customize-mark-as-set (symbol) |
856 |
"Mark current value of SYMBOL as being set from customize. |
"Mark current value of SYMBOL as being set from customize. |
857 |
|
|
858 |
If the default value of SYMBOL is different from the saved value if any, |
If the default value of SYMBOL is different from the saved value if any, |
859 |
or else if it is different from the standard value, set the |
or else if it is different from the standard value, set the |
860 |
`customized-value' property to a list whose car evaluates to the |
`customized-value' property to a list whose car evaluates to the |
861 |
default value. Otherwise, set it til nil. |
default value. Otherwise, set it to nil. |
862 |
|
|
863 |
Return non-nil iff the `customized-value' property actually changed." |
Return non-nil iff the `customized-value' property actually changed." |
864 |
(let* ((get (or (get symbol 'custom-get) 'default-value)) |
(let* ((get (or (get symbol 'custom-get) 'default-value)) |
867 |
(old (or (get symbol 'saved-value) (get symbol 'standard-value)))) |
(old (or (get symbol 'saved-value) (get symbol 'standard-value)))) |
868 |
;; Mark default value as set iff different from old value. |
;; Mark default value as set iff different from old value. |
869 |
(if (or (null old) |
(if (or (null old) |
870 |
(not (equal value (condition-case nil |
(not (equal value (condition-case nil |
871 |
(eval (car old)) |
(eval (car old)) |
872 |
(error nil))))) |
(error nil))))) |
873 |
(put symbol 'customized-value (list (custom-quote value))) |
(put symbol 'customized-value (list (custom-quote value))) |
875 |
;; Changed? |
;; Changed? |
876 |
(not (equal customized (get symbol 'customized-value))))) |
(not (equal customized (get symbol 'customized-value))))) |
877 |
|
|
878 |
|
;;; Theme Manipulation |
879 |
|
|
880 |
|
(defvar custom-loaded-themes nil |
881 |
|
"Themes in the order they are loaded.") |
882 |
|
|
883 |
|
(defun custom-theme-loaded-p (theme) |
884 |
|
"Return non-nil when THEME has been loaded." |
885 |
|
(memq theme custom-loaded-themes)) |
886 |
|
|
887 |
|
(defun provide-theme (theme) |
888 |
|
"Indicate that this file provides THEME. |
889 |
|
Add THEME to `custom-loaded-themes' and `provide' whatever |
890 |
|
is stored in THEME's property `theme-feature'. |
891 |
|
|
892 |
|
Usually the theme-feature property contains a symbol created |
893 |
|
by `custom-make-theme-feature'." |
894 |
|
(custom-check-theme theme) |
895 |
|
(provide (get theme 'theme-feature)) |
896 |
|
(setq custom-loaded-themes (nconc (list theme) custom-loaded-themes))) |
897 |
|
|
898 |
|
(defun require-theme (theme) |
899 |
|
"Try to load a theme by requiring its feature. |
900 |
|
THEME's feature is stored in THEME's `theme-feature' property. |
901 |
|
|
902 |
|
Usually the `theme-feature' property contains a symbol created |
903 |
|
by `custom-make-theme-feature'." |
904 |
|
;; Note we do no check for validity of the theme here. |
905 |
|
;; This allows to pull in themes by a file-name convention |
906 |
|
(require (or (get theme 'theme-feature) |
907 |
|
(custom-make-theme-feature theme)))) |
908 |
|
|
909 |
|
(defun custom-remove-theme (spec-alist theme) |
910 |
|
"Delete all elements from SPEC-ALIST whose car is THEME." |
911 |
|
(let ((elt (assoc theme spec-alist))) |
912 |
|
(while elt |
913 |
|
(setq spec-alist (delete elt spec-alist) |
914 |
|
elt (assoc theme spec-alist)))) |
915 |
|
spec-alist) |
916 |
|
|
917 |
|
(defun custom-do-theme-reset (theme) |
918 |
|
"Undo all settings defined by THEME. |
919 |
|
|
920 |
|
A variable remains unchanged if its property `theme-value' does not |
921 |
|
contain a value for THEME. A face remains unchanged if its property |
922 |
|
`theme-face' does not contain a value for THEME. In either case, all |
923 |
|
settings for THEME are removed from the property and the variable or |
924 |
|
face is set to the `user' theme. |
925 |
|
|
926 |
|
See `custom-known-themes' for a list of known themes." |
927 |
|
(let (spec-list) |
928 |
|
(mapatoms (lambda (symbol) |
929 |
|
;; This works even if symbol is both a variable and a |
930 |
|
;; face. |
931 |
|
(setq spec-list (get symbol 'theme-value)) |
932 |
|
(when spec-list |
933 |
|
(put symbol 'theme-value (custom-remove-theme spec-list theme)) |
934 |
|
(custom-theme-reset-internal symbol 'user)) |
935 |
|
(setq spec-list (get symbol 'theme-face)) |
936 |
|
(when spec-list |
937 |
|
(put symbol 'theme-face (custom-remove-theme spec-list theme)) |
938 |
|
(custom-theme-reset-internal-face symbol 'user)))))) |
939 |
|
|
940 |
|
(defun custom-theme-load-themes (by-theme &rest body) |
941 |
|
"Load the themes specified by BODY. |
942 |
|
Record them as required by theme BY-THEME. BODY is a sequence of either |
943 |
|
|
944 |
|
THEME |
945 |
|
BY-THEME requires THEME |
946 |
|
\(reset THEME) |
947 |
|
Undo all the settings made by THEME |
948 |
|
\(hidden THEME) |
949 |
|
Require THEME but hide it from the user |
950 |
|
|
951 |
|
All the themes loaded for BY-THEME are recorded in BY-THEME's property |
952 |
|
`theme-loads-themes'. Any theme loaded with the hidden predicate will |
953 |
|
be given the property `theme-hidden' unless it has been loaded before. |
954 |
|
Whether a theme has been loaded before is determined by the function |
955 |
|
`custom-theme-loaded-p'." |
956 |
|
(custom-check-theme by-theme) |
957 |
|
(let ((theme) |
958 |
|
(themes-loaded (get by-theme 'theme-loads-themes))) |
959 |
|
(while theme |
960 |
|
(setq theme (car body) |
961 |
|
body (cdr body)) |
962 |
|
(cond ((and (consp theme) (eq (car theme) 'reset)) |
963 |
|
(custom-do-theme-reset (cadr theme))) |
964 |
|
((and (consp theme) (eq (car theme) 'hidden)) |
965 |
|
(require-theme (cadr theme)) |
966 |
|
(unless (custom-theme-loaded-p (cadr theme)) |
967 |
|
(put (cadr theme) 'theme-hidden t))) |
968 |
|
(t |
969 |
|
(require-theme theme) |
970 |
|
(put theme 'theme-hidden nil))) |
971 |
|
(setq themes-loaded (nconc (list theme) themes-loaded))) |
972 |
|
(put by-theme 'theme-loads-themes themes-loaded))) |
973 |
|
|
974 |
|
(defun custom-load-themes (&rest body) |
975 |
|
"Load themes for the USER theme as specified by BODY. |
976 |
|
|
977 |
|
See `custom-theme-load-themes' for more information on BODY." |
978 |
|
(apply 'custom-theme-load-themes 'user body)) |
979 |
|
|
980 |
|
; (defsubst copy-upto-last (elt list) |
981 |
|
; "Copy all the elements of the list upto the last occurence of elt" |
982 |
|
; ;; Is it faster to do more work in C than to do less in elisp? |
983 |
|
; (nreverse (cdr (member elt (reverse list))))) |
984 |
|
|
985 |
|
(defun custom-theme-value (theme theme-spec-list) |
986 |
|
"Determine the value for THEME defined by THEME-SPEC-LIST. |
987 |
|
Returns a list with the original value if found; nil otherwise. |
988 |
|
|
989 |
|
THEME-SPEC-LIST is an alist with themes as its key. As new themes are |
990 |
|
installed, these are added to the front of THEME-SPEC-LIST. |
991 |
|
Each element has the form |
992 |
|
|
993 |
|
\(THEME MODE VALUE) |
994 |
|
|
995 |
|
MODE is either the symbol `set' or the symbol `reset'. See |
996 |
|
`custom-push-theme' for more information on the format of |
997 |
|
THEME-SPEC-LIST." |
998 |
|
;; Note we do _NOT_ signal an error if the theme is unknown |
999 |
|
;; it might have gone away without the user knowing. |
1000 |
|
(let ((value (cdr (assoc theme theme-spec-list)))) |
1001 |
|
(if value |
1002 |
|
(if (eq (car value) 'set) |
1003 |
|
(cdr value) |
1004 |
|
(custom-theme-value (cadr value) theme-spec-list))))) |
1005 |
|
|
1006 |
|
(defun custom-theme-variable-value (variable theme) |
1007 |
|
"Return (list value) indicating value of VARIABLE in THEME. |
1008 |
|
If THEME does not define a value for VARIABLE, return nil. The value |
1009 |
|
definitions per theme are stored in VARIABLE's property `theme-value'. |
1010 |
|
The actual work is done by function `custom-theme-value', which see. |
1011 |
|
See `custom-push-theme' for more information on how these definitions |
1012 |
|
are stored." |
1013 |
|
(custom-theme-value theme (get variable 'theme-value))) |
1014 |
|
|
1015 |
|
(defun custom-theme-reset-internal (symbol to-theme) |
1016 |
|
"Reset SYMBOL to the value defined by TO-THEME. |
1017 |
|
If SYMBOL is not defined in TO-THEME, reset SYMBOL to the standard |
1018 |
|
value. See `custom-theme-variable-value'. The standard value is |
1019 |
|
stored in SYMBOL's property `standard-value'." |
1020 |
|
(let ((value (custom-theme-variable-value symbol to-theme)) |
1021 |
|
was-in-theme) |
1022 |
|
(setq was-in-theme value) |
1023 |
|
(setq value (or value (get symbol 'standard-value))) |
1024 |
|
(when value |
1025 |
|
(put symbol 'saved-value was-in-theme) |
1026 |
|
(if (or (get 'force-value symbol) (default-boundp symbol)) |
1027 |
|
(funcall (or (get symbol 'custom-set) 'set-default) symbol |
1028 |
|
(eval (car value))))) |
1029 |
|
value)) |
1030 |
|
|
1031 |
|
(defun custom-theme-reset-variables (theme &rest args) |
1032 |
|
"Reset the value of the variables to values previously defined. |
1033 |
|
Associate this setting with THEME. |
1034 |
|
|
1035 |
|
ARGS is a list of lists of the form |
1036 |
|
|
1037 |
|
(VARIABLE TO-THEME) |
1038 |
|
|
1039 |
|
This means reset VARIABLE to its value in TO-THEME." |
1040 |
|
(custom-check-theme theme) |
1041 |
|
(mapcar '(lambda (arg) |
1042 |
|
(apply 'custom-theme-reset-internal arg) |
1043 |
|
(custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) |
1044 |
|
args)) |
1045 |
|
|
1046 |
|
(defun custom-reset-variables (&rest args) |
1047 |
|
"Reset the value of the variables to values previously saved. |
1048 |
|
This is the setting associated the `user' theme. |
1049 |
|
|
1050 |
|
ARGS is a list of lists of the form |
1051 |
|
|
1052 |
|
(VARIABLE TO-THEME) |
1053 |
|
|
1054 |
|
This means reset VARIABLE to its value in TO-THEME." |
1055 |
|
(apply 'custom-theme-reset-variables 'user args)) |
1056 |
|
|
1057 |
;;; The End. |
;;; The End. |
1058 |
|
|
1059 |
;; Process the defcustoms for variables loaded before this file. |
;; Process the defcustoms for variables loaded before this file. |