Download
(require 'cus-edit)
(eval-when-compile (when (< emacs-major-version 21) (require 'cl)))
(require 'wid-edit+ nil t)
(require 'autofit-frame nil t)
(defvar custom-commands)
(defvar custom-search-field)
(define-key custom-mode-map "q" 'quit-window)
(defgroup Custom-Plus nil
"Enhancements to Customize."
:prefix "customp-" :group 'customize
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
cus-edit+.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/cus-edit+.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/CustomizingAndSaving#CustomizePlus")
:link '(emacs-commentary-link :tag "Commentary" "cus-edit+")
)
(defcustom customize-customized-ignore
(append (and (boundp 'savehist-minibuffer-history-variables)
savehist-minibuffer-history-variables)
'(case-fold-search debug-on-error))
"*User preferences to ignore in `customize-customized'.
Items in this list are symbols naming faces or variables."
:type '(repeat symbol) :group 'Custom-Plus
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download"
"http://www.emacswiki.org/cgi-bin/wiki/cus-edit+.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/CustomizingAndSaving#CustomizePlus")
:link '(emacs-commentary-link :tag "Commentary" "cus-edit+")
)
(when (< emacs-major-version 22)
(defcustom custom-buffer-verbose-help t
"*If non-nil, include explanatory text in the customization buffer."
:type 'boolean :group 'custom-buffer))
(defcustom customp-buffer-create-hook (and (fboundp 'fit-frame-if-one-window)
'fit-frame-if-one-window)
"*Hook called when creating a Customize buffer."
:type 'hook
:group 'Custom-Plus)
(when (< emacs-major-version 21)
(require 'speedbar)
(defcustom speedbar-use-imenu-flag (fboundp 'imenu)
"*Non-nil means use imenu for file parsing. nil to use etags.
XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
use etags instead. Etags support is not as robust as imenu support."
:tag "User Imenu" :group 'speedbar :type 'boolean))
(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." "\
The group is now hidden - invoke \"Show\" to show it.")
(invalid "x" custom-invalid-face "\
INVALID - the %c cannot be set to the value shown.")
(modified "*" custom-modified-face "\
EDITED - your changes for this %c take effect only when you set or save it." "\
You have edited something in this group, but not set it.")
(set "+" custom-set-face "\
SET - your changes for this %c are for this session only, unless you also save them." "\
Something in this group has been set, but not saved.")
(changed ":" custom-changed-face "\
CHANGED OUTSIDE - this %c has been changed outside buffer *Customize*." "\
Something in this group has been changed outside customize.")
(saved "!" custom-saved-face "\
UNCHANGED - this %c is unchanged from the SAVED (startup) setting." "\
Something in this group is unchanged from the saved (startup) setting.")
(themed "o" custom-themed "\
THEMED - this %c has been set by a theme." "\
Visible group members are all at standard values.")
(rogue "@" custom-rogue-face "\
NO CUSTOMIZATION DATA - this %c has NOT been changed using Customize." "\
Something in this group is not prepared for customization.")
(standard " " nil "\
STANDARD - this %c is unchanged from its standard setting." "\
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
STATE is one of the following symbols:
`nil'
For internal use, should never occur.
`unknown'
For internal use, should never occur.
`hidden'
This item is not being displayed.
`invalid'
This item is modified, but has an invalid form.
`modified'
This item is modified, and has a valid form.
`set'
This item has been set but not saved.
`changed'
The current value of this item has been changed temporarily.
`saved'
This item is marked for saving.
`themed'
This item has been set by a theme.
`rogue'
This item has no customization information.
`standard'
This item is unchanged from the standard setting.
MAGIC is a string used to present that state.
FACE is a face used to present the state.
ITEM-DESC is a string describing the state for options.
GROUP-DESC is a string describing the state for groups. If this is
left out, ITEM-DESC will be used.
The string `%c' in either description will be replaced with the
category of the item. These are `group'. `option', and `face'.
The list should be sorted most significant first.")
(defun custom-add-parent-links (widget &optional initial-string
doc-initial-string)
"Add \"Groups: ...\" to WIDGET if WIDGET has groups.
The value is non-nil if any groups were found.
If INITIAL-STRING is non-nil, use that rather than \"Groups:\"."
(let ((name (widget-value widget))
(type (widget-type widget))
(buttons (widget-get widget :buttons))
(start (point))
(parents nil))
(insert (or initial-string "\nGroups:"))
(mapatoms (lambda (symbol)
(when (member (list name type) (get symbol 'custom-group))
(insert " ")
(push (widget-create-child-and-convert
widget 'custom-group-link
:tag (custom-unlispify-tag-name symbol)
symbol)
buttons)
(setq parents (cons symbol parents)))))
(and (null (get name 'custom-links))
(= (length parents) 1)
(let* ((links (delq nil (mapcar (lambda (w)
(unless (eq (widget-type w)
'custom-group-link)
w))
(get (car parents) 'custom-links))))
(many (> (length links) 2)))
(when links
(let ((pt (point))
(left-margin (+ left-margin 2)))
(insert "\n" (or doc-initial-string "See Also:") " ")
(while links
(push (widget-create-child-and-convert
widget (car links)
:button-face 'custom-link
:mouse-face 'highlight
:pressed-face 'highlight)
buttons)
(setq links (cdr links))
(cond ((null links)
(insert ".\n"))
((null (cdr links))
(if many
(insert ", and ")
(insert " and ")))
(t
(insert ", "))))
(fill-region-as-paragraph pt (point))
(delete-to-left-margin (1+ pt) (+ pt 2))))))
(if parents
(insert "\n")
(delete-region start (point)))
(widget-put widget :buttons buttons)
parents))
(defvar custom-check-for-changes-interval 60
"Number of seconds to wait before checking for preference changes.
Do NOT change this yourself to change the wait period
`\\[customize-set-auto-update-timer-period]'.")
(defvar custom-check-for-changes-when-idle-p nil
"If non-`nil', then automatically tell Customize of outside changes
when Emacs is idle for `custom-check-for-changes-interval' seconds.
Do NOT change this yourself
`\\[customize-toggle-outside-change-updates]'.")
(defvar custom-update-timer
(run-with-idle-timer custom-check-for-changes-interval t 'customize-update-all)
"Timer used to automatically tell Customize of outside changes
to preferences when idle.")
(defconst custom-face-menu
'(("Set for Current Session" custom-face-set)
("Save for Future Sessions" custom-face-save-command)
("Consider Unchanged" custom-consider-face-unchanged
(lambda (widget) (not (get (widget-get-tag-or-value widget) 'saved-face))))
("Ignore Unsaved Changes" custom-ignore-unsaved-preference
(lambda (widget) (eq (widget-get widget :custom-state) 'set)))
("Set from External Changes" custom-update-face
(lambda (widget) (let* ((symbol (widget-get-tag-or-value widget))
(cface (or (get symbol 'customized-face)
(get symbol 'saved-face)
(get symbol 'face-defface-spec))))
(and cface
(custom-facep symbol)
(not (face-spec-match-p symbol cface))))))
("Reset to Saved" custom-face-reset-saved
(lambda (widget)
(or (get (widget-value widget) 'saved-face)
(get (widget-value widget) 'saved-face-comment))))
("Reset to Standard Setting" custom-face-reset-standard
(lambda (widget)
(get (widget-value widget) 'face-defface-spec)))
("---" ignore ignore)
("Add Comment" custom-comment-show
(lambda (widget)
(and (boundp 'custom-comment-invisible-p)
custom-comment-invisible-p)))
("---" ignore ignore)
("Show all display specs" custom-face-edit-all
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'all))))
("Just current attributes" custom-face-edit-selected
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'selected))))
("Show as Lisp expression" custom-face-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp)))))
"Alist of actions for the `custom-face' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-face'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")
(defconst custom-variable-menu
`(("Set for Current Session"
custom-variable-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
,@(when
(or custom-file init-file-user)
'(("Save for Future Sessions" custom-variable-save
(lambda (widget)
(memq (widget-get widget :custom-state)
'(modified set changed rogue))))))
("Consider Unchanged"
custom-consider-variable-unchanged
(lambda (widget) (not (get (widget-get-tag-or-value widget) 'saved-value))))
("Ignore Unsaved Changes"
custom-ignore-unsaved-preference
(lambda (widget) (eq (widget-get widget :custom-state) 'set)))
("Set from External Changes"
custom-update-variable
(lambda (widget)
(let* ((symbol (widget-get-tag-or-value widget))
(cval (or (get symbol 'customized-value)
(get symbol 'saved-value)
(get symbol 'standard-value))))
(and cval
(default-boundp symbol)
(not (equal (eval (car cval))
(default-value symbol)))))))
("Reset to Current"
custom-redraw
(lambda (widget)
(and (default-boundp (widget-value widget))
(memq (widget-get widget :custom-state) '(modified changed)))))
("Reset to Saved"
custom-variable-reset-saved
(lambda (widget)
(and (or (get (widget-value widget) 'saved-value)
(get (widget-value widget) 'saved-variable-comment))
(memq (widget-get widget :custom-state)
'(modified set changed rogue)))))
,@(when (or custom-file init-file-user)
'(("Reset to Standard Setting" custom-variable-reset-standard
(lambda (widget)
(and (get (widget-value widget) 'standard-value)
(memq (widget-get widget :custom-state)
'(modified set changed saved rogue)))))))
,@(when (>= emacs-major-version 21)
'(("Use Backup Value" custom-variable-reset-backup
(lambda (widget)
(get (widget-value widget) 'backup-value)))))
,@(when (boundp 'custom-comment-invisible-p)
'(("---" ignore ignore)
("Add Comment" custom-comment-show
(lambda (widget) custom-comment-invisible-p))))
("---" ignore ignore)
("Don't show as Lisp expression"
custom-variable-edit
(lambda (widget)
(eq (widget-get widget :custom-form) 'lisp)))
("Show initial Lisp expression"
custom-variable-edit-lisp
(lambda (widget)
(eq (widget-get widget :custom-form) 'edit))))
"Alist of actions for the `custom-variable' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-variable'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")
(when (< emacs-major-version 21) (defvar custom-raised-buttons nil))
(defun customize-apropos-options-of-type (type regexp &optional arg)
"Customize all loaded customizable options of type TYPE that match REGEXP.
With no prefix arg, each option is defined with `defcustom' type TYPE.
With a prefix arg, either each option is defined with `defcustom' type
TYPE or its current value is compatible with TYPE.
If TYPE is nil (the default value) then all `defcustom' variables are
potential candidates."
(interactive
(list (car (condition-case err
(read-from-string
(let ((types ()))
(mapatoms
(lambda (cand)
(when (custom-variable-p cand)
(push (list (format "%s" (format "%S" (get cand 'custom-type))))
types))))
(completing-read "Customize all options of type: "
(help-remove-duplicates types)
nil nil nil nil "nil")))
(end-of-file (error "No such custom type"))))
(read-string "Customize options matching (regexp): ")
current-prefix-arg))
(let ((found ()))
(mapatoms (lambda (symb)
(when (and (string-match regexp (symbol-name symb))
(boundp symb)
(or (not (fboundp 'indirect-variable))
(eq (indirect-variable symb) symb))
(or (get symb 'saved-value)
(custom-variable-p symb))
(or (not type)
(if arg
(custom-var-is-of-type-p symb (list type))
(equal (get symb 'custom-type) type))))
(push (list symb 'custom-variable) found))))
(unless found (error "No options of type `%S' matching regexp `%s'" type regexp))
(custom-buffer-create (custom-sort-items found t "*Customize Apropos*"))))
(defun custom-var-is-of-type-p (variable types &optional mode)
"Return non-nil if VARIABLE satisfies one of the custom types in TYPES.
TYPES is a list of `defcustom' type sexps or a list of regexp strings.
TYPES are matched, in order, against VARIABLE's type definition or
VARIABLE's current value, until one is satisfied or all are tried.
If TYPES is a list of regexps, then each is regexp-matched against
VARIABLE's custom type.
Otherwise, TYPES is a list of type sexps, each of which is a
definition acceptable for `defcustom' :type or the first symbol of
such a definition (e.g. `choice'). In this case, two kinds of type
comparison are possible:
1. VARIABLE's custom type, or its first symbol, is matched using
`equal' against each type in TYPES.
2. VARIABLE's current value is checked against each type in TYPES to
see if it satisfies one of them. In this case, VARIABLE's own type
is not used
variable not defined using `defcustom'.
For any of the comparisons against VARIABLE's type, either that type
can be checked directly or its supertypes (inherited types) can also
be checked.
These different type-checking possibilities depend on the value of
argument MODE, as follows, and they determine the meaning of the
returned value:
`direct': VARIABLE's type matches a member of list TYPES
`inherit': VARIABLE's type matches or is a subtype of a TYPES member
`value': VARIABLE is bound, and its value satisfies a type in TYPES
`inherit-or-value': `inherit' or `value', tested in that order
`direct-or-value': `direct' or `value', tested in that order
anything else (default): `inherit'
VARIABLE's current value cannot satisfy a regexp type: it is
impossible to know which concrete types a value must match."
(case mode
((nil inherit) (custom-var-inherits-type-p variable types))
(inherit-or-value (or (custom-var-inherits-type-p variable types)
(custom-var-val-satisfies-type-p variable types)))
(value (custom-var-val-satisfies-type-p variable types))
(direct (custom-var-matches-type-p variable types))
(direct-or-value (or (member (get variable 'custom-type) types)
(custom-var-val-satisfies-type-p variable types)))
(otherwise (custom-var-inherits-type-p variable types))))
(defun custom-var-matches-type-p (variable types)
"VARIABLE's type matches a member of TYPES."
(catch 'custom-type-matches
(let ((var-type (get variable 'custom-type)))
(dolist (type types)
(when (if (stringp type)
(save-match-data (string-match type (format "%s" (format "%S" var-type))))
(equal var-type type))
(throw 'custom-type-matches t))))
nil))
(defun custom-var-inherits-type-p (variable types)
"VARIABLE's type matches or is a subtype of a member of list TYPES."
(catch 'custom-type-inherits
(let ((var-type (get variable 'custom-type)))
(dolist (type types)
(while var-type
(when (or (and (stringp type)
(save-match-data
(string-match type (format "%s" (format "%S" var-type)))))
(equal type var-type))
(throw 'custom-type-inherits t))
(when (consp var-type) (setq var-type (car var-type)))
(when (or (and (stringp type)
(save-match-data
(string-match type (format "%s" (format "%S" var-type)))))
(equal type var-type))
(throw 'custom-type-inherits t))
(setq var-type (car (get var-type 'widget-type))))
(setq var-type (get variable 'custom-type))))
nil))
(defun custom-var-val-satisfies-type-p (variable types)
"VARIABLE is bound, and its value satisfies a type in the list TYPES."
(and (boundp variable)
(let ((val (symbol-value variable)))
(and (widget-convert (get variable 'custom-type))
(custom-value-satisfies-type-p val types)))))
(defun custom-value-satisfies-type-p (value types)
"Return non-nil if VALUE satisfies a type in the list TYPES."
(catch 'custom-type-value-satisfies
(dolist (type types)
(unless (stringp type)
(setq type (widget-convert type))
(when (condition-case nil
(progn (when (and (widget-get type :match)
(widget-apply type :match value))
(throw 'custom-type-value-satisfies t))
(when (and (widget-get type :validate)
(progn (widget-put type :value value)
(not (widget-apply type :validate))))
(throw 'custom-type-value-satisfies t)))
(error nil))
(throw 'custom-type-value-satisfies t))))
nil))
(defun custom-type (variable)
"Returns the `defcustom' type of VARIABLE.
Returns nil if VARIABLE is not a user option.
Note: If the library that defines VARIABLE has not yet been loaded,
then `custom-type' loads it. Be sure you want to do that before you
call this function."
(and (custom-variable-p variable)
(or (get variable 'custom-type) (progn (custom-load-symbol variable)
(get variable 'custom-type)))))
(defun widget-get-tag-or-value (widget)
"Return :tag or :value of WIDGET, as a symbol."
(let ((tag (widget-get widget :tag)))
(if tag
(intern tag)
(widget-get widget :value))))
(when (>= emacs-major-version 21)
(defun face-valid-attribute-values (attribute &optional frame)
"Return valid values for face attribute ATTRIBUTE.
The optional argument FRAME is used to determine available fonts
and colors. If it is nil or not specified, the selected frame is
used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
an integer value."
(let ((valid
(case attribute
(:family
(if window-system
(mapcar #'(lambda (x) (cons (car x) (car x)))
(x-font-family-list))
(list (cons "default" "default"))))
((:width :weight :slant :inverse-video)
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
((:underline :overline :strike-through :box)
(if window-system
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
(let ((executing-kbd-macro t))
(mapcar #'(lambda (c) (cons c c))
(x-defined-colors frame))))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((:foreground :background)
(mapcar #'(lambda (c) (cons c c))
(defined-colors frame)))
((:height)
'integerp)
(:stipple
(and (memq window-system '(x w32 mac))
(mapcar #'list
(apply #'nconc
(mapcar (lambda (dir)
(and (file-readable-p dir)
(file-directory-p dir)
(directory-files dir)))
x-bitmap-file-path)))))
(:inherit
(cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c))
(face-list))))
(t
(error "Internal error")))))
(if (and (listp valid) (not (memq attribute '(:inherit))))
(nconc (list (cons "unspecified" 'unspecified)) valid)
valid))))
(defalias 'customize-customized 'customize-unsaved)
(defun customize-unsaved (&optional check-all-p)
"Open Customize to check all preferences currently set but not saved.
This is useful in `kill-emacs-query-functions' to check changes you
have made (and possibly saving them) before exiting Emacs.
Changes to preferences listed in `customize-customized-ignore'
are normally ignored here. However, with non-`nil' CHECK-ALL-P (prefix
argument), all changes are checked.
Changes to preferences that you have declared \"unchanged\" (using,
for example, `Consider Unchanged') are always ignored here."
(interactive "P")
(condition-case failure
(progn
(let ((found nil))
(mapatoms
(lambda (symbol)
(and (or check-all-p (not (memq symbol customize-customized-ignore)))
(or (get symbol 'customized-face)
(get symbol 'customized-face-comment))
(custom-facep symbol)
(push (list symbol 'custom-face) found))
(and (or check-all-p (not (memq symbol customize-customized-ignore)))
(or (get symbol 'customized-value)
(get symbol 'customized-variable-comment))
(boundp symbol)
(push (list symbol 'custom-variable) found))))
(if (not found)
(error "No unsaved customizations (faces or variables)")
(when (or (interactive-p)
(y-or-n-p
"You have unsaved preferences. Do you want to check them? "))
(custom-buffer-create (custom-sort-items found t nil)
"*Customize - Unsaved Changes*"))))
t)
(error (message "%s" (error-message-string failure)) t)))
(add-hook 'kill-emacs-query-functions
(lambda () (condition-case nil (customize-unsaved) (error t))))
(remove-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
(defun customize-update-all (&rest _IGNORED)
"Tell Customize that all preferences changed outside it are now set.
This means all changes to all preferences (faces and user variables).
This is suitable to be run automatically as a hook or with a timer,
to keep Customize synched with Emacs changes.
When interactive, call `custom-redraw' on each Customize widget."
(interactive)
(when (interactive-p)
(message "Updating Customize to recognize external settings..."))
(customize-update-all-vars)
(customize-update-all-faces)
(dolist (widget custom-options) (custom-redraw widget))
(when (interactive-p)
(message "Updating Customize to recognize external settings...done")))
(defun customize-update-all-vars ()
"Tell customize that all variables changed outside it are now set.
This is suitable to be run automatically as a hook or with a timer,
to keep Customize synched with Emacs changes.
When interactive, call `custom-redraw' on each Customize widget."
(interactive)
(when (interactive-p)
(message "Updating Customize to recognize external variable settings..."))
(mapatoms
(lambda (symbol)
(let ((cval (or (get symbol 'customized-value)
(get symbol 'saved-value)
(get symbol 'standard-value))))
(when (and cval
(default-boundp symbol)
(not (equal (eval (car cval))
(default-value symbol))))
(put symbol 'customized-value (list (custom-quote (eval symbol))))))))
(when (interactive-p)
(dolist (widget custom-options) (custom-redraw widget))
(message
"Updating Customize to recognize external variable settings...done")))
(defun customize-update-all-faces ()
"Tell Customize that all faces changed outside it are now set.
When interactive, call `custom-redraw' on each Customize widget.
This is suitable to be run automatically as a hook or with a timer,
to keep Customize synched with Emacs changes."
(interactive)
(when (interactive-p)
(message "Updating Customize to recognize external face settings..."))
(mapatoms
(lambda (symbol)
(let ((cface (or (get symbol 'customized-face)
(get symbol 'saved-face)
(get symbol 'face-defface-spec))))
(when (and cface
(custom-facep symbol)
(not (eq 'default symbol))
(not (face-spec-match-p symbol cface)))
(put symbol 'customized-face (list (list 't (face-attr-construct symbol))))
(unless (< emacs-major-version 21)
(put symbol 'customized-face-comment (get symbol 'face-comment))
(put symbol 'face-modified nil))))))
(when (interactive-p)
(dolist (widget custom-options) (custom-redraw widget))
(message "Updating Customize to recognize external face settings...done")))
(defun custom-update-variable (widget)
"Tell Customize that this variable, changed outside Customize, is now set."
(let* ((symbol (widget-get-tag-or-value widget)))
(put symbol 'customized-value (list (custom-quote (eval symbol))))
(custom-redraw widget)
(message "Variable `%s' is now set (but not saved)." symbol)))
(defun custom-update-face (widget)
"Tell Customize that this face, changed outside Customize, is now set.
The definition of the face for the *current frame* is used."
(let* ((symbol (widget-get-tag-or-value widget)))
(put symbol 'customized-face (list (list 't (face-attr-construct symbol))))
(unless (< emacs-major-version 21)
(put symbol 'customized-face-comment (get symbol 'face-comment))
(put symbol 'face-modified nil))
(custom-redraw widget)
(message "Face `%s' is now set (but NOT saved)." symbol)))
(defalias 'toggle-customize-outside-change-updates
'customize-toggle-outside-change-updates)
(defun customize-toggle-outside-change-updates (&optional arg)
"Turn on or off automatically telling Customize of outside changes.
When on, Customize is told about any preference changes made outside
of Customize, so that it considers them to have been made inside.
With prefix argument, turn on if ARG > 0
(interactive "p")
(cond ((or (and arg (< arg 0)) custom-check-for-changes-when-idle-p)
(cancel-timer custom-update-timer)
(setq custom-check-for-changes-when-idle-p nil)
(message "Turned OFF automatically telling Customize of outside changes."))
(t
(timer-activate-when-idle custom-update-timer)
(setq custom-check-for-changes-when-idle-p t)
(message "Turned ON automatically telling Customize of outside changes."))))
(unless (featurep 'cus-edit+) (customize-toggle-outside-change-updates -99))
(defun customize-set-auto-update-timer-period (secs)
"Set wait until automatically tell Customize of outside changes to SECS
seconds after Emacs is idle. Whenever Emacs is idle for this many
seconds it will check for user preferences that have been changed
outside of Customize. All user preference (variable and face) changes
are reported to Customize, so that it recognizes them as if they had
been made within Customize itself.
To turn on or off automatically telling Customize of outside changes,
use `\\[toggle-customize-update-changes]."
(interactive
"nSeconds to idle, before telling Customize of outside changes to preferences: ")
(timer-set-idle-time custom-update-timer
(setq custom-check-for-changes-interval secs)
t))
(defun Custom-ignore-unsaved (&rest _IGNORED)
"Ignore all currently customized but unsaved preferences.
The preferences that are currently customized but not saved are added
to the list of preferences that `customize-customized' will ignore
when checking for unsaved changes.
NOTE: This list of preferences that `customize-customized' ignores is
updated here and saved to your customizations file. To undo
this change, use `\\[Custom-reset-standard]' on variable
`customize-customized-ignore'."
(interactive)
(if (not (y-or-n-p
"Unsaved changes to all of these preferences will be IGNORED \
from now on. Continue? "))
(message nil)
(let ((children custom-options))
(mapc (lambda (child)
(let ((symbol (widget-get-tag-or-value child)))
(when (or (get symbol 'customized-value) (get symbol 'customized-face))
(message "Changes to `%s' will be IGNORED from now on." symbol))
(sit-for 0)
(push symbol customize-customized-ignore)))
children))
(customize-save-variable 'customize-customized-ignore customize-customized-ignore)
(message
(substitute-command-keys "Changes to all of these preferences will be ignored. \
Use `\\[Custom-reset-standard]' to undo."))))
(defun custom-ignore-unsaved-preference (widget)
"Ignore any unsaved changes to this preference.
Add it to the list of preferences that `customize-customized' will
ignore when checking for unsaved changes. Save that list in your
custom file."
(let ((symbol (widget-get-tag-or-value widget)))
(unless (or (get symbol 'customized-value) (get symbol 'customized-face))
(error "No unsaved changes to `%s'" symbol))
(if (not (y-or-n-p
(format "Unsaved changes to `%s' will be IGNORED from now on. Continue? "
symbol)))
(message nil)
(message "Changes to `%s' will be ignored from now on."
(widget-get-tag-or-value widget))
(sit-for 0)
(push symbol customize-customized-ignore)
(customize-save-variable 'customize-customized-ignore
customize-customized-ignore))))
(defun Custom-consider-unchanged (&rest _IGNORED)
"Consider all preferences here as being unchanged now.
This does not save the current values
unchanged values. If no further changes are made to any of these
preferences, then after doing this, `customize-customize' will not
display any of these preferences, since they were considered
unchanged."
(interactive)
(if (not (y-or-n-p
"All of these values will be considered unchanged now, \
without being saved. Continue? "))
(message nil)
(message "Please wait...")
(let ((children custom-options))
(mapc
(lambda (child)
(let ((symbol (widget-get-tag-or-value child)))
(cond ((custom-facep symbol)
(custom-consider-face-unchanged child))
((custom-variable-p symbol)
(custom-consider-variable-unchanged child)))))
children))
(message
"Current values here are now considered unchanged. They were not saved.")))
(unless (fboundp 'custom-variable-p)
(defun custom-variable-p (variable)
"Return non-nil if VARIABLE is a custom variable."
(or (get variable 'standard-value) (get variable 'custom-autoload))))
(defun custom-consider-face-unchanged (widget)
"Consider this face as being unchanged now.
This does not save the current face properties
face to be unchanged. If no further changes are made to this face,
then after doing this, `customize-customize' will not display this
face, since it was considered unchanged."
(message "Please wait...")
(let ((symbol (widget-value widget))
(hidden-p (eq 'hidden (widget-get widget :custom-state))))
(when hidden-p
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((child (car (widget-get widget :children)))
(value (if (< emacs-major-version 21)
(widget-value child)
(custom-post-filter-face-spec (widget-value child)))))
(unless (eq (widget-get widget :custom-state) 'standard)
(put symbol 'saved-face value)))
(put symbol 'customized-face nil)
(widget-put widget :custom-state 'saved)
(when hidden-p
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)
(custom-redraw widget)))
(custom-redraw-magic widget)
(message "Current face setting is now considered unchanged. It was not saved."))
(defun custom-consider-variable-unchanged (widget)
"Consider this variable as being unchanged now.
This does not save the current value
be unchanged. If no further changes are made to this variable, then
after doing this, `customize-customize' will not display this
variable, since it was considered unchanged."
(message "Please wait...")
(let* ((form (widget-get widget :custom-form))
(hidden-p (eq (widget-get widget :custom-state) 'hidden)))
(when hidden-p
(widget-put widget :custom-state 'unknown)
(custom-redraw widget)
(setq form (widget-get widget :custom-form)))
(let ((child (car (widget-get widget :children)))
(symbol (widget-value widget)))
(cond ((memq form '(lisp mismatch))
(put symbol 'saved-value (list (widget-value child))))
(t
(put symbol 'saved-value (list (custom-quote (widget-value child))))))
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil))
(widget-put widget :custom-state 'saved)
(when hidden-p
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)
(custom-redraw widget)))
(custom-redraw-magic widget)
(message "Current variable value is now considered unchanged. It was not saved."))
(defun customize-consider-all-unchanged ()
"Consider all customizable preferences as saved, without saving them."
(interactive)
(when (interactive-p) (message "Please wait..."))
(customize-consider-all-faces-unchanged)
(customize-consider-all-vars-unchanged)
(message
"All current preference values are now considered unchanged. They were not saved."))
(defun customize-consider-all-vars-unchanged ()
"Consider all customizable variables as saved, without saving them."
(interactive)
(when (interactive-p) (message "Please wait..."))
(mapatoms
(lambda (symbol)
(when (and (or (custom-variable-p symbol) (user-variable-p symbol))
(default-boundp symbol)
(not (member (list (custom-quote (default-value symbol)))
(list (get symbol 'saved-value)
(get symbol 'standard-value)))))
(put symbol 'saved-value (list (custom-quote (default-value symbol)))))
(put symbol 'customized-value nil)
(when (get symbol 'customized-variable-comment)
(put symbol 'saved-variable-comment (get symbol 'customized-variable-comment)))
(put symbol 'customized-variable-comment nil)))
(message
"All variables are now considered unchanged (\"saved\"), but they were not saved."))
(defun customize-consider-all-faces-unchanged ()
"Consider all customizable faces as saved, without saving them."
(interactive)
(when (interactive-p) (message "Please wait..."))
(mapatoms
(lambda (symbol)
(when (and (custom-facep symbol)
(not (face-spec-match-p symbol (get symbol 'saved-face)))
(not (face-spec-match-p symbol (get symbol 'face-defface-spec))))
(put symbol 'saved-face (list (list t (custom-face-attributes-get symbol nil)))))
(put symbol 'customized-face nil)
(let ((c-face-comment (get symbol 'customized-face-comment)))
(when (and c-face-comment (>= emacs-major-version 21))
(put symbol 'saved-face-comment c-face-comment)
(put symbol 'face-comment c-face-comment)))
(put symbol 'customized-face-comment nil)))
(message
"All faces are now considered unchanged (\"saved\"), but they were not saved."))
(when (< emacs-major-version 24)
(easy-menu-define
Custom-mode-menu
custom-mode-map
"Menu used in customization buffers."
`("Custom"
,(customize-menu-create 'customize)
["Set" Custom-set t]
["Save" Custom-save t]
["Consider Unchanged" Custom-consider-unchanged t]
["Ignore Unsaved Changes" Custom-ignore-unsaved t]
["Set from External Changes" customize-update-all t]
["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])))
(when (>= emacs-major-version 24)
(setq custom-commands
'((" Set for current session " Custom-set t
"Apply all settings in this buffer to the current session"
"index"
"Apply")
(" Save for future sessions " Custom-save
(or custom-file user-init-file)
"Apply all settings in this buffer and save them for future Emacs sessions."
"save"
"Save")
(" Consider unchanged" Custom-consider-unchanged t
"Treat changed preferences as if they were unchanged, without saving them."
"consider_unchanged"
"Consider Unchanged")
(" Ignore unsaved changes" Custom-ignore-unsaved t
"Add to the `customize-customized-ignore' preferences, whose changes \
are ignored by `customize-customized'."
"ignore_unsaved"
"Ignore Unsaved")
(" Set from external changes" customize-update-all t
"Tell Customize that all preferences changed outside it are now set."
"set_from_external"
"Set from External Changes")
(" Undo edits " Custom-reset-current t
"Restore all settings in this buffer to reflect their current values."
"refresh"
"Undo")
(" Reset to saved " Custom-reset-saved t
"Restore all settings in this buffer to their saved values (if any)."
"undo"
"Reset")
(" Erase customizations " Custom-reset-standard
(or custom-file user-init-file)
"Un-customize all settings in this buffer and save them with standard values."
"delete"
"Uncustomize")
(" Help for Customize " Custom-help t
"Get help for using Customize."
"help"
"Help")
(" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit")))
(defun custom-buffer-create-internal (options &optional _description)
(message "Creating customization buffer...")
(Custom-mode)
(let ((init-file (or custom-file user-init-file)))
(when custom-buffer-verbose-help
(widget-insert (if init-file
"To apply changes, use the Save or Set buttons."
"Custom settings cannot be saved)
"\nFor details, see ")
(widget-create 'custom-manual
:tag "Saving Customizations"
"(emacs)Saving Customizations")
(widget-insert " in the ")
(widget-create 'custom-manual
:tag "Emacs manual"
:help-echo "Read the Emacs manual."
"(emacs)Top")
(widget-insert "."))
(widget-insert "\n")
(when custom-search-field
(widget-insert "\n")
(let* ((echo "Search for custom items")
(search-widget
(widget-create
'editable-field
:size 40 :help-echo echo
:action `(lambda (widget &optional event)
(customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button
:tag " Search "
:help-echo echo :action
(lambda (widget &optional _event)
(customize-apropos (widget-value (widget-get widget :parent)))))
(widget-insert "\n")))
(when custom-buffer-verbose-help (widget-insert "
Operate on all settings in this buffer:\n"))
(let ((button (lambda (tag action active help _icon _label)
(widget-insert " ")
(when (eval active)
(widget-create 'push-button
:tag tag :help-echo help :action action))))
(commands custom-commands))
(apply button (pop commands))
(apply button (pop commands))
(widget-insert "\n")
(apply button (pop commands))
(apply button (pop commands))
(apply button (pop commands))
(if custom-reset-button-menu
(progn (widget-insert " ")
(widget-create 'push-button
:tag "Reset buffer"
:help-echo "Show a menu with reset operations."
:mouse-down-action 'ignore
:action 'custom-reset))
(widget-insert "\n")
(apply button (pop commands))
(apply button (pop commands))
(apply button (pop commands))
(widget-insert " ")
(pop commands)
(apply button (pop commands))))
(widget-insert "\n\n"))
(message "Creating customization items...")
(buffer-disable-undo)
(setq custom-options
(if (= (length options) 1)
(mapcar (lambda (entry)
(widget-create (nth 1 entry)
:documentation-shown t
:custom-state 'unknown
:tag (custom-unlispify-tag-name
(nth 0 entry))
:value (nth 0 entry)))
options)
(let ((count 0)
(length (length options)))
(mapcar (lambda (entry)
(prog2 (message "Creating customization items...%2d%%"
(/ (* 100.0 count) length))
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name (nth 0 entry))
:value (nth 0 entry))
(setq count (1+ count))
(unless (eq (preceding-char) ?\n) (widget-insert "\n"))
(widget-insert "\n")))
options))))
(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 setup...done")
(run-hooks 'customp-buffer-create-hook)))
(when (fboundp 'custom-group-of-mode)
(defun customize-mode (mode)
"Customize options related to a major or minor mode.
By default the current major is used.
With a prefix argument or if the current major mode has no known group,
you are prompted 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 "Mode: " obarray 'custom-group-of-mode
t nil nil (and group (symbol-name major-mode))))))))
(customize-group (custom-group-of-mode mode))))
(unless(fboundp 'Custom-mode)
(defun custom-buffer-create-internal (options &optional description)
(message "Creating customization buffer...")
(custom-mode)
(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
on an active field to invoke its action. Editing an option value
changes the text in the buffer
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-insert " "))
(widget-create 'push-button
:tag "Set for Current Session"
:help-echo "\
Make your editing in this buffer take effect for this session."
:action (lambda (widget &optional event)
(Custom-set)))
(widget-insert " ")
(widget-create 'push-button
:tag "Save for Future Sessions"
:help-echo "\
Make your editing in this buffer take effect for future Emacs sessions."
:action (lambda (widget &optional event)
(Custom-save)))
(widget-insert "\n ")
(widget-create 'push-button
:tag "Consider Unchanged"
:help-echo "\
Treat changed preferences as if they were unchanged, without saving them."
:action (lambda (widget &optional event)
(Custom-consider-unchanged)))
(widget-insert " ")
(widget-create 'push-button
:tag "Ignore Unsaved Changes"
:help-echo "\
Add to the `customize-customized-ignore' preferences, whose changes \
are ignored by `customize-customized'."
:action (lambda (widget &optional event)
(Custom-ignore-unsaved)))
(widget-insert " ")
(widget-create 'push-button
:tag "Set from External Changes"
:help-echo "\
Tell Customize that all preferences changed outside it are now set."
:action (lambda (widget &optional event)
(customize-update-all)
(message "Updating Customize to recognize external \
settings...done")))
(if custom-reset-button-menu
(progn
(widget-insert " ")
(widget-create 'push-button
:tag "Reset"
:help-echo "Show a menu with reset operations."
:mouse-down-action (lambda (&rest junk) t)
:action (lambda (widget &optional event)
(custom-reset event))))
(widget-insert "\n ")
(widget-create 'push-button
:tag "Reset"
:help-echo "\
Reset all edited text in this buffer to reflect current values."
:action 'Custom-reset-current)
(widget-insert " ")
(widget-create 'push-button
:tag "Reset to Saved"
:help-echo "\
Reset all values in this buffer to their saved settings."
:action 'Custom-reset-saved)
(widget-insert " ")
(widget-create 'push-button
:tag "Reset to Standard"
:help-echo "\
Reset all values in buffer to standard settings, updating your custom file."
: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"
:help-echo "Finish with this buffer"
:action (lambda (widget &optional event)
(quit-window)))
(widget-insert "\n\n")
(message "Creating customization items...")
(buffer-disable-undo)
(setq custom-options
(if (= (length options) 1)
(mapcar (lambda (entry)
(widget-create (nth 1 entry)
:documentation-shown t
:custom-state 'unknown
:tag (custom-unlispify-tag-name
(nth 0 entry))
:value (nth 0 entry)))
options)
(let ((count 0)
(length (length options)))
(mapcar (lambda (entry)
(prog2
(message "Creating customization items...%2d%%"
(/ (* 100.0 count) length))
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(nth 0 entry))
:value (nth 0 entry))
(setq count (1+ count))
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
(widget-insert "\n")))
options))))
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
(message "Creating customization items...done")
(unless (eq custom-buffer-style 'tree)
(mapc 'custom-magic-reset custom-options))
(message "Creating customization setup...")
(widget-setup)
(buffer-enable-undo)
(goto-char (point-min))
(message "Creating customization buffer...done")
(run-hooks 'customp-buffer-create-hook)))
(when (fboundp 'fit-frame-if-one-window)
(defadvice custom-browse-visibility-action
(after customize-toggle-tree-node-fit-frame activate)
"Fit frame to buffer if only one window."
(fit-frame-if-one-window)))
(when (fboundp 'fit-frame-if-one-window)
(defadvice customize-group-other-window (after customize-group-fit-frame activate)
"Fit frame to buffer if only one window."
(fit-frame-if-one-window)))
(defun customize-other-window ()
"Select a customization buffer which you can use to set user options
in a different window.
User options are structured into \"groups\".
Initially the top-level group `Emacs' and its immediate subgroups
are shown
(interactive)
(customize-group-other-window 'emacs))
(provide 'cus-edit+)