-;;; 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.9929
+;; Version: 1.9944
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
;;
;; See `custom.el'.
+;; No commands should have names starting with `custom-' because
+;; that interferes with completion. Use `customize-' for commands
+;; that the user will run with M-x, and `Custom-' for interactive commands.
+
;;; Code:
(require 'cus-face)
:group 'customize
:group 'faces)
+(defgroup custom-browse nil
+ "Control customize browser."
+ :prefix "custom-"
+ :group 'customize)
+
(defgroup custom-buffer nil
- "Control the customize buffers."
+ "Control customize buffers."
:prefix "custom-"
:group 'customize)
(defgroup custom-menu nil
- "Control how the customize menus."
+ "Control customize menus."
:prefix "custom-"
:group 'customize)
;;; 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 the members of each customization group alphabetically."
+ "If non-nil, sort members of each customization group alphabetically."
:type 'boolean
:group 'custom-buffer)
-(defcustom custom-buffer-groups-last nil
- "If non-nil, put subgroups after all ordinary options within a group."
- :type 'boolean
+(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 the members of each customization group alphabetically."
+ "If non-nil, sort members of each customization group alphabetically."
:type 'boolean
:group 'custom-menu)
-(defcustom custom-menu-groups-first t
- "If non-nil, put subgroups before all ordinary options within a group."
- :type 'boolean
+(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-buffer-sort-predicate (a b)
- "Return t iff A should come before B in a customization buffer.
-A and B should be members of a `custom-group' property."
- (cond ((and (not custom-buffer-groups-last)
- (not custom-buffer-sort-alphabetically))
- nil)
- ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
- (not custom-buffer-groups-last))
- (if custom-buffer-sort-alphabetically
- (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
- nil))
- (t
- (not (eq (nth 1 a) 'custom-group) ))))
-
-(defalias 'custom-browse-sort-predicate 'ignore)
-
-(defun custom-menu-sort-predicate (a b)
- "Return t iff A should come before B in a customization menu.
-A and B should be members of a `custom-group' property."
- (cond ((and (not custom-menu-groups-first)
- (not custom-menu-sort-alphabetically))
- nil)
- ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
- (not custom-menu-groups-first))
- (if custom-menu-sort-alphabetically
- (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
- nil))
- (t
- (eq (nth 1 a) 'custom-group) )))
+(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)
- ("Standard Settings" . custom-reset-standard))
+ '(("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 (&rest ignore)
+(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 (&rest ignore)
+(defun Custom-reset-saved (&rest ignore)
"Reset all modified or set group members to their saved value."
(interactive)
(let ((children custom-options))
(widget-apply child :custom-reset-saved)))
children)))
-(defun custom-reset-standard (&rest ignore)
+(defun Custom-reset-standard (&rest ignore)
"Reset all modified, set, or saved group members to their standard settings."
(interactive)
(let ((children custom-options))
(eval-minibuffer prompt)))))))
;;;###autoload
-(defun custom-set-value (var val)
+(defun customize-set-value (var val)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
If VARIABLE has a `variable-interactive' property, that is used as if
(set var val))
;;;###autoload
-(defun custom-set-variable (var val)
+(defun customize-set-variable (var val)
"Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
If VARIABLE has a `custom-set' property, that is used for setting
(if (get-buffer name)
(switch-to-buffer name)
(custom-buffer-create (list (list group 'custom-group))
- name))))
+ name
+ (concat " for group "
+ (custom-unlispify-tag-name group))))))
;;;###autoload
(defun customize-group-other-window (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)
- (push (list symbol 'custom-face) found))
- (nreverse (mapcar 'intern
- (sort (mapcar 'symbol-name (face-list))
- 'string-lessp))))
-
- (custom-buffer-create found "*Customize Faces*"))
- (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))
(and (get symbol 'customized-value)
(boundp symbol)
(push (list symbol 'custom-variable) found))))
- (if found
- (custom-buffer-create found "*Customize Customized*")
- (error "No customized user options"))))
+ (if (not found)
+ (error "No customized user options")
+ (custom-buffer-create (custom-sort-items found t nil)
+ "*Customize Customized*"))))
;;;###autoload
(defun customize-saved ()
(and (get symbol 'saved-value)
(boundp symbol)
(push (list symbol 'custom-variable) found))))
- (if found
- (custom-buffer-create found "*Customize Saved*")
- (error "No saved user options"))))
+ (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)
(push (list symbol 'custom-variable) found)))))
(if (not found)
(error "No matches")
- (let ((custom-buffer-sort-alphabetically t))
- (custom-buffer-create (sort found 'custom-buffer-sort-predicate)
- "*Customize Apropos*")))))
+ (custom-buffer-create (custom-sort-items found t
+ custom-buffer-order-groups)
+ "*Customize Apropos*"))))
;;;###autoload
(defun customize-apropos-options (regexp &optional arg)
:group 'custom-buffer)
;;;###autoload
-(defun custom-buffer-create (options &optional name)
+(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
(unless name (setq name "*Customization*"))
(kill-buffer (get-buffer-create name))
(switch-to-buffer (get-buffer-create name))
- (custom-buffer-create-internal options))
+ (custom-buffer-create-internal options description))
;;;###autoload
-(defun custom-buffer-create-other-window (options &optional name)
+(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
(kill-buffer (get-buffer-create name))
(let ((window (selected-window)))
(switch-to-buffer-other-window (get-buffer-create name))
- (custom-buffer-create-internal options)
+ (custom-buffer-create-internal options description)
(select-window window)))
(defcustom custom-reset-button-menu nil
:type 'boolean
:group 'custom-buffer)
-(defun custom-buffer-create-internal (options)
+(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 ")
+ (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."
"(emacs)Easy Customization")
(widget-insert " for more information.\n\n")
(message "Creating customization buttons...")
+ (widget-insert "Operate on everything in this buffer:\n ")
(widget-create 'push-button
- :tag "Set"
- :help-echo "Set all modifications for this session."
+ :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)))
+ (Custom-set)))
(widget-insert " ")
(widget-create 'push-button
- :tag "Save"
+ :tag "Save for Future Sessions"
:help-echo "\
-Make the modifications default for future sessions."
+Make your editing in this buffer take effect for future Emacs sessions."
:action (lambda (widget &optional event)
- (custom-save)))
- (widget-insert " ")
+ (Custom-save)))
(if custom-reset-button-menu
- (widget-create 'push-button
- :tag "Reset"
- :help-echo "Show a menu with reset operations."
- :mouse-down-action (lambda (&rest junk) t)
- :action (lambda (widget &optional event)
- (custom-reset event)))
+ (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 visible items in this buffer to their current settings."
- :action 'custom-reset-current)
+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 visible items in this buffer to their saved settings."
- :action 'custom-reset-saved)
+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 visible items in this buffer to their standard settings."
- :action 'custom-reset-standard))
- (widget-insert " ")
+Reset all values in this buffer to their standard settings."
+ :action 'Custom-reset-standard))
+ (widget-insert " ")
(widget-create 'push-button
- :tag "Done"
+ :tag "Bury Buffer"
:help-echo "Bury the buffer."
:action (lambda (widget &optional event)
(bury-buffer)))
;;; The Tree Browser.
;;;###autoload
-(defun customize-browse ()
+(defun customize-browse (group)
"Create a tree browser for the customize hierarchy."
- (interactive)
+ (interactive (list (let ((completion-ignore-case t))
+ (completing-read "Customize group: (default emacs) "
+ obarray
+ (lambda (symbol)
+ (get symbol 'custom-group))
+ t))))
+
+ (when (stringp group)
+ (if (string-equal "" group)
+ (setq group 'emacs)
+ (setq group (intern group))))
(let ((name "*Customize Browser*"))
(kill-buffer (get-buffer-create name))
(switch-to-buffer (get-buffer-create name)))
(custom-mode)
(widget-insert "\
-Invoke [+] below to expand items, and [-] to collapse items.
-Invoke the [group], [face], and [option] buttons below to edit that
-item in another window.\n\n")
+Invoke [+] or [?] below to expand items, and [-] to collapse items.\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 'emacs)
- :value 'emacs))
+ :tag (custom-unlispify-tag-name group)
+ :value group))
(goto-char (point-min)))
-(define-widget 'custom-tree-visibility 'item
+(define-widget 'custom-browse-visibility 'item
"Control visibility of of items in the customize tree browser."
- :button-prefix "["
- :button-suffix "]"
- :format "%[%t%]"
- :action 'custom-tree-visibility-action)
+ :format "%[[%t]%]"
+ :action 'custom-browse-visibility-action)
-(defun custom-tree-visibility-action (widget &rest ignore)
+(defun custom-browse-visibility-action (widget &rest ignore)
(let ((custom-buffer-style 'tree))
(custom-toggle-parent widget)))
-(define-widget 'custom-tree-group-tag 'push-button
+(define-widget 'custom-browse-group-tag 'push-button
"Show parent in other window when activated."
- :tag "group"
- :action 'custom-tree-group-tag-action)
+ :tag "Group"
+ :tag-glyph "folder"
+ :action 'custom-browse-group-tag-action)
-(defun custom-tree-group-tag-action (widget &rest ignore)
+(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-tree-variable-tag 'push-button
+(define-widget 'custom-browse-variable-tag 'push-button
"Show parent in other window when activated."
- :tag "option"
- :action 'custom-tree-variable-tag-action)
+ :tag "Option"
+ :tag-glyph "option"
+ :action 'custom-browse-variable-tag-action)
-(defun custom-tree-variable-tag-action (widget &rest ignore)
+(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-tree-face-tag 'push-button
+(define-widget 'custom-browse-face-tag 'push-button
"Show parent in other window when activated."
- :tag "face"
- :action 'custom-tree-face-tag-action)
+ :tag "Face"
+ :tag-glyph "face"
+ :action 'custom-browse-face-tag-action)
-(defun custom-tree-face-tag-action (widget &rest ignore)
+(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
(invalid "x" custom-invalid-face "\
the value displayed for this %c is invalid and cannot be set.")
(modified "*" custom-modified-face "\
-you have edited the value, and can now set the %c." "\
-you have edited something in this group, and can now set it.")
+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." "\
-something in this group has been set, but not yet saved.")
+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.")
(defcustom custom-magic-show 'long
"If non-nil, show textual description of the state.
-If non-nil and not the symbol `long', only show first word."
+If `long', show a full-line description, not just one word."
:type '(choice (const :tag "no" nil)
(const short)
(const long))
: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
+ "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."
+ "Show a \"magic\" button indicating the state of each customization option."
:type 'boolean
:group 'custom-buffer)
: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)))
+ (when lisp
+ (insert " (lisp)"))
+ (put-text-property start (point) 'face 'custom-state-face))
(insert "\n"))
(when (and (eq category 'group)
(not (and (eq custom-buffer-style 'links)
;;; The `custom' Widget.
+(defface custom-button-face nil
+ "Face used for buttons in customization buffers."
+ :group 'custom-faces)
+
+(defface custom-documentation-face nil
+ "Face used for documentation strings in customization buffers."
+ :group 'custom-faces)
+
+(defface custom-state-face '((((class color)
+ (background dark))
+ (:foreground "lime green"))
+ (((class color)
+ (background light))
+ (:foreground "dark green"))
+ (t nil))
+ "Face used for State descriptions in the customize buffer."
+ :group 'custom-faces)
+
(define-widget 'custom 'default
"Customize a user option."
:format "%v"
(require load)
(error nil)))
;; Don't reload a file already loaded.
+ ((member load preloaded-file-list))
((assoc load load-history))
((assoc (locate-library load) load-history))
(t
"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"))
(widget-setup)))
(defun custom-toggle-parent (widget &rest ignore)
- "Toggle visibility of parent to WIDGET."
+ "Toggle visibility of parent of WIDGET."
(custom-toggle-hide (widget-get widget :parent)))
(defun custom-add-see-also (widget &optional prefix)
(insert ", "))))
(widget-put widget :buttons buttons))))
-(defun custom-add-parent-links (widget)
- "Add `Parent groups: ...' to WIDGET."
+(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 "Parent groups:")
+ (insert (or initial-string "Parent groups:"))
(mapatoms (lambda (symbol)
- (let ((group (get symbol 'custom-group)))
- (when (assq name group)
- (when (eq type (nth 1 (assq name group)))
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'custom-group-link
- :tag (custom-unlispify-tag-name symbol)
- symbol)
- buttons)
- (setq found t))))))
+ (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)
- (unless found
- (insert " (none)"))
- (insert "\n")))
+ (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)
(setq form 'lisp)))
;; Now we can create the child widget.
(cond ((eq custom-buffer-style 'tree)
- (insert prefix (if last " +--- " " |--- "))
+ (insert prefix (if last " `--- " " |--- "))
(push (widget-create-child-and-convert
- widget 'custom-tree-variable-tag)
+ widget 'custom-browse-variable-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(push (widget-create-child-and-convert
widget 'item
:format "%{%t%}: "
- :sample-face 'custom-variable-sample-face
+ :sample-face 'custom-variable-tag-face
:tag tag
:parent widget)
buttons)
:help-echo "Change value of this option."
:mouse-down-action 'custom-tag-mouse-down-action
:button-face 'custom-variable-button-face
- :sample-face 'custom-variable-sample-face
+ :sample-face 'custom-variable-tag-face
tag)
buttons)
(insert " ")
(widget-put widget :custom-state state)))
(defvar custom-variable-menu
- '(("Set" custom-variable-set
+ '(("Set for Current Session" custom-variable-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
- ("Save" custom-variable-save
+ ("Save for Future Sessions" custom-variable-save
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified set changed rogue))))
("Reset to Current" custom-redraw
(unless tag
(setq tag (prin1-to-string symbol)))
(cond ((eq custom-buffer-style 'tree)
- (insert prefix (if is-last " +--- " " |--- "))
+ (insert prefix (if is-last " `--- " " |--- "))
(push (widget-create-child-and-convert
- widget 'custom-tree-face-tag)
+ widget 'custom-browse-face-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(message "Creating face editor...done"))))))
(defvar custom-face-menu
- '(("Set" custom-face-set)
- ("Save" custom-face-save)
+ '(("Set for Current Session" custom-face-set)
+ ("Save for Future Sessions" custom-face-save)
("Reset to Saved" custom-face-reset-saved
(lambda (widget)
(get (widget-value widget) 'saved-face)))
(define-widget 'custom-group-link 'link
"Show parent in other window when activated."
- :help-echo "Create customize buffer for this group group."
+ :help-echo "Create customization buffer for this group."
:action 'custom-group-link-action)
(defun custom-group-link-action (widget &rest ignore)
;;; 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,
(or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
'custom-group-tag-face))
+(define-widget 'custom-group-visibility 'visibility
+ "An indicator and manipulator for hidden group contents."
+ :create 'custom-group-visibility-create)
+
+(defun custom-group-visibility-create (widget)
+ (let ((visible (widget-value widget)))
+ (if visible
+ (insert "--------")))
+ (widget-default-create widget))
+
(defun custom-group-value-create (widget)
"Insert a customize group for WIDGET in the current buffer."
(let ((state (widget-get widget :custom-state))
(tag (widget-get widget :tag))
(symbol (widget-value widget)))
(cond ((and (eq custom-buffer-style 'tree)
- (eq state 'hidden))
- (insert prefix)
+ (eq state 'hidden)
+ (or (get symbol 'custom-group)
+ (custom-unloaded-widget-p widget)))
+ (custom-browse-insert-prefix prefix)
(push (widget-create-child-and-convert
- widget 'custom-tree-visibility :tag "+")
+ widget 'custom-browse-visibility
+ ;; :tag-glyph "plus"
+ :tag (if (custom-unloaded-widget-p widget) "?" "+"))
buttons)
(insert "-- ")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
- widget 'custom-tree-group-tag)
+ widget 'custom-browse-group-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
((and (eq custom-buffer-style 'tree)
(zerop (length (get symbol 'custom-group))))
- (insert prefix "[ ]-- ")
+ (custom-browse-insert-prefix prefix)
+ (insert "[ ]-- ")
+ ;; (widget-glyph-insert nil "[ ]" "empty")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
- widget 'custom-tree-group-tag)
+ widget 'custom-browse-group-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
((eq custom-buffer-style 'tree)
- (insert prefix)
+ (custom-browse-insert-prefix prefix)
(custom-load-widget widget)
(if (zerop (length (get symbol 'custom-group)))
(progn
- (insert prefix "[ ]-- ")
+ (custom-browse-insert-prefix prefix)
+ (insert "[ ]-- ")
+ ;; (widget-glyph-insert nil "[ ]" "empty")
+ ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
- widget 'custom-tree-group-tag)
+ widget 'custom-browse-group-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(push (widget-create-child-and-convert
- widget 'custom-tree-visibility :tag "-")
+ widget 'custom-browse-visibility
+ ;; :tag-glyph "minus"
+ :tag "-")
buttons)
- (insert "-+ ")
+ (insert "-\\ ")
+ ;; (widget-glyph-insert nil "-\\ " "top")
(push (widget-create-child-and-convert
- widget 'custom-tree-group-tag)
+ widget 'custom-browse-group-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons)
(message "Creating group...")
- (let* ((members (sort (copy-sequence (get symbol 'custom-group))
- 'custom-browse-sort-predicate))
+ (let* ((members (custom-sort-items (get symbol 'custom-group)
+ custom-browse-sort-alphabetically
+ custom-browse-order-groups))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
- (length (length members))
(extra-prefix (if (widget-get widget :custom-last)
" "
" | "))
(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))
+ (when (or (not custom-browse-only-groups)
+ (eq (nth 1 entry) 'custom-group))
+ (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.
(if (eq custom-buffer-style 'links)
(push (widget-create-child-and-convert
widget 'custom-group-link
- :tag "Show"
+ :tag "Go to Group"
symbol)
buttons)
(push (widget-create-child-and-convert
(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 "/- ")
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-default-format-handler widget ?h)
- ;; Parents and See also.
- (when (eq level 1)
- (insert-char ?\ custom-buffer-indent)
- (custom-add-parent-links widget))
+ ;; Parent groups.
+ (if nil ;;; This should test that the buffer
+ ;;; was not made to display a group.
+ (when (eq level 1)
+ (insert-char ?\ custom-buffer-indent)
+ (custom-add-parent-links widget)))
(custom-add-see-also widget
(make-string (* custom-buffer-indent level)
?\ ))
;; Members.
(message "Creating group...")
(custom-load-widget widget)
- (let* ((members (sort (copy-sequence (get symbol 'custom-group))
- 'custom-buffer-sort-predicate))
+ (let* ((members (custom-sort-items (get symbol 'custom-group)
+ 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))
(insert "/\n")))))
(defvar custom-group-menu
- '(("Set" custom-group-set
+ '(("Set for Current Session" custom-group-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
- ("Save" custom-group-save
+ ("Save for Future Sessions" custom-group-save
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified set))))
("Reset to Current" custom-group-reset-current
(princ "\n")))))
;;;###autoload
-(defun custom-save-customized ()
+(defun customize-save-customized ()
"Save all user options which have been set in this session."
(interactive)
(mapatoms (lambda (symbol)
(unless (string-match "XEmacs" emacs-version)
(defconst custom-help-menu
'("Customize"
- ["Update menu..." custom-menu-update t]
+ ["Update menu" Custom-menu-update t]
+ ["Browse" (customize-browse 'emacs) t]
["Group..." customize-group t]
- ["Variable..." customize-variable t]
+ ["Option..." customize-option t]
["Face..." customize-face t]
["Saved..." customize-saved t]
["Set..." customize-customized t]
- ["--" custom-menu-sep t]
+ "--"
["Apropos..." customize-apropos t]
["Group apropos..." customize-apropos-groups t]
- ["Variable apropos..." customize-apropos-options t]
+ ["Option apropos..." customize-apropos-options t]
["Face apropos..." customize-apropos-faces t])
;; This menu should be identical to the one defined in `menu-bar.el'.
"Customize menu")
(easy-menu-create-keymaps (car custom-help-menu)
(cdr custom-help-menu)))))
- (defun custom-menu-update (event)
+ (defun Custom-menu-update (event)
"Update customize menu."
(interactive "e")
(add-hook 'custom-define-hook 'custom-menu-reset)
(< (length (get symbol 'custom-group)) widget-menu-max-size))
(let ((custom-prefix-list (custom-prefix-add symbol
custom-prefix-list))
- (members (sort (copy-sequence (get symbol 'custom-group))
- 'custom-menu-sort-predicate)))
+ (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
(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)
(suppress-keymap custom-mode-map)
- (define-key custom-mode-map "q" 'bury-buffer))
-
-(easy-menu-define custom-mode-menu
+ (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"
,(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]
+ ["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 '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]
-Invoke button under the mouse pointer. \\[widget-button-click]
+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]
+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-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.