X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9f5d3236b9d24311ad27a63f69edd461eea078a7..c4e8cde8c6cea5ab85abbac10626bd5c1fe5a6af:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9ac11a8580..8f88e4d049 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,7 +1,7 @@ ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; -;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Maintainer: FSF @@ -21,8 +21,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; @@ -35,7 +35,7 @@ ;; that the user will run with M-x, and `Custom-' for interactive commands. ;; The identity of a customize option is represented by a Lisp symbol. -;; There is the following values associated with an option. +;; The following values are associated with an option. ;; 0. The current value. @@ -48,42 +48,42 @@ ;; 1. The widget value. -;; This is the value shown in the widget in a customize buffer. +;; This is the value shown in the widget in a customize buffer. ;; 2. The customized value. ;; This is the last value given to the option through customize. ;; It is stored in the 'customized-value' property of the option, in a -;; cons-cell whose car evaluate to the customized value. +;; cons-cell whose car evaluates to the customized value. ;; 3. The saved value. ;; This is last value saved from customize. ;; It is stored in the 'saved-value' property of the option, in a -;; cons-cell whose car evaluate to the saved value. +;; cons-cell whose car evaluates to the saved value. ;; 4. The standard value. ;; This is the value given in the 'defcustom' declaration. ;; It is stored in the 'standard-value' property of the option, in a -;; cons-cell whose car evaluate to the standard value. +;; cons-cell whose car evaluates to the standard value. ;; 5. The "think" value. - -;; This is what customize think the current value should be. - -;; This is the customize value, if any such value exists, otherwise + +;; This is what customize thinks the current value should be. + +;; This is the customized value, if any such value exists, otherwise ;; the saved value, if that exists, and as a last resort the standard -;; value. +;; value. ;; The reason for storing values unevaluated: This is so you can have ;; values that depend on the environment. For example, you can have a -;; valiable that has one value when Emacs is running under a window +;; variable that has one value when Emacs is running under a window ;; system, and another value on a tty. Since the evaluation is only done -;; when the variable is firsty initialized, this is only relevant for the +;; when the variable is first initialized, this is only relevant for the ;; saved (and standard) values, but affect others values for ;; compatibility. @@ -103,8 +103,8 @@ ;; The widget value is different from the current value. ;; 2. changed - -;; The current value is different from the "think" value. + +;; The current value is different from the "think" value. ;; 3. set @@ -120,7 +120,12 @@ ;; 6. rogue -;; There are no standard value. +;; There is no standard value. This means that the variable was +;; not defined with defcustom, nor handled in cus-start.el. You +;; can not create a Custom buffer for such variables using the +;; normal interactive Custom commands. However, such Custom +;; buffers can be created in other ways, for instance, by calling +;; `customize-option' non-interactively. ;; 7. hidden @@ -129,14 +134,15 @@ ;; 8. mismatch ;; The widget value is not valid member of the :type specified for the -;; option. +;; option. ;;; Code: (require 'cus-face) (require 'wid-edit) (eval-when-compile - (defvar custom-versions-load-alist)) ; from cus-load + (defvar custom-versions-load-alist) ; from cus-load + (defvar recentf-exclude)) ; from recentf.el (condition-case nil (require 'cus-load) @@ -412,7 +418,7 @@ :group 'development) (defgroup minibuffer nil - "Controling the behaviour of the minibuffer." + "Controling the behavior of the minibuffer." :link '(custom-manual "(emacs)Minibuffer") :group 'environment) @@ -428,6 +434,10 @@ "Input from the menus." :group 'environment) +(defgroup dnd nil + "Handling data from drag and drop." + :group 'environment) + (defgroup auto-save nil "Preventing accidential loss of data." :group 'files) @@ -485,7 +495,7 @@ Return a list suitable for use in `interactive'." val) (setq val (completing-read (if (and (symbolp v) (custom-variable-p v)) - (format "Customize option: (default %s) " v) + (format "Customize option (default %s): " v) "Customize option: ") obarray 'custom-variable-p t)) (list (if (equal val "") @@ -957,7 +967,7 @@ then prompt for the MODE to customize." (defun customize-group (group) "Customize GROUP, which must be a customization group." (interactive (list (let ((completion-ignore-case t)) - (completing-read "Customize group: (default emacs) " + (completing-read "Customize group (default emacs): " obarray (lambda (symbol) (or (get symbol 'custom-loads) @@ -980,7 +990,7 @@ then prompt for the MODE to customize." (defun customize-group-other-window (group) "Customize GROUP, which must be a customization group." (interactive (list (let ((completion-ignore-case t)) - (completing-read "Customize group: (default emacs) " + (completing-read "Customize group (default emacs): " obarray (lambda (symbol) (or (get symbol 'custom-loads) @@ -1012,9 +1022,12 @@ then prompt for the MODE to customize." (defun customize-option (symbol) "Customize SYMBOL, which must be a user option variable." (interactive (custom-variable-prompt)) - (custom-buffer-create (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" - (custom-unlispify-tag-name symbol)))) + (let ((basevar (indirect-variable symbol))) + (custom-buffer-create (list (list basevar 'custom-variable)) + (format "*Customize Option: %s*" + (custom-unlispify-tag-name basevar))) + (unless (eq symbol basevar) + (message "`%s' is an alias for `%s'" symbol basevar)))) ;;;###autoload (defalias 'customize-variable-other-window 'customize-option-other-window) @@ -1024,9 +1037,12 @@ then prompt for the MODE to customize." "Customize SYMBOL, which must be a user option variable. Show the buffer in another window, but don't select it." (interactive (custom-variable-prompt)) - (custom-buffer-create-other-window - (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol)))) + (let ((basevar (indirect-variable symbol))) + (custom-buffer-create-other-window + (list (list basevar 'custom-variable)) + (format "*Customize Option: %s*" (custom-unlispify-tag-name basevar))) + (unless (eq symbol basevar) + (message "`%s' is an alias for `%s'" symbol basevar)))) (defvar customize-changed-options-previous-release "20.2" "Version for `customize-changed-options' to refer back to by default.") @@ -1107,7 +1123,8 @@ version." ;;;###autoload (defun customize-face (&optional face) "Customize FACE, which should be a face name or nil. -If FACE is nil, customize all faces. +If FACE is nil, customize all faces. If FACE is actually a +face-alias, customize the face it is aliased to. Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." @@ -1124,6 +1141,9 @@ suggest to customize that face, if it's customizable." face) t nil) "*Customize Faces*") + ;; If FACE is actually an alias, customize the face it is aliased to. + (if (get face 'face-alias) + (setq face (get face 'face-alias))) (unless (facep face) (error "Invalid face %S" face)) (custom-buffer-create (list (list face 'custom-face)) @@ -1133,6 +1153,7 @@ suggest to customize that face, if it's customizable." ;;;###autoload (defun customize-face-other-window (&optional face) "Show customization buffer for face FACE in other window. +If FACE is actually a face-alias, customize the face it is aliased to. Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." @@ -1150,6 +1171,8 @@ suggest to customize that face, if it's customizable." face) t nil) "*Customize Faces*") + (if (get face 'face-alias) + (setq face (get face 'face-alias))) (unless (facep face) (error "Invalid face %S" face)) (custom-buffer-create-other-window @@ -1363,7 +1386,6 @@ Otherwise use brackets." :group 'custom-buffer) (defun custom-buffer-create-internal (options &optional description) - (message "Creating customization buffer...") (custom-mode) (if custom-buffer-verbose-help (progn @@ -1373,17 +1395,23 @@ Otherwise use brackets." (widget-insert (format ". %s 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 " (if custom-raised-buttons - "`Raised' buttons" - "Square brackets"))) +changes only the text in the buffer. Invoke the State button to set or +save the option value. Saving an option normally edits your init file. +Invoke " + (if custom-raised-buttons + "`Raised' buttons" + "Square brackets"))) + (widget-create 'info-link + :tag "Custom file" + "(emacs)Saving Customizations") + (widget-insert + " for information on how to save in a different file. +Invoke ") (widget-create 'info-link :tag "Help" :help-echo "Read the online help." "(emacs)Easy Customization") - (widget-insert " for more information.\n\n") - (message "Creating customization buttons...") + (widget-insert " for general information.\n\n") (widget-insert "Operate on everything in this buffer:\n ")) (widget-insert " ")) (widget-create 'push-button @@ -1397,7 +1425,7 @@ Make your editing in this buffer take effect for this session." :tag "Save for Future Sessions" :help-echo "\ Make your editing in this buffer take effect for future Emacs sessions. -This updates your Emacs initialization file or creates a new one one." +This updates your Emacs initialization file or creates a new one." :action (lambda (widget &optional event) (Custom-save))) (if custom-reset-button-menu @@ -1474,13 +1502,15 @@ Un-customize all values in this buffer. They get their standard settings." (unless (eq (preceding-char) ?\n) (widget-insert "\n")) (message "Creating customization items ...done") + (message "Resetting customization items...") (unless (eq custom-buffer-style 'tree) (mapc 'custom-magic-reset custom-options)) + (message "Resetting customization items...done") (message "Creating customization setup...") (widget-setup) (buffer-enable-undo) (goto-char (point-min)) - (message "Creating customization buffer...done")) + (message "Creating customization setup...done")) ;;; The Tree Browser. @@ -1620,72 +1650,90 @@ item in another window.\n\n")) :group 'custom-faces :group 'custom-buffer) -(defface custom-invalid-face '((((class color)) - (:foreground "yellow" :background "red")) - (t - (:weight bold :slant italic :underline t))) +(defface custom-invalid '((((class color)) + (:foreground "yellow1" :background "red1")) + (t + (: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) -(defface custom-rogue-face '((((class color)) - (:foreground "pink" :background "black")) - (t - (:underline t))) +(defface custom-rogue '((((class color)) + (:foreground "pink" :background "black")) + (t + (: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) -(defface custom-modified-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic :bold))) +(defface custom-modified '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (:slant italic :bold))) "Face used when the customize item has been modified." :group 'custom-magic-faces) - -(defface custom-set-face '((((class color)) - (:foreground "blue" :background "white")) - (t - (:slant italic))) +;; backward-compatibility alias +(put 'custom-modified-face 'face-alias 'custom-modified) + +(defface custom-set '((((min-colors 88) (class color)) + (:foreground "blue1" :background "white")) + (((class color)) + (:foreground "blue" :background "white")) + (t + (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) - -(defface custom-changed-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic))) +;; backward-compatibility alias +(put 'custom-set-face 'face-alias 'custom-set) + +(defface custom-changed '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (: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) -(defface custom-saved-face '((t (:underline t))) +(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) (defconst custom-magic-alist '((nil "#" underline "\ -uninitialized, you should not see this.") +UNINITIALIZED, you should not see this.") (unknown "?" italic "\ -unknown, you should not see this.") +UNKNOWN, you should not see this.") (hidden "-" default "\ -hidden, invoke \"Show\" in the previous line to show." "\ +HIDDEN, invoke \"Show\" in the previous line to show." "\ group now hidden, invoke \"Show\", above, to show contents.") - (invalid "x" custom-invalid-face "\ -the value displayed for this %c is invalid and cannot be set.") - (modified "*" custom-modified-face "\ -you have edited the value as text, but you have not set the %c." "\ -you have edited something in this group, but not set it.") - (set "+" custom-set-face "\ -you have set this %c, but not saved it for future sessions." "\ -something in this group has been set, but not saved.") - (changed ":" custom-changed-face "\ -this %c has been changed outside the customize buffer." "\ + (invalid "x" custom-invalid "\ +INVALID, the displayed value cannot be set.") + (modified "*" custom-modified "\ +EDITED, shown value does not take effect until you set or save it." "\ +something in this group has been edited but not set.") + (set "+" custom-set "\ +SET for current session only." "\ +something in this group has been set but not saved.") + (changed ":" custom-changed "\ +CHANGED outside Customize; operating on it here may be unreliable." "\ something in this group has been changed outside customize.") - (saved "!" custom-saved-face "\ -this %c has been set and saved." "\ + (saved "!" custom-saved "\ +SAVED and set." "\ something in this group has been set and saved.") - (rogue "@" custom-rogue-face "\ -this %c has not been changed with customize." "\ + (rogue "@" custom-rogue "\ +NO CUSTOMIZATION DATA; you should not see this." "\ something in this group is not prepared for customization.") (standard " " nil "\ -this %c is unchanged from its standard setting." "\ +STANDARD." "\ visible group members are all at standard settings.")) "Alist of customize option states. Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where @@ -1705,7 +1753,7 @@ STATE is one of the following symbols: `set' This item has been set but not saved. `changed' - The current value of this item has been changed temporarily. + The current value of this item has been changed outside Customize. `saved' This item is marked for saving. `rogue' @@ -1808,7 +1856,7 @@ and `face'." (insert " (lisp)")) ((eq form 'mismatch) (insert " (mismatch)"))) - (put-text-property start (point) 'face 'custom-state-face)) + (put-text-property start (point) 'face 'custom-state)) (insert "\n")) (when (and (eq category 'group) (not (and (eq custom-buffer-style 'links) @@ -1842,7 +1890,7 @@ and `face'." ;;; The `custom' Widget. -(defface custom-button-face +(defface custom-button '((((type x w32 mac) (class color)) ; Like default modeline (:box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) @@ -1851,8 +1899,10 @@ and `face'." "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-button-face 'face-alias 'custom-button) -(defface custom-button-pressed-face +(defface custom-button-pressed '((((type x w32 mac) (class color)) (:box (:line-width 2 :style pressed-button) :background "lightgrey" :foreground "black")) @@ -1861,20 +1911,26 @@ and `face'." "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed) -(defface custom-documentation-face nil +(defface custom-documentation 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)) +;; backward-compatibility alias +(put 'custom-documentation-face 'face-alias 'custom-documentation) + +(defface custom-state '((((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) +;; backward-compatibility alias +(put 'custom-state-face 'face-alias 'custom-state) (define-widget 'custom 'default "Customize a user option." @@ -2070,20 +2126,22 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." ;;; The `custom-comment' Widget. ;; like the editable field -(defface custom-comment-face '((((class grayscale color) - (background light)) - (:background "gray85")) - (((class grayscale color) - (background dark)) - (:background "dim gray")) - (t - (:slant italic))) +(defface custom-comment '((((class grayscale color) + (background light)) + (:background "gray85")) + (((class grayscale color) + (background dark)) + (:background "dim gray")) + (t + (:slant italic))) "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) ;; like font-lock-comment-face -(defface custom-comment-tag-face +(defface custom-comment-tag '((((class color) (background dark)) (:foreground "gray80")) (((class color) (background light)) (:foreground "blue4")) (((class grayscale) (background light)) @@ -2093,6 +2151,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (t (:weight bold))) "Face used for variables or faces comment tags" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag) (define-widget 'custom-comment 'string "User comment." @@ -2132,20 +2192,27 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." ;; When this was underlined blue, users confused it with a ;; Mosaic-style hyperlink... -(defface custom-variable-tag-face +(defface custom-variable-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) + (((min-colors 88) (class color) + (background light)) + (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) (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) -(defface custom-variable-button-face '((t (:underline t :weight bold))) +(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) (defcustom custom-variable-default-form 'edit "Default form of displaying variable values." @@ -2849,10 +2916,12 @@ Only match frames that support the specified face attributes.") ;;; The `custom-face' Widget. -(defface custom-face-tag-face +(defface custom-face-tag `((t (:weight bold :height 1.2 :inherit variable-pitch))) "Face used for face tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-face-tag-face 'face-alias 'custom-face-tag) (defcustom custom-face-default-form 'selected "Default form of displaying face definition." @@ -3281,54 +3350,41 @@ restoring it to the state of a face that has never been customized." ;;; The `face' Widget. -(define-widget 'face 'default - "Select and customize a face." - :convert-widget 'widget-value-convert-widget - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :format "%{%t%}: %[select face%] %v" +(defvar widget-face-prompt-value-history nil + "History of input to `widget-face-prompt-value'.") + +(define-widget 'face 'symbol + "A Lisp face name (with sample)." + :format "%t: (%{sample%}) %v" :tag "Face" :value 'default - :value-create 'widget-face-value-create - :value-delete 'widget-face-value-delete - :value-get 'widget-value-value-get - :validate 'widget-children-validate - :action 'widget-face-action - :match (lambda (widget value) (symbolp value))) + :sample-face-get 'widget-face-sample-face-get + :notify 'widget-face-notify + :match (lambda (widget value) (facep value)) + :complete-function (lambda () + (interactive) + (lisp-complete-symbol 'facep)) + :prompt-match 'facep + :prompt-history 'widget-face-prompt-value-history + :validate (lambda (widget) + (unless (facep (widget-value widget)) + (widget-put widget + :error (format "Invalid face: %S" + (widget-value widget))) + widget))) + +(defun widget-face-sample-face-get (widget) + (let ((value (widget-value widget))) + (if (facep value) + value + 'default))) + +(defun widget-face-notify (widget child &optional event) + "Update the sample, and notify the parent." + (overlay-put (widget-get widget :sample-overlay) + 'face (widget-apply widget :sample-face-get)) + (widget-default-notify widget child event)) -(defun widget-face-value-create (widget) - "Create a `custom-face' child." - (let* ((symbol (widget-value widget)) - (custom-buffer-style 'face) - (child (widget-create-child-and-convert - widget 'custom-face - :custom-level nil - :value symbol))) - (custom-magic-reset child) - (setq custom-options (cons child custom-options)) - (widget-put widget :children (list child)))) - -(defun widget-face-value-delete (widget) - "Remove the child from the options." - (let ((child (car (widget-get widget :children)))) - (setq custom-options (delq child custom-options)) - (widget-children-value-delete widget))) - -(defvar face-history nil - "History of entered face names.") - -(defun widget-face-action (widget &optional event) - "Prompt for a face." - (let ((answer (completing-read "Face: " - (mapcar (lambda (face) - (list (symbol-name face))) - (face-list)) - nil nil nil - 'face-history))) - (unless (zerop (length answer)) - (widget-value-set widget (intern answer)) - (widget-apply widget :notify widget event) - (widget-setup)))) ;;; The `hook' Widget. @@ -3384,32 +3440,41 @@ restoring it to the state of a face that has never been customized." ;; Fixme: make it do so in Emacs. "Face used for group tags. The first member is used for level 1 groups, the second for level 2, -and so forth. The remaining group tags are shown with -`custom-group-tag-face'." +and so forth. The remaining group tags are shown with `custom-group-tag'." :type '(repeat face) :group 'custom-faces) -(defface custom-group-tag-face-1 +(defface custom-group-tag-1 `((((class color) (background dark)) (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) + (((min-colors 88) (class color) + (background light)) + (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch)) (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) -(defface custom-group-tag-face +(defface custom-group-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2)) + (((min-colors 88) (class color) + (background light)) + (:foreground "blue1" :weight bold :height 1.2)) (((class color) (background light)) (:foreground "blue" :weight bold :height 1.2)) (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-widget 'custom-group 'custom "Customize group." @@ -3430,7 +3495,7 @@ and so forth. The remaining group tags are shown with (defun custom-group-sample-face-get (widget) ;; Use :sample-face. (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) - 'custom-group-tag-face)) + 'custom-group-tag)) (define-widget 'custom-group-visibility 'visibility "An indicator and manipulator for hidden group contents." @@ -3771,8 +3836,9 @@ Optional EVENT is the location for the menu." (setq magics (cdr magics))))) (widget-put widget :custom-state found))) (custom-magic-reset widget)) + +;;; Reading and writing the custom file. -;;; The `custom-save-all' Function. ;;;###autoload (defcustom custom-file nil "File used for storing customization information. @@ -3817,27 +3883,49 @@ if only the first line of the docstring is shown.")) (defun custom-file () "Return the file name for saving customizations." - (or custom-file - (let ((user-init-file user-init-file) - (default-init-file - (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs"))) - (when (null user-init-file) - (if (or (file-exists-p default-init-file) - (and (eq system-type 'windows-nt) - (file-exists-p "~/_emacs"))) - ;; Started with -q, i.e. the file containing - ;; Custom settings hasn't been read. Saving - ;; settings there would overwrite other settings. - (error "Saving settings from \"emacs -q\" would overwrite existing customizations")) - (setq user-init-file default-init-file)) - user-init-file))) + (file-chase-links + (or custom-file + (let ((user-init-file user-init-file) + (default-init-file + (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs"))) + (when (null user-init-file) + (if (or (file-exists-p default-init-file) + (and (eq system-type 'windows-nt) + (file-exists-p "~/_emacs"))) + ;; Started with -q, i.e. the file containing + ;; Custom settings hasn't been read. Saving + ;; settings there would overwrite other settings. + (error "Saving settings from \"emacs -q\" would overwrite existing customizations")) + (setq user-init-file default-init-file)) + user-init-file)))) + +;;;###autoload +(defun custom-save-all () + "Save all customizations in `custom-file'." + (let* ((filename (custom-file)) + (recentf-exclude (if recentf-mode + (cons (concat "\\`" + (regexp-quote (custom-file)) + "\\'") + recentf-exclude))) + (old-buffer (find-buffer-visiting filename))) + (with-current-buffer (or old-buffer (find-file-noselect filename)) + (let ((inhibit-read-only t)) + (custom-save-variables) + (custom-save-faces)) + (let ((file-precious-flag t)) + (save-buffer)) + (unless old-buffer + (kill-buffer (current-buffer)))))) + +;; Editing the custom file contents in a buffer. (defun custom-save-delete (symbol) - "Visit `custom-file' and delete all calls to SYMBOL from it. + "Delete all calls to SYMBOL from the contents of the current buffer. Leave point at the old location of the first such call, -or (if there were none) at the end of the buffer." - (let ((default-major-mode 'emacs-lisp-mode)) - (set-buffer (find-file-noselect (custom-file)))) +or (if there were none) at the end of the buffer. + +This function does not save the buffer." (goto-char (point-min)) ;; Skip all whitespace and comments. (while (forward-comment 1)) @@ -4057,19 +4145,7 @@ or (if there were none) at the end of the buffer." (put symbol 'customized-face-comment nil))))) ;; We really should update all custom buffers here. (custom-save-all)) - -;;;###autoload -(defun custom-save-all () - "Save all customizations in `custom-file'." - (let ((inhibit-read-only t)) - (custom-save-variables) - (custom-save-faces) - (save-excursion - (let ((default-major-mode nil)) - (set-buffer (find-file-noselect (custom-file)))) - (let ((file-precious-flag t)) - (save-buffer))))) - + ;;; The Customize Menu. ;;; Menu support @@ -4163,6 +4239,7 @@ The format is suitable for use with `easy-menu-define'." (suppress-keymap map) (define-key map " " 'scroll-up) (define-key map "\177" 'scroll-down) + (define-key map "\C-c\C-c" 'Custom-set) (define-key map "\C-x\C-s" 'Custom-save) (define-key map "q" 'Custom-buffer-done) (define-key map "u" 'Custom-goto-parent) @@ -4192,7 +4269,7 @@ The format is suitable for use with `easy-menu-define'." ["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 "(emacs)Easy Customization") t])) + ["Info" (info "(emacs)Easy Customization") t])) (defun Custom-goto-parent () "Go to the parent group listed at the top of this buffer. @@ -4242,13 +4319,12 @@ if that value is non-nil." (make-local-variable 'custom-options) (make-local-variable 'custom-local-buffer) (make-local-variable 'widget-documentation-face) - (setq widget-documentation-face 'custom-documentation-face) + (setq widget-documentation-face 'custom-documentation) (make-local-variable 'widget-button-face) - (setq widget-button-face 'custom-button-face) - (set (make-local-variable 'widget-button-pressed-face) - 'custom-button-pressed-face) + (setq widget-button-face 'custom-button) + (set (make-local-variable 'widget-button-pressed-face) 'custom-button-pressed) (set (make-local-variable 'widget-mouse-face) - 'custom-button-pressed-face) ; buttons `depress' when moused + 'custom-button-pressed) ; buttons `depress' when moused ;; When possible, use relief for buttons, not bracketing. This test ;; may not be optimal. (when custom-raised-buttons @@ -4257,7 +4333,7 @@ if that value is non-nil." (set (make-local-variable 'widget-link-prefix) "") (set (make-local-variable 'widget-link-suffix) "")) (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) - (run-hooks 'custom-mode-hook)) + (run-mode-hooks 'custom-mode-hook)) (put 'custom-mode 'mode-class 'special)