-;;; cus-edit.el --- Tools for customization Emacs.
+;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.84
+;; Version: 1.9954
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
;;; Commentary:
;;
+;; This file implements the code to create and edit customize buffers.
+;;
;; See `custom.el'.
+;; No commands should have names starting with `custom-' because
+;; that interferes with completion. Use `customize-' for commands
+;; that the user will run with M-x, and `Custom-' for interactive commands.
+
;;; Code:
(require 'cus-face)
(require 'wid-edit)
(require 'easymenu)
+(eval-when-compile (require 'cl))
-(defun custom-face-display-set (face spec &optional frame)
- (face-spec-set face spec frame))
+(condition-case nil
+ (require 'cus-load)
+ (error nil))
-(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-browse nil
+ "Control customize browser."
+ :prefix "custom-"
+ :group 'customize)
+
+(defgroup custom-buffer nil
+ "Control customize buffers."
+ :prefix "custom-"
+ :group 'customize)
+
+(defgroup custom-menu nil
+ "Control 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 'boundp t))
+ 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'.
+MENU should be in the same format as `custom-variable-menu'.
+WIDGET is the widget to apply the filter entries of MENU on."
+ (let ((result nil)
+ current name action filter)
+ (while menu
+ (setq current (car menu)
+ name (nth 0 current)
+ action (nth 1 current)
+ filter (nth 2 current)
+ menu (cdr menu))
+ (if (or (null filter) (funcall filter widget))
+ (push (cons name action) result)
+ (push name result)))
+ (nreverse result)))
;;; Unlispify.
(defcustom custom-unlispify-menu-entries t
"Display menu entries as words instead of symbols if non nil."
- :group 'customize
+ :group 'custom-menu
+ :type 'boolean)
+
+(defcustom custom-unlispify-remove-prefixes nil
+ "Non-nil means remove group prefixes from option names in buffer."
+ :group 'custom-menu
:type 'boolean)
(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
(re-search-forward "-p\\'" nil t))
(replace-match "" t t)
(goto-char (point-min)))
- (let ((prefixes custom-prefix-list)
- prefix)
- (while prefixes
- (setq prefix (car prefixes))
- (if (search-forward prefix (+ (point) (length prefix)) t)
- (progn
- (setq prefixes nil)
- (delete-region (point-min) (point)))
- (setq prefixes (cdr prefixes)))))
+ (if custom-unlispify-remove-prefixes
+ (let ((prefixes custom-prefix-list)
+ prefix)
+ (while prefixes
+ (setq prefix (car prefixes))
+ (if (search-forward prefix (+ (point) (length prefix)) t)
+ (progn
+ (setq prefixes nil)
+ (delete-region (point-min) (point)))
+ (setq prefixes (cdr prefixes))))))
(subst-char-in-region (point-min) (point-max) ?- ?\ t)
(capitalize-region (point-min) (point-max))
(unless 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-browse-sort-alphabetically nil
+ "If non-nil, sort members of each customization group alphabetically."
+ :type 'boolean
+ :group 'custom-browse)
+
+(defcustom custom-browse-order-groups nil
+ "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+ :type '(choice (const first)
+ (const last)
+ (const :tag "none" nil))
+ :group 'custom-browse)
+
+(defcustom custom-browse-only-groups nil
+ "If non-nil, show group members only within each customization group."
+ :type 'boolean
+ :group 'custom-browse)
+
+(defcustom custom-buffer-sort-alphabetically nil
+ "If non-nil, sort members of each customization group alphabetically."
+ :type 'boolean
+ :group 'custom-buffer)
+
+(defcustom custom-buffer-order-groups 'last
+ "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+ :type '(choice (const first)
+ (const last)
+ (const :tag "none" nil))
+ :group 'custom-buffer)
+
+(defcustom custom-menu-sort-alphabetically nil
+ "If non-nil, sort members of each customization group alphabetically."
+ :type 'boolean
+ :group 'custom-menu)
+
+(defcustom custom-menu-order-groups 'first
+ "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+ :type '(choice (const first)
+ (const last)
+ (const :tag "none" nil))
+ :group 'custom-menu)
+
+(defun custom-sort-items (items sort-alphabetically order-groups)
+ "Return a sorted copy of ITEMS.
+ITEMS should be a `custom-group' property.
+If SORT-ALPHABETICALLY non-nil, sort alphabetically.
+If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
+groups after non-groups, if nil do not order groups at all."
+ (sort (copy-sequence items)
+ (lambda (a b)
+ (let ((typea (nth 1 a)) (typeb (nth 1 b))
+ (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b))))
+ (cond ((not order-groups)
+ ;; Since we don't care about A and B order, maybe sort.
+ (when sort-alphabetically
+ (string-lessp namea nameb)))
+ ((eq typea 'custom-group)
+ ;; If B is also a group, maybe sort. Otherwise, order A and B.
+ (if (eq typeb 'custom-group)
+ (when sort-alphabetically
+ (string-lessp namea nameb))
+ (eq order-groups 'first)))
+ ((eq typeb 'custom-group)
+ ;; Since A cannot be a group, order A and B.
+ (eq order-groups 'last))
+ (sort-alphabetically
+ ;; Since A and B cannot be groups, sort.
+ (string-lessp namea nameb)))))))
+
;;; 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
+(defun custom-prompt-variable (prompt-var prompt-val)
+ "Prompt for a variable and a value and return them as a list.
+PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
+prompt for the value. The %s escape in PROMPT-VAL is replaced with
+the name of the variable.
+
+If the variable has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If the variable has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value."
+ (let* ((var (read-variable prompt-var))
+ (minibuffer-help-form '(describe-variable var)))
+ (list var
+ (let ((prop (get var 'variable-interactive))
+ (type (get var 'custom-type))
+ (prompt (format prompt-val var)))
+ (unless (listp type)
+ (setq type (list type)))
+ (cond (prop
+ ;; Use VAR's `variable-interactive' property
+ ;; as an interactive spec for prompting.
+ (call-interactively (list 'lambda '(arg)
+ (list 'interactive prop)
+ 'arg)))
+ (type
+ (widget-prompt-value type
+ prompt
+ (if (boundp var)
+ (symbol-value var))
+ (not (boundp var))))
+ (t
+ (eval-minibuffer prompt)))))))
+
;;;###autoload
-(defun customize (symbol)
+(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
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value."
+ (interactive (custom-prompt-variable "Set variable: "
+ "Set %s to value: "))
+
+ (set var val))
+
+;;;###autoload
+(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
+VARIABLE, otherwise `set-default' is used.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value. "
+ (interactive (custom-prompt-variable "Set variable: "
+ "Set customized value for %s to: "))
+ (funcall (or (get var 'custom-set) 'set-default) var val)
+ (put var 'customized-value (list (custom-quote val))))
+
+;;;###autoload
+(defun customize-save-variable (var val)
+ "Set the default for VARIABLE to VALUE, and save it for future sessions.
+If VARIABLE has a `custom-set' property, that is used for setting
+VARIABLE, otherwise `set-default' is used.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value. "
+ (interactive (custom-prompt-variable "Set and ave variable: "
+ "Set and save value for %s as: "))
+ (funcall (or (get var 'custom-set) 'set-default) var val)
+ (put var 'saved-value (list (custom-quote val)))
+ (custom-save-all))
+
+;;;###autoload
+(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))
+
+;;;###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)
+ (or (get symbol 'custom-loads)
+ (get symbol 'custom-group)))
+ t))))
+ (when (stringp group)
+ (if (string-equal "" group)
+ (setq group 'emacs)
+ (setq group (intern group))))
+ (or (get group 'custom-group)
+ (custom-load-symbol group))
+ (let ((name (format "*Customize Group: %s*"
+ (custom-unlispify-tag-name group))))
+ (if (get-buffer name)
+ (switch-to-buffer name)
+ (custom-buffer-create (list (list group 'custom-group))
+ name
+ (concat " for group "
+ (custom-unlispify-tag-name group))))))
+
+;;;###autoload
+(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 (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
+(defalias 'customize-variable-other-window 'customize-option-other-window)
;;;###autoload
-(defun customize-variable-other-window (symbol)
- "Customize SYMBOL, which must be a variable.
+(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)
(interactive (list (completing-read "Customize face: (default all) "
obarray 'custom-facep)))
(if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
- (let ((found nil))
- (message "Looking for faces...")
- (mapcar (lambda (symbol)
- (setq found (cons (list symbol 'custom-face) found)))
- (nreverse (mapcar 'intern
- (sort (mapcar 'symbol-name (face-list))
- 'string<))))
-
- (custom-buffer-create found))
- (if (stringp symbol)
- (setq symbol (intern symbol)))
+ (custom-buffer-create (custom-sort-items
+ (mapcar (lambda (symbol)
+ (list symbol 'custom-face))
+ (face-list))
+ t nil)
+ "*Customize Faces*")
+ (when (stringp symbol)
+ (setq symbol (intern symbol)))
(unless (symbolp symbol)
(error "Should be a symbol %S" symbol))
- (custom-buffer-create (list (list symbol 'custom-face)))))
+ (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 ()
- "Customize all already customized user options."
+ "Customize all user options set since the last save in this session."
+ (interactive)
+ (let ((found nil))
+ (mapatoms (lambda (symbol)
+ (and (get symbol 'customized-face)
+ (custom-facep symbol)
+ (push (list symbol 'custom-face) found))
+ (and (get symbol 'customized-value)
+ (boundp symbol)
+ (push (list symbol 'custom-variable) found))))
+ (if (not found)
+ (error "No customized user options")
+ (custom-buffer-create (custom-sort-items found t nil)
+ "*Customize Customized*"))))
+
+;;;###autoload
+(defun customize-saved ()
+ "Customize all already saved user options."
(interactive)
(let ((found nil))
(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)))))
- (if found
- (custom-buffer-create found)
- (error "No customized user options"))))
+ (push (list symbol 'custom-variable) found))))
+ (if (not found )
+ (error "No saved user options")
+ (custom-buffer-create (custom-sort-items found t nil)
+ "*Customize Saved*"))))
;;;###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")
+ (custom-buffer-create (custom-sort-items found t
+ custom-buffer-order-groups)
+ "*Customize Apropos*"))))
;;;###autoload
-(defun custom-buffer-create (options)
+(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 &optional name description)
"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*"))
- (custom-buffer-create-internal options))
+ (unless name (setq name "*Customization*"))
+ (kill-buffer (get-buffer-create name))
+ (switch-to-buffer (get-buffer-create name))
+ (custom-buffer-create-internal options description))
-(defun custom-buffer-create-other-window (options)
+;;;###autoload
+(defun custom-buffer-create-other-window (options &optional name description)
"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*"))
- (custom-buffer-create-internal options)
+ (switch-to-buffer-other-window (get-buffer-create name))
+ (custom-buffer-create-internal options description)
(select-window window)))
-
-(defun custom-buffer-create-internal (options)
+(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 &optional description)
(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)
+ (widget-insert "This is a customization buffer")
+ (if description
+ (widget-insert description))
+ (widget-insert ".
+Square brackets show active fields; type RET or click mouse-1
+on an active field to invoke its action. Editing an option value
+changes the text in the buffer; invoke the State button and
+choose the Set operation to set the option value.
+Invoke ")
(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 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)))
+ (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 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")
+ (message "Creating customization items %2d%%...done" 100)
+ (unless (eq custom-buffer-style 'tree)
+ (mapcar 'custom-magic-reset custom-options))
(message "Creating customization setup...")
(widget-setup)
(goto-char (point-min))
(message "Creating customization buffer...done"))
+;;; The Tree Browser.
+
+;;;###autoload
+(defun customize-browse (&optional group)
+ "Create a tree browser for the customize hierarchy."
+ (interactive)
+ (unless group
+ (setq group 'emacs))
+ (let ((name "*Customize Browser*"))
+ (kill-buffer (get-buffer-create name))
+ (switch-to-buffer (get-buffer-create name)))
+ (custom-mode)
+ (widget-insert "\
+Square brackets show active fields; type RET or click mouse-1
+on an active field to invoke its action.
+Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
+ (if custom-browse-only-groups
+ (widget-insert "\
+Invoke the [Group] button below to edit that item in another window.\n\n")
+ (widget-insert "Invoke the ")
+ (widget-create 'item
+ :format "%t"
+ :tag "[Group]"
+ :tag-glyph "folder")
+ (widget-insert ", ")
+ (widget-create 'item
+ :format "%t"
+ :tag "[Face]"
+ :tag-glyph "face")
+ (widget-insert ", and ")
+ (widget-create 'item
+ :format "%t"
+ :tag "[Option]"
+ :tag-glyph "option")
+ (widget-insert " 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 group)
+ :value group))
+ (goto-char (point-min)))
+
+(define-widget 'custom-browse-visibility 'item
+ "Control visibility of of items in the customize tree browser."
+ :format "%[[%t]%]"
+ :action 'custom-browse-visibility-action)
+
+(defun custom-browse-visibility-action (widget &rest ignore)
+ (let ((custom-buffer-style 'tree))
+ (custom-toggle-parent widget)))
+
+(define-widget 'custom-browse-group-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Group"
+ :tag-glyph "folder"
+ :action 'custom-browse-group-tag-action)
+
+(defun custom-browse-group-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-group-other-window (widget-value parent))))
+
+(define-widget 'custom-browse-variable-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Option"
+ :tag-glyph "option"
+ :action 'custom-browse-variable-tag-action)
+
+(defun custom-browse-variable-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-variable-other-window (widget-value parent))))
+
+(define-widget 'custom-browse-face-tag 'push-button
+ "Show parent in other window when activated."
+ :tag "Face"
+ :tag-glyph "face"
+ :action 'custom-browse-face-tag-action)
+
+(defun custom-browse-face-tag-action (widget &rest ignore)
+ (let ((parent (widget-get widget :parent)))
+ (customize-face-other-window (widget-value parent))))
+
+(defconst custom-browse-alist '((" " "space")
+ (" | " "vertical")
+ ("-\\ " "top")
+ (" |-" "middle")
+ (" `-" "bottom")))
+
+(defun custom-browse-insert-prefix (prefix)
+ "Insert PREFIX. On XEmacs convert it to line graphics."
+ (if nil ; (string-match "XEmacs" emacs-version)
+ (progn
+ (insert "*")
+ (while (not (string-equal prefix ""))
+ (let ((entry (substring prefix 0 3)))
+ (setq prefix (substring prefix 3))
+ (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
+ (name (nth 1 (assoc entry custom-browse-alist))))
+ (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
+ (overlay-put overlay 'start-open t)
+ (overlay-put overlay 'end-open t)))))
+ (insert prefix)))
+
;;; 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 as text, but you have not set the %c." "\
+you have edited something in this group, but not set it.")
+ (set "+" custom-set-face "\
+you have set this %c, but not saved it for future sessions." "\
+something in this group has been set, but not saved.")
+ (changed ":" custom-changed-face "\
+this %c has been changed outside the customize buffer." "\
+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 `long', show a full-line description, not just one word."
:type '(choice (const :tag "no" nil)
(const short)
(const long))
- :group 'customize)
-
-(defcustom custom-magic-show-button t
- "Show a magic button indicating the state of each customization option."
+ :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 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))
- (lisp (eq (widget-get parent :custom-form) 'lisp))
+ (category (widget-get parent :custom-category))
+ (text (or (and (eq category 'group)
+ (nth 4 entry))
+ (nth 3 entry)))
+ (form (widget-get parent :custom-form))
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)
- (insert text)
- (insert (symbol-name state)))
- (when lisp
- (insert " (lisp)"))
+ (let ((start (point)))
+ (if (eq custom-magic-show 'long)
+ (insert text)
+ (insert (symbol-name state)))
+ (cond ((eq form 'lisp)
+ (insert " (lisp)"))
+ ((eq form 'mismatch)
+ (insert " (mismatch)")))
+ (put-text-property start (point) 'face 'custom-state-face))
(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 (memq form '(lisp mismatch))
+ (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.
+;;; The `custom' Widget.
-(define-widget 'custom-level 'item
- "The custom level buttons."
- :format "%[%t%]"
- :help-echo "Expand or collapse this item."
- :action 'custom-level-action)
+(defface custom-button-face nil
+ "Face used for buttons in customization buffers."
+ :group 'custom-faces)
-(defun custom-level-action (widget &optional event)
- "Toggle visibility for parent to WIDGET."
- (let* ((parent (widget-get widget :parent))
- (state (widget-get parent :custom-state)))
- (cond ((memq state '(invalid modified))
- (error "There are unset changes"))
- ((eq state 'hidden)
- (widget-put parent :custom-state 'unknown))
- (t
- (widget-put parent :custom-state 'hidden)))
- (custom-redraw parent)))
+(defface custom-documentation-face nil
+ "Face used for documentation strings in customization buffers."
+ :group 'custom-faces)
-;;; The `custom' Widget.
+(defface custom-state-face '((((class color)
+ (background dark))
+ (:foreground "lime green"))
+ (((class color)
+ (background light))
+ (:foreground "dark green"))
+ (t nil))
+ "Face used for State descriptions in the customize buffer."
+ :group 'custom-faces)
(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."
- (let ((pos (point))
+ (let ((line (count-lines (point-min) (point)))
+ (column (current-column))
+ (pos (point))
(from (marker-position (widget-get widget :from)))
(to (marker-position (widget-get widget :to))))
(save-excursion
(widget-value-set widget (widget-value widget))
(custom-redraw-magic widget))
(when (and (>= pos from) (<= pos to))
- (goto-char pos))))
+ (condition-case nil
+ (progn
+ (if (> column 0)
+ (goto-line line)
+ (goto-line (1+ line)))
+ (move-to-column column))
+ (error nil)))))
(defun custom-redraw-magic (widget)
"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.
+ ((and (boundp 'preloaded-file-list)
+ (member load preloaded-file-list)))
((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)
"Load all dependencies for WIDGET."
(custom-load-symbol (widget-value widget)))
+(defun custom-unloaded-symbol-p (symbol)
+ "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
+ (let ((found nil)
+ (loads (get symbol 'custom-loads))
+ load)
+ (while loads
+ (setq load (car loads)
+ loads (cdr loads))
+ (cond ((symbolp load)
+ (unless (featurep load)
+ (setq found t)))
+ ((assoc load load-history))
+ ((assoc (locate-library load) load-history)
+ (message nil))
+ (t
+ (setq found t))))
+ found))
+
+(defun custom-unloaded-widget-p (widget)
+ "Return non-nil if the dependencies of WIDGET has not yet been loaded."
+ (custom-unloaded-symbol-p (widget-value widget)))
+
+(defun custom-toggle-hide (widget)
+ "Toggle visibility of WIDGET."
+ (custom-load-widget widget)
+ (let ((state (widget-get widget :custom-state)))
+ (cond ((memq state '(invalid modified))
+ (error "There are unset changes"))
+ ((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)
+ (widget-setup)))
+
+(defun custom-toggle-parent (widget &rest ignore)
+ "Toggle visibility of parent of 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 ((entry (assq name (get symbol 'custom-group))))
+ (when (eq (nth 1 entry) type)
+ (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.
-(defface custom-variable-sample-face '((t (:underline t)))
+(defface custom-variable-tag-face '((((class color)
+ (background dark))
+ (:foreground "light blue" :underline t))
+ (((class color)
+ (background light))
+ (:foreground "blue" :underline t))
+ (t (:underline t)))
"Face used for unpushable variable tags."
:group 'custom-faces)
(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))
(tag (widget-get widget :tag))
(type (custom-variable-type symbol))
(conv (widget-convert type))
+ (get (or (get symbol 'custom-get) 'default-value))
+ (prefix (widget-get widget :custom-prefix))
+ (last (widget-get widget :custom-last))
(value (if (default-boundp symbol)
- (default-value symbol)
+ (funcall get symbol)
(widget-get conv :value))))
;; If the widget is new, the child determine whether it is hidden.
(cond (state)
(when (eq state 'unknown)
(unless (widget-apply conv :match value)
;; (widget-apply (widget-convert type) :match value)
- (setq form 'lisp)))
+ (setq form 'mismatch)))
;; 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-browse-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%}: ..."
- :sample-face 'custom-variable-sample-face
+ :format "%{%t%}: "
+ :sample-face 'custom-variable-tag-face
:tag tag
:parent widget)
- children))
- ((eq form 'lisp)
+ buttons)
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Show the value of this option."
+ :action 'custom-toggle-parent
+ nil)
+ buttons))
+ ((memq form '(lisp mismatch))
;; 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 (default-value 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-tag-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."
(let* ((symbol (widget-value widget))
+ (get (or (get symbol 'custom-get) 'default-value))
(value (if (default-boundp symbol)
- (default-value symbol)
+ (funcall get symbol)
(widget-get widget :value)))
tmp
(state (cond ((setq tmp (get symbol 'customized-value))
(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
- '(("Edit" . custom-variable-edit)
- ("Edit Lisp" . custom-variable-edit-lisp)
- ("Set" . custom-variable-set)
- ("Save" . custom-variable-save)
- ("Reset to Current" . custom-redraw)
- ("Reset to Saved" . custom-variable-reset-saved)
- ("Reset to Factory Settings" . custom-variable-reset-factory))
+ '(("Set for Current Session" custom-variable-set
+ (lambda (widget)
+ (eq (widget-get widget :custom-state) 'modified)))
+ ("Save for Future Sessions" custom-variable-save
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set changed rogue))))
+ ("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 (get (widget-value widget) 'saved-value)
+ (memq (widget-get widget :custom-state)
+ '(modified set changed rogue)))))
+ ("Reset to Standard Settings" custom-variable-reset-standard
+ (lambda (widget)
+ (and (get (widget-value widget) 'standard-value)
+ (memq (widget-get widget :custom-state)
+ '(modified set changed saved rogue)))))
+ ("---" 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.
-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
-when the action is chosen.")
+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.")
(defun custom-variable-action (widget &optional event)
"Show the menu for `custom-variable' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
- (widget-put widget :custom-state 'unknown)
- (custom-redraw widget))
+ (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))
- custom-variable-menu
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name
+ (widget-get widget :value)))
+ (custom-menu-filter custom-variable-menu
+ widget)
event)))
(if answer
(funcall answer widget)))))
(defun custom-variable-set (widget)
"Set the current value for the variable being edited by WIDGET."
- (let ((form (widget-get widget :custom-form))
- (state (widget-get widget :custom-state))
- (child (car (widget-get widget :children)))
- (symbol (widget-value widget))
- val)
+ (let* ((form (widget-get widget :custom-form))
+ (state (widget-get widget :custom-state))
+ (child (car (widget-get widget :children)))
+ (symbol (widget-value widget))
+ (set (or (get symbol 'custom-set) 'set-default))
+ val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable."))
+ (error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "%s" (widget-get val :error)))
- ((eq form 'lisp)
- (set-default symbol (eval (setq val (widget-value child))))
+ ((memq form '(lisp mismatch))
+ (funcall set symbol (eval (setq val (widget-value child))))
(put symbol 'customized-value (list val)))
(t
- (set-default symbol (setq val (widget-value child)))
+ (funcall set symbol (setq val (widget-value child)))
(put symbol 'customized-value (list (custom-quote val)))))
(custom-variable-state-set widget)
(custom-redraw-magic widget)))
(defun custom-variable-save (widget)
- "Set the default value for the variable being edited by WIDGET."
- (let ((form (widget-get widget :custom-form))
- (state (widget-get widget :custom-state))
- (child (car (widget-get widget :children)))
- (symbol (widget-value widget))
- val)
+ "Set and save the value for the variable being edited by WIDGET."
+ (let* ((form (widget-get widget :custom-form))
+ (state (widget-get widget :custom-state))
+ (child (car (widget-get widget :children)))
+ (symbol (widget-value widget))
+ (set (or (get symbol 'custom-set) 'set-default))
+ val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable."))
+ (error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "%s" (widget-get val :error)))
- ((eq form 'lisp)
+ ((memq form '(lisp mismatch))
(put symbol 'saved-value (list (widget-value child)))
- (set-default symbol (eval (widget-value child))))
+ (funcall set symbol (eval (widget-value child))))
(t
(put symbol
'saved-value (list (custom-quote (widget-value
child))))
- (set-default symbol (widget-value child))))
+ (funcall set symbol (widget-value child))))
(put symbol 'customized-value nil)
(custom-save-all)
(custom-variable-state-set widget)
(defun custom-variable-reset-saved (widget)
"Restore the saved value for the variable being edited by WIDGET."
- (let ((symbol (widget-value widget)))
+ (let* ((symbol (widget-value widget))
+ (set (or (get symbol 'custom-set) 'set-default)))
(if (get symbol 'saved-value)
(condition-case nil
- (set-default symbol (eval (car (get symbol 'saved-value))))
+ (funcall set symbol (eval (car (get symbol 'saved-value))))
(error nil))
(error "No saved value for %s" symbol))
(put symbol 'customized-value nil)
(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."
- (let ((symbol (widget-value widget)))
- (if (get symbol 'factory-value)
- (set-default symbol (eval (car (get symbol 'factory-value))))
- (error "No factory default for %S" symbol))
+(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 '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)
:sibling-args (:help-echo "\
OS/2 Presentation Manager.")
pm)
- (const :format "Win32 "
+ (const :format "W32 "
:sibling-args (:help-echo "\
-Windows NT/95/97.")
- win32)
+Windows NT/9X.")
+ w32)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
(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."
- (and (listp value)
- (eq (length value) 2)
- (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-browse-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)
+ ;; If the user has changed this face in some other way,
+ ;; edit it as the user has specified it.
+ (if (not (face-spec-match-p symbol spec (selected-frame)))
+ (setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
+ (setq 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
- '(("Edit Selected" . custom-face-edit-selected)
- ("Edit All" . custom-face-edit-all)
- ("Edit Lisp" . custom-face-edit-lisp)
- ("Set" . custom-face-set)
- ("Save" . custom-face-save)
- ("Reset to Saved" . custom-face-reset-saved)
- ("Reset to Factory Setting" . custom-face-reset-factory))
+ '(("Set for Current Session" custom-face-set)
+ ("Save for Future Sessions" custom-face-save-command)
+ ("Reset to Saved" custom-face-reset-saved
+ (lambda (widget)
+ (get (widget-value widget) 'saved-face)))
+ ("Reset to Standard Setting" custom-face-reset-standard
+ (lambda (widget)
+ (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))))
+ ("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.
-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
-when the action is chosen.")
+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.")
(defun custom-face-edit-selected (widget)
"Edit selected attributes of the value of WIDGET."
'set)
((get symbol 'saved-face)
'saved)
- ((get symbol 'factory-face)
- 'factory)
+ ((get symbol 'face-defface-spec)
+ 'standard)
(t
'rogue)))))
"Show the menu for `custom-face' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
- (widget-put widget :custom-state 'unknown)
- (custom-redraw widget))
+ (custom-toggle-hide widget)
(let* ((completion-ignore-case t)
(symbol (widget-get widget :value))
- (answer (widget-choose (custom-unlispify-tag-name symbol)
- custom-face-menu event)))
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name symbol))
+ (custom-menu-filter custom-face-menu
+ widget)
+ event)))
(if answer
(funcall answer widget)))))
(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)))
+(defun custom-face-save-command (widget)
+ "Save in `.emacs' the face attributes in WIDGET."
+ (custom-face-save widget)
+ (custom-save-all))
+
(defun custom-face-save (widget)
- "Make the face attributes in WIDGET default."
+ "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
(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)
(define-widget 'hook 'list
"A emacs lisp hook"
+ :value-to-internal (lambda (widget value)
+ (if (and value (symbolp value))
+ (list value)
+ value))
+ :match (lambda (widget value)
+ (or (symbolp value)
+ (widget-editable-list-match widget value)))
:convert-widget 'custom-hook-convert-widget
:tag "Hook")
(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 customization buffer for this 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)
+(defcustom custom-group-tag-faces nil
;; In XEmacs, this ought to play games with font size.
"Face used for group tags.
The first member is used for level 1 groups, the second for level 2,
(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-members (symbol groups-only)
+ "Return SYMBOL's custom group members.
+If GROUPS-ONLY non-nil, return only those members that are groups."
+ (if (not groups-only)
+ (get symbol 'custom-group)
+ (let (members)
+ (dolist (entry (get symbol 'custom-group))
+ (when (eq (nth 1 entry) 'custom-group)
+ (push entry members)))
+ (nreverse members))))
+
(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))
+ (members (custom-group-members symbol
+ (and (eq custom-buffer-style 'tree)
+ custom-browse-only-groups))))
+ (cond ((and (eq custom-buffer-style 'tree)
+ (eq state 'hidden)
+ (or members (custom-unloaded-widget-p widget)))
+ (custom-browse-insert-prefix prefix)
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-visibility
+ ;; :tag-glyph "plus"
+ :tag "+")
+ buttons)
+ (insert "-- ")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ ((and (eq custom-buffer-style 'tree)
+ (zerop (length members)))
+ (custom-browse-insert-prefix prefix)
+ (insert "[ ]-- ")
+ ;; (widget-glyph-insert nil "[ ]" "empty")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ ((eq custom-buffer-style 'tree)
+ (custom-browse-insert-prefix prefix)
+ (custom-load-widget widget)
+ (if (zerop (length members))
+ (progn
+ (custom-browse-insert-prefix prefix)
+ (insert "[ ]-- ")
+ ;; (widget-glyph-insert nil "[ ]" "empty")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons))
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-visibility
+ ;; :tag-glyph "minus"
+ :tag "-")
+ buttons)
+ (insert "-\\ ")
+ ;; (widget-glyph-insert nil "-\\ " "top")
+ (push (widget-create-child-and-convert
+ widget 'custom-browse-group-tag)
+ buttons)
+ (insert " " tag "\n")
+ (widget-put widget :buttons buttons)
+ (message "Creating group...")
+ (let* ((members (custom-sort-items members
+ custom-browse-sort-alphabetically
+ custom-browse-order-groups))
+ (prefixes (widget-get widget :custom-prefixes))
+ (custom-prefix-list (custom-prefix-add symbol prefixes))
+ (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 "Go to Group"
+ 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 (custom-sort-items members
+ custom-buffer-sort-alphabetically
+ custom-buffer-order-groups))
+ (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
- '(("Set" . custom-group-set)
- ("Save" . custom-group-save)
- ("Reset to Current" . custom-group-reset-current)
- ("Reset to Saved" . custom-group-reset-saved)
- ("Reset to Factory" . custom-group-reset-factory))
+ '(("Set for Current Session" custom-group-set
+ (lambda (widget)
+ (eq (widget-get widget :custom-state) 'modified)))
+ ("Save for Future Sessions" custom-group-save
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set))))
+ ("Reset to Current" custom-group-reset-current
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified))))
+ ("Reset to Saved" custom-group-reset-saved
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set))))
+ ("Reset to standard setting" custom-group-reset-standard
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set saved)))))
"Alist of actions for the `custom-group' widget.
-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
-when the action is chosen.")
+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-group'
+widget as an argument, and returns non-nil if ACTION is valid on that
+widget. If FILTER is nil, ACTION is always valid.")
(defun custom-group-action (widget &optional event)
"Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
- (widget-put widget :custom-state 'unknown)
- (custom-redraw widget))
+ (custom-toggle-hide widget)
(let* ((completion-ignore-case t)
- (answer (widget-choose (custom-unlispify-tag-name
- (widget-get widget :value))
- custom-group-menu
+ (answer (widget-choose (concat "Operation on "
+ (custom-unlispify-tag-name
+ (widget-get widget :value)))
+ (custom-menu-filter custom-group-menu
+ widget)
event)))
(if answer
(funcall answer widget)))))
(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 nil
"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."
- :type 'file
+The default is nil, which means to use your init file
+as specified by `user-init-file'. If you specify some other file,
+you need to explicitly load that file for the settings to take effect."
+ :type '(choice (const :tag "Your Emacs init file" nil) file)
:group 'customize)
(defun custom-save-delete (symbol)
"Delete the call to SYMBOL form `custom-file'.
Leave point at the location of the call, or after the last expression."
- (set-buffer (find-file-noselect custom-file))
+ (set-buffer (find-file-noselect (or custom-file user-init-file)))
(goto-char (point-min))
(catch 'found
(while t
(princ "\n"))
(princ "(custom-set-variables")
(mapatoms (lambda (symbol)
- (let ((value (get symbol 'saved-value)))
+ (let ((value (get symbol 'saved-value))
+ (requests (get symbol 'custom-requests))
+ (now (not (or (get symbol 'standard-value)
+ (and (not (boundp symbol))
+ (not (get symbol 'force-value)))))))
(when value
(princ "\n '(")
(princ symbol)
(princ " ")
(prin1 (car value))
- (if (or (get symbol 'factory-value)
- (and (not (boundp symbol))
- (not (get symbol 'force-value))))
- (princ ")")
- (princ " t)"))))))
+ (cond (requests
+ (if now
+ (princ " t ")
+ (princ " nil "))
+ (prin1 requests)
+ (princ ")"))
+ (now
+ (princ " t)"))
+ (t
+ (princ ")")))))))
(princ ")")
(unless (looking-at "\n")
(princ "\n")))))
(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 ")")
(unless (looking-at "\n")
(princ "\n")))))
+;;;###autoload
+(defun customize-save-customized ()
+ "Save all user options which have been set in this session."
+ (interactive)
+ (mapatoms (lambda (symbol)
+ (let ((face (get symbol 'customized-face))
+ (value (get symbol 'customized-value)))
+ (when face
+ (put symbol 'saved-face face)
+ (put symbol 'customized-face nil))
+ (when value
+ (put symbol 'saved-value value)
+ (put symbol 'customized-value nil)))))
+ ;; We really should update all custom buffers here.
+ (custom-save-all))
+
;;;###autoload
(defun custom-save-all ()
"Save all customizations in `custom-file'."
- (custom-save-variables)
- (custom-save-faces)
- (save-excursion
- (set-buffer (find-file-noselect custom-file))
- (save-buffer)))
+ (let ((inhibit-read-only t))
+ (custom-save-variables)
+ (custom-save-faces)
+ (save-excursion
+ (set-buffer (find-file-noselect (or custom-file user-init-file)))
+ (save-buffer))))
;;; The Customize Menu.
;;; 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])
- ;; This menu should be identical to the one defined in `menu-bar.el'.
- "Customize menu")
-
- (defun custom-menu-reset ()
- "Reset customize menu."
- (remove-hook 'custom-define-hook 'custom-menu-reset)
- (define-key global-map [menu-bar help-menu customize-menu]
- (cons (car custom-help-menu)
- (easy-menu-create-keymaps (car custom-help-menu)
- (cdr custom-help-menu)))))
-
- (defun custom-menu-update (event)
- "Update customize menu."
- (interactive "e")
- (add-hook 'custom-define-hook 'custom-menu-reset)
- (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
- (menu `(,(car custom-help-menu)
- ,emacs
- ,@(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)))))
-
- (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 (custom-sort-items (get symbol 'custom-group)
+ custom-menu-sort-alphabetically
+ custom-menu-order-groups)))
(custom-load-symbol symbol)
`(,(custom-unlispify-menu-entry symbol t)
,item
(nth 1 entry)
(list (nth 1 entry)))
:custom-menu (nth 0 entry)))
- (get symbol 'custom-group))))
+ members)))
item)))
;;;###autoload
(defvar custom-mode-map nil
"Keymap for `custom-mode'.")
-
+
(unless custom-mode-map
(setq custom-mode-map (make-sparse-keymap))
(set-keymap-parent custom-mode-map widget-keymap)
- (define-key custom-mode-map "q" 'bury-buffer))
-
-(easy-menu-define custom-mode-customize-menu
- custom-mode-map
- "Menu used in customization buffers."
- (customize-menu-create 'customize))
-
-(easy-menu-define custom-mode-menu
+ (suppress-keymap custom-mode-map)
+ (define-key custom-mode-map " " 'scroll-up)
+ (define-key custom-mode-map "\177" 'scroll-down)
+ (define-key custom-mode-map "q" 'bury-buffer)
+ (define-key custom-mode-map "u" 'Custom-goto-parent)
+ (define-key custom-mode-map "n" 'widget-forward)
+ (define-key custom-mode-map "p" 'widget-backward)
+ (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke))
+
+(defun Custom-move-and-invoke (event)
+ "Move to where you click, and if it is an active field, invoke it."
+ (interactive "e")
+ (mouse-set-point event)
+ (if (widget-event-point event)
+ (let* ((pos (widget-event-point event))
+ (button (get-char-property pos 'button)))
+ (if button
+ (widget-button-click event)))))
+
+(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]))
+(defun Custom-goto-parent ()
+ "Go to the parent group listed at the top of this buffer.
+If several parents are listed, go to the first of them."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward "\nGo to parent group: " nil t)
+ (let* ((button (get-char-property (point) 'button))
+ (parent (downcase (widget-get button :tag))))
+ (customize-group parent)))))
+
(defcustom custom-mode-hook nil
"Hook called when entering custom-mode."
:type 'hook
- :group 'customize)
+ :group 'custom-buffer )
+
+(defun custom-state-buffer-message (widget)
+ (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
+ (message "To install your edits, 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]
+\\<widget-field-keymap>\
+Complete content of editable text field. \\[widget-complete]
+\\<custom-mode-map>\
+Invoke button under the mouse pointer. \\[Custom-move-and-invoke]
+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-variable 'widget-documentation-face)
+ (setq widget-documentation-face 'custom-documentation-face)
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face 'custom-button-face)
+ (make-local-hook 'widget-edit-functions)
+ (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
(run-hooks 'custom-mode-hook))
;;; The End.
HCoop / bpt / emacs.git / blobdiff