X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/189638d565a4c0e21ff19e8e9867d20063bf53f6..f590a2a442d19f3a74d7bbd02bbcb4e3239f2327:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 6f0ca3a591..89fcb63313 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,8 +1,9 @@ -;;; cus-edit.el --- Tools for customizing Emacs and Lisp packages. +;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; -;; Copyright (C) 1996, 1997, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,1999,2000,01,02,03,2004 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: FSF ;; Keywords: help, faces ;; This file is part of GNU Emacs. @@ -25,7 +26,7 @@ ;;; Commentary: ;; ;; This file implements the code to create and edit customize buffers. -;; +;; ;; See `custom.el'. ;; No commands should have names starting with `custom-' because @@ -73,6 +74,7 @@ (defgroup emulations nil "Emulations of other editors." + :link '(custom-manual "(emacs)Emulation") :group 'editing) (defgroup mouse nil @@ -87,11 +89,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 +113,7 @@ (defgroup c nil "Support for the C language and related languages." + :link '(custom-manual "(ccmode)") :group 'languages) (defgroup tools nil @@ -140,6 +138,7 @@ (defgroup news nil "Support for netnews reading and posting." + :link '(custom-manual "(gnus)") :group 'applications) (defgroup games nil @@ -194,6 +193,7 @@ (defgroup i18n nil "Internationalization and alternate character-set support." + :link '(custom-manual "(emacs)International") :group 'environment :group 'editing) @@ -244,8 +244,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 +269,7 @@ (defgroup abbrev-mode nil "Word abbreviations mode." + :link '(custom-manual "(emacs)Abbrevs") :group 'abbrev) (defgroup alloc nil @@ -280,16 +279,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) @@ -320,6 +316,7 @@ (defgroup minibuffer nil "Controling the behaviour of the minibuffer." + :link '(custom-manual "(emacs)Minibuffer") :group 'environment) (defgroup keyboard nil @@ -348,6 +345,7 @@ (defgroup windows nil "Windows within a frame." + :link '(custom-manual "(emacs)Windows") :group 'environment) ;;; Utilities. @@ -383,20 +381,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) + (if (and (symbolp v) (custom-variable-p 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)) + "Customize option: ") + obarray 'custom-variable-p t)) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -431,6 +425,7 @@ WIDGET is the widget to apply the filter entries of MENU on." (defcustom custom-unlispify-remove-prefixes nil "Non-nil means remove group prefixes from option names in buffer." :group 'custom-menu + :group 'custom-buffer :type 'boolean) (defun custom-unlispify-menu-entry (symbol &optional no-suffix) @@ -442,15 +437,16 @@ 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)) - (when (and (eq (get symbol 'custom-type) 'boolean) - (re-search-forward "-p\\'" nil t)) - (replace-match "" t t) - (goto-char (point-min))) + ;; FIXME: Boolean variables are not predicates, so they shouldn't + ;; end with `-p'. -stef + ;; (when (and (eq (get symbol 'custom-type) 'boolean) + ;; (re-search-forward "-p\\'" nil t)) + ;; (replace-match "" t t) + ;; (goto-char (point-min))) (if custom-unlispify-remove-prefixes (let ((prefixes custom-prefix-list) prefix) @@ -672,22 +668,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. @@ -697,7 +691,7 @@ making them as if they had never been customized at all." (interactive) (let ((children custom-options)) (mapc (lambda (widget) - (and (get (widget-value widget) 'standard-value) + (and (widget-apply widget :custom-standard-value) (if (memq (widget-get widget :custom-state) '(modified set changed saved rogue)) (widget-apply widget :custom-reset-standard)))) @@ -747,8 +741,8 @@ it as the third element in the list." (list var val)))) ;;;###autoload -(defun customize-set-value (var val &optional comment) - "Set VARIABLE to VALUE. VALUE is a Lisp object. +(defun customize-set-value (variable value &optional comment) + "Set VARIABLE to VALUE, and return VALUE. VALUE is a Lisp object. If VARIABLE has a `variable-interactive' property, that is used as if it were the arg to `interactive' (which see) to interactively read the value. @@ -760,16 +754,17 @@ 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)) - - (set var val) + (cond ((string= comment "") - (put var 'variable-comment nil)) + (put variable 'variable-comment nil)) (comment - (put var 'variable-comment comment)))) + (put variable 'variable-comment comment))) + (set variable value)) ;;;###autoload (defun customize-set-variable (variable value &optional comment) - "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. + "Set the default for VARIABLE to VALUE, and return VALUE. +VALUE is a Lisp object. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -787,6 +782,7 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set variable: " "Set customized value for %s to: " current-prefix-arg)) + (custom-load-symbol variable) (funcall (or (get variable 'custom-set) 'set-default) variable value) (put variable 'customized-value (list (custom-quote value))) (cond ((string= comment "") @@ -794,11 +790,14 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (put variable 'customized-variable-comment nil)) (comment (put variable 'variable-comment comment) - (put variable 'customized-variable-comment comment)))) + (put variable 'customized-variable-comment comment))) + value) ;;;###autoload -(defun customize-save-variable (var value &optional comment) +(defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. +Return VALUE. + If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -812,18 +811,20 @@ If VARIABLE has a `custom-type' property, it must be a widget and the `:prompt-value' property of that widget will be used for reading the value. If given a prefix (or a COMMENT argument), also prompt for a comment." - (interactive (custom-prompt-variable "Set and ave variable: " + (interactive (custom-prompt-variable "Set and save variable: " "Set and save value for %s as: " current-prefix-arg)) - (funcall (or (get var 'custom-set) 'set-default) var value) - (put var 'saved-value (list (custom-quote value))) + (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 var 'variable-comment nil) - (put var 'saved-variable-comment nil)) + (put variable 'variable-comment nil) + (put variable 'saved-variable-comment nil)) (comment - (put var 'variable-comment comment) - (put var 'saved-variable-comment comment))) - (custom-save-all)) + (put variable 'variable-comment comment) + (put variable 'saved-variable-comment comment))) + (custom-save-all) + value) ;;;###autoload (defun customize () @@ -834,6 +835,27 @@ 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." @@ -848,8 +870,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) @@ -873,14 +893,17 @@ 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) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (pop-to-buffer name)) (custom-buffer-create-other-window (list (list group 'custom-group)) name @@ -894,32 +917,22 @@ 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)))) +;;;###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)))) + (defvar customize-changed-options-previous-release "20.2" "Version for `customize-changed-options' to refer back to by default.") @@ -943,52 +956,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 @@ -1012,54 +1008,59 @@ 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 symbol) - "Customize SYMBOL, which should be a face name or nil. -If SYMBOL is nil, customize all faces." - (interactive (list (completing-read "Customize face: (default all) " - obarray 'custom-facep t))) - (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) +(defun customize-face (&optional face) + "Customize FACE, which should be a face name or nil. +If FACE is nil, customize all faces. + +Interactively, when point is on text which has a face specified, +suggest to customize that face, if it's customizable." + (interactive + (list (read-face-name "Customize face" "all faces" t))) + (if (member face '(nil "")) + (setq face (face-list))) + (if (and (listp face) (null (cdr face))) + (setq face (car face))) + (if (listp face) (custom-buffer-create (custom-sort-items - (mapcar (lambda (symbol) - (list symbol 'custom-face)) - (face-list)) + (mapcar (lambda (s) + (list s 'custom-face)) + face) t nil) "*Customize Faces*") - (when (stringp symbol) - (setq symbol (intern symbol))) - (unless (symbolp symbol) - (error "Should be a symbol %S" symbol)) - (custom-buffer-create (list (list symbol 'custom-face)) + (unless (facep face) + (error "Invalid face %S" face)) + (custom-buffer-create (list (list face 'custom-face)) (format "*Customize Face: %s*" - (custom-unlispify-tag-name symbol))))) + (custom-unlispify-tag-name face))))) ;;;###autoload -(defun customize-face-other-window (&optional symbol) - "Show customization buffer for face SYMBOL in other window." - (interactive (list (completing-read "Customize face: " - obarray 'custom-facep t))) - (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) - () - (if (stringp symbol) - (setq symbol (intern symbol))) - (unless (symbolp symbol) - (error "Should be a symbol %S" symbol)) +(defun customize-face-other-window (&optional face) + "Show customization buffer for face FACE in other window. + +Interactively, when point is on text which has a face specified, +suggest to customize that face, if it's customizable." + (interactive + (list (read-face-name "Customize face" "all faces" t))) + (if (member face '(nil "")) + (setq face (face-list))) + (if (and (listp face) (null (cdr face))) + (setq face (car face))) + (if (listp face) + (custom-buffer-create-other-window + (custom-sort-items + (mapcar (lambda (s) + (list s 'custom-face)) + face) + t nil) + "*Customize Faces*") + (unless (facep face) + (error "Invalid face %S" face)) (custom-buffer-create-other-window - (list (list symbol 'custom-face)) - (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol))))) + (list (list face 'custom-face)) + (format "*Customize Face: %s*" + (custom-unlispify-tag-name face))))) ;;;###autoload (defun customize-customized () @@ -1081,6 +1082,25 @@ If SYMBOL is nil, customize all faces." "*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) @@ -1120,7 +1140,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)))) @@ -1165,7 +1185,8 @@ links: groups have links to subgroups." ;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from ;; the window. (defun custom-bury-buffer (buffer) - (bury-buffer)) + (with-current-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. @@ -1181,6 +1202,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. @@ -1188,29 +1234,25 @@ 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) + (let ((pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (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. @@ -1218,6 +1260,11 @@ This button will have a menu with all three reset operations." :type 'boolean :group 'custom-buffer) +(defcustom custom-buffer-verbose-help t + "If non-nil, include explanatory text in the customization buffer." + :type 'boolean + :group 'custom-buffer) + (defun Custom-buffer-done (&rest ignore) "Remove current buffer by calling `custom-buffer-done-function'." (interactive) @@ -1234,10 +1281,12 @@ Otherwise use brackets." (defun custom-buffer-create-internal (options &optional description) (message "Creating customization buffer...") (custom-mode) - (widget-insert "This is a customization buffer") - (if description - (widget-insert description)) - (widget-insert (format ". + (if custom-buffer-verbose-help + (progn + (widget-insert "This is a customization buffer") + (if description + (widget-insert description)) + (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 @@ -1245,13 +1294,14 @@ choose the Set operation to set the option value. Invoke " (if custom-raised-buttons "`Raised' buttons" "Square brackets"))) - (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 "Operate on everything in this buffer:\n ") + (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 "Operate on everything in this buffer:\n ")) + (widget-insert " ")) (widget-create 'push-button :tag "Set for Current Session" :help-echo "\ @@ -1292,6 +1342,13 @@ Reset all values in this buffer to their saved settings." :help-echo "\ Un-customize all values in this buffer. They get their standard settings." :action 'Custom-reset-standard)) + (if (not custom-buffer-verbose-help) + (progn + (widget-insert " ") + (widget-create 'info-link + :tag "Help" + :help-echo "Read the online help." + "(emacs)Easy Customization"))) (widget-insert " ") (widget-create 'push-button :tag "Finish" @@ -1335,7 +1392,7 @@ Un-customize all values in this buffer. They get their standard settings." options)))) (unless (eq (preceding-char) ?\n) (widget-insert "\n")) - (message "Creating customization items ...%2d%%done" 100) + (message "Creating customization items ...done") (unless (eq custom-buffer-style 'tree) (mapc 'custom-magic-reset custom-options)) (message "Creating customization setup...") @@ -1353,8 +1410,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 @@ -1386,6 +1442,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 @@ -1485,7 +1542,7 @@ item in another window.\n\n")) (defface custom-invalid-face '((((class color)) (:foreground "yellow" :background "red")) (t - (:bold t :italic t :underline t))) + (:weight bold :slant italic :underline t))) "Face used when the customize item is invalid." :group 'custom-magic-faces) @@ -1499,21 +1556,21 @@ item in another window.\n\n")) (defface custom-modified-face '((((class color)) (:foreground "white" :background "blue")) (t - (:italic t :bold))) + (:slant italic :bold))) "Face used when the customize item has been modified." :group 'custom-magic-faces) (defface custom-set-face '((((class color)) (:foreground "blue" :background "white")) (t - (:italic t))) + (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) (defface custom-changed-face '((((class color)) (:foreground "white" :background "blue")) (t - (:italic t))) + (:slant italic))) "Face used when the customize item has been changed." :group 'custom-magic-faces) @@ -1812,42 +1869,12 @@ and `face'." (t (funcall show widget value))))) -(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) - (loads (get symbol 'custom-loads)) - load) - (while loads - (setq load (car loads) - loads (cdr loads)) - (cond ((symbolp load) - (condition-case nil - (require load) - (error nil))) - ;; Don't reload a file already loaded. - ((and (boundp 'preloaded-file-list) - (member load preloaded-file-list))) - ((assoc load load-history)) - ((assoc (locate-library load) load-history)) - (t - (condition-case nil - ;; 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. - (or (equal load "cus-edit") - (load-library load)) - (error nil)))))))) - (defun custom-load-widget (widget) "Load all dependencies for WIDGET." (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) @@ -1865,7 +1892,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) @@ -1922,7 +1949,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)))) @@ -1933,12 +1960,30 @@ 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. @@ -1950,7 +1995,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (background dark)) (:background "dim gray")) (t - (:italic t))) + (:slant italic))) "Face used for comments on variables or faces" :version "21.1" :group 'custom-faces) @@ -1960,10 +2005,10 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." '((((class color) (background dark)) (:foreground "gray80")) (((class color) (background light)) (:foreground "blue4")) (((class grayscale) (background light)) - (:foreground "DimGray" :bold t :italic t)) + (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) - (:foreground "LightGray" :bold t :italic t)) - (t (:bold t))) + (:foreground "LightGray" :weight bold :slant italic)) + (t (:weight bold))) "Face used for variables or faces comment tags" :group 'custom-faces) @@ -2008,15 +2053,15 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (defface custom-variable-tag-face `((((class color) (background dark)) - (:foreground "light blue" :bold t :height 1.2 :inherit variable-pitch)) + (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) - (:foreground "blue" :bold t :height 1.2 :inherit variable-pitch)) - (t (:bold t))) + (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) + (t (:weight bold))) "Face used for unpushable variable tags." :group 'custom-faces) -(defface custom-variable-button-face '((t (:underline t :bold t))) +(defface custom-variable-button-face '((t (:underline t :weight bold))) "Face used for pushable variable tags." :group 'custom-faces) @@ -2027,11 +2072,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 @@ -2042,7 +2101,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :custom-save 'custom-variable-save :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-variable-reset-saved - :custom-reset-standard 'custom-variable-reset-standard) + :custom-reset-standard 'custom-variable-reset-standard + :custom-standard-value 'custom-variable-standard-value) (defun custom-variable-type (symbol) "Return a widget suitable for editing the value of SYMBOL. @@ -2110,6 +2170,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (push (widget-create-child-and-convert widget 'visibility :help-echo "Show the value of this option." + :off "Show Value" :action 'custom-toggle-parent nil) buttons)) @@ -2127,6 +2188,8 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (push (widget-create-child-and-convert widget 'visibility :help-echo "Hide the value of this option." + :on "Hide Value" + :off "Show Value" :action 'custom-toggle-parent t) buttons) @@ -2161,6 +2224,8 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (push (widget-create-child-and-convert widget 'visibility :help-echo "Hide the value of this option." + :on "Hide Value" + :off "Show Value" :action 'custom-toggle-parent t) buttons) @@ -2183,6 +2248,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." ;; this anyway. The doc string widget should be added like the others. ;; --dv (widget-put widget :buttons buttons) + (insert "\n") ;; Insert documentation. (widget-default-format-handler widget ?h) @@ -2260,6 +2326,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (t 'rogue)))) (widget-put widget :custom-state state))) +(defun custom-variable-standard-value (widget) + (get (widget-value widget) 'standard-value)) + (defvar custom-variable-menu '(("Set for Current Session" custom-variable-set (lambda (widget) @@ -2282,6 +2351,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (and (get (widget-value widget) 'standard-value) (memq (widget-get widget :custom-state) '(modified set changed saved rogue))))) + ("Use Backup Value" custom-variable-reset-backup + (lambda (widget) + (get (widget-value widget) 'backup-value))) ("---" ignore ignore) ("Add Comment" custom-comment-show custom-comment-invisible-p) ("---" ignore ignore) @@ -2348,6 +2420,7 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) + (custom-variable-backup-value widget) (funcall set symbol (eval (setq val (widget-value child)))) (put symbol 'customized-value (list val)) (put symbol 'variable-comment comment) @@ -2357,6 +2430,7 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) + (custom-variable-backup-value widget) (funcall set symbol (setq val (widget-value child))) (put symbol 'customized-value (list (custom-quote val))) (put symbol 'variable-comment comment) @@ -2385,6 +2459,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)) @@ -2395,6 +2471,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))) @@ -2405,13 +2484,16 @@ Optional EVENT is the location for the menu." (custom-redraw-magic widget))) (defun custom-variable-reset-saved (widget) - "Restore the saved value for the variable being edited by WIDGET." + "Restore the saved value for the variable being edited by WIDGET. +The value that was current before this operation +becomes the backup value, so you can get it again." (let* ((symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default)) (value (get symbol 'saved-value)) (comment (get symbol 'saved-variable-comment))) (cond ((or value comment) (put symbol 'variable-comment comment) + (custom-variable-backup-value widget) (condition-case nil (funcall set symbol (eval (car value))) (error nil))) @@ -2426,23 +2508,68 @@ Optional EVENT is the location for the menu." (defun custom-variable-reset-standard (widget) "Restore the standard setting for the variable being edited by WIDGET. This operation eliminates any saved setting for the variable, -restoring it to the state of a variable that has never been customized." +restoring it to the state of a variable that has never been customized. +The value that was current before this operation +becomes the backup value, so you can get it again." (let* ((symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default))) (if (get symbol 'standard-value) - (funcall set symbol (eval (car (get symbol 'standard-value)))) + (progn + (custom-variable-backup-value widget) + (funcall set symbol (eval (car (get symbol 'standard-value))))) (error "No standard setting known for %S" symbol)) (put symbol 'variable-comment nil) (put symbol 'customized-value nil) (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) ;; This call will possibly make the comment invisible (custom-redraw widget))) +(defun custom-variable-backup-value (widget) + "Back up the current value for WIDGET's variable. +The backup value is kept in the car of the `backup-value' property." + (let* ((symbol (widget-value widget)) + (get (or (get symbol 'custom-get) 'default-value)) + (type (custom-variable-type symbol)) + (conv (widget-convert type)) + (value (if (default-boundp symbol) + (funcall get symbol) + (widget-get conv :value)))) + (put symbol 'backup-value (list value)))) + +(defun custom-variable-reset-backup (widget) + "Restore the backup value for the variable being edited by WIDGET. +The value that was current before this operation +becomes the backup value, so you can use this operation repeatedly +to switch between two values." + (let* ((symbol (widget-value widget)) + (set (or (get symbol 'custom-set) 'set-default)) + (value (get symbol 'backup-value)) + (comment-widget (widget-get widget :comment-widget)) + (comment (widget-value comment-widget))) + (if value + (progn + (custom-variable-backup-value widget) + (condition-case nil + (funcall set symbol (car value)) + (error nil))) + (error "No backup value for %s" symbol)) + (put symbol 'customized-value (list (car value))) + (put symbol 'variable-comment comment) + (put symbol 'customized-variable-comment comment) + (custom-variable-state-set widget) + ;; This call will possibly make the comment invisible + (custom-redraw widget))) + ;;; The `custom-face-edit' Widget. (define-widget 'custom-face-edit 'checklist @@ -2451,6 +2578,11 @@ restoring it to the state of a variable that has never been customized." :tag "Attributes" :extra-offset 12 :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 + (custom-face-edit-fix-value widget value))) + :convert-widget 'custom-face-edit-convert-widget :args (mapcar (lambda (att) (list 'group :inline t @@ -2459,6 +2591,96 @@ restoring it to the state of a variable that has never been customized." (nth 1 att))) custom-face-attributes)) +(defun custom-face-edit-fix-value (widget value) + "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 + (let ((key (car value)) + (val (car (cdr value)))) + (cond ((eq key :italic) + (push :slant result) + (push (if val 'italic 'normal) result)) + ((eq key :bold) + (push :weight result) + (push (if val 'bold 'normal) result)) + ((eq key :reverse-video) + (push :inverse-video result) + (push val result)) + (t + (push key result) + (push val result)))) + (setq value (cdr (cdr value)))) + (setq result (nreverse result)) + result) + value)) + +(defun custom-face-edit-convert-widget (widget) + "Convert :args as widget types in WIDGET." + (widget-put + widget + :args (mapcar (lambda (arg) + (widget-convert arg + :deactivate 'custom-face-edit-deactivate + :activate 'custom-face-edit-activate + :delete 'custom-face-edit-delete)) + (widget-get widget :args))) + widget) + +(defun custom-face-edit-deactivate (widget) + "Make face widget WIDGET inactive for user modifications." + (unless (widget-get widget :inactive) + (let ((tag (custom-face-edit-attribute-tag widget)) + (from (copy-marker (widget-get widget :from))) + (value (widget-value widget)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (save-excursion + (goto-char from) + (widget-default-delete widget) + (insert tag ": *\n") + (widget-put widget :inactive + (cons value (cons from (- (point) from)))))))) + +(defun custom-face-edit-activate (widget) + "Make face widget WIDGET inactive for user modifications." + (let ((inactive (widget-get widget :inactive)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (when (consp inactive) + (save-excursion + (goto-char (car (cdr inactive))) + (delete-region (point) (+ (point) (cdr (cdr inactive)))) + (widget-put widget :inactive nil) + (widget-apply widget :create) + (widget-value-set widget (car inactive)) + (widget-setup))))) + +(defun custom-face-edit-delete (widget) + "Remove WIDGET from the buffer." + (let ((inactive (widget-get widget :inactive)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (if (not inactive) + ;; Widget is alive, we don't have to do anything special + (widget-default-delete widget) + ;; WIDGET is already deleted because we did so to inactivate it; + ;; now just get rid of the label we put in its place. + (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." + (let ((tag (widget-get widget :tag))) + (or (and (not (equal tag "")) tag) + (let ((children (widget-get widget :children))) + (while (and (null tag) children) + (setq tag (custom-face-edit-attribute-tag (pop children)))) + tag)))) + ;;; The `custom-display' Widget. (define-widget 'custom-display 'menu-choice @@ -2488,6 +2710,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.") @@ -2515,6 +2741,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: " @@ -2528,12 +2758,16 @@ Match frames with light backgrounds.") (const :format "Dark\n" :sibling-args (:help-echo "\ Match frames with dark backgrounds.") - dark))))))) + dark))) + (group :sibling-args (:help-echo "\ +Only match frames that support the specified face attributes.") + (const :format "Supports attributes:" supports) + (custom-face-edit :inline t :format "%n%v")))))) ;;; The `custom-face' Widget. (defface custom-face-tag-face - `((t (:bold t :height 1.2 :inherit variable-pitch))) + `((t (:weight bold :height 1.2 :inherit variable-pitch))) "Face used for face tags." :group 'custom-faces) @@ -2559,6 +2793,7 @@ Match frames with dark backgrounds.") :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-face-reset-saved :custom-reset-standard 'custom-face-reset-standard + :custom-standard-value 'custom-face-standard-value :custom-menu 'custom-face-menu-create) (define-widget 'custom-face-all 'editable-list @@ -2593,7 +2828,7 @@ Match frames with dark backgrounds.") (defconst custom-face-selected (widget-convert 'custom-face-selected) "Converted version of the `custom-face-selected' widget.") -(defun custom-filter-face-spec (spec filter-index default-filter) +(defun custom-filter-face-spec (spec filter-index &optional default-filter) "Return a canonicalized version of SPEC using. FILTER-INDEX is the index in the entry for each attribute in `custom-face-attributes' at which the appropriate filter function can be @@ -2628,21 +2863,11 @@ don't specify one." (defun custom-pre-filter-face-spec (spec) "Return SPEC changed as necessary for editing by the face customization widget. SPEC must be a full face spec." - (custom-filter-face-spec - spec 2 - (lambda (value) - (cond ((eq value 'unspecified) nil) - ((eq value nil) 'off) - (t value))))) + (custom-filter-face-spec spec 2)) (defun custom-post-filter-face-spec (spec) "Return the customized SPEC in a form suitable for setting the face." - (custom-filter-face-spec - spec 3 - (lambda (value) - (cond ((eq value nil) 'unspecified) - ((eq value 'off) nil) - (t value))))) + (custom-filter-face-spec spec 3)) (defun custom-face-value-create (widget) "Create a list of the display specifications for WIDGET." @@ -2683,6 +2908,8 @@ SPEC must be a full face spec." (push (widget-create-child-and-convert widget 'visibility :help-echo "Hide or show this face." + :on "Hide Face" + :off "Show Face" :action 'custom-toggle-parent (not (eq state 'hidden))) buttons) @@ -2720,7 +2947,8 @@ SPEC must be a full face spec." (unless (widget-get widget :custom-form) (widget-put widget :custom-form custom-face-default-form)) (let* ((symbol (widget-value widget)) - (spec (or (get symbol 'saved-face) + (spec (or (get symbol 'customized-face) + (get symbol 'saved-face) (get symbol 'face-defface-spec) ;; Attempt to construct it. (list (list t (custom-face-attributes-get @@ -2804,28 +3032,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. @@ -2885,7 +3119,9 @@ Optional EVENT is the location for the menu." ;; face-set-spec ignores empty attribute lists, so just give it ;; something harmless instead. (face-spec-set symbol '((t :foreground unspecified)))) - (put symbol 'saved-face value) + (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) @@ -2913,6 +3149,9 @@ Optional EVENT is the location for the menu." (custom-face-state-set widget) (custom-redraw-magic widget))) +(defun custom-face-standard-value (widget) + (get (widget-value widget) 'face-defface-spec)) + (defun custom-face-reset-standard (widget) "Restore WIDGET to the face's standard settings. This operation eliminates any saved setting for the face, @@ -2927,6 +3166,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) @@ -3050,22 +3293,22 @@ and so forth. The remaining group tags are shown with (defface custom-group-tag-face-1 `((((class color) (background dark)) - (:foreground "pink" :bold t :height 1.2 :inherit variable-pitch)) + (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) - (:foreground "red" :bold t :height 1.2 :inherit variable-pitch)) - (t (:bold t))) + (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch)) + (t (:weight bold))) "Face used for group tags." :group 'custom-faces) (defface custom-group-tag-face `((((class color) (background dark)) - (:foreground "light blue" :bold t :height 1.2)) + (:foreground "light blue" :weight bold :height 1.2)) (((class color) (background light)) - (:foreground "blue" :bold t :height 1.2)) - (t (:bold t))) + (:foreground "blue" :weight bold :height 1.2)) + (t (:weight bold))) "Face used for low level group tags." :group 'custom-faces) @@ -3113,6 +3356,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)) @@ -3152,7 +3397,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) @@ -3293,7 +3537,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)) @@ -3449,15 +3692,25 @@ to the new custom file. This will preserve your existing customizations." "Return the file name for saving customizations." (setq custom-file (or custom-file - user-init-file - (read-file-name "File for customizations: " - "~/" nil nil ".emacs")))) + (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)))) (defun custom-save-delete (symbol) "Visit `custom-file' and delete all calls to SYMBOL from it. 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)) + (let ((default-major-mode 'emacs-lisp-mode)) (set-buffer (find-file-noselect (custom-file)))) (goto-char (point-min)) ;; Skip all whitespace and comments. @@ -3495,7 +3748,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) @@ -3508,45 +3765,45 @@ or (if there were none) at the end of the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-variables - ;; custom-set-variables was added by Custom -- don't edit or cut/paste it! - ;; Your init file should contain only one such instance.\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) + ;; custom-set-variables was added by Custom. + ;; 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") + (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 ")") @@ -3556,7 +3813,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) @@ -3572,43 +3831,80 @@ or (if there were none) at the end of the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-faces - ;; custom-set-faces was added by Custom -- don't edit or cut/paste it! - ;; Your init file should contain only one such instance.\n") - (mapcar - (lambda (symbol) - (let ((value (get symbol 'saved-face)) - (now (not (or (get 'default 'face-defface-spec) - (and (not (custom-facep 'default)) - (not (get 'default 'force-face)))))) - (comment (get 'default 'saved-face-comment))) - (unless (eq symbol 'default)) - ;; 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) + ;; custom-set-faces was added by Custom. + ;; 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") + (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." @@ -3621,9 +3917,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) @@ -3643,7 +3941,8 @@ or (if there were none) at the end of the buffer." (save-excursion (let ((default-major-mode nil)) (set-buffer (find-file-noselect (custom-file)))) - (save-buffer)))) + (let ((file-precious-flag t)) + (save-buffer))))) ;;; The Customize Menu. @@ -3683,7 +3982,8 @@ or (if there were none) at the end of the buffer." "Ignoring WIDGET, create a menu entry for customization group SYMBOL." `( ,(custom-unlispify-menu-entry symbol t) :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) + (let ((menu (custom-menu-create ',symbol))) + (if (consp menu) (cdr menu) menu))))) ;;;###autoload (defun custom-menu-create (symbol) @@ -3694,13 +3994,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 "--" @@ -3722,7 +4023,8 @@ The format is suitable for use with `easy-menu-define'." (setq name "Customize")) `(,name :filter (lambda (&rest junk) - (custom-menu-create ',symbol)))) + (let ((menu (custom-menu-create ',symbol))) + (if (consp menu) (cdr menu) menu))))) ;;; The Custom Mode. @@ -3737,6 +4039,7 @@ The format is suitable for use with `easy-menu-define'." (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 "\C-x\C-s" 'Custom-save) (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) @@ -3811,6 +4114,7 @@ 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) (make-local-variable 'widget-button-face) @@ -3839,4 +4143,5 @@ if that value is non-nil." (provide 'cus-edit) +;;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f ;;; cus-edit.el ends here