;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
"Basic text editing facilities."
:group 'emacs)
+(defgroup convenience nil
+ "Convenience features for faster editing."
+ :group 'emacs)
+
+(defgroup files nil
+ "Support for editing files."
+ :group 'emacs)
+
+(defgroup wp nil
+ "Support for editing text files."
+ :tag "Text"
+ :group 'emacs)
+
+(defgroup data nil
+ "Support for editing binary data files."
+ :group 'emacs)
+
(defgroup abbrev nil
"Abbreviation handling, typing shortcuts, macros."
:tag "Abbreviations"
- :group 'editing)
+ :group 'convenience)
(defgroup matching nil
"Various sorts of searching and matching."
(defgroup outlines nil
"Support for hierarchical outlining."
- :group 'editing)
+ :group 'wp)
(defgroup external nil
"Interfacing to external utilities."
:group 'emacs)
+(defgroup comm nil
+ "Communications, networking, and remote access to files."
+ :tag "Communication"
+ :group 'emacs)
+
(defgroup processes nil
"Process, subshell, compilation, and job control support."
- :group 'external
- :group 'development)
-
-(defgroup convenience nil
- "Convenience features for faster editing."
- :group 'emacs)
+ :group 'external)
(defgroup programming nil
"Support for programming in other languages."
"Programming tools."
:group 'programming)
-(defgroup oop nil
- "Support for object-oriented programming."
- :group 'programming)
-
(defgroup applications nil
"Applications written in Emacs."
:group 'emacs)
"Fitting Emacs with its environment."
:group 'emacs)
-(defgroup comm nil
- "Communications, networking, remote access to files."
- :tag "Communication"
- :group 'environment)
-
(defgroup hardware nil
- "Support for interfacing with exotic hardware."
+ "Support for interfacing with miscellaneous hardware."
:group 'environment)
(defgroup terminals nil
"Support for Emacs frames and window systems."
:group 'environment)
-(defgroup data nil
- "Support editing files of data."
- :group 'emacs)
-
-(defgroup files nil
- "Support editing files."
- :group 'emacs)
-
-(defgroup wp nil
- "Word processing."
- :group 'emacs)
-
(defgroup tex nil
"Code related to the TeX formatter."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
"Support for multiple fonts."
:group 'emacs)
-(defgroup hypermedia nil
- "Support for links between text or other media types."
- :group 'emacs)
-
(defgroup help nil
"Support for on-line help systems."
:group 'emacs)
:group 'custom-browse)
;;;###autoload
-(defcustom custom-buffer-sort-alphabetically nil
- "If non-nil, sort each customization group alphabetically in Custom buffer."
+(defcustom custom-buffer-sort-alphabetically t
+ "Whether to sort customization groups alphabetically in Custom buffer."
:type 'boolean
- :group 'custom-buffer)
+ :group 'custom-buffer
+ :version "24.1")
(defcustom custom-buffer-order-groups 'last
"If non-nil, order group members within each customization group.
(const :tag "none" nil))
:group 'custom-menu)
-;;;###autoload (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
+;;;###autoload (add-hook 'same-window-regexps (purecopy "\\`\\*Customiz.*\\*\\'"))
(defun custom-sort-items (items sort-alphabetically order-groups)
"Return a sorted copy of ITEMS.
;;; Custom Mode Commands.
;; This variable is used by `custom-tool-bar-map', or directly by
-;; `custom-buffer-create-internal' if the toolbar is not present and
-;; `custom-buffer-verbose-help' is non-nil.
+;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
'(("Set for current session" Custom-set t
"Apply all settings in this buffer to the current session"
- "index")
+ "index"
+ "Apply")
("Save for future sessions" Custom-save
(or custom-file user-init-file)
"Apply all settings in this buffer and save them for future Emacs sessions."
- "save")
+ "save"
+ "Save")
("Undo edits" Custom-reset-current t
"Restore all settings in this buffer to reflect their current values."
- "refresh")
+ "refresh"
+ "Undo")
("Reset to saved" Custom-reset-saved t
"Restore all settings in this buffer to their saved values (if any)."
- "undo")
+ "undo"
+ "Reset")
("Erase customizations" Custom-reset-standard
(or custom-file user-init-file)
"Un-customize all settings in this buffer and save them with standard values."
- "delete")
+ "delete"
+ "Uncustomize")
("Help for Customize" Custom-help t
"Get help for using Customize."
- "help")
- ("Exit" Custom-buffer-done t "Exit Customize." "exit")))
+ "help"
+ "Help")
+ ("Exit" Custom-buffer-done t "Exit Customize." "exit" "Exit")))
(defun Custom-help ()
"Read the node on Easy Customization in the Emacs manual."
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "21.1"
+(defvar customize-changed-options-previous-release "23.1"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
+(declare-function apropos-parse-pattern "apropos" (pattern))
+
;;;###autoload
-(defun customize-apropos (regexp &optional all)
- "Customize all loaded options, faces and groups matching REGEXP.
-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 variables
+(defun customize-apropos (pattern &optional type)
+ "Customize all loaded options, faces and groups matching PATTERN.
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+If TYPE is `options', include only options.
+If TYPE is `faces', include only faces.
+If TYPE is `groups', include only groups.
+If TYPE is t (interactively, with prefix arg), include variables
that are not customizable options, as well as faces and groups
\(but we recommend using `apropos-variable' instead)."
- (interactive "sCustomize (regexp): \nP")
- (let ((found nil))
- (mapatoms (lambda (symbol)
- (when (string-match regexp (symbol-name 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)
- (eq (indirect-variable symbol) symbol)
- (or (get symbol 'saved-value)
- (custom-variable-p symbol)
- (and (not (memq all '(nil options)))
- (get symbol 'variable-documentation))))
- (push (list symbol 'custom-variable) found)))))
+ (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
+ (require 'apropos)
+ (apropos-parse-pattern pattern)
+ (let (found tests)
+ (mapatoms
+ `(lambda (symbol)
+ (when (string-match apropos-regexp (symbol-name symbol))
+ ,(if (not (memq type '(faces options)))
+ '(if (get symbol 'custom-group)
+ (push (list symbol 'custom-group) found)))
+ ,(if (not (memq type '(options groups)))
+ '(if (custom-facep symbol)
+ (push (list symbol 'custom-face) found)))
+ ,(if (not (memq type '(groups faces)))
+ `(if (and (boundp symbol)
+ (eq (indirect-variable symbol) symbol)
+ (or (get symbol 'saved-value)
+ (custom-variable-p symbol)
+ ,(if (not (memq type '(nil options)))
+ '(get symbol 'variable-documentation))))
+ (push (list symbol 'custom-variable) found))))))
(if (not found)
(error "No %s matching %s"
- (if (eq all t)
- "items"
- (format "customizable %s"
- (if (memq all '(options faces groups))
- (symbol-name all)
- "items")))
- regexp)
+ (if (eq type t)
+ "items"
+ (format "customizable %s"
+ (if (memq type '(options faces groups))
+ (symbol-name type)
+ "items")))
+ pattern)
(custom-buffer-create
(custom-sort-items found t custom-buffer-order-groups)
"*Customize Apropos*"))))
;;;###autoload
(defun customize-apropos-options (regexp &optional arg)
"Customize all loaded customizable options matching REGEXP.
-With prefix arg, include variables that are not customizable options
+With prefix ARG, include variables that are not customizable options
\(but it is better to use `apropos-variable' if you want to find those)."
(interactive "sCustomize options (regexp): \nP")
(customize-apropos regexp (or arg 'options)))
:group 'custom-buffer)
(defcustom custom-buffer-done-kill nil
- "*Non-nil means exiting a Custom buffer should kill it."
+ "Non-nil means exiting a Custom buffer should kill it."
:type 'boolean
:version "22.1"
:group 'custom-buffer)
(defvar custom-button-pressed nil
"Face used for pressed buttons in customization buffers.")
+(defcustom custom-search-field t
+ "If non-nil, show a search field in Custom buffers."
+ :type 'boolean
+ :version "24.1"
+ :group 'custom-buffer)
+
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
"If non-nil, indicate active buttons in a `raised-button' style.
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
- (widget-insert "Editing a setting changes only the text in this buffer."
- (if init-file
- "
-To apply your changes, use the Save or Set buttons.
-Saving a change normally works by editing your init file."
- "
-Currently, these settings cannot be saved for future Emacs sessions,
-possibly because you started Emacs with `-q'.")
+ (widget-insert (if init-file
+ "To apply changes, use the Save or Set buttons."
+ "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
"\nFor details, see ")
(widget-create 'custom-manual
:tag "Saving Customizations"
:help-echo "Read the Emacs manual."
"(emacs)Top")
(widget-insert "."))
- ;; Insert custom command buttons if the toolbar is not in use.
-
(widget-insert "\n")
- ;; tool-bar is not dumped in builds without x.
- (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
- (if custom-buffer-verbose-help
- (widget-insert "\n
- Operate on all settings in this buffer that are not marked HIDDEN:\n"))
- (let ((button (lambda (tag action active help icon)
- (widget-insert " ")
- (if (eval active)
- (widget-create 'push-button :tag tag
- :help-echo help :action action))))
- (commands custom-commands))
- (apply button (pop commands)) ; Set for current session
- (apply button (pop commands)) ; Save for future sessions
- (if custom-reset-button-menu
- (progn
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Reset buffer"
- :help-echo "Show a menu with reset operations."
- :mouse-down-action 'ignore
- :action 'custom-reset))
- (widget-insert "\n")
- (apply button (pop commands)) ; Undo edits
- (apply button (pop commands)) ; Reset to saved
- (apply button (pop commands)) ; Erase customization
- (widget-insert " ")
- (pop commands) ; Help (omitted)
- (apply button (pop commands))))) ; Exit
+
+ ;; Insert the search field.
+ (when custom-search-field
+ (widget-insert "\n")
+ (let* ((echo "Search for custom items")
+ (search-widget
+ (widget-create
+ 'editable-field
+ :size 40 :help-echo echo
+ :action `(lambda (widget &optional event)
+ (customize-apropos (widget-value widget))))))
+ (widget-insert " ")
+ (widget-create-child-and-convert
+ search-widget 'push-button
+ :tag "Search"
+ :help-echo echo :action
+ (lambda (widget &optional event)
+ (customize-apropos (widget-value (widget-get widget :parent)))))
+ (widget-insert "\n")))
+
+ ;; The custom command buttons are also in the toolbar, so for a
+ ;; time they were not inserted in the buffer if the toolbar was in use.
+ ;; But it can be a little confusing for the buffer layout to
+ ;; change according to whether or nor the toolbar is on, not to
+ ;; mention that a custom buffer can in theory be created in a
+ ;; frame with a toolbar, then later viewed in one without.
+ ;; So now the buttons are always inserted in the buffer. (Bug#1326)
+ (if custom-buffer-verbose-help
+ (widget-insert "
+ Operate on all settings in this buffer:\n"))
+ (let ((button (lambda (tag action active help icon label)
+ (widget-insert " ")
+ (if (eval active)
+ (widget-create 'push-button :tag tag
+ :help-echo help :action action))))
+ (commands custom-commands))
+ (apply button (pop commands)) ; Set for current session
+ (apply button (pop commands)) ; Save for future sessions
+ (if custom-reset-button-menu
+ (progn
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset buffer"
+ :help-echo "Show a menu with reset operations."
+ :mouse-down-action 'ignore
+ :action 'custom-reset))
+ (widget-insert "\n")
+ (apply button (pop commands)) ; Undo edits
+ (apply button (pop commands)) ; Reset to saved
+ (apply button (pop commands)) ; Erase customization
+ (widget-insert " ")
+ (pop commands) ; Help (omitted)
+ (apply button (pop commands)))) ; Exit
(widget-insert "\n\n"))
;; Now populate the custom buffer.
(:weight bold :slant italic :underline t)))
"Face used when the customize item is invalid."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-invalid-face 'face-alias 'custom-invalid)
+(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1")
(defface custom-rogue '((((class color))
(:foreground "pink" :background "black"))
(:underline t)))
"Face used when the customize item is not defined for customization."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-rogue-face 'face-alias 'custom-rogue)
+(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1")
(defface custom-modified '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(:slant italic :bold)))
"Face used when the customize item has been modified."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-modified-face 'face-alias 'custom-modified)
+(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1")
(defface custom-set '((((min-colors 88) (class color))
(:foreground "blue1" :background "white"))
(:slant italic)))
"Face used when the customize item has been set."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-set-face 'face-alias 'custom-set)
+(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1")
(defface custom-changed '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(:slant italic)))
"Face used when the customize item has been changed."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-changed-face 'face-alias 'custom-changed)
+(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1")
(defface custom-themed '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(defface custom-saved '((t (:underline t)))
"Face used when the customize item has been saved."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-saved-face 'face-alias 'custom-saved)
+(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1")
(defconst custom-magic-alist
'((nil "#" underline "\
(nth 3 entry)))
(form (widget-get parent :custom-form))
children)
- (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 " ")
+ (unless (eq state 'hidden)
+ (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 ": ")
+ (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))
+ (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))))
- (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 ": ")
- (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))
- (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
- :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)))
+ (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
+ :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))))
(defun custom-magic-reset (widget)
"Redraw the :custom-magic property of WIDGET."
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-button-face 'face-alias 'custom-button)
+(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1")
(defface custom-button-mouse
'((((type x w32 ns) (class color))
"Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
+(define-obsolete-face-alias 'custom-button-pressed-face
+ 'custom-button-pressed "22.1")
(defface custom-button-pressed-unraised
'((default :inherit custom-button-unraised)
(defface custom-documentation '((t nil))
"Face used for documentation strings in customization buffers."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-documentation-face 'face-alias 'custom-documentation)
+(define-obsolete-face-alias 'custom-documentation-face
+ 'custom-documentation "22.1")
(defface custom-state '((((class color)
(background dark))
(t nil))
"Face used for State descriptions in the customize buffer."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-state-face 'face-alias 'custom-state)
+(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1")
(defface custom-link
'((t :inherit link))
(when (and (>= pos from) (<= pos to))
(condition-case nil
(progn
- (if (> column 0)
- (goto-line line)
- (goto-line (1+ line)))
+ (goto-char (point-min))
+ (forward-line (if (> column 0)
+ (1- line)
+ line))
(move-to-column column))
(error nil)))))
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
(let ((show (widget-get widget :custom-show)))
- (cond ((null show)
- nil)
- ((eq t show)
- t)
- (t
- (funcall show widget value)))))
+ (if (functionp show)
+ (funcall show widget value)
+ show)))
(defun custom-load-widget (widget)
"Load all dependencies for WIDGET."
(insert ", "))))
(widget-put widget :buttons buttons))))
-(defun custom-add-parent-links (widget &optional initial-string
- doc-initial-string)
+(defun custom-add-parent-links (widget &optional initial-string doc-initial-string)
"Add \"Parent groups: ...\" to WIDGET if the group has parents.
The value is non-nil if any parents were found.
If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
symbol)
buttons)
(setq parents (cons symbol parents)))))
- (and (null (get name 'custom-links)) ;No links of its own.
- (= (length parents) 1) ;A single parent.
- (let* ((links (delq nil (mapcar (lambda (w)
- (unless (eq (widget-type w)
- 'custom-group-link)
- w))
- (get (car parents) 'custom-links))))
- (many (> (length links) 2)))
- (when links
- (let ((pt (point))
- (left-margin (+ left-margin 2)))
- (insert "\n" (or doc-initial-string "Group documentation:") " ")
- (while links
- (push (widget-create-child-and-convert
- widget (car links)
- :button-face 'custom-link
- :mouse-face 'highlight
- :pressed-face 'highlight)
- buttons)
- (setq links (cdr links))
- (cond ((null links)
- (insert ".\n"))
- ((null (cdr links))
- (if many
- (insert ", and ")
- (insert " and ")))
- (t
- (insert ", "))))
- (fill-region-as-paragraph pt (point))
- (delete-to-left-margin (1+ pt) (+ pt 2))))))
(if parents
(insert "\n")
(delete-region start (point)))
:background "dim gray")
(t
:slant italic))
- "Face used for comments on variables or faces"
+ "Face used for comments on variables or faces."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-comment-face 'face-alias 'custom-comment)
+(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1")
;; like font-lock-comment-face
(defface custom-comment-tag
(((class grayscale) (background dark))
(:foreground "LightGray" :weight bold :slant italic))
(t (:weight bold)))
- "Face used for variables or faces comment tags"
+ "Face used for the comment tag on variables or faces."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
+(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1")
(define-widget 'custom-comment 'string
"User comment."
:tag "Comment"
:help-echo "Edit a comment here."
- :sample-face 'custom-comment-tag-face
- :value-face 'custom-comment-face
+ :sample-face 'custom-comment-tag
+ :value-face 'custom-comment
:shown nil
:create 'custom-comment-create)
;;; The `custom-variable' Widget.
-;; When this was underlined blue, users confused it with a
-;; Mosaic-style hyperlink...
(defface custom-variable-tag
`((((class color)
(background dark))
(t (:weight bold)))
"Face used for unpushable variable tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag)
+(define-obsolete-face-alias 'custom-variable-tag-face
+ 'custom-variable-tag "22.1")
(defface custom-variable-button '((t (:underline t :weight bold)))
"Face used for pushable variable tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-variable-button-face 'face-alias 'custom-variable-button)
+(define-obsolete-face-alias 'custom-variable-button-face
+ 'custom-variable-button "22.1")
(defcustom custom-variable-default-form 'edit
"Default form of displaying variable values."
(documentation-property variable 'variable-documentation)))
(define-widget 'custom-variable 'custom
- "Customize variable."
+ "A widget for displaying a Custom variable.
+
+The following property has a special meaning for this widget:
+:hidden-states - A list of widget states for which the widget's initial
+ contents should be hidden."
:format "%v"
:help-echo "Set or reset this variable."
:documentation-property #'custom-variable-documentation
:custom-form nil ; defaults to value of `custom-variable-default-form'
:value-create 'custom-variable-value-create
:action 'custom-variable-action
+ :hidden-states '(standard)
:custom-set 'custom-variable-set
:custom-mark-to-save 'custom-variable-mark-to-save
:custom-reset-current 'custom-redraw
(let* ((buttons (widget-get widget :buttons))
(children (widget-get widget :children))
(form (widget-get widget :custom-form))
- (state (widget-get widget :custom-state))
(symbol (widget-get widget :value))
(tag (widget-get widget :tag))
(type (custom-variable-type symbol))
(last (widget-get widget :custom-last))
(value (if (default-boundp symbol)
(funcall get symbol)
- (widget-get conv :value))))
- ;; If the widget is new, the child determines whether it is hidden.
- (cond (state)
- ((custom-show type value)
- (setq state 'unknown))
- (t
- (setq state 'hidden)))
+ (widget-get conv :value)))
+ (state (or (widget-get widget :custom-state)
+ (if (memq (custom-variable-state symbol value)
+ (widget-get widget :hidden-states))
+ 'hidden))))
+
;; If we don't know the state, see if we need to edit it in lisp form.
+ (unless state
+ (setq state (if (custom-show type value) 'unknown 'hidden)))
(when (eq state 'unknown)
(unless (widget-apply conv :match value)
- ;; (widget-apply (widget-convert type) :match value)
(setq form 'mismatch)))
;; Now we can create the child widget.
(cond ((eq custom-buffer-style 'tree)
((eq state 'hidden)
;; Indicate hidden value.
(push (widget-create-child-and-convert
- widget 'item
- :format "%{%t%}: "
- :sample-face 'custom-variable-tag-face
- :tag tag
- :parent widget)
- buttons)
- (push (widget-create-child-and-convert
- widget 'visibility
+ widget 'custom-visibility
:help-echo "Show the value of this option."
+ :on-image "down"
+ :on "Hide"
+ :off-image "right"
:off "Show Value"
:action 'custom-toggle-parent
nil)
+ buttons)
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'item
+ :format "%{%t%} "
+ :sample-face 'custom-variable-tag
+ :tag tag
+ :parent widget)
buttons))
((memq form '(lisp mismatch))
;; In lisp mode edit the saved value when possible.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide the value of this option."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (insert " ")
(let* ((value (cond ((get symbol 'saved-value)
(car (get symbol 'saved-value)))
((get symbol 'standard-value)
(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."
- :on "Hide Value"
- :off "Show Value"
- :action 'custom-toggle-parent
- t)
- buttons)
- (insert " ")
(push (widget-create-child-and-convert
widget 'sexp
:button-face 'custom-variable-button-face
children)))
(t
;; Edit mode.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this option."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (insert " ")
(let* ((format (widget-get type :format))
tag-format value-format)
(unless (string-match ":" 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
+ :button-face 'custom-variable-button
+ :sample-face 'custom-variable-tag
tag)
buttons)
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'visibility
- :help-echo "Hide the value of this option."
- :on "Hide Value"
- :off "Show Value"
- :action 'custom-toggle-parent
- t)
- buttons)
(push (widget-create-child-and-convert
widget type
:format value-format
;; Don't push it !!! Custom assumes that the first child is the
;; value one.
(setq children (append children (list comment-widget)))))
- ;; Update the rest of the properties properties.
+ ;; Update the rest of the properties.
(widget-put widget :custom-form form)
(widget-put widget :children children)
;; Now update the state.
(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))
+(defun custom-variable-state (symbol val)
+ "Return the state of SYMBOL if its value is VAL.
+If SYMBOL has a non-nil `custom-get' property, it overrides VAL.
+Possible return values are `standard', `saved', `set', `themed',
+`changed', and `rogue'."
+ (let* ((get (or (get symbol 'custom-get) 'default-value))
(value (if (default-boundp symbol)
(funcall get symbol)
- (widget-get widget :value)))
+ val))
(comment (get symbol 'variable-comment))
tmp
- temp
- (state (cond ((progn (setq tmp (get symbol 'customized-value))
- (setq temp
- (get symbol 'customized-variable-comment))
- (or tmp temp))
- (if (condition-case nil
- (and (equal value (eval (car tmp)))
- (equal comment temp))
- (error nil))
- 'set
- 'changed))
- ((progn (setq tmp (get symbol 'theme-value))
- (setq temp (get symbol 'saved-variable-comment))
- (or tmp temp))
- (if (condition-case nil
- (and (equal comment temp)
- (equal value
- (eval
- (car (custom-variable-theme-value
- symbol)))))
- (error nil))
- (cond
- ((eq (caar tmp) 'user) 'saved)
- ((eq (caar tmp) 'changed)
- (if (condition-case nil
- (and (null comment)
- (equal value
- (eval
- (car (get symbol 'standard-value)))))
- (error nil))
- ;; The value was originally set outside
- ;; custom, but it was set to the standard
- ;; value (probably an autoloaded defcustom).
- 'standard
- 'changed))
- (t 'themed))
- 'changed))
- ((setq tmp (get symbol 'standard-value))
- (if (condition-case nil
- (and (equal value (eval (car tmp)))
- (equal comment nil))
- (error nil))
- 'standard
- 'changed))
- (t 'rogue))))
- (widget-put widget :custom-state state)))
+ temp)
+ (cond ((progn (setq tmp (get symbol 'customized-value))
+ (setq temp
+ (get symbol 'customized-variable-comment))
+ (or tmp temp))
+ (if (condition-case nil
+ (and (equal value (eval (car tmp)))
+ (equal comment temp))
+ (error nil))
+ 'set
+ 'changed))
+ ((progn (setq tmp (get symbol 'theme-value))
+ (setq temp (get symbol 'saved-variable-comment))
+ (or tmp temp))
+ (if (condition-case nil
+ (and (equal comment temp)
+ (equal value
+ (eval
+ (car (custom-variable-theme-value
+ symbol)))))
+ (error nil))
+ (cond
+ ((eq (caar tmp) 'user) 'saved)
+ ((eq (caar tmp) 'changed)
+ (if (condition-case nil
+ (and (null comment)
+ (equal value
+ (eval
+ (car (get symbol 'standard-value)))))
+ (error nil))
+ ;; The value was originally set outside
+ ;; custom, but it was set to the standard
+ ;; value (probably an autoloaded defcustom).
+ 'standard
+ 'changed))
+ (t 'themed))
+ 'changed))
+ ((setq tmp (get symbol 'standard-value))
+ (if (condition-case nil
+ (and (equal value (eval (car tmp)))
+ (equal comment nil))
+ (error nil))
+ 'standard
+ 'changed))
+ (t 'rogue))))
+
+(defun custom-variable-state-set (widget &optional state)
+ "Set the state of WIDGET to STATE.
+If STATE is nil, the value is computed by `custom-variable-state'."
+ (widget-put widget :custom-state
+ (or state (custom-variable-state (widget-value widget)
+ (widget-get widget :value)))))
(defun custom-variable-standard-value (widget)
(get (widget-value widget) 'standard-value))
:button-face 'custom-visibility
:pressed-face 'custom-visibility
:mouse-face 'highlight
- :pressed-face 'highlight)
+ :pressed-face 'highlight
+ :on-image nil
+ :off-image nil)
(defface custom-visibility
'((t :height 0.8 :inherit link))
(defun custom-face-edit-attribute-tag (widget)
- "Returns the first :tag property in WIDGET or one of its children."
+ "Return the first :tag property in WIDGET or one of its children."
(let ((tag (widget-get widget :tag)))
(or (and (not (equal tag "")) tag)
(let ((children (widget-get widget :children)))
`((t :inherit custom-variable-tag))
"Face used for face tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-face-tag-face 'face-alias 'custom-face-tag)
+(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1")
(defcustom custom-face-default-form 'selected
"Default form of displaying face definition."
(define-widget 'custom-face 'custom
"Customize face."
- :sample-face 'custom-face-tag-face
+ :sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
:value-create 'custom-face-value-create
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(t
+ ;; Visibility.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this face."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ (not (eq state 'hidden)))
+ buttons)
+ (insert " ")
;; Create tag.
(insert tag)
(widget-specify-sample widget begin (point))
:sample-face symbol
:tag "sample")
buttons)
- ;; Visibility.
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'visibility
- :help-echo "Hide or show this face."
- :on "Hide Face"
- :off "Show Face"
- :action 'custom-toggle-parent
- (not (eq state 'hidden)))
- buttons)
;; Magic.
(insert "\n")
(let ((magic (widget-create-child-and-convert
(t (:weight bold)))
"Face used for group tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1)
+(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1")
(defface custom-group-tag
`((((class color)
(t (:weight bold)))
"Face used for low level group tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-group-tag-face 'face-alias 'custom-group-tag)
+(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1")
(define-widget 'custom-group 'custom
"Customize group."
(symbol (widget-value widget))
(members (custom-group-members symbol
(and (eq custom-buffer-style 'tree)
- custom-browse-only-groups))))
+ custom-browse-only-groups)))
+ (doc (widget-docstring widget)))
(cond ((and (eq custom-buffer-style 'tree)
(eq state 'hidden)
(or members (custom-unloaded-widget-p widget)))
(insert " " tag "\n")
(widget-put widget :buttons buttons)
(message "Creating group...")
- (let* ((members (custom-sort-items members
- custom-browse-sort-alphabetically
+ (let* ((members (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ custom-browse-sort-alphabetically)
custom-browse-order-groups))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
;; Nested style.
(t ;Visible.
+ ;; Draw a horizontal line (this works for both graphical
+ ;; and text displays):
+ (let ((p (point)))
+ (insert "\n")
+ (put-text-property p (1+ p) 'face '(:underline t))
+ (overlay-put (make-overlay p (1+ p))
+ 'before-string
+ (propertize "\n" 'face '(:underline t)
+ 'display '(space :align-to 999))))
+
;; 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
- "Parent groups:"
- "Parent group documentation:")
- (insert "\n"))))
- ;; Create level indicator.
+ (when (eq level 1)
+ (if (custom-add-parent-links widget "Parent groups:")
+ (insert "\n")))
(insert-char ?\ (* custom-buffer-indent (1- level)))
- (insert "/- ")
;; Create tag.
(let ((start (point)))
(insert tag " group: ")
(widget-specify-sample widget start (point)))
- (insert (widget-docstring widget))
+ (cond
+ ((not doc)
+ (insert " Group definition missing. "))
+ ((< (length doc) 50)
+ (insert doc)))
;; Create visibility indicator.
(unless (eq custom-buffer-style 'links)
(insert "--------")
(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")
+ (insert "\n")
;; Create magic button.
(let ((magic (widget-create-child-and-convert
widget 'custom-magic
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
- (widget-add-documentation-string-button
- widget :visibility-widget 'custom-visibility)
+ (when (and doc (>= (length doc) 50))
+ (widget-add-documentation-string-button
+ widget :visibility-widget 'custom-visibility))
;; Parent groups.
(if nil ;;; This should test that the buffer
?\ ))
;; Members.
(message "Creating group...")
- (let* ((members (custom-sort-items members
- custom-buffer-sort-alphabetically
- custom-buffer-order-groups))
+ (let* ((members (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ 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))
+ (len (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...")
+ (reporter (make-progress-reporter
+ "Creating group entries..." 0 len))
+ children)
+ (setq children
+ (mapcar
+ (lambda (entry)
+ (widget-insert "\n")
+ (progress-reporter-update reporter (setq count (1+ count)))
+ (let ((sym (nth 0 entry))
+ (type (nth 1 entry))
+ hidden-p)
+ (prog1
+ (widget-create-child-and-convert
+ widget type
+ :group widget
+ :tag (custom-unlispify-tag-name sym)
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :value sym)
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n")))))
+ members))
(mapc 'custom-magic-reset children)
- (message "Creating group state...")
(widget-put widget :children children)
(custom-group-state-update widget)
- (message "Creating group... done"))
+ (progress-reporter-done reporter))
;; 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")))))
+ (let ((p (point)))
+ (insert "\n")
+ (put-text-property p (1+ p) 'face '(:underline t))
+ (overlay-put (make-overlay p (1+ p))
+ 'before-string
+ (propertize "\n" 'face '(:underline t)
+ 'display '(space :align-to 999))))))))
(defvar custom-group-menu
`(("Set for Current Session" custom-group-set
:doc
"Please read entire docstring below before setting \
this through Custom.
-Click om \"More\" \(or position point there and press RETURN)
+Click on \"More\" \(or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
\\<widget-keymap>\
Move to next button, link or editable field. \\[widget-forward]
-Move to previous button, link or editable field. \\[advertised-widget-backward]
+Move to previous button, link or editable field. \\[widget-backward]
\\<custom-field-keymap>\
Complete content of editable text field. \\[widget-complete]
\\<custom-mode-map>\
if that value is non-nil."
(use-local-map custom-mode-map)
(easy-menu-add Custom-mode-menu)
- (when (display-graphic-p)
- (set (make-local-variable 'tool-bar-map)
- (or custom-tool-bar-map
- ;; Set up `custom-tool-bar-map'.
- (let ((map (make-sparse-keymap)))
- (mapc
- (lambda (arg)
- (tool-bar-local-item-from-menu
- (nth 1 arg) (nth 4 arg) map custom-mode-map))
- custom-commands)
- (setq custom-tool-bar-map map)))))
+ (set (make-local-variable 'tool-bar-map)
+ (or custom-tool-bar-map
+ ;; Set up `custom-tool-bar-map'.
+ (let ((map (make-sparse-keymap)))
+ (mapc
+ (lambda (arg)
+ (tool-bar-local-item-from-menu
+ (nth 1 arg) (nth 4 arg) map custom-mode-map
+ :label (nth 5 arg)))
+ custom-commands)
+ (setq custom-tool-bar-map map))))
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(make-local-variable 'widget-documentation-face)
HCoop / bpt / emacs.git / blobdiff