X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e2ed433103e2ef2903f8bbf10000d894d2306905..e623859c9604ee1a6994ef05d82cf91053d5aba8:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 055772f418..9827ab7d59 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,6 +1,7 @@ ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; -;; Copyright (C) 1996,97,1999,2000,01,02,03,2004 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Maintainer: FSF @@ -20,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: ;; @@ -33,12 +34,115 @@ ;; that interferes with completion. Use `customize-' for commands ;; 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. +;; The following values are associated with an option. + +;; 0. The current value. + +;; This is the value of the option as seen by "the rest of Emacs". + +;; Usually extracted by 'default-value', but can be extracted with +;; different means if the option symbol has the 'custom-get' +;; property. Similarly, set-default (or the 'custom-set' property) +;; can set it. + +;; 1. The widget value. + +;; 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 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 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 evaluates to the standard value. + +;; 5. The "think" value. + +;; 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. + +;; The reason for storing values unevaluated: This is so you can have +;; values that depend on the environment. For example, you can have a +;; 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 first initialized, this is only relevant for the +;; saved (and standard) values, but affect others values for +;; compatibility. + +;; You can see (and modify and save) this unevaluated value by selecting +;; "Show initial Lisp expression" from the Lisp interface. This will +;; give you the unevaluated saved value, if any, otherwise the +;; unevaluated standard value. + +;; The possible states for a customize widget are: + +;; 0. unknown + +;; The state has not been determined yet. + +;; 1. modified + +;; The widget value is different from the current value. + +;; 2. changed + +;; The current value is different from the "think" value. + +;; 3. set + +;; The "think" value is the customized value. + +;; 4. saved + +;; The "think" value is the saved value. + +;; 5. standard + +;; The "think" value is the standard value. + +;; 6. rogue + +;; 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 + +;; There is no widget value. + +;; 8. mismatch + +;; The widget value is not valid member of the :type specified for the +;; 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) @@ -243,7 +347,6 @@ (defgroup customize '((widgets custom-group)) "Customization of the Customization support." - :link '(custom-manual "(emacs)Easy Customization") :prefix "custom-" :group 'help) @@ -315,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) @@ -331,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) @@ -563,7 +670,7 @@ If `last', order groups after non-groups." :type 'boolean :group 'custom-browse) -(defcustom custom-buffer-sort-alphabetically nil +(defcustom custom-buffer-sort-alphabetically t "If non-nil, sort members of each customization group alphabetically." :type 'boolean :group 'custom-buffer) @@ -899,8 +1006,6 @@ then prompt for the MODE to customize." (let ( ;; Copied from `custom-buffer-create-other-window'. (pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer name)) @@ -917,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) @@ -929,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.") @@ -1012,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." @@ -1029,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)) @@ -1038,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." @@ -1055,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 @@ -1182,19 +1300,10 @@ links: groups have links to subgroups." (const links)) :group 'custom-buffer) -;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from -;; the window. -(defun custom-bury-buffer (buffer) - (with-current-buffer buffer - (bury-buffer))) - -(defcustom custom-buffer-done-function 'custom-bury-buffer - "*Function called to remove a Custom buffer when the user is done with it. -Called with one argument, the buffer to remove." - :type '(choice (function-item :tag "Bury buffer" custom-bury-buffer) - (function-item :tag "Kill buffer" kill-buffer) - (function :tag "Other")) - :version "21.1" +(defcustom custom-buffer-done-kill nil + "*Non-nil means exiting a Custom buffer should kill it." + :type 'boolean + :version "22.1" :group 'custom-buffer) (defcustom custom-buffer-indent 3 @@ -1247,8 +1356,6 @@ SYMBOL is a customization option, and WIDGET is a widget for editing that option." (unless name (setq name "*Customization*")) (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer (custom-get-fresh-buffer name)) @@ -1266,9 +1373,9 @@ This button will have a menu with all three reset operations." :group 'custom-buffer) (defun Custom-buffer-done (&rest ignore) - "Remove current buffer by calling `custom-buffer-done-function'." + "Exit current Custom buffer according to `custom-buffer-done-kill'." (interactive) - (funcall custom-buffer-done-function (current-buffer))) + (quit-window custom-buffer-done-kill)) (defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box) '(("unspecified" . unspecified)))) @@ -1279,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 @@ -1289,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 @@ -1312,7 +1424,8 @@ Make your editing in this buffer take effect for this session." (widget-create 'push-button :tag "Save for Future Sessions" :help-echo "\ -Make your editing in this buffer take effect for future Emacs sessions." +Make your editing in this buffer take effect for future Emacs sessions. +This updates your Emacs initialization file or creates a new one." :action (lambda (widget &optional event) (Custom-save))) (if custom-reset-button-menu @@ -1354,13 +1467,9 @@ Un-customize all values in this buffer. They get their standard settings." :tag "Finish" :help-echo (lambda (&rest ignore) - (cond - ((eq custom-buffer-done-function - 'custom-bury-buffer) - "Bury this buffer") - ((eq custom-buffer-done-function 'kill-buffer) - "Kill this buffer") - (t "Finish with this buffer"))) + (if custom-buffer-done-kill + "Kill this buffer" + "Bury this buffer")) :action #'Custom-buffer-done) (widget-insert "\n\n") (message "Creating customization items...") @@ -1393,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. @@ -1539,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 @@ -1624,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' @@ -1727,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) @@ -1761,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")) @@ -1770,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")) @@ -1780,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." @@ -1989,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)) @@ -2012,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." @@ -2051,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." @@ -2768,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." @@ -3200,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. @@ -3303,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." @@ -3349,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." @@ -3690,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. @@ -3736,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)) @@ -3976,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 @@ -4073,23 +4230,24 @@ The format is suitable for use with `easy-menu-define'." ;;; The Custom Mode. -(defvar custom-mode-map nil - "Keymap for `custom-mode'.") - -(unless custom-mode-map +(defvar custom-mode-map ;; This keymap should be dense, but a dense keymap would prevent inheriting ;; "\r" bindings from the parent map. - (setq custom-mode-map (make-sparse-keymap)) - (set-keymap-parent custom-mode-map widget-keymap) - (suppress-keymap custom-mode-map) - (define-key custom-mode-map " " 'scroll-up) - (define-key custom-mode-map "\177" 'scroll-down) - (define-key custom-mode-map "\C-x\C-s" 'Custom-save) - (define-key custom-mode-map "q" 'Custom-buffer-done) - (define-key custom-mode-map "u" 'Custom-goto-parent) - (define-key custom-mode-map "n" 'widget-forward) - (define-key custom-mode-map "p" 'widget-backward) - (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke)) + ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. + (let ((map (make-keymap))) + (set-keymap-parent map widget-keymap) + (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) + (define-key map "n" 'widget-forward) + (define-key map "p" 'widget-backward) + (define-key map [mouse-1] 'Custom-move-and-invoke) + map) + "Keymap for `custom-mode'.") (defun Custom-move-and-invoke (event) "Move to where you click, and if it is an active field, invoke it." @@ -4111,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. @@ -4161,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 @@ -4176,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) @@ -4188,5 +4345,5 @@ if that value is non-nil." (provide 'cus-edit) -;;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f +;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f ;;; cus-edit.el ends here