;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.90
+;; Version: 1.9929
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
;;
;; See `custom.el'.
+;; No commands should have names starting with `custom-' because
+;; that interferes with completion. Use `customize-' for commands
+;; that the user will run with M-x, and `Custom-' for interactive commands.
+
;;; Code:
(require 'cus-face)
(require 'cus-load)
(error nil))
-(defun custom-face-display-set (face spec &optional frame)
- (face-spec-set face spec frame))
-
-(defun custom-display-match-frame (display frame)
- (face-spec-set-match-display display frame))
+(condition-case nil
+ (require 'cus-start)
+ (error nil))
-(define-widget-keywords :custom-prefixes :custom-menu :custom-show
+(define-widget-keywords :custom-last :custom-prefix :custom-category
+ :custom-prefixes :custom-menu
+ :custom-show
:custom-magic :custom-state :custom-level :custom-form
:custom-set :custom-save :custom-reset-current :custom-reset-saved
- :custom-reset-factory)
+ :custom-reset-standard)
(put 'custom-define-hook 'custom-type 'hook)
-(put 'custom-define-hook 'factory-value '(nil))
+(put 'custom-define-hook 'standard-value '(nil))
(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
;;; Customization Groups.
:group 'environment
:group 'editing)
+(defgroup x nil
+ "The X Window system."
+ :group 'environment)
+
(defgroup frames nil
"Support for Emacs frames and window systems."
:group 'environment)
"Support editing files of data."
:group 'emacs)
+(defgroup files nil
+ "Support editing files."
+ :group 'emacs)
+
(defgroup wp nil
"Word processing."
:group 'emacs)
:group 'customize
:group 'faces)
+(defgroup custom-buffer nil
+ "Control the customize buffers."
+ :prefix "custom-"
+ :group 'customize)
+
+(defgroup custom-menu nil
+ "Control how the customize menus."
+ :prefix "custom-"
+ :group 'customize)
+
(defgroup abbrev-mode nil
"Word abbreviations mode."
:group 'abbrev)
(defgroup auto-save nil
"Preventing accidential loss of data."
- :group 'data)
+ :group 'files)
(defgroup processes-basics nil
"Basic stuff dealing with processes."
:group 'processes)
+(defgroup mule nil
+ "MULE Emacs internationalization."
+ :group 'i18n)
+
(defgroup windows nil
"Windows within a frame."
- :group 'processes)
+ :group 'environment)
;;; Utilities.
+(defun custom-last (x &optional n)
+ ;; Stolen from `cl.el'.
+ "Returns the last link in the list LIST.
+With optional argument N, returns Nth-to-last link (default 1)."
+ (if n
+ (let ((m 0) (p x))
+ (while (consp p) (incf m) (pop p))
+ (if (<= n 0) p
+ (if (< n m) (nthcdr (- m n) x) x)))
+ (while (consp (cdr x)) (pop x))
+ x))
+
(defun custom-quote (sexp)
"Quote SEXP iff it is not self quoting."
(if (or (memq sexp '(t nil))
(enable-recursive-minibuffers t)
val)
(setq val (completing-read
- (if v
- (format "Customize variable (default %s): " v)
+ (if (symbolp v)
+ (format "Customize option: (default %s) " v)
"Customize variable: ")
obarray (lambda (symbol)
(and (boundp symbol)
(or (get symbol 'custom-type)
(user-variable-p symbol))))))
(list (if (equal val "")
- v (intern val)))))
+ (if (symbolp v) v nil)
+ (intern val)))))
(defun custom-menu-filter (menu widget)
"Convert MENU to the form used by `widget-choose'.
(defcustom custom-unlispify-menu-entries t
"Display menu entries as words instead of symbols if non nil."
- :group 'customize
+ :group 'custom-menu
:type 'boolean)
(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
(defcustom custom-unlispify-tag-names t
"Display tag names as words instead of symbols if non nil."
- :group 'customize
+ :group 'custom-buffer
:type 'boolean)
(defun custom-unlispify-tag-name (symbol)
docs nil))))))
found))
+;;; Sorting.
+
+(defcustom custom-buffer-sort-alphabetically nil
+ "If non-nil, sort the members of each customization group alphabetically."
+ :type 'boolean
+ :group 'custom-buffer)
+
+(defcustom custom-buffer-groups-last nil
+ "If non-nil, put subgroups after all ordinary options within a group."
+ :type 'boolean
+ :group 'custom-buffer)
+
+(defcustom custom-menu-sort-alphabetically nil
+ "If non-nil, sort the members of each customization group alphabetically."
+ :type 'boolean
+ :group 'custom-menu)
+
+(defcustom custom-menu-groups-first t
+ "If non-nil, put subgroups before all ordinary options within a group."
+ :type 'boolean
+ :group 'custom-menu)
+
+(defun custom-buffer-sort-predicate (a b)
+ "Return t iff A should come before B in a customization buffer.
+A and B should be members of a `custom-group' property."
+ (cond ((and (not custom-buffer-groups-last)
+ (not custom-buffer-sort-alphabetically))
+ nil)
+ ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
+ (not custom-buffer-groups-last))
+ (if custom-buffer-sort-alphabetically
+ (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
+ nil))
+ (t
+ (not (eq (nth 1 a) 'custom-group) ))))
+
+(defun custom-menu-sort-predicate (a b)
+ "Return t iff A should come before B in a customization menu.
+A and B should be members of a `custom-group' property."
+ (cond ((and (not custom-menu-groups-first)
+ (not custom-menu-sort-alphabetically))
+ nil)
+ ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
+ (not custom-menu-groups-first))
+ (if custom-menu-sort-alphabetically
+ (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
+ nil))
+ (t
+ (eq (nth 1 a) 'custom-group) )))
+
;;; Custom Mode Commands.
(defvar custom-options nil
"Customization widgets in the current buffer.")
-(defun custom-set ()
+(defun Custom-set ()
"Set changes in all modified options."
(interactive)
(let ((children custom-options))
(widget-apply child :custom-set)))
children)))
-(defun custom-save ()
+(defun Custom-save ()
"Set all modified group members and save them."
(interactive)
(let ((children custom-options))
(custom-save-all))
(defvar custom-reset-menu
- '(("Current" . custom-reset-current)
- ("Saved" . custom-reset-saved)
- ("Factory Settings" . custom-reset-factory))
+ '(("Current" . Custom-reset-current)
+ ("Saved" . Custom-reset-saved)
+ ("Standard Settings" . Custom-reset-standard))
"Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a
lisp function taking the widget as an element which will be called
(if answer
(funcall answer))))
-(defun custom-reset-current ()
+(defun Custom-reset-current (&rest ignore)
"Reset all modified group members to their current value."
(interactive)
(let ((children custom-options))
(widget-apply child :custom-reset-current)))
children)))
-(defun custom-reset-saved ()
+(defun Custom-reset-saved (&rest ignore)
"Reset all modified or set group members to their saved value."
(interactive)
(let ((children custom-options))
(mapcar (lambda (child)
(when (eq (widget-get child :custom-state) 'modified)
- (widget-apply child :custom-reset-current)))
+ (widget-apply child :custom-reset-saved)))
children)))
-(defun custom-reset-factory ()
- "Reset all modified, set, or saved group members to their factory settings."
+(defun Custom-reset-standard (&rest ignore)
+ "Reset all modified, set, or saved group members to their standard settings."
(interactive)
(let ((children custom-options))
(mapcar (lambda (child)
(when (eq (widget-get child :custom-state) 'modified)
- (widget-apply child :custom-reset-current)))
+ (widget-apply child :custom-reset-standard)))
children)))
;;; The Customize Commands
(eval-minibuffer prompt)))))))
;;;###autoload
-(defun custom-set-value (var val)
+(defun customize-set-value (var val)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
If VARIABLE has a `variable-interactive' property, that is used as if
(set var val))
;;;###autoload
-(defun custom-set-variable (var val)
+(defun customize-set-variable (var val)
"Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
If VARIABLE has a `custom-set' property, that is used for setting
(put var 'customized-value (list (custom-quote val))))
;;;###autoload
-(defun customize (symbol)
- "Customize SYMBOL, which must be a customization group."
- (interactive (list (completing-read "Customize group: (default emacs) "
- obarray
- (lambda (symbol)
- (get symbol 'custom-group))
- t)))
+(defun customize ()
+ "Select a customization buffer which you can use to set user options.
+User options are structured into \"groups\".
+Initially the top-level group `Emacs' and its immediate subgroups
+are shown; the contents of those subgroups are initially hidden."
+ (interactive)
+ (customize-group 'emacs))
- (when (stringp symbol)
- (if (string-equal "" symbol)
- (setq symbol 'emacs)
- (setq symbol (intern symbol))))
- (custom-buffer-create (list (list symbol 'custom-group))))
+;;;###autoload
+(defun customize-group (group)
+ "Customize GROUP, which must be a customization group."
+ (interactive (list (let ((completion-ignore-case t))
+ (completing-read "Customize group: (default emacs) "
+ obarray
+ (lambda (symbol)
+ (get symbol 'custom-group))
+ t))))
+
+ (when (stringp group)
+ (if (string-equal "" group)
+ (setq group 'emacs)
+ (setq group (intern group))))
+ (let ((name (format "*Customize Group: %s*"
+ (custom-unlispify-tag-name group))))
+ (if (get-buffer name)
+ (switch-to-buffer name)
+ (custom-buffer-create (list (list group 'custom-group))
+ name))))
;;;###autoload
-(defun customize-other-window (symbol)
+(defun customize-group-other-window (symbol)
"Customize SYMBOL, which must be a customization group."
(interactive (list (completing-read "Customize group: (default emacs) "
obarray
(if (string-equal "" symbol)
(setq symbol 'emacs)
(setq symbol (intern symbol))))
- (custom-buffer-create-other-window (list (list symbol 'custom-group))))
+ (custom-buffer-create-other-window
+ (list (list symbol 'custom-group))
+ (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
+
+;;;###autoload
+(defalias 'customize-variable 'customize-option)
;;;###autoload
-(defun customize-variable (symbol)
- "Customize SYMBOL, which must be a variable."
+(defun customize-option (symbol)
+ "Customize SYMBOL, which must be a user option variable."
(interactive (custom-variable-prompt))
- (custom-buffer-create (list (list symbol 'custom-variable))))
+ (custom-buffer-create (list (list symbol 'custom-variable))
+ (format "*Customize Option: %s*"
+ (custom-unlispify-tag-name symbol))))
;;;###autoload
-(defun customize-variable-other-window (symbol)
- "Customize SYMBOL, which must be a variable.
+(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))))
+ (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)
(let ((found nil))
(message "Looking for faces...")
(mapcar (lambda (symbol)
- (setq found (cons (list symbol 'custom-face) found)))
- (nreverse (mapcar 'intern
+ (push (list symbol 'custom-face) found))
+ (nreverse (mapcar 'intern
(sort (mapcar 'symbol-name (face-list))
- 'string<))))
+ 'string-lessp))))
- (custom-buffer-create found))
+ (custom-buffer-create found "*Customize Faces*"))
(if (stringp symbol)
(setq symbol (intern symbol)))
(unless (symbolp symbol)
(error "Should be a symbol %S" symbol))
- (custom-buffer-create (list (list symbol 'custom-face)))))
+ (custom-buffer-create (list (list symbol 'custom-face))
+ (format "*Customize Face: %s*"
+ (custom-unlispify-tag-name symbol)))))
;;;###autoload
(defun customize-face-other-window (&optional symbol)
(setq symbol (intern symbol)))
(unless (symbolp symbol)
(error "Should be a symbol %S" symbol))
- (custom-buffer-create-other-window (list (list symbol 'custom-face)))))
+ (custom-buffer-create-other-window
+ (list (list symbol 'custom-face))
+ (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
;;;###autoload
(defun customize-customized ()
(mapatoms (lambda (symbol)
(and (get symbol 'customized-face)
(custom-facep symbol)
- (setq found (cons (list symbol 'custom-face) found)))
+ (push (list symbol 'custom-face) found))
(and (get symbol 'customized-value)
(boundp symbol)
- (setq found
- (cons (list symbol 'custom-variable) found)))))
+ (push (list symbol 'custom-variable) found))))
(if found
- (custom-buffer-create found)
+ (custom-buffer-create found "*Customize Customized*")
(error "No customized user options"))))
;;;###autoload
(mapatoms (lambda (symbol)
(and (get symbol 'saved-face)
(custom-facep symbol)
- (setq found (cons (list symbol 'custom-face) found)))
+ (push (list symbol 'custom-face) found))
(and (get symbol 'saved-value)
(boundp symbol)
- (setq found
- (cons (list symbol 'custom-variable) found)))))
+ (push (list symbol 'custom-variable) found))))
(if found
- (custom-buffer-create found)
+ (custom-buffer-create found "*Customize Saved*")
(error "No saved user options"))))
;;;###autoload
(defun customize-apropos (regexp &optional all)
"Customize all user options matching REGEXP.
-If ALL (e.g., started with a prefix key), include options which are not
-user-settable."
+If ALL is `options', include only options.
+If ALL is `faces', include only faces.
+If ALL is `groups', include only groups.
+If ALL is t (interactively, with prefix arg), include options which are not
+user-settable, as well as faces and groups."
(interactive "sCustomize regexp: \nP")
(let ((found nil))
(mapatoms (lambda (symbol)
(when (string-match regexp (symbol-name symbol))
- (when (get symbol 'custom-group)
- (setq found (cons (list symbol 'custom-group) found)))
- (when (custom-facep symbol)
- (setq found (cons (list symbol 'custom-face) found)))
- (when (and (boundp symbol)
+ (when (and (not (memq all '(faces options)))
+ (get symbol 'custom-group))
+ (push (list symbol 'custom-group) found))
+ (when (and (not (memq all '(options groups)))
+ (custom-facep symbol))
+ (push (list symbol 'custom-face) found))
+ (when (and (not (memq all '(groups faces)))
+ (boundp symbol)
(or (get symbol 'saved-value)
- (get symbol 'factory-value)
- (if all
- (get symbol 'variable-documentation)
- (user-variable-p symbol))))
- (setq found
- (cons (list symbol 'custom-variable) found))))))
- (if found
- (custom-buffer-create found)
- (error "No matches"))))
+ (get symbol 'standard-value)
+ (if (memq all '(nil options))
+ (user-variable-p symbol)
+ (get symbol 'variable-documentation))))
+ (push (list symbol 'custom-variable) found)))))
+ (if (not found)
+ (error "No matches")
+ (let ((custom-buffer-sort-alphabetically t))
+ (custom-buffer-create (sort found 'custom-buffer-sort-predicate)
+ "*Customize Apropos*")))))
+
+;;;###autoload
+(defun customize-apropos-options (regexp &optional arg)
+ "Customize all user options matching REGEXP.
+With prefix arg, include options which are not user-settable."
+ (interactive "sCustomize regexp: \nP")
+ (customize-apropos regexp (or arg 'options)))
+
+;;;###autoload
+(defun customize-apropos-faces (regexp)
+ "Customize all user faces matching REGEXP."
+ (interactive "sCustomize regexp: \n")
+ (customize-apropos regexp 'faces))
+
+;;;###autoload
+(defun customize-apropos-groups (regexp)
+ "Customize all user groups matching REGEXP."
+ (interactive "sCustomize regexp: \n")
+ (customize-apropos regexp 'groups))
;;; Buffer.
+(defcustom custom-buffer-style 'links
+ "Control the presentation style for customization buffers.
+The value should be a symbol, one of:
+
+brackets: groups nest within each other with big horizontal brackets.
+links: groups have links to subgroups."
+ :type '(radio (const brackets)
+ (const links))
+ :group 'custom-buffer)
+
+(defcustom custom-buffer-indent 3
+ "Number of spaces to indent nested groups."
+ :type 'integer
+ :group 'custom-buffer)
+
;;;###autoload
-(defun custom-buffer-create (options)
+(defun custom-buffer-create (options &optional name)
"Create a buffer containing OPTIONS.
+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."
- (kill-buffer (get-buffer-create "*Customization*"))
- (switch-to-buffer (get-buffer-create "*Customization*"))
+ (unless name (setq name "*Customization*"))
+ (kill-buffer (get-buffer-create name))
+ (switch-to-buffer (get-buffer-create name))
(custom-buffer-create-internal options))
;;;###autoload
-(defun custom-buffer-create-other-window (options)
+(defun custom-buffer-create-other-window (options &optional name)
"Create a buffer containing OPTIONS.
+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."
- (kill-buffer (get-buffer-create "*Customization*"))
+ (unless name (setq name "*Customization*"))
+ (kill-buffer (get-buffer-create name))
(let ((window (selected-window)))
- (switch-to-buffer-other-window (get-buffer-create "*Customization*"))
+ (switch-to-buffer-other-window (get-buffer-create name))
(custom-buffer-create-internal options)
(select-window window)))
-
+
+(defcustom custom-reset-button-menu nil
+ "If non-nil, only show a single reset button in customize buffers.
+This button will have a menu with all three reset operations."
+ :type 'boolean
+ :group 'custom-buffer)
(defun custom-buffer-create-internal (options)
(message "Creating customization buffer...")
(custom-mode)
(widget-insert "This is a customization buffer.
-Push RET or click mouse-2 on the word ")
- ;; (put-text-property 1 2 'start-open nil)
+Square brackets show active fields; type RET or click mouse-2
+on an active field to invoke its action. Invoke ")
(widget-create 'info-link
- :tag "help"
+ :tag "Help"
:help-echo "Read the online help."
- "(custom)The Customization Buffer")
+ "(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 'push-button
+ :tag "Set"
+ :help-echo "Set all modifications for this session."
+ :action (lambda (widget &optional event)
+ (Custom-set)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Save"
+ :help-echo "\
+Make the modifications default for future sessions."
+ :action (lambda (widget &optional event)
+ (Custom-save)))
+ (widget-insert " ")
+ (if custom-reset-button-menu
+ (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-create 'push-button
+ :tag "Reset"
+ :help-echo "\
+Reset all visible items in this buffer to their current settings."
+ :action 'Custom-reset-current)
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset to Saved"
+ :help-echo "\
+Reset all visible items 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 visible items in this buffer to their standard settings."
+ :action 'Custom-reset-standard))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Bury Buffer"
+ :help-echo "Bury the buffer."
+ :action (lambda (widget &optional event)
+ (bury-buffer)))
+ (widget-insert "\n\n")
+ (message "Creating customization items...")
(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))
options))))
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
- (widget-insert "\n")
- (message "Creating customization magic...")
- (mapcar 'custom-magic-reset custom-options)
- (message "Creating customization buttons...")
- (widget-create 'push-button
- :tag "Set"
- :help-echo "Set all modifications for this session."
- :action (lambda (widget &optional event)
- (custom-set)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Save"
- :help-echo "\
-Make the modifications default for future sessions."
- :action (lambda (widget &optional event)
- (custom-save)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Reset"
- :help-echo "Undo all modifications."
- :action (lambda (widget &optional event)
- (custom-reset event)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Done"
- :help-echo "Bury the buffer."
- :action (lambda (widget &optional event)
- (bury-buffer)
- ;; Steal button release event.
- (if (and (fboundp 'button-press-event-p)
- (fboundp 'next-command-event))
- ;; XEmacs
- (and event
- (button-press-event-p event)
- (next-command-event))
- ;; Emacs
- (when (memq 'down (event-modifiers event))
- (read-event)))))
- (widget-insert "\n")
+ (unless (eq custom-buffer-style 'tree)
+ (mapcar 'custom-magic-reset custom-options))
(message "Creating customization setup...")
(widget-setup)
(goto-char (point-min))
- (forward-line 3) ;Kludge: bob is writable in XEmacs.
(message "Creating customization buffer...done"))
+;;; The Tree Browser.
+
+;;;###autoload
+(defun customize-browse ()
+ "Create a tree browser for the customize hierarchy."
+ (interactive)
+ (let ((name "*Customize Browser*"))
+ (kill-buffer (get-buffer-create name))
+ (switch-to-buffer (get-buffer-create name)))
+ (custom-mode)
+ (widget-insert "\
+Invoke [+] below to expand items, and [-] to collapse items.
+Invoke the [Group], [Face], and [Option] buttons below to edit that
+item in another window.\n\n")
+ (let ((custom-buffer-style 'tree))
+ (widget-create 'custom-group
+ :custom-last t
+ :custom-state 'unknown
+ :tag (custom-unlispify-tag-name 'emacs)
+ :value 'emacs))
+ (goto-char (point-min)))
+
+(define-widget 'custom-tree-visibility 'item
+ "Control visibility of of items in the customize tree browser."
+ :button-prefix "["
+ :button-suffix "]"
+ :format "%[%t%]"
+ :action 'custom-tree-visibility-action)
+
+(defun custom-tree-visibility-action (widget &rest ignore)
+ (let ((custom-buffer-style 'tree))
+ (custom-toggle-parent widget)))
+
+(define-widget 'custom-tree-group-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Group"
+ :action 'custom-tree-group-tag-action)
+
+(defun custom-tree-group-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-group-other-window (widget-value parent))))
+
+(define-widget 'custom-tree-variable-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Option"
+ :action 'custom-tree-variable-tag-action)
+
+(defun custom-tree-variable-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-variable-other-window (widget-value parent))))
+
+(define-widget 'custom-tree-face-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Face"
+ :action 'custom-tree-face-tag-action)
+
+(defun custom-tree-face-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-face-other-window (widget-value parent))))
+
;;; Modification of Basic Widgets.
;;
;; We add extra properties to the basic widgets needed here. This is
;;; The `custom-magic' Widget.
+(defgroup custom-magic-faces nil
+ "Faces used by the magic button."
+ :group 'custom-faces
+ :group 'custom-buffer)
+
(defface custom-invalid-face '((((class color))
(:foreground "yellow" :background "red"))
(t
(:bold t :italic t :underline t)))
- "Face used when the customize item is invalid.")
+ "Face used when the customize item is invalid."
+ :group 'custom-magic-faces)
(defface custom-rogue-face '((((class color))
(:foreground "pink" :background "black"))
(t
(:underline t)))
- "Face used when the customize item is not defined for customization.")
+ "Face used when the customize item is not defined for customization."
+ :group 'custom-magic-faces)
(defface custom-modified-face '((((class color))
(:foreground "white" :background "blue"))
(t
(:italic t :bold)))
- "Face used when the customize item has been modified.")
+ "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)))
- "Face used when the customize item has been set.")
+ "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)))
- "Face used when the customize item has been changed.")
+ "Face used when the customize item has been changed."
+ :group 'custom-magic-faces)
(defface custom-saved-face '((t (:underline t)))
- "Face used when the customize item has been saved.")
+ "Face used when the customize item has been saved."
+ :group 'custom-magic-faces)
-(defcustom custom-magic-alist '((nil "#" underline "\
+(defconst custom-magic-alist '((nil "#" underline "\
uninitialized, you should not see this.")
- (unknown "?" italic "\
+ (unknown "?" italic "\
unknown, you should not see this.")
- (hidden "-" default "\
-hidden, press the state button to show.")
- (invalid "x" custom-invalid-face "\
-the value displayed for this item is invalid and cannot be set.")
- (modified "*" custom-modified-face "\
-you have edited the item, and can now set it.")
- (set "+" custom-set-face "\
-you have set this item, but not saved it.")
- (changed ":" custom-changed-face "\
-this item has been changed outside customize.")
- (saved "!" custom-saved-face "\
-this item has been saved.")
- (rogue "@" custom-rogue-face "\
-this item is not prepared for customization.")
- (factory " " nil "\
-this item is unchanged from its factory setting."))
+ (hidden "-" default "\
+hidden, invoke \"Show\" in the previous line to show." "\
+group now hidden, invoke \"Show\", above, to show contents.")
+ (invalid "x" custom-invalid-face "\
+the value displayed for this %c is invalid and cannot be set.")
+ (modified "*" custom-modified-face "\
+you have edited the value, and can now set the %c." "\
+you have edited something in this group, and can now set it.")
+ (set "+" custom-set-face "\
+you have set this %c, but not saved it." "\
+something in this group has been set, but not yet saved.")
+ (changed ":" custom-changed-face "\
+this %c has been changed outside the customize buffer." "\
+something in this group has been changed outside customize.")
+ (saved "!" custom-saved-face "\
+this %c has been set and saved." "\
+something in this group has been set and saved.")
+ (rogue "@" custom-rogue-face "\
+this %c has not been changed with customize." "\
+something in this group is not prepared for customization.")
+ (standard " " nil "\
+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 DESCRIPTION), where
+Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
STATE is one of the following symbols:
This item is marked for saving.
`rogue'
This item has no customization information.
-`factory'
- This item is unchanged from the factory default.
+`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.
-DESCRIPTION is a string describing the state.
-
-The list should be sorted most significant first."
- :type '(list (checklist :inline t
- (group (const nil)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const unknown)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const hidden)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const invalid)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const modified)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const set)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const changed)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const saved)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const rogue)
- (string :tag "Magic")
- face
- (string :tag "Description"))
- (group (const factory)
- (string :tag "Magic")
- face
- (string :tag "Description")))
- (editable-list :inline t
- (group symbol
- (string :tag "Magic")
- face
- (string :tag "Description"))))
- :group 'customize
- :group 'custom-faces)
+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.")
(defcustom custom-magic-show 'long
- "Show long description of the state of each customization option."
+ "If non-nil, show textual description of the state.
+If non-nil and not the symbol `long', only show first word."
:type '(choice (const :tag "no" nil)
(const short)
(const long))
- :group 'customize)
+ :group 'custom-buffer)
+
+(defcustom custom-magic-show-hidden '(option face)
+ "Control whether the state button is shown for hidden items.
+The value should be a list with the custom categories where the state
+button should be visible. Possible categories are `group', `option',
+and `face'."
+ :type '(set (const group) (const option) (const face))
+ :group 'custom-buffer)
-(defcustom custom-magic-show-button t
+(defcustom custom-magic-show-button nil
"Show a magic button indicating the state of each customization option."
:type 'boolean
- :group 'customize)
+ :group 'custom-buffer)
(define-widget 'custom-magic 'default
"Show and manipulate state for a customization option."
:format "%v"
- :action 'widget-choice-item-action
+ :action 'widget-parent-action
:notify 'ignore
:value-get 'ignore
:value-create 'custom-magic-value-create
:value-delete 'widget-children-value-delete)
+(defun widget-magic-mouse-down-action (widget &optional event)
+ ;; Non-nil unless hidden.
+ (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
+ :custom-state)
+ 'hidden)))
+
(defun custom-magic-value-create (widget)
;; Create compact status report for WIDGET.
(let* ((parent (widget-get widget :parent))
(state (widget-get parent :custom-state))
+ (hidden (eq state 'hidden))
(entry (assq state custom-magic-alist))
(magic (nth 1 entry))
(face (nth 2 entry))
- (text (nth 3 entry))
+ (category (widget-get parent :custom-category))
+ (text (or (and (eq category 'group)
+ (nth 4 entry))
+ (nth 3 entry)))
(lisp (eq (widget-get parent :custom-form) 'lisp))
children)
- (when custom-magic-show
- (push (widget-create-child-and-convert widget 'choice-item
- :help-echo "\
-Change the state of this item."
- :format "%[%t%]"
- :tag "State")
+ (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
+ (setq text (concat (match-string 1 text)
+ (symbol-name category)
+ (match-string 2 text))))
+ (when (and custom-magic-show
+ (or (not hidden)
+ (memq category custom-magic-show-hidden)))
+ (insert " ")
+ (when (and (eq category 'group)
+ (not (and (eq custom-buffer-style 'links)
+ (> (widget-get parent :custom-level) 1))))
+ (insert-char ?\ (* custom-buffer-indent
+ (widget-get parent :custom-level))))
+ (push (widget-create-child-and-convert
+ widget 'choice-item
+ :help-echo "Change the state of this item."
+ :format (if hidden "%t" "%[%t%]")
+ :button-prefix 'widget-push-button-prefix
+ :button-suffix 'widget-push-button-suffix
+ :mouse-down-action 'widget-magic-mouse-down-action
+ :tag "State")
children)
(insert ": ")
(if (eq custom-magic-show 'long)
(when lisp
(insert " (lisp)"))
(insert "\n"))
+ (when (and (eq category 'group)
+ (not (and (eq custom-buffer-style 'links)
+ (> (widget-get parent :custom-level) 1))))
+ (insert-char ?\ (* custom-buffer-indent
+ (widget-get parent :custom-level))))
(when custom-magic-show-button
(when custom-magic-show
(let ((indent (widget-get parent :indent)))
(when indent
(insert-char ? indent))))
- (push (widget-create-child-and-convert widget 'choice-item
- :button-face face
- :help-echo "Change the state."
- :format "%[%t%]"
- :tag (if lisp
- (concat "(" magic ")")
- (concat "[" magic "]")))
+ (push (widget-create-child-and-convert
+ widget 'choice-item
+ :mouse-down-action 'widget-magic-mouse-down-action
+ :button-face face
+ :button-prefix ""
+ :button-suffix ""
+ :help-echo "Change the state."
+ :format (if hidden "%t" "%[%t%]")
+ :tag (if lisp
+ (concat "(" magic ")")
+ (concat "[" magic "]")))
children)
(insert " "))
(widget-put widget :children children)))
(let ((magic (widget-get widget :custom-magic)))
(widget-value-set magic (widget-value magic))))
-;;; The `custom-level' Widget.
-
-(define-widget 'custom-level 'item
- "The custom level buttons."
- :format "%[%t%]"
- :help-echo "Expand or collapse this item."
- :action 'custom-level-action)
-
-(defun custom-level-action (widget &optional event)
- "Toggle visibility for parent to WIDGET."
- (custom-toggle-hide (widget-get widget :parent)))
-
;;; The `custom' Widget.
(define-widget 'custom 'default
"Customize a user option."
+ :format "%v"
:convert-widget 'custom-convert-widget
- :format "%l%[%t%]: %v%m%h%a"
- :format-handler 'custom-format-handler
:notify 'custom-notify
+ :custom-prefix ""
:custom-level 1
:custom-state 'hidden
:documentation-property 'widget-subclass-responsibility
:value-create 'widget-subclass-responsibility
:value-delete 'widget-children-value-delete
- :value-get 'widget-item-value-get
- :validate 'widget-editable-list-validate
+ :value-get 'widget-value-value-get
+ :validate 'widget-children-validate
:match (lambda (widget value) (symbolp value)))
(defun custom-convert-widget (widget)
(widget-put widget :args nil)))
widget)
-(defun custom-format-handler (widget escape)
- ;; We recognize extra escape sequences.
- (let* ((buttons (widget-get widget :buttons))
- (state (widget-get widget :custom-state))
- (level (widget-get widget :custom-level)))
- (cond ((eq escape ?l)
- (when level
- (push (widget-create-child-and-convert
- widget 'custom-level (make-string level ?*))
- buttons)
- (widget-insert " ")
- (widget-put widget :buttons buttons)))
- ((eq escape ?L)
- (when (eq state 'hidden)
- (widget-insert " ...")))
- ((eq escape ?m)
- (and (eq (preceding-char) ?\n)
- (widget-get widget :indent)
- (insert-char ? (widget-get widget :indent)))
- (let ((magic (widget-create-child-and-convert
- widget 'custom-magic nil)))
- (widget-put widget :custom-magic magic)
- (push magic buttons)
- (widget-put widget :buttons buttons)))
- ((eq escape ?a)
- (let* ((symbol (widget-get widget :value))
- (links (get symbol 'custom-links))
- (many (> (length links) 2)))
- (when links
- (and (eq (preceding-char) ?\n)
- (widget-get widget :indent)
- (insert-char ? (widget-get widget :indent)))
- (insert "See also ")
- (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 ", "))))
- (widget-put widget :buttons buttons))))
- (t
- (widget-default-format-handler widget escape)))))
-
(defun custom-notify (widget &rest args)
"Keep track of changes."
- (unless (memq (widget-get widget :custom-state) '(nil unknown hidden))
- (widget-put widget :custom-state 'modified))
- (let ((buffer-undo-list t))
- (custom-magic-reset widget))
- (apply 'widget-default-notify widget args))
+ (let ((state (widget-get widget :custom-state)))
+ (unless (eq state 'modified)
+ (unless (memq state '(nil unknown hidden))
+ (widget-put widget :custom-state 'modified))
+ (custom-magic-reset widget)
+ (apply 'widget-default-notify widget args))))
(defun custom-redraw (widget)
"Redraw WIDGET with current settings."
(when (and (>= pos from) (<= pos to))
(condition-case nil
(progn
- (goto-line line)
+ (if (> column 0)
+ (goto-line line)
+ (goto-line (1+ line)))
(move-to-column column))
(error nil)))))
"Redraw WIDGET state with current settings."
(while widget
(let ((magic (widget-get widget :custom-magic)))
- (unless magic
- (debug))
- (widget-value-set magic (widget-value magic))
- (when (setq widget (widget-get widget :group))
- (custom-group-state-update widget))))
+ (cond (magic
+ (widget-value-set magic (widget-value magic))
+ (when (setq widget (widget-get widget :group))
+ (custom-group-state-update widget)))
+ (t
+ (setq widget nil)))))
(widget-setup))
(defun custom-show (widget value)
(condition-case nil
(require load)
(error nil)))
+ ;; Don't reload a file already loaded.
((assoc load load-history))
+ ((assoc (locate-library load) load-history))
(t
(condition-case nil
- (load-library load)
+ ;; 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)
((eq state 'hidden)
(widget-put widget :custom-state 'unknown))
(t
+ (widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)))
- (custom-redraw widget)))
+ (custom-redraw widget)
+ (widget-setup)))
+
+(defun custom-toggle-parent (widget &rest ignore)
+ "Toggle visibility of parent to WIDGET."
+ (custom-toggle-hide (widget-get widget :parent)))
+
+(defun custom-add-see-also (widget &optional prefix)
+ "Add `See also ...' to WIDGET if there are any links.
+Insert PREFIX first if non-nil."
+ (let* ((symbol (widget-get widget :value))
+ (links (get symbol 'custom-links))
+ (many (> (length links) 2))
+ (buttons (widget-get widget :buttons))
+ (indent (widget-get widget :indent)))
+ (when links
+ (when indent
+ (insert-char ?\ indent))
+ (when prefix
+ (insert prefix))
+ (insert "See also ")
+ (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 ", "))))
+ (widget-put widget :buttons buttons))))
+
+(defun custom-add-parent-links (widget &optional initial-string)
+ "Add \"Parent groups: ...\" to WIDGET if the group has parents.
+The value if non-nil if any parents were found.
+If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
+ (let ((name (widget-value widget))
+ (type (widget-type widget))
+ (buttons (widget-get widget :buttons))
+ (start (point))
+ found)
+ (insert (or initial-string "Parent groups:"))
+ (mapatoms (lambda (symbol)
+ (let ((group (get symbol 'custom-group)))
+ (when (assq name group)
+ (when (eq type (nth 1 (assq name group)))
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'custom-group-link
+ :tag (custom-unlispify-tag-name symbol)
+ symbol)
+ buttons)
+ (setq found t))))))
+ (widget-put widget :buttons buttons)
+ (if found
+ (insert "\n")
+ (delete-region start (point)))
+ found))
;;; The `custom-variable' Widget.
(define-widget 'custom-variable 'custom
"Customize variable."
- :format "%l%v%m%h%a"
+ :format "%v"
:help-echo "Set or reset this variable."
:documentation-property 'variable-documentation
+ :custom-category 'option
:custom-state nil
:custom-menu 'custom-variable-menu-create
:custom-form 'edit
:custom-save 'custom-variable-save
:custom-reset-current 'custom-redraw
:custom-reset-saved 'custom-variable-reset-saved
- :custom-reset-factory 'custom-variable-reset-factory)
+ :custom-reset-standard 'custom-variable-reset-standard)
(defun custom-variable-type (symbol)
"Return a widget suitable for editing the value of SYMBOL.
If SYMBOL has a `custom-type' property, use that.
Otherwise, look up symbol in `custom-guess-type-alist'."
(let* ((type (or (get symbol 'custom-type)
- (and (not (get symbol 'factory-value))
+ (and (not (get symbol 'standard-value))
(custom-guess-type symbol))
'sexp))
(options (get symbol 'custom-options))
(type (custom-variable-type symbol))
(conv (widget-convert type))
(get (or (get symbol 'custom-get) 'default-value))
- (set (or (get symbol 'custom-set) 'set-default))
+ (prefix (widget-get widget :custom-prefix))
+ (last (widget-get widget :custom-last))
(value (if (default-boundp symbol)
(funcall get symbol)
(widget-get conv :value))))
;; (widget-apply (widget-convert type) :match value)
(setq form 'lisp)))
;; Now we can create the child widget.
- (cond ((eq state 'hidden)
+ (cond ((eq custom-buffer-style 'tree)
+ (insert prefix (if last " +--- " " |--- "))
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-variable-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ ((eq state 'hidden)
;; Indicate hidden value.
(push (widget-create-child-and-convert
widget 'item
- :format "%{%t%}: ..."
+ :format "%{%t%}: "
:sample-face 'custom-variable-sample-face
:tag tag
:parent widget)
- children))
+ buttons)
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Show the value of this option."
+ :action 'custom-toggle-parent
+ nil)
+ buttons))
((eq form 'lisp)
;; In lisp mode edit the saved value when possible.
(let* ((value (cond ((get symbol 'saved-value)
(car (get symbol 'saved-value)))
- ((get symbol 'factory-value)
- (car (get symbol 'factory-value)))
+ ((get symbol 'standard-value)
+ (car (get symbol 'standard-value)))
((default-boundp symbol)
(custom-quote (funcall get symbol)))
(t
(custom-quote (widget-get conv :value))))))
+ (insert (symbol-name symbol) ": ")
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Hide the value of this option."
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (insert " ")
(push (widget-create-child-and-convert
widget 'sexp
:button-face 'custom-variable-button-face
+ :format "%v"
:tag (symbol-name symbol)
:parent widget
:value value)
children)))
(t
;; Edit mode.
- (push (widget-create-child-and-convert
- widget type
- :tag tag
- :button-face 'custom-variable-button-face
- :sample-face 'custom-variable-sample-face
- :value value)
- children)))
- ;; Now update the state.
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))
- (if (eq state 'hidden)
- (widget-put widget :custom-state state)
- (custom-variable-state-set widget))
- (widget-put widget :custom-form form)
- (widget-put widget :buttons buttons)
- (widget-put widget :children children)))
+ (let* ((format (widget-get type :format))
+ tag-format value-format)
+ (unless (string-match ":" format)
+ (error "Bad format."))
+ (setq tag-format (substring format 0 (match-end 0)))
+ (setq value-format (substring format (match-end 0)))
+ (push (widget-create-child-and-convert
+ widget 'item
+ :format tag-format
+ :action 'custom-tag-action
+ :help-echo "Change value of this option."
+ :mouse-down-action 'custom-tag-mouse-down-action
+ :button-face 'custom-variable-button-face
+ :sample-face 'custom-variable-sample-face
+ tag)
+ buttons)
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Hide the value of this option."
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (push (widget-create-child-and-convert
+ widget type
+ :format value-format
+ :value value)
+ children))))
+ (unless (eq custom-buffer-style 'tree)
+ ;; Now update the state.
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (if (eq state 'hidden)
+ (widget-put widget :custom-state state)
+ (custom-variable-state-set widget))
+ ;; Create the magic button.
+ (let ((magic (widget-create-child-and-convert
+ widget 'custom-magic nil)))
+ (widget-put widget :custom-magic magic)
+ (push magic buttons))
+ ;; Update properties.
+ (widget-put widget :custom-form form)
+ (widget-put widget :buttons buttons)
+ (widget-put widget :children children)
+ ;; Insert documentation.
+ (widget-default-format-handler widget ?h)
+ ;; See also.
+ (unless (eq state 'hidden)
+ (when (eq (widget-get widget :custom-level) 1)
+ (custom-add-parent-links widget))
+ (custom-add-see-also widget)))))
+
+(defun custom-tag-action (widget &rest args)
+ "Pass :action to first child of WIDGET's parent."
+ (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+ :action args))
+
+(defun custom-tag-mouse-down-action (widget &rest args)
+ "Pass :mouse-down-action to first child of WIDGET's parent."
+ (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+ :mouse-down-action args))
(defun custom-variable-state-set (widget)
"Set the state of WIDGET."
(error nil))
'saved
'changed))
- ((setq tmp (get symbol 'factory-value))
+ ((setq tmp (get symbol 'standard-value))
(if (condition-case nil
(equal value (eval (car tmp)))
(error nil))
- 'factory
+ 'standard
'changed))
(t 'rogue))))
(widget-put widget :custom-state state)))
(defvar custom-variable-menu
- '(("Hide" custom-toggle-hide
- (lambda (widget)
- (not (memq (widget-get widget :custom-state) '(modified invalid)))))
- ("Edit" custom-variable-edit
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'edit))))
- ("Edit Lisp" custom-variable-edit-lisp
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'lisp))))
- ("Set" custom-variable-set
+ '(("Set" custom-variable-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
("Save" custom-variable-save
("Reset to Current" custom-redraw
(lambda (widget)
(and (default-boundp (widget-value widget))
- (memq (widget-get widget :custom-state) '(modified)))))
+ (memq (widget-get widget :custom-state) '(modified changed)))))
("Reset to Saved" custom-variable-reset-saved
(lambda (widget)
(and (get (widget-value widget) 'saved-value)
(memq (widget-get widget :custom-state)
'(modified set changed rogue)))))
- ("Reset to Factory Settings" custom-variable-reset-factory
+ ("Reset to Standard Settings" custom-variable-reset-standard
(lambda (widget)
- (and (get (widget-value widget) 'factory-value)
+ (and (get (widget-value widget) 'standard-value)
(memq (widget-get widget :custom-state)
- '(modified set changed saved rogue))))))
+ '(modified set changed saved rogue)))))
+ ("---" ignore ignore)
+ ("Don't show as Lisp expression" custom-variable-edit
+ (lambda (widget)
+ (not (eq (widget-get widget :custom-form) 'edit))))
+ ("Show as Lisp expression" custom-variable-edit-lisp
+ (lambda (widget)
+ (not (eq (widget-get widget :custom-form) 'lisp)))))
"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
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
(custom-toggle-hide widget)
+ (unless (eq (widget-get widget :custom-state) 'modified)
+ (custom-variable-state-set widget))
+ (custom-redraw-magic widget)
(let* ((completion-ignore-case t)
- (answer (widget-choose (custom-unlispify-tag-name
- (widget-get widget :value))
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name
+ (widget-get widget :value)))
(custom-menu-filter custom-variable-menu
widget)
event)))
(widget-put widget :custom-state 'unknown)
(custom-redraw widget)))
-(defun custom-variable-reset-factory (widget)
- "Restore the factory setting for the variable being edited by WIDGET."
+(defun custom-variable-reset-standard (widget)
+ "Restore the standard setting for the variable being edited by WIDGET."
(let* ((symbol (widget-value widget))
(set (or (get symbol 'custom-set) 'set-default)))
- (if (get symbol 'factory-value)
- (funcall set symbol (eval (car (get symbol 'factory-value))))
- (error "No factory default for %S" symbol))
+ (if (get symbol 'standard-value)
+ (funcall set symbol (eval (car (get symbol 'standard-value))))
+ (error "No standard setting known for %S" symbol))
(put symbol 'customized-value nil)
(when (get symbol 'saved-value)
(put symbol 'saved-value nil)
(define-widget 'custom-face 'custom
"Customize face."
- :format "%l%{%t%}: %s%m%h%a%v"
- :format-handler 'custom-face-format-handler
:sample-face 'custom-face-tag-face
:help-echo "Set or reset this face."
:documentation-property '(lambda (face)
(face-doc-string face))
:value-create 'custom-face-value-create
:action 'custom-face-action
+ :custom-category 'face
:custom-form 'selected
:custom-set 'custom-face-set
:custom-save 'custom-face-save
:custom-reset-current 'custom-redraw
:custom-reset-saved 'custom-face-reset-saved
- :custom-reset-factory 'custom-face-reset-factory
+ :custom-reset-standard 'custom-face-reset-standard
:custom-menu 'custom-face-menu-create)
-(defun custom-face-format-handler (widget escape)
- ;; We recognize extra escape sequences.
- (let (child
- (symbol (widget-get widget :value)))
- (cond ((eq escape ?s)
- (and (string-match "XEmacs" emacs-version)
- ;; XEmacs cannot display initialized faces.
- (not (custom-facep symbol))
- (copy-face 'custom-face-empty symbol))
- (setq child (widget-create-child-and-convert
- widget 'item
- :format "(%{%t%})\n"
- :sample-face symbol
- :tag "sample")))
- (t
- (custom-format-handler widget escape)))
- (when child
- (widget-put widget
- :buttons (cons child (widget-get widget :buttons))))))
-
(define-widget 'custom-face-all 'editable-list
"An editable list of display specifications and attributes."
:entry-format "%i %d %v"
(defun custom-display-unselected-match (widget value)
"Non-nil if VALUE is an unselected display specification."
- (not (custom-display-match-frame value (selected-frame))))
+ (not (face-spec-set-match-display value (selected-frame))))
(define-widget 'custom-face-selected 'group
"Edit the attributes of the selected display in a face specification."
"Converted version of the `custom-face-selected' widget.")
(defun custom-face-value-create (widget)
- ;; Create a list of the display specifications.
- (unless (eq (preceding-char) ?\n)
- (insert "\n"))
- (when (not (eq (widget-get widget :custom-state) 'hidden))
- (message "Creating face editor...")
- (custom-load-widget widget)
- (let* ((symbol (widget-value widget))
- (spec (or (get symbol 'saved-face)
- (get symbol 'factory-face)
- ;; Attempt to construct it.
- (list (list t (custom-face-attributes-get
- symbol (selected-frame))))))
- (form (widget-get widget :custom-form))
- (indent (widget-get widget :indent))
- (edit (widget-create-child-and-convert
- widget
- (cond ((and (eq form 'selected)
- (widget-apply custom-face-selected :match spec))
- (when indent (insert-char ?\ indent))
- 'custom-face-selected)
- ((and (not (eq form 'lisp))
- (widget-apply custom-face-all :match spec))
- 'custom-face-all)
- (t
- (when indent (insert-char ?\ indent))
- 'sexp))
- :value spec)))
- (custom-face-state-set widget)
- (widget-put widget :children (list edit)))
- (message "Creating face editor...done")))
+ "Create a list of the display specifications for WIDGET."
+ (let ((buttons (widget-get widget :buttons))
+ (symbol (widget-get widget :value))
+ (tag (widget-get widget :tag))
+ (state (widget-get widget :custom-state))
+ (begin (point))
+ (is-last (widget-get widget :custom-last))
+ (prefix (widget-get widget :custom-prefix)))
+ (unless tag
+ (setq tag (prin1-to-string symbol)))
+ (cond ((eq custom-buffer-style 'tree)
+ (insert prefix (if is-last " +--- " " |--- "))
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-face-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ (t
+ ;; Create tag.
+ (insert tag)
+ (if (eq custom-buffer-style 'face)
+ (insert " ")
+ (widget-specify-sample widget begin (point))
+ (insert ": "))
+ ;; Sample.
+ (and (string-match "XEmacs" emacs-version)
+ ;; XEmacs cannot display uninitialized faces.
+ (not (custom-facep symbol))
+ (copy-face 'custom-face-empty symbol))
+ (push (widget-create-child-and-convert widget 'item
+ :format "(%{%t%})"
+ :sample-face symbol
+ :tag "sample")
+ buttons)
+ ;; Visibility.
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Hide or show this face."
+ :action 'custom-toggle-parent
+ (not (eq state 'hidden)))
+ buttons)
+ ;; Magic.
+ (insert "\n")
+ (let ((magic (widget-create-child-and-convert
+ widget 'custom-magic nil)))
+ (widget-put widget :custom-magic magic)
+ (push magic buttons))
+ ;; Update buttons.
+ (widget-put widget :buttons buttons)
+ ;; Insert documentation.
+ (widget-default-format-handler widget ?h)
+ ;; See also.
+ (unless (eq state 'hidden)
+ (when (eq (widget-get widget :custom-level) 1)
+ (custom-add-parent-links widget))
+ (custom-add-see-also widget))
+ ;; Editor.
+ (unless (eq (preceding-char) ?\n)
+ (insert "\n"))
+ (unless (eq state 'hidden)
+ (message "Creating face editor...")
+ (custom-load-widget widget)
+ (let* ((symbol (widget-value widget))
+ (spec (or (get symbol 'saved-face)
+ (get symbol 'face-defface-spec)
+ ;; Attempt to construct it.
+ (list (list t (custom-face-attributes-get
+ symbol (selected-frame))))))
+ (form (widget-get widget :custom-form))
+ (indent (widget-get widget :indent))
+ (edit (widget-create-child-and-convert
+ widget
+ (cond ((and (eq form 'selected)
+ (widget-apply custom-face-selected
+ :match spec))
+ (when indent (insert-char ?\ indent))
+ 'custom-face-selected)
+ ((and (not (eq form 'lisp))
+ (widget-apply custom-face-all
+ :match spec))
+ 'custom-face-all)
+ (t
+ (when indent (insert-char ?\ indent))
+ 'sexp))
+ :value spec)))
+ (custom-face-state-set widget)
+ (widget-put widget :children (list edit)))
+ (message "Creating face editor...done"))))))
(defvar custom-face-menu
- '(("Hide" custom-toggle-hide
+ '(("Set" custom-face-set)
+ ("Save" custom-face-save)
+ ("Reset to Saved" custom-face-reset-saved
(lambda (widget)
- (not (memq (widget-get widget :custom-state) '(modified invalid)))))
- ("Edit Selected" custom-face-edit-selected
+ (get (widget-value widget) 'saved-face)))
+ ("Reset to Standard Setting" custom-face-reset-standard
(lambda (widget)
- (not (eq (widget-get widget :custom-form) 'selected))))
- ("Edit All" custom-face-edit-all
+ (get (widget-value widget) 'face-defface-spec)))
+ ("---" ignore ignore)
+ ("Show all display specs" custom-face-edit-all
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'all))))
- ("Edit Lisp" custom-face-edit-lisp
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'lisp))))
- ("Set" custom-face-set)
- ("Save" custom-face-save)
- ("Reset to Saved" custom-face-reset-saved
+ ("Just current attributes" custom-face-edit-selected
(lambda (widget)
- (get (widget-value widget) 'saved-face)))
- ("Reset to Factory Setting" custom-face-reset-factory
+ (not (eq (widget-get widget :custom-form) 'selected))))
+ ("Show as Lisp expression" custom-face-edit-lisp
(lambda (widget)
- (get (widget-value widget) 'factory-face))))
+ (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
'set)
((get symbol 'saved-face)
'saved)
- ((get symbol 'factory-face)
- 'factory)
+ ((get symbol 'face-defface-spec)
+ 'standard)
(t
'rogue)))))
(custom-toggle-hide widget)
(let* ((completion-ignore-case t)
(symbol (widget-get widget :value))
- (answer (widget-choose (custom-unlispify-tag-name symbol)
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name symbol))
(custom-menu-filter custom-face-menu
widget)
event)))
(child (car (widget-get widget :children)))
(value (widget-value child)))
(put symbol 'customized-face value)
- (custom-face-display-set symbol value)
+ (face-spec-set symbol value)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (widget-value child)))
- (custom-face-display-set symbol value)
+ (face-spec-set symbol value)
(put symbol 'saved-face value)
(put symbol 'customized-face nil)
(custom-face-state-set widget)
(unless value
(error "No saved value for this face"))
(put symbol 'customized-face nil)
- (custom-face-display-set symbol value)
+ (face-spec-set symbol value)
(widget-value-set child value)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
-(defun custom-face-reset-factory (widget)
- "Restore WIDGET to the face's factory settings."
+(defun custom-face-reset-standard (widget)
+ "Restore WIDGET to the face's standard settings."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
- (value (get symbol 'factory-face)))
+ (value (get symbol 'face-defface-spec)))
(unless value
- (error "No factory default for this face"))
+ (error "No standard setting for this face"))
(put symbol 'customized-face nil)
(when (get symbol 'saved-face)
(put symbol 'saved-face nil)
(custom-save-all))
- (custom-face-display-set symbol value)
+ (face-spec-set symbol value)
(widget-value-set child value)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
(define-widget 'face 'default
"Select and customize a face."
- :convert-widget 'widget-item-convert-widget
- :format "%[%t%]: %v"
+ :convert-widget 'widget-value-convert-widget
+ :button-prefix 'widget-push-button-prefix
+ :button-suffix 'widget-push-button-suffix
+ :format "%t: %[select face%] %v"
:tag "Face"
:value 'default
:value-create 'widget-face-value-create
:value-delete 'widget-face-value-delete
- :value-get 'widget-item-value-get
- :validate 'widget-editable-list-validate
+ :value-get 'widget-value-value-get
+ :validate 'widget-children-validate
:action 'widget-face-action
:match '(lambda (widget value) (symbolp value)))
(defun widget-face-value-create (widget)
;; Create a `custom-face' child.
(let* ((symbol (widget-value widget))
+ (custom-buffer-style 'face)
(child (widget-create-child-and-convert
widget 'custom-face
- :format "%t %s%m%h%v"
:custom-level nil
:value symbol)))
(custom-magic-reset child)
(widget-put widget :args args)
widget))
+;;; The `custom-group-link' Widget.
+
+(define-widget 'custom-group-link 'link
+ "Show parent in other window when activated."
+ :help-echo "Create customize buffer for this group group."
+ :action 'custom-group-link-action)
+
+(defun custom-group-link-action (widget &rest ignore)
+ (customize-group (widget-value widget)))
+
;;; The `custom-group' Widget.
(defcustom custom-group-tag-faces '(custom-group-tag-face-1)
(define-widget 'custom-group 'custom
"Customize group."
- :format "%l%{%t%}:%L\n%m%h%a%v"
+ :format "%v"
:sample-face-get 'custom-group-sample-face-get
:documentation-property 'group-documentation
:help-echo "Set or reset all members of this group."
:value-create 'custom-group-value-create
:action 'custom-group-action
+ :custom-category 'group
:custom-set 'custom-group-set
:custom-save 'custom-group-save
:custom-reset-current 'custom-group-reset-current
:custom-reset-saved 'custom-group-reset-saved
- :custom-reset-factory 'custom-group-reset-factory
+ :custom-reset-standard 'custom-group-reset-standard
:custom-menu 'custom-group-menu-create)
(defun custom-group-sample-face-get (widget)
(or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
'custom-group-tag-face))
+(define-widget 'custom-group-visibility 'visibility
+ "An indicator and manipulator for hidden group contents."
+ :create 'custom-group-visibility-create)
+
+(defun custom-group-visibility-create (widget)
+ (let ((visible (widget-value widget)))
+ (if visible
+ (insert "--------")))
+ (widget-default-create widget))
+
(defun custom-group-value-create (widget)
- (let ((state (widget-get widget :custom-state)))
- (unless (eq state 'hidden)
- (message "Creating group...")
- (custom-load-widget widget)
- (let* ((level (widget-get widget :custom-level))
- (symbol (widget-value widget))
- (members (get symbol 'custom-group))
- (prefixes (widget-get widget :custom-prefixes))
- (custom-prefix-list (custom-prefix-add symbol prefixes))
- (length (length members))
- (count 0)
- (children (mapcar (lambda (entry)
- (widget-insert "\n")
- (message "Creating group members... %2d%%"
- (/ (* 100.0 count) length))
- (setq count (1+ count))
- (prog1
- (widget-create-child-and-convert
- widget (nth 1 entry)
- :group widget
- :tag (custom-unlispify-tag-name
- (nth 0 entry))
- :custom-prefixes custom-prefix-list
- :custom-level (1+ level)
- :value (nth 0 entry))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))))
- members)))
- (message "Creating group magic...")
- (mapcar 'custom-magic-reset children)
- (message "Creating group state...")
- (widget-put widget :children children)
- (custom-group-state-update widget)
- (message "Creating group... done")))))
+ "Insert a customize group for WIDGET in the current buffer."
+ (let ((state (widget-get widget :custom-state))
+ (level (widget-get widget :custom-level))
+ (indent (widget-get widget :indent))
+ (prefix (widget-get widget :custom-prefix))
+ (buttons (widget-get widget :buttons))
+ (tag (widget-get widget :tag))
+ (symbol (widget-value widget)))
+ (cond ((and (eq custom-buffer-style 'tree)
+ (eq state 'hidden))
+ (insert prefix)
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-visibility :tag "+")
+ buttons)
+ (insert "-- ")
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ ((and (eq custom-buffer-style 'tree)
+ (zerop (length (get symbol 'custom-group))))
+ (insert prefix "[ ]-- ")
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ ((eq custom-buffer-style 'tree)
+ (insert prefix)
+ (custom-load-widget widget)
+ (if (zerop (length (get symbol 'custom-group)))
+ (progn
+ (insert prefix "[ ]-- ")
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-visibility :tag "-")
+ buttons)
+ (insert "-+ ")
+ (push (widget-create-child-and-convert
+ widget 'custom-tree-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons)
+ (message "Creating group...")
+ (let* ((members (copy-sequence (get symbol 'custom-group)))
+ (prefixes (widget-get widget :custom-prefixes))
+ (custom-prefix-list (custom-prefix-add symbol prefixes))
+ (length (length members))
+ (extra-prefix (if (widget-get widget :custom-last)
+ " "
+ " | "))
+ (prefix (concat prefix extra-prefix))
+ children entry)
+ (while members
+ (setq entry (car members)
+ members (cdr members))
+ (push (widget-create-child-and-convert
+ widget (nth 1 entry)
+ :group widget
+ :tag (custom-unlispify-tag-name
+ (nth 0 entry))
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :custom-last (null members)
+ :value (nth 0 entry)
+ :custom-prefix prefix)
+ children))
+ (widget-put widget :children (reverse children)))
+ (message "Creating group...done")))
+ ;; Nested style.
+ ((eq state 'hidden)
+ ;; Create level indicator.
+ (unless (eq custom-buffer-style 'links)
+ (insert-char ?\ (* custom-buffer-indent (1- level)))
+ (insert "-- "))
+ ;; Create tag.
+ (let ((begin (point)))
+ (insert tag)
+ (widget-specify-sample widget begin (point)))
+ (insert " group: ")
+ ;; Create link/visibility indicator.
+ (if (eq custom-buffer-style 'links)
+ (push (widget-create-child-and-convert
+ widget 'custom-group-link
+ :tag "Show"
+ symbol)
+ buttons)
+ (push (widget-create-child-and-convert
+ widget 'group-visibility
+ :help-echo "Show members of this group."
+ :action 'custom-toggle-parent
+ (not (eq state 'hidden)))
+ buttons))
+ (insert " \n")
+ ;; Create magic button.
+ (let ((magic (widget-create-child-and-convert
+ widget 'custom-magic nil)))
+ (widget-put widget :custom-magic magic)
+ (push magic buttons))
+ ;; Update buttons.
+ (widget-put widget :buttons buttons)
+ ;; Insert documentation.
+ (if (and (eq custom-buffer-style 'links) (> level 1))
+ (widget-put widget :documentation-indent 0))
+ (widget-default-format-handler widget ?h))
+ ;; Nested style.
+ (t ;Visible.
+ ;; Add parent groups references above the group.
+ (if t ;;; This should test that the buffer
+ ;;; was made to display a group.
+ (when (eq level 1)
+ (if (custom-add-parent-links widget
+ "Go to parent group:")
+ (insert "\n"))))
+ ;; Create level indicator.
+ (insert-char ?\ (* custom-buffer-indent (1- level)))
+ (insert "/- ")
+ ;; Create tag.
+ (let ((start (point)))
+ (insert tag)
+ (widget-specify-sample widget start (point)))
+ (insert " group: ")
+ ;; Create visibility indicator.
+ (unless (eq custom-buffer-style 'links)
+ (insert "--------")
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Hide members of this group."
+ :action 'custom-toggle-parent
+ (not (eq state 'hidden)))
+ buttons)
+ (insert " "))
+ ;; Create more dashes.
+ ;; Use 76 instead of 75 to compensate for the temporary "<"
+ ;; added by `widget-insert'.
+ (insert-char ?- (- 76 (current-column)
+ (* custom-buffer-indent level)))
+ (insert "\\\n")
+ ;; Create magic button.
+ (let ((magic (widget-create-child-and-convert
+ widget 'custom-magic
+ :indent 0
+ nil)))
+ (widget-put widget :custom-magic magic)
+ (push magic buttons))
+ ;; Update buttons.
+ (widget-put widget :buttons buttons)
+ ;; Insert documentation.
+ (widget-default-format-handler widget ?h)
+ ;; Parent groups.
+ (if nil ;;; This should test that the buffer
+ ;;; was not made to display a group.
+ (when (eq level 1)
+ (insert-char ?\ custom-buffer-indent)
+ (custom-add-parent-links widget)))
+ (custom-add-see-also widget
+ (make-string (* custom-buffer-indent level)
+ ?\ ))
+ ;; Members.
+ (message "Creating group...")
+ (custom-load-widget widget)
+ (let* ((members (sort (copy-sequence (get symbol 'custom-group))
+ 'custom-buffer-sort-predicate))
+ (prefixes (widget-get widget :custom-prefixes))
+ (custom-prefix-list (custom-prefix-add symbol prefixes))
+ (length (length members))
+ (count 0)
+ (children (mapcar (lambda (entry)
+ (widget-insert "\n")
+ (message "\
+Creating group members... %2d%%"
+ (/ (* 100.0 count) length))
+ (setq count (1+ count))
+ (prog1
+ (widget-create-child-and-convert
+ widget (nth 1 entry)
+ :group widget
+ :tag (custom-unlispify-tag-name
+ (nth 0 entry))
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :value (nth 0 entry))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))))
+ members)))
+ (message "Creating group magic...")
+ (mapcar 'custom-magic-reset children)
+ (message "Creating group state...")
+ (widget-put widget :children children)
+ (custom-group-state-update widget)
+ (message "Creating group... done"))
+ ;; End line
+ (insert "\n")
+ (insert-char ?\ (* custom-buffer-indent (1- level)))
+ (insert "\\- " (widget-get widget :tag) " group end ")
+ (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
+ (insert "/\n")))))
(defvar custom-group-menu
- '(("Hide" custom-toggle-hide
- (lambda (widget)
- (not (memq (widget-get widget :custom-state) '(modified invalid)))))
- ("Set" custom-group-set
+ '(("Set" custom-group-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
("Save" custom-group-save
(memq (widget-get widget :custom-state) '(modified set))))
("Reset to Current" custom-group-reset-current
(lambda (widget)
- (and (default-boundp (widget-value widget))
- (memq (widget-get widget :custom-state) '(modified)))))
+ (memq (widget-get widget :custom-state) '(modified))))
("Reset to Saved" custom-group-reset-saved
(lambda (widget)
- (and (get (widget-value widget) 'saved-value)
- (memq (widget-get widget :custom-state) '(modified set)))))
- ("Reset to Factory" custom-group-reset-factory
+ (memq (widget-get widget :custom-state) '(modified set))))
+ ("Reset to standard setting" custom-group-reset-standard
(lambda (widget)
- (and (get (widget-value widget) 'factory-value)
- (memq (widget-get widget :custom-state) '(modified set saved))))))
+ (memq (widget-get widget :custom-state) '(modified set saved)))))
"Alist of actions for the `custom-group' 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
(if (eq (widget-get widget :custom-state) 'hidden)
(custom-toggle-hide widget)
(let* ((completion-ignore-case t)
- (answer (widget-choose (custom-unlispify-tag-name
- (widget-get widget :value))
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name
+ (widget-get widget :value)))
(custom-menu-filter custom-group-menu
widget)
event)))
(widget-apply child :custom-reset-saved)))
children )))
-(defun custom-group-reset-factory (widget)
+(defun custom-group-reset-standard (widget)
"Reset all modified, set, or saved group members."
(let ((children (widget-get widget :children)))
(mapcar (lambda (child)
(when (memq (widget-get child :custom-state)
'(modified set saved))
- (widget-apply child :custom-reset-factory)))
+ (widget-apply child :custom-reset-standard)))
children )))
(defun custom-group-state-update (widget)
(widget-get child :custom-state))
children))
(magics custom-magic-alist)
- (found 'factory))
+ (found 'standard))
(while magics
(let ((magic (car (car magics))))
(if (and (not (eq magic 'hidden))
(custom-magic-reset widget))
;;; The `custom-save-all' Function.
-
-(defcustom custom-file "~/.emacs"
+;;;###autoload
+(defcustom custom-file (if (featurep 'xemacs)
+ "~/.xemacs-custom"
+ "~/.emacs")
"File used for storing customization information.
If you change this from the default \"~/.emacs\" you need to
explicitly load that file for the settings to take effect."
(mapatoms (lambda (symbol)
(let ((value (get symbol 'saved-value))
(requests (get symbol 'custom-requests))
- (now (not (or (get symbol 'factory-value)
+ (now (not (or (get symbol 'standard-value)
(and (not (boundp symbol))
(not (get symbol 'force-value)))))))
(when value
(when value
(princ "\n '(default ")
(prin1 value)
- (if (or (get 'default 'factory-face)
+ (if (or (get 'default 'face-defface-spec)
(and (not (custom-facep 'default))
(not (get 'default 'force-face))))
(princ ")")
(princ symbol)
(princ " ")
(prin1 value)
- (if (or (get symbol 'factory-face)
+ (if (or (get symbol 'face-defface-spec)
(and (not (custom-facep symbol))
(not (get symbol 'force-face))))
(princ ")")
(princ "\n")))))
;;;###autoload
-(defun custom-save-customized ()
+(defun customize-save-customized ()
"Save all user options which have been set in this session."
(interactive)
(mapatoms (lambda (symbol)
;;; Menu support
(unless (string-match "XEmacs" emacs-version)
- (defconst custom-help-menu '("Customize"
- ["Update menu..." custom-menu-update t]
- ["Group..." customize t]
- ["Variable..." customize-variable t]
- ["Face..." customize-face t]
- ["Saved..." customize-customized t]
- ["Apropos..." customize-apropos t])
+ (defconst custom-help-menu
+ '("Customize"
+ ["Update menu..." Custom-menu-update t]
+ ["Group..." customize-group t]
+ ["Variable..." customize-variable t]
+ ["Face..." customize-face t]
+ ["Saved..." customize-saved t]
+ ["Set..." customize-customized t]
+ ["--" custom-menu-sep t]
+ ["Apropos..." customize-apropos t]
+ ["Group apropos..." customize-apropos-groups t]
+ ["Variable apropos..." customize-apropos-options t]
+ ["Face apropos..." customize-apropos-faces t])
;; This menu should be identical to the one defined in `menu-bar.el'.
"Customize menu")
(easy-menu-create-keymaps (car custom-help-menu)
(cdr custom-help-menu)))))
- (defun custom-menu-update (event)
+ (defun Custom-menu-update (event)
"Update customize menu."
(interactive "e")
(add-hook 'custom-define-hook 'custom-menu-reset)
,@(cdr (cdr custom-help-menu)))))
(let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
(define-key global-map [menu-bar help-menu customize-menu]
- (cons (car menu) map)))))
+ (cons (car menu) map))))))
- (defcustom custom-menu-nesting 2
- "Maximum nesting in custom menus."
- :type 'integer
- :group 'customize))
+(defcustom custom-menu-nesting 2
+ "Maximum nesting in custom menus."
+ :type 'integer
+ :group 'custom-menu)
(defun custom-face-menu-create (widget symbol)
"Ignoring WIDGET, create a menu entry for customization face SYMBOL."
(vector (custom-unlispify-menu-entry symbol)
- `(custom-buffer-create '((,symbol custom-face)))
+ `(customize-face ',symbol)
t))
(defun custom-variable-menu-create (widget symbol)
(if (and type (widget-get type :custom-menu))
(widget-apply type :custom-menu symbol)
(vector (custom-unlispify-menu-entry symbol)
- `(custom-buffer-create '((,symbol custom-variable)))
+ `(customize-variable ',symbol)
t))))
;; Add checkboxes to boolean variable entries.
(widget-put (get 'boolean 'widget-type)
:custom-menu (lambda (widget symbol)
(vector (custom-unlispify-menu-entry symbol)
- `(custom-buffer-create
- '((,symbol custom-variable)))
+ `(customize-variable ',symbol)
':style 'toggle
':selected symbol)))
"Create menu for customization group SYMBOL.
The menu is in a format applicable to `easy-menu-define'."
(let* ((item (vector (custom-unlispify-menu-entry symbol)
- `(custom-buffer-create '((,symbol custom-group)))
+ `(customize-group ',symbol)
t)))
(if (and (or (not (boundp 'custom-menu-nesting))
(>= custom-menu-nesting 0))
(< (length (get symbol 'custom-group)) widget-menu-max-size))
(let ((custom-prefix-list (custom-prefix-add symbol
- custom-prefix-list)))
+ custom-prefix-list))
+ (members (sort (copy-sequence (get symbol 'custom-group))
+ 'custom-menu-sort-predicate)))
(custom-load-symbol symbol)
`(,(custom-unlispify-menu-entry symbol t)
,item
(nth 1 entry)
(list (nth 1 entry)))
:custom-menu (nth 0 entry)))
- (get symbol 'custom-group))))
+ members)))
item)))
;;;###autoload
(unless custom-mode-map
(setq custom-mode-map (make-sparse-keymap))
(set-keymap-parent custom-mode-map widget-keymap)
+ (suppress-keymap custom-mode-map)
(define-key custom-mode-map "q" 'bury-buffer))
-(easy-menu-define custom-mode-customize-menu
- custom-mode-map
- "Menu used to customize customization buffers."
- (customize-menu-create 'customize))
-
-(easy-menu-define custom-mode-menu
+(easy-menu-define Custom-mode-menu
custom-mode-map
"Menu used in customization buffers."
`("Custom"
- ["Set" custom-set t]
- ["Save" custom-save t]
- ["Reset to Current" custom-reset-current t]
- ["Reset to Saved" custom-reset-saved t]
- ["Reset to Factory Settings" custom-reset-factory t]
+ ,(customize-menu-create 'customize)
+ ["Set" Custom-set t]
+ ["Save" Custom-save 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 "(custom)The Customization Buffer") t]))
(defcustom custom-mode-hook nil
"Hook called when entering custom-mode."
:type 'hook
- :group 'customize)
+ :group 'custom-buffer )
+
+(defun custom-state-buffer-message ()
+ (message "To set the value, invoke [State] and choose the Set operation"))
(defun custom-mode ()
"Major mode for editing customization buffers.
Move to next button or editable field. \\[widget-forward]
Move to previous button or editable field. \\[widget-backward]
-Activate button under the mouse pointer. \\[widget-button-click]
-Activate button under point. \\[widget-button-press]
-Set all modifications. \\[custom-set]
-Make all modifications default. \\[custom-save]
-Reset all modified options. \\[custom-reset-current]
-Reset all modified or set options. \\[custom-reset-saved]
-Reset all options. \\[custom-reset-factory]
+Invoke button under the mouse pointer. \\[widget-button-click]
+Invoke button under point. \\[widget-button-press]
+Set all modifications. \\[Custom-set]
+Make all modifications default. \\[Custom-save]
+Reset all modified options. \\[Custom-reset-current]
+Reset all modified or set options. \\[Custom-reset-saved]
+Reset all options. \\[Custom-reset-standard]
Entry to this mode calls the value of `custom-mode-hook'
if that value is non-nil."
(setq major-mode 'custom-mode
mode-name "Custom")
(use-local-map custom-mode-map)
- (easy-menu-add custom-mode-customize-menu)
- (easy-menu-add custom-mode-menu)
+ (easy-menu-add Custom-mode-menu)
(make-local-variable 'custom-options)
+ (make-local-hook 'widget-edit-hook)
+ (add-hook 'widget-edit-hook 'custom-state-buffer-message nil t)
(run-hooks 'custom-mode-hook))
;;; The End.