;;; 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, 2011 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
:group 'environment)
(defgroup hardware nil
- "Support for interfacing with exotic hardware."
+ "Support for interfacing with miscellaneous hardware."
:group 'environment)
(defgroup terminals nil
"Front-ends/assistants for, or emulators of, UNIX features."
:group 'environment)
-(defgroup vms nil
- "Support code for vms."
- :group 'environment)
-
(defgroup i18n nil
"Internationalization and alternate character-set support."
:link '(custom-manual "(emacs)International")
:group 'environment)
(defgroup data nil
- "Support editing files of data."
+ "Support for editing files of data."
:group 'emacs)
(defgroup files nil
- "Support editing files."
+ "Support for editing files."
:group 'emacs)
(defgroup wp nil
"Debugging Emacs itself."
:group 'development)
-(defgroup minibuffer nil
- "Controlling the behavior of the minibuffer."
- :link '(custom-manual "(emacs)Minibuffer")
- :group 'environment)
-
(defgroup keyboard nil
"Input from the keyboard."
:group 'environment)
:link '(custom-manual "(emacs)Windows")
:group 'environment)
-(defgroup mac nil
- "Mac specific features."
- :link '(custom-manual "(emacs)Mac OS")
- :group 'environment
- :version "22.1"
- :prefix "mac-")
-
;;; Custom mode keymaps
(defvar custom-mode-map
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
- "Keymap for `custom-mode'.")
+ "Keymap for `Custom-mode'.")
(defvar custom-mode-link-map
(let ((map (make-keymap)))
(define-key map [down-mouse-1] 'mouse-drag-region)
(define-key map [mouse-2] 'widget-move-and-invoke)
map)
- "Local keymap for links in `custom-mode'.")
+ "Local keymap for links in `Custom-mode'.")
(defvar custom-field-keymap
(let ((map (copy-keymap widget-field-keymap)))
(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
(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 "22.1"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###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)
'custom-button-pressed-unraised))))
(defun custom-buffer-create-internal (options &optional description)
- (custom-mode)
+ (Custom-mode)
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
: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
+ ;; 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)
+;;; (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
+ (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
(widget-insert "\n\n"))
;; Now populate the custom buffer.
(setq group 'emacs))
(let ((name "*Customize Browser*"))
(pop-to-buffer (custom-get-fresh-buffer name)))
- (custom-mode)
+ (Custom-mode)
(widget-insert (format "\
%s buttons; type RET or click mouse-1
on a button to invoke its action.
;;; Modification of Basic Widgets.
;;
;; We add extra properties to the basic widgets needed here. This is
-;; fine, as long as we are careful to stay within out own namespace.
+;; fine, as long as we are careful to stay within our own namespace.
;;
;; We want simple widgets to be displayed by default, but complex
;; widgets to be hidden.
(: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 "\
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 mac) (class color)) ; Like default modeline
+ '((((type x w32 ns) (class color)) ; Like default modeline
(:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
(t
"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 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black"))
(t
- nil))
+ ;; This is for text terminals that support mouse, like GPM mouse
+ ;; or the MS-DOS terminal: inverse-video makes the button stand
+ ;; out on mouse-over.
+ (:inverse-video t)))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "22.1"
:group 'custom-faces)
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black"))
(t
"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)))))
"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"))
+ (cond ((memq state '(invalid modified set))
+ (error "There are unsaved changes"))
((eq state 'hidden)
(widget-put widget :custom-state 'unknown))
(t
: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)
(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."
(push (widget-create-child-and-convert
widget 'item
:format "%{%t%}: "
- :sample-face 'custom-variable-tag-face
+ :sample-face 'custom-variable-tag
:tag tag
:parent widget)
buttons)
: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 " ")
(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)))
:sibling-args (:help-echo "\
Windows NT/9X.")
w32)
- (const :format "MAC "
+ (const :format "NS "
:sibling-args (:help-echo "\
-Macintosh OS.")
- mac)
+GNUstep or Macintosh OS Cocoa interface.")
+ ns)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
;;; The `custom-face' Widget.
(defface custom-face-tag
- `((t (:weight bold :height 1.2 :inherit variable-pitch)))
+ `((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
(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)))
(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 "--------")
;; 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
: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)
(recentf-expand-file-name (custom-file)))
"\\'")
recentf-exclude)))
- (old-buffer (find-buffer-visiting filename)))
+ (old-buffer (find-buffer-visiting filename))
+ old-buffer-name)
+
(with-current-buffer (let ((find-file-visit-truename t))
(or old-buffer (find-file-noselect filename)))
+ ;; We'll save using file-precious-flag, so avoid destroying
+ ;; symlinks. (If we're not already visiting the buffer, this is
+ ;; handled by find-file-visit-truename, above.)
+ (when old-buffer
+ (setq old-buffer-name (buffer-file-name))
+ (set-visited-file-name (file-chase-links filename)))
+
(unless (eq major-mode 'emacs-lisp-mode)
(emacs-lisp-mode))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (print-length nil)
+ (print-level nil))
(custom-save-variables)
(custom-save-faces))
(let ((file-precious-flag t))
(save-buffer))
- (unless old-buffer
+ (if old-buffer
+ (progn
+ (set-visited-file-name old-buffer-name)
+ (set-buffer-modified-p nil))
(kill-buffer (current-buffer))))))
;;;###autoload
;;; `custom-tool-bar-map' used to be set up here. This will fail to
;;; DTRT when `display-graphic-p' returns nil during compilation. Hence
-;;; we set this up lazily in `custom-mode'.
+;;; we set this up lazily in `Custom-mode'.
(defvar custom-tool-bar-map nil
"Keymap for toolbar in Custom mode.")
(parent (downcase (widget-get button :tag))))
(customize-group parent)))))
-(defcustom custom-mode-hook nil
+(defcustom Custom-mode-hook nil
"Hook called when entering Custom mode."
:type 'hook
- :group 'custom-buffer )
+ :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")))
-(define-derived-mode custom-mode nil "Custom"
+(define-derived-mode Custom-mode nil "Custom"
"Major mode for editing customization buffers.
The following commands are available:
\\<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>\
Erase customizations; set options
and buffer text to the standard values. \\[Custom-reset-standard]
-Entry to this mode calls the value of `custom-mode-hook'
+Entry to this mode calls the value of `Custom-mode-hook'
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))
+ 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)
(set (make-local-variable 'widget-link-suffix) ""))
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
+(put 'Custom-mode 'mode-class 'special)
+
+;; backward-compatibility
+(defun custom-mode ()
+ "Non-interactive variant of `Custom-mode'."
+ (Custom-mode))
+(make-obsolete 'custom-mode 'Custom-mode "23.1")
(put 'custom-mode 'mode-class 'special)
+(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
(dolist (regexp
'("^No user option defaults have been changed since Emacs "
HCoop / bpt / emacs.git / blobdiff