/[emacs]/emacs/lisp/custom.el
ViewVC logotype

Diff of /emacs/lisp/custom.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.53 by rms, Sun May 19 16:07:13 2002 UTC revision 1.53.2.1 by miles, Fri Apr 4 06:20:01 2003 UTC
# Line 25  Line 25 
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    
# Line 39  Line 39 
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    
# Line 107  For the standard setting, use `set-defau Line 112  For the standard setting, use `set-defau
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)
# Line 136  not the default value itself." Line 149  not the default value itself."
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)
# Line 144  not the default value itself." Line 157  not the default value itself."
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
# Line 152  not the default value itself." Line 165  not the default value itself."
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    
# Line 169  The remaining arguments should have the Line 183  The remaining arguments should have the
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.
# Line 177  The following keywords are meaningful: Line 191  The following keywords are meaningful:
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
# Line 225  The following keywords are meaningful: Line 239  The following keywords are meaningful:
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."
# Line 309  information." Line 323  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)))
# Line 373  If there already is an entry for OPTION Line 386  If there already is an entry for OPTION
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))
# Line 430  both appear in constructs like `custom-s Line 454  both appear in constructs like `custom-s
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    
# Line 457  LOAD should be either a library file nam Line 481  LOAD should be either a library file nam
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    
# Line 466  LOAD should be either a library file nam Line 501  LOAD should be either a library file nam
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,
# Line 511  in every Customization buffer.") Line 686  in every Customization 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    
# Line 519  The arguments should be a list where eac Line 710  The arguments should be a list where eac
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
# Line 567  COMMENT is a comment string about SYMBOL Line 772  COMMENT is a comment string about SYMBOL
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.
# Line 591  this sets the local binding in that buff Line 797  this sets the local binding in that buff
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))
# Line 609  this sets the local binding in that buff Line 826  this sets the local binding in that buff
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    
# Line 638  Return non-nil iff the `saved-value' pro Line 855  Return non-nil iff the `saved-value' pro
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))
# Line 650  Return non-nil iff the `customized-value Line 867  Return non-nil iff the `customized-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)))
# Line 658  Return non-nil iff the `customized-value Line 875  Return non-nil iff the `customized-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.

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.53.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26