X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bde4f35405acfa091950acb5e9207f68b1486b31..c4e8cde8c6cea5ab85abbac10626bd5c1fe5a6af:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 99152e85db..8f88e4d049 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,8 +1,10 @@ ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; -;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: FSF ;; Keywords: help, faces ;; This file is part of GNU Emacs. @@ -19,25 +21,128 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; This file implements the code to create and edit customize buffers. -;; +;; ;; See `custom.el'. ;; No commands should have names starting with `custom-' because ;; that interferes with completion. Use `customize-' for commands ;; that the user will run with M-x, and `Custom-' for interactive commands. +;; The identity of a customize option is represented by a Lisp symbol. +;; The following values are associated with an option. + +;; 0. The current value. + +;; This is the value of the option as seen by "the rest of Emacs". + +;; Usually extracted by 'default-value', but can be extracted with +;; different means if the option symbol has the 'custom-get' +;; property. Similarly, set-default (or the 'custom-set' property) +;; can set it. + +;; 1. The widget value. + +;; This is the value shown in the widget in a customize buffer. + +;; 2. The customized value. + +;; This is the last value given to the option through customize. + +;; It is stored in the 'customized-value' property of the option, in a +;; cons-cell whose car evaluates to the customized value. + +;; 3. The saved value. + +;; This is last value saved from customize. + +;; It is stored in the 'saved-value' property of the option, in a +;; cons-cell whose car evaluates to the saved value. + +;; 4. The standard value. + +;; This is the value given in the 'defcustom' declaration. + +;; It is stored in the 'standard-value' property of the option, in a +;; cons-cell whose car evaluates to the standard value. + +;; 5. The "think" value. + +;; This is what customize thinks the current value should be. + +;; This is the customized value, if any such value exists, otherwise +;; the saved value, if that exists, and as a last resort the standard +;; value. + +;; The reason for storing values unevaluated: This is so you can have +;; values that depend on the environment. For example, you can have a +;; variable that has one value when Emacs is running under a window +;; system, and another value on a tty. Since the evaluation is only done +;; when the variable is first initialized, this is only relevant for the +;; saved (and standard) values, but affect others values for +;; compatibility. + +;; You can see (and modify and save) this unevaluated value by selecting +;; "Show initial Lisp expression" from the Lisp interface. This will +;; give you the unevaluated saved value, if any, otherwise the +;; unevaluated standard value. + +;; The possible states for a customize widget are: + +;; 0. unknown + +;; The state has not been determined yet. + +;; 1. modified + +;; The widget value is different from the current value. + +;; 2. changed + +;; The current value is different from the "think" value. + +;; 3. set + +;; The "think" value is the customized value. + +;; 4. saved + +;; The "think" value is the saved value. + +;; 5. standard + +;; The "think" value is the standard value. + +;; 6. rogue + +;; There is no standard value. This means that the variable was +;; not defined with defcustom, nor handled in cus-start.el. You +;; can not create a Custom buffer for such variables using the +;; normal interactive Custom commands. However, such Custom +;; buffers can be created in other ways, for instance, by calling +;; `customize-option' non-interactively. + +;; 7. hidden + +;; There is no widget value. + +;; 8. mismatch + +;; The widget value is not valid member of the :type specified for the +;; option. + ;;; Code: (require 'cus-face) (require 'wid-edit) (eval-when-compile - (defvar custom-versions-load-alist)) ; from cus-load + (defvar custom-versions-load-alist) ; from cus-load + (defvar recentf-exclude)) ; from recentf.el (condition-case nil (require 'cus-load) @@ -73,6 +178,7 @@ (defgroup emulations nil "Emulations of other editors." + :link '(custom-manual "(emacs)Emulation") :group 'editing) (defgroup mouse nil @@ -87,11 +193,6 @@ "Interfacing to external utilities." :group 'emacs) -(defgroup bib nil - "Code related to the `bib' bibliography processor." - :tag "Bibliography" - :group 'external) - (defgroup processes nil "Process, subshell, compilation, and job control support." :group 'external @@ -116,6 +217,7 @@ (defgroup c nil "Support for the C language and related languages." + :link '(custom-manual "(ccmode)") :group 'languages) (defgroup tools nil @@ -140,6 +242,7 @@ (defgroup news nil "Support for netnews reading and posting." + :link '(custom-manual "(gnus)") :group 'applications) (defgroup games nil @@ -194,6 +297,7 @@ (defgroup i18n nil "Internationalization and alternate character-set support." + :link '(custom-manual "(emacs)International") :group 'environment :group 'editing) @@ -243,9 +347,6 @@ (defgroup customize '((widgets custom-group)) "Customization of the Customization support." - :link '(custom-manual "(elisp)Customization") - :link '(url-link :tag "(Old?) Development Page" - "http://www.dina.kvl.dk/~abraham/custom/") :prefix "custom-" :group 'help) @@ -271,6 +372,7 @@ (defgroup abbrev-mode nil "Word abbreviations mode." + :link '(custom-manual "(emacs)Abbrevs") :group 'abbrev) (defgroup alloc nil @@ -280,16 +382,13 @@ (defgroup undo nil "Undoing changes in buffers." + :link '(custom-manual "(emacs)Undo") :group 'editing) (defgroup modeline nil "Content of the modeline." :group 'environment) -(defgroup fill nil - "Indenting and filling text." - :group 'editing) - (defgroup editing-basics nil "Most basic editing facilities." :group 'editing) @@ -319,7 +418,8 @@ :group 'development) (defgroup minibuffer nil - "Controling the behaviour of the minibuffer." + "Controling the behavior of the minibuffer." + :link '(custom-manual "(emacs)Minibuffer") :group 'environment) (defgroup keyboard nil @@ -334,6 +434,10 @@ "Input from the menus." :group 'environment) +(defgroup dnd nil + "Handling data from drag and drop." + :group 'environment) + (defgroup auto-save nil "Preventing accidential loss of data." :group 'files) @@ -348,6 +452,7 @@ (defgroup windows nil "Windows within a frame." + :link '(custom-manual "(emacs)Windows") :group 'environment) ;;; Utilities. @@ -383,20 +488,16 @@ IF REGEXP is not a string, return it unchanged." regexp)) (defun custom-variable-prompt () - "Prompt for a variable, defaulting to the variable at point. + "Prompt for a custom variable, defaulting to the variable at point. Return a list suitable for use in `interactive'." (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read - (if (symbolp v) - (format "Customize option: (default %s) " v) - "Customize variable: ") - obarray (lambda (symbol) - (and (boundp symbol) - (or (get symbol 'custom-type) - (get symbol 'custom-loads) - (get symbol 'standard-value)))) t)) + (if (and (symbolp v) (custom-variable-p v)) + (format "Customize option (default %s): " v) + "Customize option: ") + obarray 'custom-variable-p t)) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -443,8 +544,7 @@ WIDGET is the widget to apply the filter entries of MENU on." (get symbol 'custom-tag) (concat (get symbol 'custom-tag) "..."))) (t - (save-excursion - (set-buffer (get-buffer-create " *Custom-Work*")) + (with-current-buffer (get-buffer-create " *Custom-Work*") (erase-buffer) (princ symbol (current-buffer)) (goto-char (point-min)) @@ -675,22 +775,20 @@ when the action is chosen.") (interactive) (let ((children custom-options)) (mapc (lambda (widget) - (and (default-boundp (widget-value widget)) - (if (memq (widget-get widget :custom-state) - '(modified changed)) - (widget-apply widget :custom-reset-current)))) - children))) + (if (memq (widget-get widget :custom-state) + '(modified changed)) + (widget-apply widget :custom-reset-current))) + children))) (defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) (let ((children custom-options)) (mapc (lambda (widget) - (and (get (widget-value widget) 'saved-value) - (if (memq (widget-get widget :custom-state) - '(modified set changed rogue)) - (widget-apply widget :custom-reset-saved)))) - children))) + (if (memq (widget-get widget :custom-state) + '(modified set changed rogue)) + (widget-apply widget :custom-reset-saved))) + children))) (defun Custom-reset-standard (&rest ignore) "Erase all customization (either current or saved) for the group members. @@ -763,7 +861,7 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set variable: " "Set %s to value: " current-prefix-arg)) - + (cond ((string= comment "") (put variable 'variable-comment nil)) (comment @@ -825,6 +923,7 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." current-prefix-arg)) (funcall (or (get variable 'custom-set) 'set-default) variable value) (put variable 'saved-value (list (custom-quote value))) + (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value))) (cond ((string= comment "") (put variable 'variable-comment nil) (put variable 'saved-variable-comment nil)) @@ -843,11 +942,32 @@ are shown; the contents of those subgroups are initially hidden." (interactive) (customize-group 'emacs)) +;;;###autoload +(defun customize-mode (mode) + "Customize options related to the current major mode. +If a prefix \\[universal-argument] was given (or if the current major mode has no known group), +then prompt for the MODE to customize." + (interactive + (list + (let ((completion-regexp-list '("-mode\\'")) + (group (custom-group-of-mode major-mode))) + (if (and group (not current-prefix-arg)) + major-mode + (intern + (completing-read (if group + (format "Major mode (default %s): " major-mode) + "Major mode: ") + obarray + 'custom-group-of-mode + t nil nil (if group (symbol-name major-mode)))))))) + (customize-group (custom-group-of-mode mode))) + + ;;;###autoload (defun customize-group (group) "Customize GROUP, which must be a customization group." (interactive (list (let ((completion-ignore-case t)) - (completing-read "Customize group: (default emacs) " + (completing-read "Customize group (default emacs): " obarray (lambda (symbol) (or (get symbol 'custom-loads) @@ -857,8 +977,6 @@ are shown; the contents of those subgroups are initially hidden." (if (string-equal "" group) (setq group 'emacs) (setq group (intern group)))) - (or (get group 'custom-group) - (custom-load-symbol group)) (let ((name (format "*Customize Group: %s*" (custom-unlispify-tag-name group)))) (if (get-buffer name) @@ -872,7 +990,7 @@ are shown; the contents of those subgroups are initially hidden." (defun customize-group-other-window (group) "Customize GROUP, which must be a customization group." (interactive (list (let ((completion-ignore-case t)) - (completing-read "Customize group: (default emacs) " + (completing-read "Customize group (default emacs): " obarray (lambda (symbol) (or (get symbol 'custom-loads) @@ -882,14 +1000,15 @@ are shown; the contents of those subgroups are initially hidden." (if (string-equal "" group) (setq group 'emacs) (setq group (intern group)))) - (or (get group 'custom-group) - (custom-load-symbol group)) (let ((name (format "*Customize Group: %s*" (custom-unlispify-tag-name group)))) (if (get-buffer name) - (let ((window (selected-window))) - (pop-to-buffer name) - (select-window window)) + (let ( + ;; Copied from `custom-buffer-create-other-window'. + (pop-up-windows t) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (pop-to-buffer name)) (custom-buffer-create-other-window (list (list group 'custom-group)) name @@ -903,31 +1022,27 @@ are shown; the contents of those subgroups are initially hidden." (defun customize-option (symbol) "Customize SYMBOL, which must be a user option variable." (interactive (custom-variable-prompt)) - ;; If we don't have SYMBOL's real definition loaded, - ;; try to load it. - (unless (get symbol 'custom-type) - (let ((loaddefs-file (locate-library "loaddefs.el" t)) - file) - ;; See if it is autoloaded from some library. - (when loaddefs-file - (with-temp-buffer - (insert-file-contents loaddefs-file) - (when (re-search-forward (concat "^(defvar " (symbol-name symbol)) - nil t) - (search-backward "\n;;; Generated autoloads from ") - (goto-char (match-end 0)) - (setq file (buffer-substring (point) - (progn (end-of-line) (point))))))) - ;; If it is, load that library. - (when file - (when (string-match "\\.el\\'" file) - (setq file (substring file 0 (match-beginning 0)))) - (load file)))) - (unless (get symbol 'custom-type) - (error "Variable %s cannot be customized" symbol)) - (custom-buffer-create (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" - (custom-unlispify-tag-name symbol)))) + (let ((basevar (indirect-variable symbol))) + (custom-buffer-create (list (list basevar 'custom-variable)) + (format "*Customize Option: %s*" + (custom-unlispify-tag-name basevar))) + (unless (eq symbol basevar) + (message "`%s' is an alias for `%s'" symbol basevar)))) + +;;;###autoload +(defalias 'customize-variable-other-window 'customize-option-other-window) + +;;;###autoload +(defun customize-option-other-window (symbol) + "Customize SYMBOL, which must be a user option variable. +Show the buffer in another window, but don't select it." + (interactive (custom-variable-prompt)) + (let ((basevar (indirect-variable symbol))) + (custom-buffer-create-other-window + (list (list basevar 'custom-variable)) + (format "*Customize Option: %s*" (custom-unlispify-tag-name basevar))) + (unless (eq symbol basevar) + (message "`%s' is an alias for `%s'" symbol basevar)))) (defvar customize-changed-options-previous-release "20.2" "Version for `customize-changed-options' to refer back to by default.") @@ -952,52 +1067,35 @@ version." (signal 'wrong-type-argument (list 'numberp since-version)))) (unless since-version (setq since-version customize-changed-options-previous-release)) - (let ((found nil) - (versions nil)) - (mapatoms (lambda (symbol) - (and (or (boundp symbol) - ;; For variables not yet loaded. - (get symbol 'standard-value) - ;; For groups the previous test fails, this one - ;; could be used to determine if symbol is a - ;; group. Is there a better way for this? - (get symbol 'group-documentation)) - (let ((version (get symbol 'custom-version))) - (and version - (or (null since-version) - (customize-version-lessp since-version version)) - (if (member version versions) - t - ;;; Collect all versions that we use. - (push version versions)))) - (setq found - ;; We have to set the right thing here, - ;; depending if we have a group or a - ;; variable. - (if (get symbol 'group-documentation) - (cons (list symbol 'custom-group) found) - (cons (list symbol 'custom-variable) found)))))) - (if (not found) - (error "No user option defaults have been changed since Emacs %s" - since-version) - (let ((flist nil)) - (while versions - (push (copy-sequence - (cdr (assoc (car versions) custom-versions-load-alist))) - flist) - (setq versions (cdr versions))) - (put 'custom-versions-load-alist 'custom-loads - ;; Get all the files that correspond to element from the - ;; VERSIONS list. This could use some simplification. - (apply 'nconc flist))) - ;; Because we set all the files needed to be loaded as a - ;; `custom-loads' property to `custom-versions-load-alist' this - ;; call will actually load them. - (custom-load-symbol 'custom-versions-load-alist) - ;; Clean up - (put 'custom-versions-load-alist 'custom-loads nil) - (custom-buffer-create (custom-sort-items found t 'first) - "*Customize Changed Options*")))) + + ;; Load the information for versions since since-version. We use + ;; custom-load-symbol for this. + (put 'custom-versions-load-alist 'custom-loads nil) + (dolist (elt custom-versions-load-alist) + (if (customize-version-lessp since-version (car elt)) + (dolist (load (cdr elt)) + (custom-add-load 'custom-versions-load-alist load)))) + (custom-load-symbol 'custom-versions-load-alist) + (put 'custom-versions-load-alist 'custom-loads nil) + + (let (found) + (mapatoms + (lambda (symbol) + (let ((version (get symbol 'custom-version))) + (if version + (when (customize-version-lessp since-version version) + (if (or (get symbol 'custom-group) + (get symbol 'group-documentation)) + (push (list symbol 'custom-group) found)) + (if (custom-variable-p symbol) + (push (list symbol 'custom-variable) found)) + (if (custom-facep symbol) + (push (list symbol 'custom-face) found))))))) + (if found + (custom-buffer-create (custom-sort-items found t 'first) + "*Customize Changed Options*") + (error "No user option defaults have been changed since Emacs %s" + since-version)))) (defun customize-version-lessp (version1 version2) ;; Why are the versions strings, and given that they are, why aren't @@ -1021,26 +1119,15 @@ version." (or (< major1 major2) (and (= major1 major2) (< minor1 minor2))))) - -;;;###autoload -(defalias 'customize-variable-other-window 'customize-option-other-window) - -;;;###autoload -(defun customize-option-other-window (symbol) - "Customize SYMBOL, which must be a user option variable. -Show the buffer in another window, but don't select it." - (interactive (custom-variable-prompt)) - (custom-buffer-create-other-window - (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol)))) ;;;###autoload (defun customize-face (&optional face) - "Customize SYMBOL, which should be a face name or nil. -If SYMBOL is nil, customize all faces. + "Customize FACE, which should be a face name or nil. +If FACE is nil, customize all faces. If FACE is actually a +face-alias, customize the face it is aliased to. Interactively, when point is on text which has a face specified, -suggest to customized that face, if it's customizable." +suggest to customize that face, if it's customizable." (interactive (list (read-face-name "Customize face" "all faces" t))) (if (member face '(nil "")) @@ -1054,18 +1141,22 @@ suggest to customized that face, if it's customizable." face) t nil) "*Customize Faces*") + ;; If FACE is actually an alias, customize the face it is aliased to. + (if (get face 'face-alias) + (setq face (get face 'face-alias))) (unless (facep face) - (error "Invalid face %S")) + (error "Invalid face %S" face)) (custom-buffer-create (list (list face 'custom-face)) (format "*Customize Face: %s*" (custom-unlispify-tag-name face))))) ;;;###autoload (defun customize-face-other-window (&optional face) - "Show customization buffer for face SYMBOL in other window. + "Show customization buffer for face FACE in other window. +If FACE is actually a face-alias, customize the face it is aliased to. Interactively, when point is on text which has a face specified, -suggest to customized that face, if it's customizable." +suggest to customize that face, if it's customizable." (interactive (list (read-face-name "Customize face" "all faces" t))) (if (member face '(nil "")) @@ -1080,8 +1171,10 @@ suggest to customized that face, if it's customizable." face) t nil) "*Customize Faces*") + (if (get face 'face-alias) + (setq face (get face 'face-alias))) (unless (facep face) - (error "Invalid face %S")) + (error "Invalid face %S" face)) (custom-buffer-create-other-window (list (list face 'custom-face)) (format "*Customize Face: %s*" @@ -1107,6 +1200,25 @@ suggest to customized that face, if it's customizable." "*Customize Customized*")))) ;;;###autoload +(defun customize-rogue () + "Customize all user variable modified outside customize." + (interactive) + (let ((found nil)) + (mapatoms (lambda (symbol) + (let ((cval (or (get symbol 'customized-value) + (get symbol 'saved-value) + (get symbol 'standard-value)))) + (when (and cval ;Declared with defcustom. + (default-boundp symbol) ;Has a value. + (not (equal (eval (car cval)) + ;; Which does not match customize. + (default-value symbol)))) + (push (list symbol 'custom-variable) found))))) + (if (not found) + (error "No rogue user options") + (custom-buffer-create (custom-sort-items found t nil) + "*Customize Rogue*")))) +;;;###autoload (defun customize-saved () "Customize all already saved user options." (interactive) @@ -1146,7 +1258,7 @@ user-settable, as well as faces and groups." (when (and (not (memq all '(groups faces))) (boundp symbol) (or (get symbol 'saved-value) - (get symbol 'standard-value) + (custom-variable-p symbol) (if (memq all '(nil options)) (user-variable-p symbol) (get symbol 'variable-documentation)))) @@ -1188,18 +1300,10 @@ links: groups have links to subgroups." (const links)) :group 'custom-buffer) -;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from -;; the window. -(defun custom-bury-buffer (buffer) - (bury-buffer)) - -(defcustom custom-buffer-done-function 'custom-bury-buffer - "*Function called to remove a Custom buffer when the user is done with it. -Called with one argument, the buffer to remove." - :type '(choice (function-item :tag "Bury buffer" custom-bury-buffer) - (function-item :tag "Kill buffer" kill-buffer) - (function :tag "Other")) - :version "21.1" +(defcustom custom-buffer-done-kill nil + "*Non-nil means exiting a Custom buffer should kill it." + :type 'boolean + :version "22.1" :group 'custom-buffer) (defcustom custom-buffer-indent 3 @@ -1207,6 +1311,31 @@ Called with one argument, the buffer to remove." :type 'integer :group 'custom-buffer) +(defun custom-get-fresh-buffer (name) + "Get a fresh new buffer with name NAME. +If the buffer already exist, clean it up to be like new. +Beware: it's not quite like new. Good enough for custom, but maybe +not for everybody." + ;; To be more complete, we should also kill all permanent-local variables, + ;; but it's not needed for custom. + (let ((buf (get-buffer name))) + (when (and buf (buffer-local-value 'buffer-file-name buf)) + ;; This will check if the file is not saved. + (kill-buffer buf) + (setq buf nil)) + (if (null buf) + (get-buffer-create name) + (with-current-buffer buf + (kill-all-local-variables) + (run-hooks 'kill-buffer-hook) + ;; Delete overlays before erasing the buffer so the overlay hooks + ;; don't get run spuriously when we erase the buffer. + (let ((ols (overlay-lists))) + (dolist (ol (nconc (car ols) (cdr ols))) + (delete-overlay ol))) + (erase-buffer) + buf)))) + ;;;###autoload (defun custom-buffer-create (options &optional name description) "Create a buffer containing OPTIONS. @@ -1214,29 +1343,23 @@ Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." - (unless name (setq name "*Customization*")) - (kill-buffer (get-buffer-create name)) - (pop-to-buffer (get-buffer-create name)) + (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*"))) (custom-buffer-create-internal options description)) ;;;###autoload (defun custom-buffer-create-other-window (options &optional name description) - "Create a buffer containing OPTIONS. + "Create a buffer containing OPTIONS, and display it in another window. +The result includes selecting that window. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." (unless name (setq name "*Customization*")) - (kill-buffer (get-buffer-create name)) - (let ((window (selected-window)) - (pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) + (let ((pop-up-windows t) (same-window-buffer-names nil) (same-window-regexps nil)) - (pop-to-buffer (get-buffer-create name)) - (custom-buffer-create-internal options description) - (select-window window))) + (pop-to-buffer (custom-get-fresh-buffer name)) + (custom-buffer-create-internal options description))) (defcustom custom-reset-button-menu nil "If non-nil, only show a single reset button in customize buffers. @@ -1250,9 +1373,9 @@ This button will have a menu with all three reset operations." :group 'custom-buffer) (defun Custom-buffer-done (&rest ignore) - "Remove current buffer by calling `custom-buffer-done-function'." + "Exit current Custom buffer according to `custom-buffer-done-kill'." (interactive) - (funcall custom-buffer-done-function (current-buffer))) + (quit-window custom-buffer-done-kill)) (defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box) '(("unspecified" . unspecified)))) @@ -1263,7 +1386,6 @@ Otherwise use brackets." :group 'custom-buffer) (defun custom-buffer-create-internal (options &optional description) - (message "Creating customization buffer...") (custom-mode) (if custom-buffer-verbose-help (progn @@ -1273,17 +1395,23 @@ Otherwise use brackets." (widget-insert (format ". %s show active fields; type RET or click mouse-1 on an active field to invoke its action. Editing an option value -changes the text in the buffer; invoke the State button and -choose the Set operation to set the option value. -Invoke " (if custom-raised-buttons - "`Raised' buttons" - "Square brackets"))) +changes only the text in the buffer. Invoke the State button to set or +save the option value. Saving an option normally edits your init file. +Invoke " + (if custom-raised-buttons + "`Raised' buttons" + "Square brackets"))) + (widget-create 'info-link + :tag "Custom file" + "(emacs)Saving Customizations") + (widget-insert + " for information on how to save in a different file. +Invoke ") (widget-create 'info-link :tag "Help" :help-echo "Read the online help." "(emacs)Easy Customization") - (widget-insert " for more information.\n\n") - (message "Creating customization buttons...") + (widget-insert " for general information.\n\n") (widget-insert "Operate on everything in this buffer:\n ")) (widget-insert " ")) (widget-create 'push-button @@ -1296,7 +1424,8 @@ Make your editing in this buffer take effect for this session." (widget-create 'push-button :tag "Save for Future Sessions" :help-echo "\ -Make your editing in this buffer take effect for future Emacs sessions." +Make your editing in this buffer take effect for future Emacs sessions. +This updates your Emacs initialization file or creates a new one." :action (lambda (widget &optional event) (Custom-save))) (if custom-reset-button-menu @@ -1338,13 +1467,9 @@ Un-customize all values in this buffer. They get their standard settings." :tag "Finish" :help-echo (lambda (&rest ignore) - (cond - ((eq custom-buffer-done-function - 'custom-bury-buffer) - "Bury this buffer") - ((eq custom-buffer-done-function 'kill-buffer) - "Kill this buffer") - (t "Finish with this buffer"))) + (if custom-buffer-done-kill + "Kill this buffer" + "Bury this buffer")) :action #'Custom-buffer-done) (widget-insert "\n\n") (message "Creating customization items...") @@ -1377,13 +1502,15 @@ Un-customize all values in this buffer. They get their standard settings." (unless (eq (preceding-char) ?\n) (widget-insert "\n")) (message "Creating customization items ...done") + (message "Resetting customization items...") (unless (eq custom-buffer-style 'tree) (mapc 'custom-magic-reset custom-options)) + (message "Resetting customization items...done") (message "Creating customization setup...") (widget-setup) (buffer-enable-undo) (goto-char (point-min)) - (message "Creating customization buffer...done")) + (message "Creating customization setup...done")) ;;; The Tree Browser. @@ -1394,8 +1521,7 @@ Un-customize all values in this buffer. They get their standard settings." (unless group (setq group 'emacs)) (let ((name "*Customize Browser*")) - (kill-buffer (get-buffer-create name)) - (pop-to-buffer (get-buffer-create name))) + (pop-to-buffer (custom-get-fresh-buffer name))) (custom-mode) (widget-insert "\ Square brackets show active fields; type RET or click mouse-1 @@ -1427,6 +1553,7 @@ item in another window.\n\n")) :custom-state 'unknown :tag (custom-unlispify-tag-name group) :value group)) + (widget-setup) (goto-char (point-min))) (define-widget 'custom-browse-visibility 'item @@ -1523,71 +1650,90 @@ item in another window.\n\n")) :group 'custom-faces :group 'custom-buffer) -(defface custom-invalid-face '((((class color)) - (:foreground "yellow" :background "red")) - (t - (:weight bold :slant italic :underline t))) +(defface custom-invalid '((((class color)) + (:foreground "yellow1" :background "red1")) + (t + (:weight bold :slant italic :underline t))) "Face used when the customize item is invalid." :group 'custom-magic-faces) +;; backward-compatibility alias +(put 'custom-invalid-face 'face-alias 'custom-invalid) -(defface custom-rogue-face '((((class color)) - (:foreground "pink" :background "black")) - (t - (:underline t))) +(defface custom-rogue '((((class color)) + (:foreground "pink" :background "black")) + (t + (:underline t))) "Face used when the customize item is not defined for customization." :group 'custom-magic-faces) - -(defface custom-modified-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic :bold))) +;; backward-compatibility alias +(put 'custom-rogue-face 'face-alias 'custom-rogue) + +(defface custom-modified '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (:slant italic :bold))) "Face used when the customize item has been modified." :group 'custom-magic-faces) +;; backward-compatibility alias +(put 'custom-modified-face 'face-alias 'custom-modified) -(defface custom-set-face '((((class color)) - (:foreground "blue" :background "white")) - (t - (:slant italic))) +(defface custom-set '((((min-colors 88) (class color)) + (:foreground "blue1" :background "white")) + (((class color)) + (:foreground "blue" :background "white")) + (t + (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) +;; backward-compatibility alias +(put 'custom-set-face 'face-alias 'custom-set) -(defface custom-changed-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic))) +(defface custom-changed '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (:slant italic))) "Face used when the customize item has been changed." :group 'custom-magic-faces) +;; backward-compatibility alias +(put 'custom-changed-face 'face-alias 'custom-changed) -(defface custom-saved-face '((t (:underline t))) +(defface custom-saved '((t (:underline t))) "Face used when the customize item has been saved." :group 'custom-magic-faces) - -(defconst custom-magic-alist '((nil "#" underline "\ -uninitialized, you should not see this.") - (unknown "?" italic "\ -unknown, you should not see this.") - (hidden "-" default "\ -hidden, invoke \"Show\" in the previous line to show." "\ +;; backward-compatibility alias +(put 'custom-saved-face 'face-alias 'custom-saved) + +(defconst custom-magic-alist + '((nil "#" underline "\ +UNINITIALIZED, you should not see this.") + (unknown "?" italic "\ +UNKNOWN, you should not see this.") + (hidden "-" default "\ +HIDDEN, invoke \"Show\" in the previous line to show." "\ group now hidden, invoke \"Show\", above, to show contents.") - (invalid "x" custom-invalid-face "\ -the value displayed for this %c is invalid and cannot be set.") - (modified "*" custom-modified-face "\ -you have edited the value as text, but you have not set the %c." "\ -you have edited something in this group, but not set it.") - (set "+" custom-set-face "\ -you have set this %c, but not saved it for future sessions." "\ -something in this group has been set, but not saved.") - (changed ":" custom-changed-face "\ -this %c has been changed outside the customize buffer." "\ + (invalid "x" custom-invalid "\ +INVALID, the displayed value cannot be set.") + (modified "*" custom-modified "\ +EDITED, shown value does not take effect until you set or save it." "\ +something in this group has been edited but not set.") + (set "+" custom-set "\ +SET for current session only." "\ +something in this group has been set but not saved.") + (changed ":" custom-changed "\ +CHANGED outside Customize; operating on it here may be unreliable." "\ something in this group has been changed outside customize.") - (saved "!" custom-saved-face "\ -this %c has been set and saved." "\ + (saved "!" custom-saved "\ +SAVED and set." "\ something in this group has been set and saved.") - (rogue "@" custom-rogue-face "\ -this %c has not been changed with customize." "\ + (rogue "@" custom-rogue "\ +NO CUSTOMIZATION DATA; you should not see this." "\ something in this group is not prepared for customization.") - (standard " " nil "\ -this %c is unchanged from its standard setting." "\ + (standard " " nil "\ +STANDARD." "\ visible group members are all at standard settings.")) "Alist of customize option states. Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where @@ -1607,7 +1753,7 @@ STATE is one of the following symbols: `set' This item has been set but not saved. `changed' - The current value of this item has been changed temporarily. + The current value of this item has been changed outside Customize. `saved' This item is marked for saving. `rogue' @@ -1710,7 +1856,7 @@ and `face'." (insert " (lisp)")) ((eq form 'mismatch) (insert " (mismatch)"))) - (put-text-property start (point) 'face 'custom-state-face)) + (put-text-property start (point) 'face 'custom-state)) (insert "\n")) (when (and (eq category 'group) (not (and (eq custom-buffer-style 'links) @@ -1744,7 +1890,7 @@ and `face'." ;;; The `custom' Widget. -(defface custom-button-face +(defface custom-button '((((type x w32 mac) (class color)) ; Like default modeline (:box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) @@ -1753,8 +1899,10 @@ and `face'." "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-button-face 'face-alias 'custom-button) -(defface custom-button-pressed-face +(defface custom-button-pressed '((((type x w32 mac) (class color)) (:box (:line-width 2 :style pressed-button) :background "lightgrey" :foreground "black")) @@ -1763,20 +1911,26 @@ and `face'." "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed) -(defface custom-documentation-face nil +(defface custom-documentation nil "Face used for documentation strings in customization buffers." :group 'custom-faces) - -(defface custom-state-face '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) +;; backward-compatibility alias +(put 'custom-documentation-face 'face-alias 'custom-documentation) + +(defface custom-state '((((class color) + (background dark)) + (:foreground "lime green")) + (((class color) + (background light)) + (:foreground "dark green")) + (t nil)) "Face used for State descriptions in the customize buffer." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-state-face 'face-alias 'custom-state) (define-widget 'custom 'default "Customize a user option." @@ -1858,7 +2012,7 @@ and `face'." (custom-load-symbol (widget-value widget))) (defun custom-unloaded-symbol-p (symbol) - "Return non-nil if the dependencies of SYMBOL has not yet been loaded." + "Return non-nil if the dependencies of SYMBOL have not yet been loaded." (let ((found nil) (loads (get symbol 'custom-loads)) load) @@ -1876,7 +2030,7 @@ and `face'." found)) (defun custom-unloaded-widget-p (widget) - "Return non-nil if the dependencies of WIDGET has not yet been loaded." + "Return non-nil if the dependencies of WIDGET have not yet been loaded." (custom-unloaded-symbol-p (widget-value widget))) (defun custom-toggle-hide (widget) @@ -1933,7 +2087,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (type (widget-type widget)) (buttons (widget-get widget :buttons)) (start (point)) - found) + (parents nil)) (insert (or initial-string "Parent groups:")) (mapatoms (lambda (symbol) (let ((entry (assq name (get symbol 'custom-group)))) @@ -1944,30 +2098,50 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :tag (custom-unlispify-tag-name symbol) symbol) buttons) - (setq found t))))) - (widget-put widget :buttons buttons) - (if found - (insert "\n") + (setq parents (cons symbol parents)))))) + (and (null (get name 'custom-links)) ;No links of its own. + (= (length parents) 1) ;A single parent. + (let* ((links (get (car parents) 'custom-links)) + (many (> (length links) 2))) + (when links + (insert "\nParent documentation: ") + (while links + (push (widget-create-child-and-convert widget (car links)) + buttons) + (setq links (cdr links)) + (cond ((null links) + (insert ".\n")) + ((null (cdr links)) + (if many + (insert ", and ") + (insert " and "))) + (t + (insert ", "))))))) + (if parents + (insert "\n") (delete-region start (point))) - found)) + (widget-put widget :buttons buttons) + parents)) ;;; The `custom-comment' Widget. ;; like the editable field -(defface custom-comment-face '((((class grayscale color) - (background light)) - (:background "gray85")) - (((class grayscale color) - (background dark)) - (:background "dim gray")) - (t - (:slant italic))) +(defface custom-comment '((((class grayscale color) + (background light)) + (:background "gray85")) + (((class grayscale color) + (background dark)) + (:background "dim gray")) + (t + (:slant italic))) "Face used for comments on variables or faces" :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-comment-face 'face-alias 'custom-comment) ;; like font-lock-comment-face -(defface custom-comment-tag-face +(defface custom-comment-tag '((((class color) (background dark)) (:foreground "gray80")) (((class color) (background light)) (:foreground "blue4")) (((class grayscale) (background light)) @@ -1977,6 +2151,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (t (:weight bold))) "Face used for variables or faces comment tags" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag) (define-widget 'custom-comment 'string "User comment." @@ -2016,20 +2192,27 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." ;; When this was underlined blue, users confused it with a ;; Mosaic-style hyperlink... -(defface custom-variable-tag-face +(defface custom-variable-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) + (((min-colors 88) (class color) + (background light)) + (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) (t (:weight bold))) "Face used for unpushable variable tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag) -(defface custom-variable-button-face '((t (:underline t :weight bold))) +(defface custom-variable-button '((t (:underline t :weight bold))) "Face used for pushable variable tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-variable-button-face 'face-alias 'custom-variable-button) (defcustom custom-variable-default-form 'edit "Default form of displaying variable values." @@ -2038,11 +2221,25 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :group 'custom-buffer :version "20.3") +(defun custom-variable-documentation (variable) + "Return documentation of VARIABLE for use in Custom buffer. +Normally just return the docstring. But if VARIABLE automatically +becomes buffer local when set, append a message to that effect." + (if (and (local-variable-if-set-p variable) + (or (not (local-variable-p variable)) + (with-temp-buffer + (local-variable-if-set-p variable)))) + (concat (documentation-property variable 'variable-documentation) + "\n +This variable automatically becomes buffer-local when set outside Custom. +However, setting it through Custom sets the default value.") + (documentation-property variable 'variable-documentation))) + (define-widget 'custom-variable 'custom "Customize variable." :format "%v" :help-echo "Set or reset this variable." - :documentation-property 'variable-documentation + :documentation-property #'custom-variable-documentation :custom-category 'option :custom-state nil :custom-menu 'custom-variable-menu-create @@ -2411,6 +2608,8 @@ Optional EVENT is the location for the menu." ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) (put symbol 'saved-value (list (widget-value child))) + (custom-push-theme 'theme-value symbol 'user + 'set (list (widget-value child))) (funcall set symbol (eval (widget-value child))) (put symbol 'variable-comment comment) (put symbol 'saved-variable-comment comment)) @@ -2421,6 +2620,9 @@ Optional EVENT is the location for the menu." (custom-comment-hide comment-widget)) (put symbol 'saved-value (list (custom-quote (widget-value child)))) + (custom-push-theme 'theme-value symbol 'user + 'set (list (custom-quote (widget-value + child)))) (funcall set symbol (widget-value child)) (put symbol 'variable-comment comment) (put symbol 'saved-variable-comment comment))) @@ -2470,6 +2672,11 @@ becomes the backup value, so you can get it again." (put symbol 'customized-variable-comment nil) (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) (put symbol 'saved-value nil) + (custom-push-theme 'theme-value symbol 'user 'reset 'standard) + ;; As a special optimizations we do not (explictly) + ;; save resets to standard when no theme set the value. + (if (null (cdr (get symbol 'theme-value))) + (put symbol 'theme-value nil)) (put symbol 'saved-variable-comment nil) (custom-save-all)) (widget-put widget :custom-state 'unknown) @@ -2518,11 +2725,11 @@ to switch between two values." "Edit face attributes." :format "%t: %v" :tag "Attributes" - :extra-offset 12 + :extra-offset 13 :button-args '(:help-echo "Control whether this attribute has any effect.") :value-to-internal 'custom-face-edit-fix-value :match (lambda (widget value) - (widget-checklist-match widget + (widget-checklist-match widget (custom-face-edit-fix-value widget value))) :convert-widget 'custom-face-edit-convert-widget :args (mapcar (lambda (att) @@ -2534,7 +2741,8 @@ to switch between two values." custom-face-attributes)) (defun custom-face-edit-fix-value (widget value) - "Ignoring WIDGET, convert :bold and :italic in VALUE to new form." + "Ignoring WIDGET, convert :bold and :italic in VALUE to new form. +Also change :reverse-video to :inverse-video." (if (listp value) (let (result) (while value @@ -2546,7 +2754,10 @@ to switch between two values." ((eq key :bold) (push :weight result) (push (if val 'bold 'normal) result)) - (t + ((eq key :reverse-video) + (push :inverse-video result) + (push val result)) + (t (push key result) (push val result)))) (setq value (cdr (cdr value)))) @@ -2571,7 +2782,6 @@ to switch between two values." (unless (widget-get widget :inactive) (let ((tag (custom-face-edit-attribute-tag widget)) (from (copy-marker (widget-get widget :from))) - (to (widget-get widget :to)) (value (widget-value widget)) (inhibit-read-only t) (inhibit-modification-hooks t)) @@ -2597,7 +2807,7 @@ to switch between two values." (widget-setup))))) (defun custom-face-edit-delete (widget) - "Remove widget from the buffer." + "Remove WIDGET from the buffer." (let ((inactive (widget-get widget :inactive)) (inhibit-read-only t) (inhibit-modification-hooks t)) @@ -2609,7 +2819,7 @@ to switch between two values." (delete-region (car (cdr inactive)) (+ (car (cdr inactive)) (cdr (cdr inactive)))) (widget-put widget :inactive nil)))) - + (defun custom-face-edit-attribute-tag (widget) "Returns the first :tag property in WIDGET or one of its children." @@ -2628,6 +2838,7 @@ to switch between two values." :value t :help-echo "Specify frames where the face attributes should be used." :args '((const :tag "all" t) + (const :tag "defaults" default) (checklist :offset 0 :extra-offset 9 @@ -2649,6 +2860,10 @@ OS/2 Presentation Manager.") :sibling-args (:help-echo "\ Windows NT/9X.") w32) + (const :format "MAC " + :sibling-args (:help-echo "\ +Macintosh OS.") + mac) (const :format "DOS " :sibling-args (:help-echo "\ Plain MS-DOS.") @@ -2676,6 +2891,10 @@ Match grayscale frames.") Match frames with no color support.") mono))) (group :sibling-args (:help-echo "\ +The minimum number of colors the frame should support.") + (const :format "" min-colors) + (integer :tag "Minimum number of colors" )) + (group :sibling-args (:help-echo "\ Only match frames with the specified intensity.") (const :format "\ Background brightness: " @@ -2697,10 +2916,12 @@ Only match frames that support the specified face attributes.") ;;; The `custom-face' Widget. -(defface custom-face-tag-face +(defface custom-face-tag `((t (:weight bold :height 1.2 :inherit variable-pitch))) "Face used for face tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-face-tag-face 'face-alias 'custom-face-tag) (defcustom custom-face-default-form 'selected "Default form of displaying face definition." @@ -2748,13 +2969,29 @@ Only match frames that support the specified face attributes.") (define-widget 'custom-face-selected 'group "Edit the attributes of the selected display in a face specification." - :args '((repeat :format "" - :inline t - (group custom-display-unselected sexp)) - (group (sexp :format "") custom-face-edit) - (repeat :format "" - :inline t - sexp))) + :args '((choice :inline t + (group :tag "With Defaults" :inline t + (group (const :tag "" default) + (custom-face-edit :tag " Default\n Attributes")) + (repeat :format "" + :inline t + (group custom-display-unselected sexp)) + (group (sexp :format "") + (custom-face-edit :tag " Overriding\n Attributes")) + (repeat :format "" + :inline t + sexp)) + (group :tag "No Defaults" :inline t + (repeat :format "" + :inline t + (group custom-display-unselected sexp)) + (group (sexp :format "") + (custom-face-edit :tag "\n Attributes")) + (repeat :format "" + :inline t + sexp))))) + + (defconst custom-face-selected (widget-convert 'custom-face-selected) "Converted version of the `custom-face-selected' widget.") @@ -2963,28 +3200,34 @@ widget. If FILTER is nil, ACTION is always valid.") "Set the state of WIDGET." (let* ((symbol (widget-value widget)) (comment (get symbol 'face-comment)) - tmp temp) - (widget-put widget :custom-state - (cond ((progn - (setq tmp (get symbol 'customized-face)) - (setq temp (get symbol 'customized-face-comment)) - (or tmp temp)) - (if (equal temp comment) - 'set - 'changed)) - ((progn - (setq tmp (get symbol 'saved-face)) - (setq temp (get symbol 'saved-face-comment)) - (or tmp temp)) - (if (equal temp comment) - 'saved - 'changed)) - ((get symbol 'face-defface-spec) - (if (equal comment nil) - 'standard - 'changed)) - (t - 'rogue))))) + tmp temp + (state + (cond ((progn + (setq tmp (get symbol 'customized-face)) + (setq temp (get symbol 'customized-face-comment)) + (or tmp temp)) + (if (equal temp comment) + 'set + 'changed)) + ((progn + (setq tmp (get symbol 'saved-face)) + (setq temp (get symbol 'saved-face-comment)) + (or tmp temp)) + (if (equal temp comment) + 'saved + 'changed)) + ((get symbol 'face-defface-spec) + (if (equal comment nil) + 'standard + 'changed)) + (t + 'rogue)))) + ;; If the user called set-face-attribute to change the default + ;; for new frames, this face is "set outside of Customize". + (if (and (not (eq state 'rogue)) + (get symbol 'face-modified)) + (setq state 'changed)) + (widget-put widget :custom-state state))) (defun custom-face-action (widget &optional event) "Show the menu for `custom-face' WIDGET. @@ -3046,6 +3289,7 @@ Optional EVENT is the location for the menu." (face-spec-set symbol '((t :foreground unspecified)))) (unless (eq (widget-get widget :custom-state) 'standard) (put symbol 'saved-face value)) + (custom-push-theme 'theme-face symbol 'user 'set value) (put symbol 'customized-face nil) (put symbol 'face-comment comment) (put symbol 'customized-face-comment nil) @@ -3090,6 +3334,10 @@ restoring it to the state of a face that has never been customized." (put symbol 'customized-face-comment nil) (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) + (custom-push-theme 'theme-face symbol 'user 'reset 'standard) + ;; Do not explictly save resets to standards without themes. + (if (null (cdr (get symbol 'theme-face))) + (put symbol 'theme-face nil)) (put symbol 'saved-face-comment nil) (custom-save-all)) (face-spec-set symbol value) @@ -3102,54 +3350,41 @@ restoring it to the state of a face that has never been customized." ;;; The `face' Widget. -(define-widget 'face 'default - "Select and customize a face." - :convert-widget 'widget-value-convert-widget - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :format "%{%t%}: %[select face%] %v" +(defvar widget-face-prompt-value-history nil + "History of input to `widget-face-prompt-value'.") + +(define-widget 'face 'symbol + "A Lisp face name (with sample)." + :format "%t: (%{sample%}) %v" :tag "Face" :value 'default - :value-create 'widget-face-value-create - :value-delete 'widget-face-value-delete - :value-get 'widget-value-value-get - :validate 'widget-children-validate - :action 'widget-face-action - :match (lambda (widget value) (symbolp value))) + :sample-face-get 'widget-face-sample-face-get + :notify 'widget-face-notify + :match (lambda (widget value) (facep value)) + :complete-function (lambda () + (interactive) + (lisp-complete-symbol 'facep)) + :prompt-match 'facep + :prompt-history 'widget-face-prompt-value-history + :validate (lambda (widget) + (unless (facep (widget-value widget)) + (widget-put widget + :error (format "Invalid face: %S" + (widget-value widget))) + widget))) + +(defun widget-face-sample-face-get (widget) + (let ((value (widget-value widget))) + (if (facep value) + value + 'default))) + +(defun widget-face-notify (widget child &optional event) + "Update the sample, and notify the parent." + (overlay-put (widget-get widget :sample-overlay) + 'face (widget-apply widget :sample-face-get)) + (widget-default-notify widget child event)) -(defun widget-face-value-create (widget) - "Create a `custom-face' child." - (let* ((symbol (widget-value widget)) - (custom-buffer-style 'face) - (child (widget-create-child-and-convert - widget 'custom-face - :custom-level nil - :value symbol))) - (custom-magic-reset child) - (setq custom-options (cons child custom-options)) - (widget-put widget :children (list child)))) - -(defun widget-face-value-delete (widget) - "Remove the child from the options." - (let ((child (car (widget-get widget :children)))) - (setq custom-options (delq child custom-options)) - (widget-children-value-delete widget))) - -(defvar face-history nil - "History of entered face names.") - -(defun widget-face-action (widget &optional event) - "Prompt for a face." - (let ((answer (completing-read "Face: " - (mapcar (lambda (face) - (list (symbol-name face))) - (face-list)) - nil nil nil - 'face-history))) - (unless (zerop (length answer)) - (widget-value-set widget (intern answer)) - (widget-apply widget :notify widget event) - (widget-setup)))) ;;; The `hook' Widget. @@ -3205,32 +3440,41 @@ restoring it to the state of a face that has never been customized." ;; Fixme: make it do so in Emacs. "Face used for group tags. The first member is used for level 1 groups, the second for level 2, -and so forth. The remaining group tags are shown with -`custom-group-tag-face'." +and so forth. The remaining group tags are shown with `custom-group-tag'." :type '(repeat face) :group 'custom-faces) -(defface custom-group-tag-face-1 +(defface custom-group-tag-1 `((((class color) (background dark)) (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) + (((min-colors 88) (class color) + (background light)) + (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch)) (t (:weight bold))) "Face used for group tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1) -(defface custom-group-tag-face +(defface custom-group-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2)) + (((min-colors 88) (class color) + (background light)) + (:foreground "blue1" :weight bold :height 1.2)) (((class color) (background light)) (:foreground "blue" :weight bold :height 1.2)) (t (:weight bold))) "Face used for low level group tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-group-tag-face 'face-alias 'custom-group-tag) (define-widget 'custom-group 'custom "Customize group." @@ -3251,7 +3495,7 @@ and so forth. The remaining group tags are shown with (defun custom-group-sample-face-get (widget) ;; Use :sample-face. (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) - 'custom-group-tag-face)) + 'custom-group-tag)) (define-widget 'custom-group-visibility 'visibility "An indicator and manipulator for hidden group contents." @@ -3276,6 +3520,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (defun custom-group-value-create (widget) "Insert a customize group for WIDGET in the current buffer." + (unless (eq (widget-get widget :custom-state) 'hidden) + (custom-load-widget widget)) (let* ((state (widget-get widget :custom-state)) (level (widget-get widget :custom-level)) ;; (indent (widget-get widget :indent)) @@ -3315,7 +3561,6 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (widget-put widget :buttons buttons)) ((eq custom-buffer-style 'tree) (custom-browse-insert-prefix prefix) - (custom-load-widget widget) (if (zerop (length members)) (progn (custom-browse-insert-prefix prefix) @@ -3456,7 +3701,6 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ?\ )) ;; Members. (message "Creating group...") - (custom-load-widget widget) (let* ((members (custom-sort-items members custom-buffer-sort-alphabetically custom-buffer-order-groups)) @@ -3592,46 +3836,96 @@ Optional EVENT is the location for the menu." (setq magics (cdr magics))))) (widget-put widget :custom-state found))) (custom-magic-reset widget)) + +;;; Reading and writing the custom file. -;;; The `custom-save-all' Function. ;;;###autoload (defcustom custom-file nil "File used for storing customization information. The default is nil, which means to use your init file -as specified by `user-init-file'. If you specify some other file, -you need to explicitly load that file for the settings to take effect. - -When you change this variable, look in the previous custom file -\(usually your init file) for the forms `(custom-set-variables ...)' -and `(custom-set-faces ...)', and copy them (whichever ones you find) -to the new custom file. This will preserve your existing customizations." - :type '(choice (const :tag "Your Emacs init file" nil) file) +as specified by `user-init-file'. If the value is not nil, +it should be an absolute file name. + +You can set this option through Custom, if you carefully read the +last paragraph below. However, usually it is simpler to write +something like the following in your init file: + +\(setq custom-file \"~/.emacs-custom.el\") +\(load custom-file) + +Note that both lines are necessary: the first line tells Custom to +save all customizations in this file, but does not load it. + +When you change this variable outside Custom, look in the +previous custom file \(usually your init file) for the +forms `(custom-set-variables ...)' and `(custom-set-faces ...)', +and copy them (whichever ones you find) to the new custom file. +This will preserve your existing customizations. + +If you save this option using Custom, Custom will write all +currently saved customizations, including the new one for this +option itself, into the file you specify, overwriting any +`custom-set-variables' and `custom-set-faces' forms already +present in that file. It will not delete any customizations from +the old custom file. You should do that manually if that is what you +want. You also have to put something like `\(load \"CUSTOM-FILE\") +in your init file, where CUSTOM-FILE is the actual name of the +file. Otherwise, Emacs will not load the file when it starts up, +and hence will not set `custom-file' to that file either." + :type '(choice (const :tag "Your Emacs init file" nil) + (file :format "%t:%v%d" + :doc + "Please read entire docstring below before setting \ +this through Custom. +Click om \"More\" \(or position point there and press RETURN) +if only the first line of the docstring is shown.")) :group 'customize) (defun custom-file () "Return the file name for saving customizations." - (setq custom-file - (or custom-file - (let ((user-init-file user-init-file) - (default-init-file - (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs"))) - (when (null user-init-file) - (if (or (file-exists-p default-init-file) - (and (eq system-type 'windows-nt) - (file-exists-p "~/_emacs"))) - ;; Started with -q, i.e. the file containing - ;; Custom settings hasn't been read. Saving - ;; settings there would overwrite other settings. - (error "Saving settings from \"emacs -q\" would overwrite existing customizations")) - (setq user-init-file default-init-file)) - user-init-file)))) + (file-chase-links + (or custom-file + (let ((user-init-file user-init-file) + (default-init-file + (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs"))) + (when (null user-init-file) + (if (or (file-exists-p default-init-file) + (and (eq system-type 'windows-nt) + (file-exists-p "~/_emacs"))) + ;; Started with -q, i.e. the file containing + ;; Custom settings hasn't been read. Saving + ;; settings there would overwrite other settings. + (error "Saving settings from \"emacs -q\" would overwrite existing customizations")) + (setq user-init-file default-init-file)) + user-init-file)))) + +;;;###autoload +(defun custom-save-all () + "Save all customizations in `custom-file'." + (let* ((filename (custom-file)) + (recentf-exclude (if recentf-mode + (cons (concat "\\`" + (regexp-quote (custom-file)) + "\\'") + recentf-exclude))) + (old-buffer (find-buffer-visiting filename))) + (with-current-buffer (or old-buffer (find-file-noselect filename)) + (let ((inhibit-read-only t)) + (custom-save-variables) + (custom-save-faces)) + (let ((file-precious-flag t)) + (save-buffer)) + (unless old-buffer + (kill-buffer (current-buffer)))))) + +;; Editing the custom file contents in a buffer. (defun custom-save-delete (symbol) - "Visit `custom-file' and delete all calls to SYMBOL from it. + "Delete all calls to SYMBOL from the contents of the current buffer. Leave point at the old location of the first such call, -or (if there were none) at the end of the buffer." - (let ((default-major-mode)) - (set-buffer (find-file-noselect (custom-file)))) +or (if there were none) at the end of the buffer. + +This function does not save the buffer." (goto-char (point-min)) ;; Skip all whitespace and comments. (while (forward-comment 1)) @@ -3668,7 +3962,11 @@ or (if there were none) at the end of the buffer." (defun custom-save-variables () "Save all customized variables in `custom-file'." (save-excursion + (custom-save-delete 'custom-load-themes) + (custom-save-delete 'custom-reset-variables) (custom-save-delete 'custom-set-variables) + (custom-save-loaded-themes) + (custom-save-resets 'theme-value 'custom-reset-variables nil) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) sort-fold-case) @@ -3685,43 +3983,41 @@ or (if there were none) at the end of the buffer." ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right.\n") - (mapcar - (lambda (symbol) - (let ((value (get symbol 'saved-value)) - (requests (get symbol 'custom-requests)) - (now (not (or (get symbol 'standard-value) - (and (not (boundp symbol)) - (not (get symbol 'force-value)))))) - (comment (get symbol 'saved-variable-comment)) - sep) - (when (or value comment) - (unless (bolp) - (princ "\n")) - (princ " '(") - (prin1 symbol) - (princ " ") - (prin1 (car value)) - (cond ((or now requests comment) - (princ " ") - (if now - (princ "t") - (princ "nil")) - (cond ((or requests comment) - (princ " ") - (if requests - (prin1 requests) - (princ "nil")) - (cond (comment - (princ " ") - (prin1 comment) - (princ ")")) - (t - (princ ")")))) - (t - (princ ")")))) - (t - (princ ")")))))) - saved-list) + (dolist (symbol saved-list) + (let ((spec (car-safe (get symbol 'theme-value))) + (value (get symbol 'saved-value)) + (requests (get symbol 'custom-requests)) + (now (not (or (custom-variable-p symbol) + (and (not (boundp symbol)) + (not (eq (get symbol 'force-value) + 'rogue)))))) + (comment (get symbol 'saved-variable-comment))) + ;; Check `requests'. + (dolist (request requests) + (when (and (symbolp request) (not (featurep request))) + (message "Unknown requested feature: %s" request) + (setq requests (delq request requests)))) + (when (or (and spec + (eq (nth 0 spec) 'user) + (eq (nth 1 spec) 'set)) + comment + (and (null spec) (get symbol 'saved-value))) + (unless (bolp) + (princ "\n")) + (princ " '(") + (prin1 symbol) + (princ " ") + (prin1 (car value)) + (when (or now requests comment) + (princ " ") + (prin1 now) + (when (or requests comment) + (princ " ") + (prin1 requests) + (when comment + (princ " ") + (prin1 comment)))) + (princ ")")))) (if (bolp) (princ " ")) (princ ")") @@ -3731,7 +4027,9 @@ or (if there were none) at the end of the buffer." (defun custom-save-faces () "Save all customized faces in `custom-file'." (save-excursion + (custom-save-delete 'custom-reset-faces) (custom-save-delete 'custom-set-faces) + (custom-save-resets 'theme-face 'custom-reset-faces '(default)) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) sort-fold-case) @@ -3751,40 +4049,76 @@ or (if there were none) at the end of the buffer." ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right.\n") - (mapcar - (lambda (symbol) - (let ((value (get symbol 'saved-face)) - (now (not (or (get symbol 'face-defface-spec) - (and (not (custom-facep symbol)) - (not (get symbol 'force-face)))))) - (comment (get symbol 'saved-face-comment))) - ;; Don't print default face here. - (unless (bolp) - (princ "\n")) - (princ " '(") - (prin1 symbol) - (princ " ") - (prin1 value) - (cond ((or now comment) - (princ " ") - (if now - (princ "t") - (princ "nil")) - (cond (comment - (princ " ") - (prin1 comment) - (princ ")")) - (t - (princ ")")))) - (t - (princ ")"))))) - saved-list) + (dolist (symbol saved-list) + (let ((spec (car-safe (get symbol 'theme-face))) + (value (get symbol 'saved-face)) + (now (not (or (get symbol 'face-defface-spec) + (and (not (custom-facep symbol)) + (not (get symbol 'force-face)))))) + (comment (get symbol 'saved-face-comment))) + (when (or (and spec + (eq (nth 0 spec) 'user) + (eq (nth 1 spec) 'set)) + comment + (and (null spec) (get symbol 'saved-face))) + ;; Don't print default face here. + (unless (bolp) + (princ "\n")) + (princ " '(") + (prin1 symbol) + (princ " ") + (prin1 value) + (when (or now comment) + (princ " ") + (prin1 now) + (when comment + (princ " ") + (prin1 comment))) + (princ ")")))) (if (bolp) (princ " ")) (princ ")") (unless (looking-at "\n") (princ "\n"))))) +(defun custom-save-resets (property setter special) + (let (started-writing ignored-special) + ;; (custom-save-delete setter) Done by caller + (let ((standard-output (current-buffer)) + (mapper `(lambda (object) + (let ((spec (car-safe (get object (quote ,property))))) + (when (and (not (memq object ignored-special)) + (eq (nth 0 spec) 'user) + (eq (nth 1 spec) 'reset)) + ;; Do not write reset statements unless necessary. + (unless started-writing + (setq started-writing t) + (unless (bolp) + (princ "\n")) + (princ "(") + (princ (quote ,setter)) + (princ "\n '(") + (prin1 object) + (princ " ") + (prin1 (nth 3 spec)) + (princ ")"))))))) + (mapc mapper special) + (setq ignored-special special) + (mapatoms mapper) + (when started-writing + (princ ")\n"))))) + +(defun custom-save-loaded-themes () + (let ((themes (reverse (get 'user 'theme-loads-themes))) + (standard-output (current-buffer))) + (when themes + (unless (bolp) (princ "\n")) + (princ "(custom-load-themes") + (mapc (lambda (theme) + (princ "\n '") + (prin1 theme)) themes) + (princ " )\n")))) + ;;;###autoload (defun customize-save-customized () "Save all user options which have been set in this session." @@ -3797,9 +4131,11 @@ or (if there were none) at the end of the buffer." (get symbol 'customized-variable-comment))) (when face (put symbol 'saved-face face) + (custom-push-theme 'theme-face symbol 'user 'set value) (put symbol 'customized-face nil)) (when value (put symbol 'saved-value value) + (custom-push-theme 'theme-value symbol 'user 'set value) (put symbol 'customized-value nil)) (when variable-comment (put symbol 'saved-variable-comment variable-comment) @@ -3809,19 +4145,7 @@ or (if there were none) at the end of the buffer." (put symbol 'customized-face-comment nil))))) ;; We really should update all custom buffers here. (custom-save-all)) - -;;;###autoload -(defun custom-save-all () - "Save all customizations in `custom-file'." - (let ((inhibit-read-only t)) - (custom-save-variables) - (custom-save-faces) - (save-excursion - (let ((default-major-mode nil)) - (set-buffer (find-file-noselect (custom-file)))) - (let ((file-precious-flag t)) - (save-buffer))))) - + ;;; The Customize Menu. ;;; Menu support @@ -3872,13 +4196,14 @@ The menu is in a format applicable to `easy-menu-define'." t))) (if (and (or (not (boundp 'custom-menu-nesting)) (>= custom-menu-nesting 0)) - (< (length (get symbol 'custom-group)) widget-menu-max-size)) + (progn + (custom-load-symbol symbol) + (< (length (get symbol 'custom-group)) widget-menu-max-size))) (let ((custom-prefix-list (custom-prefix-add symbol custom-prefix-list)) (members (custom-sort-items (get symbol 'custom-group) custom-menu-sort-alphabetically custom-menu-order-groups))) - (custom-load-symbol symbol) `(,(custom-unlispify-menu-entry symbol t) ,item "--" @@ -3905,22 +4230,24 @@ The format is suitable for use with `easy-menu-define'." ;;; The Custom Mode. -(defvar custom-mode-map nil - "Keymap for `custom-mode'.") - -(unless custom-mode-map +(defvar custom-mode-map ;; This keymap should be dense, but a dense keymap would prevent inheriting ;; "\r" bindings from the parent map. - (setq custom-mode-map (make-sparse-keymap)) - (set-keymap-parent custom-mode-map widget-keymap) - (suppress-keymap custom-mode-map) - (define-key custom-mode-map " " 'scroll-up) - (define-key custom-mode-map "\177" 'scroll-down) - (define-key custom-mode-map "q" 'Custom-buffer-done) - (define-key custom-mode-map "u" 'Custom-goto-parent) - (define-key custom-mode-map "n" 'widget-forward) - (define-key custom-mode-map "p" 'widget-backward) - (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke)) + ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. + (let ((map (make-keymap))) + (set-keymap-parent map widget-keymap) + (suppress-keymap map) + (define-key map " " 'scroll-up) + (define-key map "\177" 'scroll-down) + (define-key map "\C-c\C-c" 'Custom-set) + (define-key map "\C-x\C-s" 'Custom-save) + (define-key map "q" 'Custom-buffer-done) + (define-key map "u" 'Custom-goto-parent) + (define-key map "n" 'widget-forward) + (define-key map "p" 'widget-backward) + (define-key map [mouse-1] 'Custom-move-and-invoke) + map) + "Keymap for `custom-mode'.") (defun Custom-move-and-invoke (event) "Move to where you click, and if it is an active field, invoke it." @@ -3942,7 +4269,7 @@ The format is suitable for use with `easy-menu-define'." ["Reset to Current" Custom-reset-current t] ["Reset to Saved" Custom-reset-saved t] ["Reset to Standard Settings" Custom-reset-standard t] - ["Info" (Info-goto-node "(emacs)Easy Customization") t])) + ["Info" (info "(emacs)Easy Customization") t])) (defun Custom-goto-parent () "Go to the parent group listed at the top of this buffer. @@ -3990,14 +4317,14 @@ if that value is non-nil." (use-local-map custom-mode-map) (easy-menu-add Custom-mode-menu) (make-local-variable 'custom-options) + (make-local-variable 'custom-local-buffer) (make-local-variable 'widget-documentation-face) - (setq widget-documentation-face 'custom-documentation-face) + (setq widget-documentation-face 'custom-documentation) (make-local-variable 'widget-button-face) - (setq widget-button-face 'custom-button-face) - (set (make-local-variable 'widget-button-pressed-face) - 'custom-button-pressed-face) + (setq widget-button-face 'custom-button) + (set (make-local-variable 'widget-button-pressed-face) 'custom-button-pressed) (set (make-local-variable 'widget-mouse-face) - 'custom-button-pressed-face) ; buttons `depress' when moused + 'custom-button-pressed) ; buttons `depress' when moused ;; When possible, use relief for buttons, not bracketing. This test ;; may not be optimal. (when custom-raised-buttons @@ -4006,7 +4333,7 @@ if that value is non-nil." (set (make-local-variable 'widget-link-prefix) "") (set (make-local-variable 'widget-link-suffix) "")) (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) - (run-hooks 'custom-mode-hook)) + (run-mode-hooks 'custom-mode-hook)) (put 'custom-mode 'mode-class 'special) @@ -4018,4 +4345,5 @@ if that value is non-nil." (provide 'cus-edit) +;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f ;;; cus-edit.el ends here