User: ben Date: 05/02/03 05:29:35 Modified: xemacs/lisp ChangeLog cus-dep.el cus-edit.el custom.el Log: behavior ws #1: custom updates cus-dep.el: If a directory has no custom dependencies, write a blank custom-load file rather than deleting the file, so that time-based rebuild checking will work. cus-edit.el: Split out code in custom-load-symbol. Support loading of the new custom-defines file. cus-edit.el: Split long menus. custom.el: Sync with FSF 21.3. Revision Changes Path 1.621 +261 -0 XEmacs/xemacs/lisp/ChangeLog (In the diff below, changes in quantity of whitespace are not shown.) Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.620 retrieving revision 1.621 diff -u -b -r1.620 -r1.621 --- ChangeLog 2005/01/31 20:08:44 1.620 +++ ChangeLog 2005/02/03 04:29:32 1.621 ＠＠ -1,3 +1,264 ＠＠ +2005-02-02 Ben Wing <ben(a)xemacs.org&gt; + + * cus-dep.el (Custom-make-dependencies-1): + If a directory has no custom dependencies, write a blank + custom-load file rather than deleting the file, so that + time-based rebuild checking will work. + + * cus-edit.el: + * cus-edit.el (custom-load-symbol): + * cus-edit.el (custom-load-symbol-1): New. + * cus-edit.el (custom-already-loaded-custom-defines): New. + * cus-edit.el (custom-define-current-source-file): New. + * cus-edit.el (custom-warn-when-reloading-necessary): New. + * cus-edit.el (custom-load-custom-defines): New. + * cus-edit.el (custom-load-custom-defines-1): New. + Split out code in custom-load-symbol. Support loading of + the new custom-defines file. + + * cus-edit.el (custom-menu-create): + Split long menus. + + * custom.el: + * custom.el (load): + * custom.el (custom-dont-initialize): New. + * custom.el (custom-current-group-alist): New. + * custom.el (custom-declare-variable): + * custom.el (defcustom): + * custom.el (custom-current-group): New. + * custom.el (custom-declare-group): + * custom.el (defgroup): + * custom.el (custom-add-to-group): + * custom.el (custom-group-of-mode): New. + * custom.el (custom-handle-all-keywords): + * custom.el (custom-autoload): New. + * custom.el (custom-variable-p): New. + * custom.el (custom-load-recursion): New. + * custom.el (custom-load-symbol): New. + * custom.el (custom-known-themes): + * custom.el (custom-declare-theme): New. + * custom.el (deftheme): + * custom.el (custom-make-theme-feature): + * custom.el (custom-check-theme): + * custom.el (custom-push-theme): + * custom.el (custom-set-variables): + * custom.el (custom-theme-set-variables): + * custom.el (custom-set-default): New. + * custom.el (custom-quote): New. + * custom.el (customize-mark-to-save): New. + * custom.el (provide-theme): + * custom.el (require-theme): + * custom.el (customize-mark-as-set): New. + * custom.el (custom-remove-theme): New. + * custom.el (custom-do-theme-reset): + * custom.el (custom-theme-load-themes): + * custom.el (custom-load-themes): + * custom.el (custom-theme-value): + * custom.el (custom-theme-variable-value): + * custom.el (custom-theme-reset-internal): + * custom.el (copy-upto-last): Removed. + * custom.el (custom-theme-reset-variables): + * custom.el (custom-reset-variables): + * custom.el: + * custom.el (load): + * custom.el (custom-dont-initialize): New. + * custom.el (custom-current-group-alist): New. + * custom.el (custom-declare-variable): + * custom.el (defcustom): + * custom.el (custom-current-group): New. + * custom.el (custom-declare-group): + * custom.el (defgroup): + * custom.el (custom-add-to-group): + * custom.el (custom-group-of-mode): New. + * custom.el (custom-handle-all-keywords): + * custom.el (custom-autoload): New. + * custom.el (custom-variable-p): New. + * custom.el (custom-load-recursion): New. + * custom.el (custom-load-symbol): New. + * custom.el (custom-known-themes): + * custom.el (custom-declare-theme): New. + * custom.el (deftheme): + * custom.el (custom-make-theme-feature): + * custom.el (custom-check-theme): + * custom.el (custom-push-theme): + * custom.el (custom-set-variables): + * custom.el (custom-theme-set-variables): + * custom.el (custom-set-default): New. + * custom.el (custom-quote): New. + * custom.el (customize-mark-to-save): New. + * custom.el (provide-theme): + * custom.el (require-theme): + * custom.el (customize-mark-as-set): New. + * custom.el (custom-remove-theme): New. + * custom.el (custom-do-theme-reset): + * custom.el (custom-theme-load-themes): + * custom.el (custom-load-themes): + * custom.el (custom-theme-value): + * custom.el (custom-theme-variable-value): + * custom.el (custom-theme-reset-internal): + * custom.el (copy-upto-last): Removed. + * custom.el (custom-theme-reset-variables): + * custom.el (custom-reset-variables): + Sync with FSF 21.3. + +2004-11-09 Ben Wing <ben(a)xemacs.org&gt; + + * easy-mmode.el, regexp-opt.el: + Move these files into core. + Uncomment stuff depending on new custom.el. + + * autoload.el: + * autoload.el (generate-autoload-function): New. + * autoload.el (autoload-feature-suffix): New. + * autoload.el (generate-autoload-section-continuation): New. + * autoload.el (make-autoload): + * autoload.el (generate-file-autoloads): + * autoload.el (generate-autoload-type-section): + * autoload.el (process-one-lisp-autoload): New. + * autoload.el (generate-lisp-file-autoloads-1): + * autoload.el (generate-c-file-autoloads-1): + * autoload.el (generate-custom-defines): New. + * autoload.el (print-autoload): Removed. + * autoload.el (autoload-print-form): New. + * autoload.el (defcustom): + * autoload.el (autoload-read-section-header): New. + * autoload.el (update-file-autoloads): + * autoload.el (update-autoloads-here): Removed. + * autoload.el (batch-update-directory-custom-defines): New. + * autoload.el (update-autoload-files): + * autoload.el (autoload-update-directory-autoloads): Removed. + * autoload.el (batch-update-directory-autoloads): New. + * autoload.el (autoload-featurep-protect-autoloads): + * autoload.el (update-autoloads-from-directory): Removed. + * autoload.el (update-custom-define-files): New. + * autoload.el (autoload-make-feature-name): + * autoload.el (batch-update-autoloads): + * autoload.el (batch-update-directory): Removed. + * autoload.el (batch-update-one-directory): Removed. + * autoload.el (batch-force-update-one-directory): Removed. + Major update. Sync with FSF 21.2. + Create the ability to make custom-defines files. + + * behavior-defs.el: + * behavior-defs.el (tty): + * behavior-defs.el ('scroll-in-place): Removed. + * behavior-defs.el ('mouse-avoidance): Removed. + * behavior-defs.el ('jka-compr): Removed. + * behavior-defs.el ('efs): Removed. + * behavior-defs.el ('resize-minibuffer): Removed. + * behavior-defs.el ('func-menu): Removed. + * behavior-defs.el ('mwheel): Removed. + * behavior-defs.el ('recent-files): Removed. + * behavior-defs.el ('filladapt): Removed. + * behavior-defs.el ('tty)): New. + * behavior-defs.el ('toolbars)): New. + * behavior-defs.el ('menus)): New. + * behavior-defs.el ('mouse)): New. + * behavior-defs.el ('editing)): New. + * behavior-defs.el ('keyboard)): New. + * behavior-defs.el ('files)): New. + * behavior-defs.el ('games)): New. + * behavior-defs.el ('processes)): New. + * behavior-defs.el ('display)): New. + * behavior-defs.el ('programming)): New. + * behavior-defs.el ('international)): New. + * behavior-defs.el ('buffers-and-windows)): New. + * behavior-defs.el ('internet)): New. + * behavior-defs.el ('compose-mail): New. + Only define the basic behavior groups here. + Move the definitions for particular packages to the + appropriate package files. + + * behavior.el: + * behavior.el (behavior-group-hash-table): New. + * behavior.el (behavior-override-hash-table): New. + * behavior.el (define-behavior): Removed. + * behavior.el (behavior-group-p): New. + * behavior.el (check-behavior-group): New. + * behavior.el (override-behavior): + * behavior.el (define-behavior-group): + * behavior.el (read-behavior): + * behavior.el (compute-behavior-group-children): New. + * behavior.el (behavior-menu-filter-1): New. + * behavior.el (behavior-menu-filter): New. + Major update. Add documentation of how it works. + + * easymenu.el (easy-menu-add): + * easymenu.el (easy-menu-remove): + * map-ynp.el (map-y-or-n-p): + Use normalize-menu-text not normalize-menu-item-name. + + * menubar-items.el (submenu-generate-accelerator-spec): Removed. + * menubar.el (submenu-generate-accelerator-spec): New. + Move to menubar.el and rewrite for cleanliness. + + * menubar-items.el (coding-system-menu-filter): + Use menu-split-long-menu-and-sort. + + * menubar-items.el (menu-item-strip-accelerator-spec): Removed. + * menubar-items.el (menu-item-generate-accelerator-spec): Removed. + * menubar-items.el (menu-max-items): Removed. + * menubar-items.el (menu-submenu-max-items): Removed. + * menubar-items.el (menu-submenu-name-format): Removed. + * menubar-items.el (menu-split-long-menu): Removed. + * menubar-items.el (menu-sort-menu): Removed. + * menubar.el (menu-item-strip-accelerator-spec): New. + * menubar.el (menu-item-generate-accelerator-spec): New. + * menubar.el (menu-max-items): New. + * menubar.el (menu-submenu-max-items): New. + * menubar.el (menu-submenu-name-format): New. + * menubar.el (menu-split-long-menu): New. + * menubar.el (menu-sort-menu): New. + Move to menubar.el. + + * menubar.el (menu-item-text): New. + * menubar.el (menu-split-long-menu-and-sort): New. + New funs. + + * menubar-items.el (default-menubar): + Delete many menus from Tools menu -- they have been integrated + as part of the behavior system. + + Delete old Behavior menu defn. Use behavior-menu-filter. + + Use menu-split-long-menu-and-sort. + + * menubar.el (find-menu-item): + * menubar.el (find-menu-item-1): New. + Split up find-menu-item w/find-menu-item-1, since PARENT is not + an external item. + Rewrite to use compare-menu-text. + + * menubar.el (add-menu-item-1): + Don't normalize items as find-menu-item does not need it. + + * mwheel.el: + * mwheel.el ('mwheel): New. + Add define-behavior for mwheel. + + * paragraphs.el: + * paragraphs.el (paragraphs): New. + * paragraphs.el (use-hard-newlines): Removed. + * paragraphs.el (paragraph-start): + * paragraphs.el (paragraph-separate): + * paragraphs.el (sentence-end-double-space): New. + * paragraphs.el (sentence-end-without-period): New. + * paragraphs.el (sentence-end): + * paragraphs.el (forward-paragraph): + * paragraphs.el (backward-paragraph): + * paragraphs.el (mark-paragraph): + * paragraphs.el (forward-sentence): + * paragraphs.el (mark-end-of-sentence): + * paragraphs.el (transpose-sentences): + Sync to 21.3. Depends on easy-mmode in core. + + * update-elc-2.el (batch-update-elc-2): + * update-elc.el (do-autoload-commands): + Rewrite to use new autoload API. + + * update-elc.el (lisp-files-needing-early-byte-compilation): + Add easy-mmode. + 2005-01-31 Ben Wing <ben(a)xemacs.org&gt; * help.el: 1.10 +2 -5 XEmacs/xemacs/lisp/cus-dep.el (In the diff below, changes in quantity of whitespace are not shown.) Index: cus-dep.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-dep.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -b -r1.9 -r1.10 --- cus-dep.el 2003/02/14 12:05:07 1.9 +++ cus-dep.el 2005/02/03 04:29:33 1.10 ＠＠ -173,11 +173,8 ＠＠ )) (cond ((zerop (hash-table-count hash)) - (if (not (file-exists-p cusload-file)) (message "(No customization dependencies)") - (message "(No customization dependencies, deleting %s)" - cusload-file) - (delete-file cusload-file))) + (write-region "" nil cusload-file)) (t (message "Generating %s...\n" cusload-base-file) (with-temp-file cusload-file 1.23 +143 -42 XEmacs/xemacs/lisp/cus-edit.el (In the diff below, changes in quantity of whitespace are not shown.) Index: cus-edit.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-edit.el,v retrieving revision 1.22 retrieving revision 1.23 diff -u -b -r1.22 -r1.23 --- cus-edit.el 2004/06/10 12:20:01 1.22 +++ cus-edit.el 2005/02/03 04:29:33 1.23 ＠＠ -1,6 +1,7 ＠＠ ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. ;; ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. +;; Copyright (C) 2003 Ben Wing. ;; ;; Author: Per Abrahamsen <abraham(a)dina.kvl.dk&gt; ;; Maintainer: Hrvoje Niksic <hniksic(a)xemacs.org&gt; ＠＠ -1656,6 +1657,9 ＠＠ (while loads (setq load (car loads) loads (cdr loads)) + (custom-load-symbol-1 load))))) + +(defun custom-load-symbol-1 (load) (cond ((symbolp load) (condition-case nil (require load) ＠＠ -1672,7 +1676,102 ＠＠ ;; and it is not in load-history yet. (or (equal load "cus-edit") (load-library load)) - (error nil)))))))) + (error nil))))) + +(defvar custom-already-loaded-custom-defines nil + "List of already-loaded `custom-defines' files.") +(defvar custom-define-current-source-file nil) +(defvar custom-warn-when-reloading-necessary nil + "For package-debugging purposes: Warn when an error hit in custom-defines.el. +When this happens, the file from which the defcustom or defgroup was taken +is loaded, and custom-defines.el is then reloaded. This works in most +cases, but may not be completely safe. It's better if the package itself +arranges for the necessary functions and variables to be available, using +\;;;###autoload declarations. When this variable is non-nil, warnings are +issued (with backtrace), to aid in tracking down the problems.") + +(defun custom-load-custom-defines (symbol) + "Load custom-defines for SYMBOL." + (unless custom-load-recursion + (let ((custom-load-recursion t) + (loads (get symbol 'custom-loads)) + load) + (while loads + (setq load (car loads) + loads (cdr loads)) + (let* ((found (locate-library + (if (symbolp load) (symbol-name load) load))) + (dir (and found (file-name-directory found)))) + ;; If we find a custom-defines file, assume the package is smart + ;; enough to have put all its defcustoms and defgroups here, and + ;; load it instead of the file itself. Otherwise, do it the + ;; hard way. + (if (and found (or (file-exists-p + (expand-file-name "custom-defines.elc" dir)) + (file-exists-p + (expand-file-name "custom-defines.el" dir)))) + (when (not (member dir custom-already-loaded-custom-defines)) + (push dir custom-already-loaded-custom-defines) + (custom-load-custom-defines-1 dir)))))))) + +(defun custom-load-custom-defines-1 (dir) + ;; Actually load the custom-defines.el file in DIR. + + ;; If we get an error loading the custom-defines, it may be because of a + ;; reference to something (e.g. a constant) that hasn't yet been defined + ;; yet. Properly, these should have been marked, so they either go into + ;; the custom-defines.el file or are autoloaded. But not everyone is so + ;; careful, so for the moment we try to load the file that the + ;; error-generating defcustom came from, and then reload the + ;; custom-defines.el file. We might loop a number of times if we have + ;; various files that need loading. If at any point we get an error that + ;; can't be solved just by loading the appropriate file (e.g. we hit the + ;; same error as before, the file is already loaded, etc.) then we signal + ;; it as a real error. + (let (source) + ;; here's how this works: if we get an error loading custom-defines, + ;; the condition handler is called; if we need to reload, we + ;; `return-from', which throws out of the handler and returns nil from + ;; the `block', which continues the while statement, executing the + ;; `load' at the bottom of this function and then entering the block + ;; again. if the condition handler doesn't throw, but instead returns + ;; normally, `signal' will continue as if nothing happened, and end up + ;; signalling the error normally. + (while + (not + (block custom-load + ;; Use call-with-condition-handler so the error can be seen + ;; with the stack intact. + (call-with-condition-handler + #'(lambda (__custom_load_cd1__) + (when (and + custom-define-current-source-file + (progn + (setq source (expand-file-name + custom-define-current-source-file + dir)) + (let ((nondir (file-name-nondirectory source))) + (and (file-exists-p source) + (not (assoc source load-history)) + (not (assoc nondir load-history)) + (not (and (boundp 'preloaded-file-list) + (member nondir + preloaded-file-list))))))) + (if custom-warn-when-reloading-necessary + (lwarn 'custom-defines 'warning + "Error while loading custom-defines, fetching source and reloading ...\n +Error: %s\n +Source file: %s\n\n +Backtrace follows:\n\n%s" + (error-message-string __custom_load_cd1__) + source + (backtrace-in-condition-handler-eliminating-handler + '__custom_load_cd1__))) + (return-from custom-load nil))) + #'(lambda () + (load (expand-file-name "custom-defines" dir)))))) + ;; we get here only from the `return-from'; see above + (load source)))) (defun custom-load-widget (widget) "Load all dependencies for WIDGET." ＠＠ -3709,13 +3808,14 ＠＠ (defun custom-menu-create (symbol) "Create menu for customization group SYMBOL. The menu is in a format applicable to `easy-menu-define'." + (menu-split-long-menu (let* ((item (vector (custom-unlispify-menu-entry symbol) `(customize-group ',symbol) t))) ;; Item is the entry for creating a menu buffer for SYMBOL. ;; We may nest, if the menu is not too big. - (custom-load-symbol symbol) - (if (< (length (get symbol 'custom-group)) widget-menu-max-size) + (custom-load-custom-defines symbol) + (if t ;(< (length (get symbol 'custom-group)) widget-menu-max-size) ;; The menu is not too big. (let ((custom-prefix-list (custom-prefix-add symbol custom-prefix-list)) ＠＠ -3732,8 +3832,9 ＠＠ (list (nth 1 entry))) :custom-menu (nth 0 entry))) members))) - ;; The menu was too big. - item))) + ; else ;; The menu was too big. + item + )))) ;;;###autoload (defun customize-menu-create (symbol &optional name) 1.13 +583 -265 XEmacs/xemacs/lisp/custom.el (In the diff below, changes in quantity of whitespace are not shown.) Index: custom.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/custom.el,v retrieving revision 1.12 retrieving revision 1.13 diff -u -b -r1.12 -r1.13 --- custom.el 2003/03/03 10:17:40 1.12 +++ custom.el 2005/02/03 04:29:33 1.13 ＠＠ -1,12 +1,10 ＠＠ -;;; custom.el -- Tools for declaring and initializing options. - -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. - +;;; custom.el --- tools for declaring and initializing options +;; +;; Copyright (C) 1996, 1997, 1999, 2001, 2002 Free Software Foundation, Inc. +;; ;; Author: Per Abrahamsen <abraham(a)dina.kvl.dk&gt; -;; Maintainer: Hrvoje Niksic <hniksic(a)xemacs.org&gt; +;; Maintainer: XEmacs Development Group ;; Keywords: help, faces, dumped -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of XEmacs. ＠＠ -25,17 +23,18 ＠＠ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched with: ??? Partially synched to 21.2 by Ben Wing. +;;; Synched with: FSF 21.3. ;;; Commentary: ;; This file is dumped with XEmacs. -;; This file only contain the code needed to declare and initialize -;; user options. The code to customize options is autoloaded from -;; `cus-edit.el'. ;; -;; The code implementing face declarations is in `cus-face.el' +;; This file only contains the code needed to declare and initialize +;; user options. The code to customize options is autoloaded from +;; `cus-edit.el' and is documented in the XEmacs Lisp Reference manual. + +;; The code implementing face declarations is in `cus-face.el'. ;;; Code: ＠＠ -44,8 +43,6 ＠＠ ;; prevent require/provide loop with custom and cus-face. (provide 'custom) -;; BEGIN SYNC WITH FSF 21.2 - (eval-when-compile (load "cl-macs" nil t) ;; To elude warnings. ＠＠ -60,6 +57,14 ＠＠ ;; Customize information for this option is in `cus-edit.el'. "Hook called after defining each customize option.") +(defvar custom-dont-initialize nil + "Non-nil means `defcustom' should not initialize the variable. +That is used for the sake of `custom-make-dependencies'. +Users should not set it.") + +(defvar custom-current-group-alist nil + "Alist of (FILE . GROUP) indicating the current group to use for FILE.") + ;;; The `defcustom' Macro. (defun custom-initialize-default (symbol value) ＠＠ -131,8 +136,16 ＠＠ (defun custom-declare-variable (symbol default doc &rest args) "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. DEFAULT should be an expression to evaluate to compute the default value, -not the default value itself." - ;; Remember the standard setting. +not the default value itself. + +DEFAULT is stored as SYMBOL's value in the standard theme. See +`custom-known-themes' for a list of known themes. For backwards +compatibility, DEFAULT is also stored in SYMBOL's property +`standard-value'. At the same time, SYMBOL's property `force-value' is +set to nil, as the value is no longer rogue." + ;; Remember the standard setting. The value should be in the standard + ;; theme, not in this property. However, his would require changeing + ;; the C source of defvar and others as well... (put symbol 'standard-value (list default)) ;; Maybe this option was rogue in an earlier version. It no longer is. (when (eq (get symbol 'force-value) 'rogue) ＠＠ -142,6 +155,8 ＠＠ (put symbol 'variable-documentation doc)) (let ((initialize 'custom-initialize-reset) (requests nil)) + (unless (memq :group args) + (custom-add-to-group (custom-current-group) symbol 'custom-variable)) (while args (let ((arg (car args))) (setq args (cdr args)) ＠＠ -158,9 +173,9 ＠＠ ((eq keyword :get) (put symbol 'custom-get value)) ((eq keyword :require) - (setq requests (cons value requests))) + (push value requests)) ((eq keyword :type) - (put symbol 'custom-type value)) + (put symbol 'custom-type (purecopy value))) ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. ＠＠ -174,10 +189,11 ＠＠ 'custom-variable)))))) (put symbol 'custom-requests requests) ;; Do the actual initialization. - (funcall initialize symbol default)) + (unless custom-dont-initialize + (funcall initialize symbol default))) ;; #### This is a rough equivalent of LOADHIST_ATTACH. However, ;; LOADHIST_ATTACH also checks for `initialized'. - (push symbol current-load-list) + (push (cons 'defvar symbol) current-load-list) (run-hooks 'custom-define-hook) symbol) ＠＠ -193,16 +209,43 ＠＠ The following keywords are meaningful: -: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. The default is `sexp'. :options VALUE should be a list of valid members of the widget type. :group VALUE should be a customization group. Add SYMBOL to that group. +:link LINK-DATA + Include an external link after the documentation string for this + item. This is a sentence containing an active field which + references some other documentation. + + There are three alternatives you can use for LINK-DATA: + + (custom-manual INFO-NODE) + Link to an Info node; INFO-NODE is a string which specifies + the node name, as in \"(emacs)Top\". The link appears as + `[manual]' in the customization buffer. + + (info-link INFO-NODE) + Like `custom-manual' except that the link appears in the + customization buffer with the Info node name. + + (url-link URL) + Link to a web page; URL is a string which specifies the URL. + The link appears in the customization buffer as URL. + + You can specify the text to use in the customization buffer by + adding `:tag NAME' after the first element of the LINK-DATA; for + example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the + Emacs manual which appears in the buffer as `foo'. + + An item can have more than one external link; however, most items + have none at all. :initialize VALUE should be a function used to initialize the variable. It takes two arguments, the symbol and value given in the `defcustom' call. The default is - `custom-initialize-reset' + `custom-initialize-reset'. :set VALUE should be a function to set the value of the symbol. It takes two arguments, the symbol to set and the value to give it. The default choice of function is `custom-set-default'. ＠＠ -219,16 +262,21 ＠＠ VALUE should be a string specifying that the variable was first introduced, or its default value was changed, in Emacs version VERSION. -:set-after VARIABLE - Specifies that SYMBOL should be set after VARIABLE when - both have been customized. +:tag LABEL + Use LABEL, a string, instead of the item's name, to label the item + in customization menus and buffers. +:load FILE + Load file FILE (a string) before displaying this customization + item. Loading is done with `load', and only if the file is + not already loaded. +:set-after VARIABLES + Specifies that SYMBOL should be set after the list of variables + VARIABLES when both have been customized. Read the section about customization in the Emacs Lisp manual for more information." `(custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,＠args)) -;; END SYNC WITH FSF 21.2 - ;;; The `defface' Macro. (defmacro defface (face spec doc &rest args) ＠＠ -278,12 +326,14 ＠＠ ;;; The `defgroup' Macro. +(defun custom-current-group () + (cdr (assoc load-file-name custom-current-group-alist))) + (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." (while members (apply 'custom-add-to-group symbol (car members)) (pop members)) - (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) (while args ＠＠ -300,6 +350,10 ＠＠ (t (custom-handle-keyword symbol keyword value 'custom-group)))))) + ;; Record the group on the `current' list. + (let ((elt (assoc load-file-name custom-current-group-alist))) + (if elt (setcdr elt symbol) + (push (cons load-file-name symbol) custom-current-group-alist))) (run-hooks 'custom-define-hook) symbol) ＠＠ -318,13 +372,24 ＠＠ [KEYWORD VALUE]... -The following KEYWORD's are defined: +The following KEYWORDs are defined: :group VALUE should be a customization group. Add SYMBOL to that group. Read the section about customization in the Emacs Lisp manual for more information." + + ;; XEmacs: Evidently a purposeful omission from the docs: +;:version VALUE should be a string specifying that the group was introduced +; in Emacs version VERSION. +; + + ;; FSF: (not a problem for XEmacs) + ;; It is better not to use backquote in this file, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. +; (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args)) `(custom-declare-group (quote ,symbol) ,members ,doc ,＠args)) (defvar custom-group-hash-table (make-hash-table :size 300 :test 'eq) ＠＠ -332,19 +397,31 ＠＠ (defun custom-add-to-group (group option widget) "To existing GROUP add a new OPTION of type WIDGET. -If there already is an entry for that option, overwrite it." - (let* ((members (get group 'custom-group)) - (old (assq option members))) - (if old - (setcar (cdr old) widget) - (put group 'custom-group (nconc members (list (list option widget)))))) +If there already is an entry for OPTION and WIDGET, nothing is done." + (let ((members (get group 'custom-group)) + (entry (list option widget))) + (unless (member entry members) + (put group 'custom-group (nconc members (list entry))))) (puthash group t custom-group-hash-table)) +(defun custom-group-of-mode (mode) + "Return the custom group corresponding to the major or minor MODE. +If no such group is found, return nil." + (or (get mode 'custom-mode-group) + (if (or (get mode 'custom-group) + (and (string-match "-mode\\'" (symbol-name mode)) + (get (setq mode (intern (substring (symbol-name mode) + 0 (match-beginning 0)))) + 'custom-group))) + mode))) + ;;; Properties. (defun custom-handle-all-keywords (symbol args type) "For customization option SYMBOL, handle keyword arguments ARGS. Third argument TYPE is the custom option type." + (unless (memq :group args) + (custom-add-to-group (custom-current-group) symbol type)) (while args (let ((arg (car args))) (setq args (cdr args)) ＠＠ -420,78 +497,195 ＠＠ (unless (member load loads) (put symbol 'custom-loads (cons load loads))))) -;;; deftheme macro +(defun custom-autoload (symbol load) + "Mark SYMBOL as autoloaded custom variable and add dependency LOAD." + (put symbol 'custom-autoload t) + (custom-add-load symbol load)) + +;; This test is also in the C code of `user-variable-p'. +(defun custom-variable-p (variable) + "Return non-nil if VARIABLE is a custom variable." + (or (get variable 'standard-value) + (get variable 'custom-autoload))) + +;;; Loading files needed to customize a symbol. +;;; This is in custom.el because menu-bar.el needs it for toggle cmds. + +(defvar custom-load-recursion nil + "Hack to avoid recursive dependencies.") + +(defun custom-load-symbol (symbol) + "Load all dependencies for SYMBOL." + (unless custom-load-recursion + (let ((custom-load-recursion t)) + (dolist (load (get symbol 'custom-loads)) + (cond ((symbolp load) (condition-case nil (require load) (error nil))) + ;; This is subsumed by the test below, but it's much faster. + ((assoc load load-history)) + ;; This was just (assoc (locate-library load) load-history) + ;; but has been optimized not to load locate-library + ;; if not necessary. + ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load) + "\\(\\'\\|\\.\\)")) + (found nil)) + (dolist (loaded load-history) + (and (stringp (car loaded)) + (string-match regexp (car loaded)) + (setq found t))) + found)) + ;; Without this, we would load cus-edit recursively. + ;; We are still loading it when we call this, + ;; and it is not in load-history yet. + ((equal load "cus-edit")) + (t (condition-case nil (load load) (error nil)))))))) (defvar custom-known-themes '(user standard) - "Themes that have been defthemed.") - -;; #### add strings for group -;; #### during bootstrap we cannot use cl-macs stuff -(defun* custom-define-theme (theme feature &optional doc - &key short-description immediate variable-reset-string - variable-set-string face-set-string face-reset-string - &allow-other-keys) - (push theme custom-known-themes) + "Themes that have been define with `deftheme'. +The default value is the list (user standard). The theme `standard' +contains the Emacs standard settings from the original Lisp files. The +theme `user' contains all the the settings the user customized and saved. +Additional themes declared with the `deftheme' macro will be added to +the front of this list.") + +(defun custom-declare-theme (theme feature &optional doc &rest args) + "Like `deftheme', but THEME is evaluated as a normal argument. +FEATURE is the feature this theme provides. This symbol is created +from THEME by `custom-make-theme-feature'." + (add-to-list 'custom-known-themes theme) (put theme 'theme-feature feature) - (put theme 'theme-documentation doc) - (if immediate (put theme 'theme-immediate immediate)) - (if variable-reset-string - (put theme 'theme-variable-reset-string variable-reset-string )) - (if variable-set-string - (put theme 'theme-variable-set-string variable-set-string )) - (if face-reset-string - (put theme 'theme-face-reset-string face-reset-string )) - (if face-set-string - (put theme 'theme-face-set-string face-set-string )) - (if short-description - (put theme 'theme-short-description short-description ))) + (when doc + (put theme 'theme-documentation doc)) + (while args + (let ((arg (car args))) + (setq args (cdr args)) + (check-argument-type 'keywordp arg) + (let ((keyword arg) + (value (car args))) + (unless args + (signal 'error (list "Keyword is missing an argument" keyword))) + (setq args (cdr args)) + (cond ((eq keyword :short-description) + (put theme 'theme-short-description value)) + ((eq keyword :immediate) + (put theme 'theme-immediate value)) + ((eq keyword :variable-set-string) + (put theme 'theme-variable-set-string value)) + ((eq keyword :variable-reset-string) + (put theme 'theme-variable-reset-string value)) + ((eq keyword :face-set-string) + (put theme 'theme-face-set-string value)) + ((eq keyword :face-reset-string) + (put theme 'theme-face-reset-string value))))))) + +(defmacro deftheme (theme &optional doc &rest args) + "Declare custom theme THEME. +The optional argument DOC is a doc string describing the theme. +The remaining arguments should have the form -(defun custom-make-theme-feature (theme) - (intern (concat (symbol-name theme) "-theme"))) + [KEYWORD VALUE]... -(defmacro deftheme (theme &rest body) - "(deftheme THEME &optional DOC &key KEYWORDS) +The following KEYWORD's are defined: -Define a theme labeled by SYMBOL THEME. The optional argument DOC is a -doc string describing the theme. It is optionally followed by the -following keyword arguments - -:short-description DESC - DESC is a short (one line) description of the theme. If not given DOC - is used. -:immediate FLAG - If FLAG is non-nil variables set in this theme are bound +:short-description + VALUE is a short (one line) description of the theme. If not + given, DOC is used. +:immediate + If VALUE is non-nil, variables specified in this theme are set immediately when loading the theme. -:variable-set-string VARIABLE_-SET-STRING - A string used by the UI to indicate that the value takes it - setting from this theme. It is passed to FORMAT with the - name of the theme a additional argument. - If not given, a generic description is used. -:variable-reset-string VARIABLE-RESET-STRING - As above but used in the case the variable has been forced to - the value in this theme. -:face-set-string FACE-SET-STRING -:face-reset-string FACE-RESET-STRING - As above but for faces." +:variable-set-string + VALUE is a string used to indicate that a variable takes its + setting from this theme. It is passed to FORMAT with the name + of the theme as an additional argument. If not given, a + generic description is used. +:variable-reset-string + VALUE is a string used in the case a variable has been forced + to its value in this theme. It is passed to FORMAT with the + name of the theme as an additional argument. If not given, a + generic description is used. +:face-set-string + VALUE is a string used to indicate that a face takes its + setting from this theme. It is passed to FORMAT with the name + of the theme as an additional argument. If not given, a + generic description is used. +:face-reset-string + VALUE is a string used in the case a face has been forced to + its value in this theme. It is passed to FORMAT with the name + of the theme as an additional argument. If not given, a + generic description is used. + +Any theme `foo' should be defined in a file called `foo-theme.el'; +see `custom-make-theme-feature' for more information." (let ((feature (custom-make-theme-feature theme))) - `(custom-define-theme (quote ,theme) (quote ,feature) ,＠body))) + ;; It is better not to use backquote in this file, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. + (nconc (list 'custom-declare-theme + (list 'quote theme) + (list 'quote feature) + doc) args))) + +(defun custom-make-theme-feature (theme) + "Given a symbol THEME, create a new symbol by appending \"-theme\". +Store this symbol in the `theme-feature' property of THEME. +Calling `provide-theme' to provide THEME actually puts `THEME-theme' +into `features'. + +This allows for a file-name convention for autoloading themes: +Every theme X has a property `provide-theme' whose value is \"X-theme\". +\(require-theme X) then attempts to load the file `X-theme.el'." + (intern (concat (symbol-name theme) "-theme"))) (defsubst custom-theme-p (theme) "Non-nil when THEME has been defined." (memq theme custom-known-themes)) (defsubst custom-check-theme (theme) - "Check whether THEME is valid and signal an error if NOT." + "Check whether THEME is valid, and signal an error if it is not." (unless (custom-theme-p theme) (error "Unknown theme `%s'" theme))) - -; #### do we need to deftheme 'user and/or 'standard here to make the -; code in cus-edit cleaner?. - ;;; Initializing. (defun custom-push-theme (prop symbol theme mode value) + "Add (THEME MODE VALUE) to the list in property PROP of SYMBOL. +If the first element in that list is already (THEME ...), +discard it first. + +MODE can be either the symbol `set' or the symbol `reset'. If it is the +symbol `set', then VALUE is the value to use. If it is the symbol +`reset', then VALUE is the mode to query instead. + +In the following example for the variable `goto-address-url-face', the +theme `subtle-hacker' uses the same value for the variable as the theme +`gnome2': + + \((standard set bold) + \(gnome2 set info-xref) + \(jonadab set underline) + \(subtle-hacker reset gnome2)) + + +If a value has been stored for themes A B and C, and a new value +is to be stored for theme C, then the old value of C is discarded. +If a new value is to be stored for theme B, however, the old value +of B is not discarded because B is not the car of the list. + +For variables, list property PROP is `theme-value'. +For faces, list property PROP is `theme-face'. +This is used in `custom-do-theme-reset', for example. + +The list looks the same in any case; the examples shows a possible +value of the `theme-face' property for the face `region': + + \((gnome2 set ((t (:foreground \"cyan\" :background \"dark cyan\")))) + \(standard set ((((class color) (background dark)) + \(:background \"blue\")) + \(t (:background \"gray\"))))) + +This records values for the `standard' and the `gnome2' themes. +The user has not customized the face; had he done that, +the list would contain an entry for the `user' theme, too. +See `custom-known-themes' for a list of known themes." (let ((old (get symbol prop))) (if (eq (car-safe (car-safe old)) theme) (setq old (cdr old))) ＠＠ -508,13 +702,14 ＠＠ (defun custom-set-variables (&rest args) "Initialize variables according to user preferences. The settings are registered as theme `user'. -Each argument should be a list of the form: +The arguments should each be a list of the form: (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as the default value for the SYMBOL. + REQUEST is a list of features we must 'require for SYMBOL. COMMENT is a comment string about SYMBOL." (apply 'custom-theme-set-variables 'user args)) ＠＠ -522,9 +717,30 ＠＠ (defun custom-theme-set-variables (theme &rest args) "Initialize variables according to settings specified by args. Records the settings as belonging to THEME. + +The arguments should be a list where each entry has the form: + + (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) + +The unevaluated VALUE is stored as the saved value for SYMBOL. +If NOW is present and non-nil, VALUE is also evaluated and bound as +the default value for the SYMBOL. +REQUEST is a list of features we must 'require for SYMBOL. +COMMENT is a comment string about SYMBOL. + +Several properties of THEME and SYMBOL are used in the process: + +If THEME property `theme-immediate' is non-nil, this is equivalent of +providing the NOW argument to all symbols in the argument list: SYMBOL +is bound to the evaluated VALUE. The only difference is SYMBOL property +`force-value': if NOW is non-nil, SYMBOL's property `force-value' is set to +the symbol `rogue', else if THEME's property `theme-immediate' is non-nil, +FACE's property `force-face' is set to the symbol `immediate'. -See `custom-set-variables' for a description of the arguments ARGS." +VALUE itself is saved unevaluated as SYMBOL property `saved-value' and +in SYMBOL's list property `theme-value' \(using `custom-push-theme')." (custom-check-theme theme) + (let ((immediate (get theme 'theme-immediate))) (setq args (sort args (lambda (a1 a2) ＠＠ -535,7 +751,6 ＠＠ (cond ((and 1-then-2 2-then-1) (error "Circular custom dependency between `%s' and `%s'" sym1 sym2)) - (1-then-2 t) (2-then-1 nil) ;; Put symbols with :require last. The macro ;; define-minor-mode generates a defcustom ＠＠ -546,7 +761,6 ＠＠ ;; customized values rather than default ;; values. (t (nth 3 a2))))))) - (let ((immediate (get theme 'theme-immediate))) (while args (let ((entry (car args))) (if (listp entry) ＠＠ -555,10 +769,14 ＠＠ (now (nth 2 entry)) (requests (nth 3 entry)) (comment (nth 4 entry)) - (set (or (get symbol 'custom-set) 'custom-set-default))) + set) + (when requests + (put symbol 'custom-requests requests) + (mapc 'require requests)) + (setq set (or (get symbol 'custom-set) 'custom-set-default)) (put symbol 'saved-value (list value)) - (custom-push-theme 'theme-value symbol theme 'set value) (put symbol 'saved-variable-comment comment) + (custom-push-theme 'theme-value symbol theme 'set value) ;; Allow for errors in the case where the setter has ;; changed between versions, say, but let the user know. (condition-case data ＠＠ -571,12 +789,9 ＠＠ (funcall set symbol (eval value)))) (error (message "Error setting %s: %s" symbol data))) + (setq args (cdr args)) (and (or now (default-boundp symbol)) - (put symbol 'variable-comment comment)) - (when requests - (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq args (cdr args))) + (put symbol 'variable-comment comment))) ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") (ding) ＠＠ -587,6 +802,85 ＠＠ (custom-push-theme 'theme-value symbol theme 'set value)) (setq args (cdr (cdr args)))))))) +(defun custom-set-default (variable value) + "Default :set function for a customizable variable. +Normally, this sets the default value of VARIABLE to VALUE, +but if `custom-local-buffer' is non-nil, +this sets the local binding in that buffer instead." + (if custom-local-buffer + (with-current-buffer custom-local-buffer + (set variable value)) + (set-default variable value))) + +(defun custom-quote (sexp) + "Quote SEXP iff it is not self quoting." + (if (or (memq sexp '(t nil)) + (keywordp sexp) + (and (listp sexp) + (memq (car sexp) '(lambda))) + (stringp sexp) + (numberp sexp) + (vectorp sexp) +;;; (and (fboundp 'characterp) +;;; (characterp sexp)) + ) + sexp + (list 'quote sexp))) + +(defun customize-mark-to-save (symbol) + "Mark SYMBOL for later saving. + +If the default value of SYMBOL is different from the standard value, +set the `saved-value' property to a list whose car evaluates to the +default value. Otherwise, set it to nil. + +To actually save the value, call `custom-save-all'. + +Return non-nil iff the `saved-value' property actually changed." + (let* ((get (or (get symbol 'custom-get) 'default-value)) + (value (funcall get symbol)) + (saved (get symbol 'saved-value)) + (standard (get symbol 'standard-value)) + (comment (get symbol 'customized-variable-comment))) + ;; Save default value iff different from standard value. + (if (or (null standard) + (not (equal value (condition-case nil + (eval (car standard)) + (error nil))))) + (put symbol 'saved-value (list (custom-quote value))) + (put symbol 'saved-value nil)) + ;; Clear customized information (set, but not saved). + (put symbol 'customized-value nil) + ;; Save any comment that might have been set. + (when comment + (put symbol 'saved-variable-comment comment)) + (not (equal saved (get symbol 'saved-value))))) + +(defun customize-mark-as-set (symbol) + "Mark current value of SYMBOL as being set from customize. + +If the default value of SYMBOL is different from the saved value if any, +or else if it is different from the standard value, set the +`customized-value' property to a list whose car evaluates to the +default value. Otherwise, set it to nil. + +Return non-nil iff the `customized-value' property actually changed." + (let* ((get (or (get symbol 'custom-get) 'default-value)) + (value (funcall get symbol)) + (customized (get symbol 'customized-value)) + (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) + ;; Mark default value as set iff different from old value. + (if (or (null old) + (not (equal value (condition-case nil + (eval (car old)) + (error nil))))) + (put symbol 'customized-value (list (custom-quote value))) + (put symbol 'customized-value nil)) + ;; Changed? + (not (equal customized (get symbol 'customized-value))))) + +;;; Theme Manipulation + (defvar custom-loaded-themes nil "Themes in the order they are loaded.") ＠＠ -595,47 +889,80 ＠＠ (memq theme custom-loaded-themes)) (defun provide-theme (theme) - "Indicate that this file provides THEME." + "Indicate that this file provides THEME. +Add THEME to `custom-loaded-themes' and `provide' whatever +is stored in THEME's property `theme-feature'. + +Usually the theme-feature property contains a symbol created +by `custom-make-theme-feature'." (custom-check-theme theme) (provide (get theme 'theme-feature)) - (push theme custom-loaded-themes)) + (setq custom-loaded-themes (nconc (list theme) custom-loaded-themes))) + +(defun require-theme (theme) + "Try to load a theme by requiring its feature. +THEME's feature is stored in THEME's `theme-feature' property. -(defun require-theme (theme &optional soft) - "Try to load a theme by requiring its feature." +Usually the `theme-feature' property contains a symbol created +by `custom-make-theme-feature'." ;; Note we do no check for validity of the theme here. ;; This allows to pull in themes by a file-name convention - (require (get theme 'theme-feature (custom-make-theme-feature theme)))) + (require (or (get theme 'theme-feature) + (custom-make-theme-feature theme)))) +(defun custom-remove-theme (spec-alist theme) + "Delete all elements from SPEC-ALIST whose car is THEME." + (let ((elt (assoc theme spec-alist))) + (while elt + (setq spec-alist (delete elt spec-alist) + elt (assoc theme spec-alist)))) + spec-alist) + (defun custom-do-theme-reset (theme) - ; #### untested! slow! + "Undo all settings defined by THEME. + +A variable remains unchanged if its property `theme-value' does not +contain a value for THEME. A face remains unchanged if its property +`theme-face' does not contain a value for THEME. In either case, all +settings for THEME are removed from the property and the variable or +face is set to the `user' theme. + +See `custom-known-themes' for a list of known themes." (let (spec-list) (mapatoms (lambda (symbol) + ;; This works even if symbol is both a variable and a + ;; face. (setq spec-list (get symbol 'theme-value)) (when spec-list - (setq spec-list (delete-if (lambda (elt) - (eq (car elt) theme)) - spec-list)) - (put symbol 'theme-value spec-list) + (put symbol 'theme-value (custom-remove-theme spec-list theme)) (custom-theme-reset-internal symbol 'user)) (setq spec-list (get symbol 'theme-face)) (when spec-list - (setq spec-list (delete-if (lambda (elt) - (eq (car elt) theme)) - spec-list)) - (put symbol 'theme-face spec-list) + (put symbol 'theme-face (custom-remove-theme spec-list theme)) (custom-theme-reset-internal-face symbol 'user)))))) (defun custom-theme-load-themes (by-theme &rest body) - "Load the themes specified by BODY and record them as required by -theme BY-THEME. BODY is a sequence of - - a SYMBOL - require the theme SYMBOL - - a list (reset THEME) - Undo all the settings made by THEME. - - a list (hidden THEME) - require the THEME but hide it from the user." + "Load the themes specified by BODY. +Record them as required by theme BY-THEME. BODY is a sequence of either + +THEME + BY-THEME requires THEME +\(reset THEME) + Undo all the settings made by THEME +\(hidden THEME) + Require THEME but hide it from the user + +All the themes loaded for BY-THEME are recorded in BY-THEME's property +`theme-loads-themes'. Any theme loaded with the hidden predicate will +be given the property `theme-hidden' unless it has been loaded before. +Whether a theme has been loaded before is determined by the function +`custom-theme-loaded-p'." (custom-check-theme by-theme) - (dolist (theme body) + (let ((theme) + (themes-loaded (get by-theme 'theme-loads-themes))) + (while theme + (setq theme (car body) + body (cdr body)) (cond ((and (consp theme) (eq (car theme) 'reset)) (custom-do-theme-reset (cadr theme))) ((and (consp theme) (eq (car theme) 'hidden)) ＠＠ -644,54 +971,56 ＠＠ (put (cadr theme) 'theme-hidden t))) (t (require-theme theme) - (remprop theme 'theme-hidden))) - (push theme (get by-theme 'theme-loads-themes)))) + (put theme 'theme-hidden nil))) + (setq themes-loaded (nconc (list theme) themes-loaded))) + (put by-theme 'theme-loads-themes themes-loaded))) (defun custom-load-themes (&rest body) "Load themes for the USER theme as specified by BODY. -BODY is as with custom-theme-load-themes." - (apply #'custom-theme-load-themes 'user body)) +See `custom-theme-load-themes' for more information on BODY." + (apply 'custom-theme-load-themes 'user body)) +; (defsubst copy-upto-last (elt list) +; "Copy all the elements of the list upto the last occurrence of elt" +; ;; Is it faster to do more work in C than to do less in elisp? +; (nreverse (cdr (member elt (reverse list))))) +(defun custom-theme-value (theme theme-spec-list) + "Determine the value for THEME defined by THEME-SPEC-LIST. +Returns a list with the original value if found; nil otherwise. +THEME-SPEC-LIST is an alist with themes as its key. As new themes are +installed, these are added to the front of THEME-SPEC-LIST. +Each element has the form -(defsubst copy-upto-last (elt list) - "Copy all the elements of the list upto the last occurrence of elt." - ;; Is it faster to do more work in C than to do less in elisp? - (nreverse (cdr (member elt (reverse list))))) + \(THEME MODE VALUE) -(defun custom-theme-value (theme theme-spec-list) - "Determine the value for THEME defined by THEME-SPEC-LIST. -Returns (list value) if found. Nil otherwise." +MODE is either the symbol `set' or the symbol `reset'. See +`custom-push-theme' for more information on the format of +THEME-SPEC-LIST." ;; Note we do _NOT_ signal an error if the theme is unknown ;; it might have gone away without the user knowing. - (let ((theme-or-lower (memq theme (cons 'user custom-loaded-themes))) - value) - (mapc #'(lambda (theme-spec) - (when (member (car theme-spec) theme-or-lower) - (setq value (cdr theme-spec)) - ;; We need to continue because if theme =A and we found - ;; B then if the load order is B A C B - ;; we actually want the value in C. - (setq theme-or-lower (copy-upto-last (car theme-spec) - theme-or-lower)) - ;; We could should circuit if this is now nil. - )) - theme-spec-list) + (let ((value (cdr (assoc theme theme-spec-list)))) (if value (if (eq (car value) 'set) - (list (cadr value)) - ;; Yet another reset spec. car value = reset + (cdr value) (custom-theme-value (cadr value) theme-spec-list))))) - (defun custom-theme-variable-value (variable theme) - "Return (list value) value of VARIABLE in THEME if the THEME modifies the -VARIABLE. Nil otherwise." + "Return (list value) indicating value of VARIABLE in THEME. +If THEME does not define a value for VARIABLE, return nil. The value +definitions per theme are stored in VARIABLE's property `theme-value'. +The actual work is done by function `custom-theme-value', which see. +See `custom-push-theme' for more information on how these definitions +are stored." (custom-theme-value theme (get variable 'theme-value))) (defun custom-theme-reset-internal (symbol to-theme) + "Reset SYMBOL to the value defined by TO-THEME. +If SYMBOL is not defined in TO-THEME, reset SYMBOL to the standard +value. See `custom-theme-variable-value'. The standard value is +stored in SYMBOL's property `standard-value'." (let ((value (custom-theme-variable-value symbol to-theme)) was-in-theme) (setq was-in-theme value) ＠＠ -699,46 +1028,37 ＠＠ (when value (put symbol 'saved-value was-in-theme) (if (or (get 'force-value symbol) (default-boundp symbol)) - (funcall (get symbol 'custom-set 'set-default) symbol + (funcall (or (get symbol 'custom-set) 'set-default) symbol (eval (car value))))) value)) - (defun custom-theme-reset-variables (theme &rest args) "Reset the value of the variables to values previously defined. Associate this setting with THEME. ARGS is a list of lists of the form - (variable to-theme) + (VARIABLE TO-THEME) -This means reset variable to its value in to-theme." +This means reset VARIABLE to its value in TO-THEME." (custom-check-theme theme) - (mapc #'(lambda (arg) - (apply #'custom-theme-reset-internal arg) + (mapcar '(lambda (arg) + (apply 'custom-theme-reset-internal arg) (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) args)) (defun custom-reset-variables (&rest args) - "Reset the value of the variables to values previously defined. -Associate this setting with the `user' theme. + "Reset the value of the variables to values previously saved. +This is the setting associated the `user' theme. -The ARGS are as in `custom-theme-reset-variables'." - (apply #'custom-theme-reset-variables 'user args)) +ARGS is a list of lists of the form -(defun custom-set-default (variable value) - "Default :set function for a customizable variable. -Normally, this sets the default value of VARIABLE to VALUE, -but if `custom-local-buffer' is non-nil, -this sets the local binding in that buffer instead." - (if custom-local-buffer - (with-current-buffer custom-local-buffer - (set variable value)) - (set-default variable value))) + (VARIABLE TO-THEME) -;;; The End. +This means reset VARIABLE to its value in TO-THEME." + (apply 'custom-theme-reset-variables 'user args)) -;; BEGIN SYNC WITH FSF 21.2 +;;; The End. ;; Process the defcustoms for variables loaded before this file. ;; `custom-declare-variable-list' is defvar'd in subr.el. Utility programs ＠＠ -747,7 +1067,5 ＠＠ (while custom-declare-variable-list (apply 'custom-declare-variable (car custom-declare-variable-list)) (setq custom-declare-variable-list (cdr custom-declare-variable-list))) - -;; END SYNC WITH FSF 21.2 ;; custom.el ends here