X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1bad168e59601c1c843a38b2962e77b29f497f11..791ffe1ce251f03d8cd51b4f67b56b975bd12083:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 7e014b4f7b..bb2f67422e 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, 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 ;; Maintainer: FSF @@ -9,10 +9,10 @@ ;; 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 @@ -20,9 +20,7 @@ ;; 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 . ;;; Commentary: ;; @@ -168,10 +166,27 @@ "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." @@ -188,20 +203,20 @@ (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." @@ -227,10 +242,6 @@ "Programming tools." :group 'programming) -(defgroup oop nil - "Support for object-oriented programming." - :group 'programming) - (defgroup applications nil "Applications written in Emacs." :group 'emacs) @@ -277,13 +288,8 @@ "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 @@ -294,10 +300,6 @@ "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") @@ -312,18 +314,6 @@ "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) @@ -333,10 +323,6 @@ "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) @@ -416,11 +402,6 @@ "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) @@ -454,13 +435,6 @@ :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 @@ -480,7 +454,7 @@ (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))) @@ -489,7 +463,7 @@ (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))) @@ -698,10 +672,11 @@ If `last', order groups after non-groups." :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. @@ -727,7 +702,7 @@ If `last', order groups after non-groups." (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. @@ -759,31 +734,36 @@ groups after non-groups, if nil do not order groups at all." ;;; 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." @@ -1155,7 +1135,7 @@ Show the buffer in another window, but don't select it." (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. @@ -1401,42 +1381,52 @@ suggest to customize that face, if it's customizable." (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*")))) @@ -1444,7 +1434,7 @@ that are not customizable options, as well as faces and groups ;;;###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))) @@ -1474,7 +1464,7 @@ links: groups have links to subgroups." :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) @@ -1559,6 +1549,12 @@ This button will have a menu with all three reset operations." (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. @@ -1578,18 +1574,13 @@ Otherwise use brackets." '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 - (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" @@ -1600,37 +1591,60 @@ possibly because you started Emacs with `-q'.") :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. @@ -1684,7 +1698,7 @@ possibly because you started Emacs with `-q'.") (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. @@ -1787,7 +1801,7 @@ item in another window.\n\n")) ;;; 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. @@ -1828,8 +1842,7 @@ item in another window.\n\n")) (: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")) @@ -1837,8 +1850,7 @@ item in another window.\n\n")) (: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")) @@ -1848,8 +1860,7 @@ item in another window.\n\n")) (: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")) @@ -1859,8 +1870,7 @@ item in another window.\n\n")) (: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")) @@ -1870,8 +1880,7 @@ item in another window.\n\n")) (: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")) @@ -1885,8 +1894,7 @@ item in another window.\n\n")) (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 "\ @@ -2009,63 +2017,64 @@ and `face'." (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." @@ -2075,7 +2084,7 @@ and `face'." ;;; 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 @@ -2083,15 +2092,17 @@ and `face'." "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) @@ -2109,7 +2120,7 @@ and `face'." (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 @@ -2117,8 +2128,8 @@ and `face'." "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) @@ -2136,8 +2147,8 @@ and `face'." (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)) @@ -2148,8 +2159,7 @@ and `face'." (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)) @@ -2204,9 +2214,10 @@ and `face'." (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))))) @@ -2225,12 +2236,9 @@ and `face'." (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." @@ -2262,8 +2270,8 @@ and `face'." "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 @@ -2308,8 +2316,7 @@ Insert PREFIX first if non-nil." (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:\"." @@ -2328,36 +2335,6 @@ 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))) @@ -2378,11 +2355,10 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." :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 @@ -2393,17 +2369,16 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (((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) @@ -2434,8 +2409,6 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." ;;; 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)) @@ -2449,14 +2422,14 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (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." @@ -2480,7 +2453,11 @@ However, setting it through Custom sets the default value.") (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 @@ -2490,6 +2467,7 @@ However, setting it through Custom sets the default value.") :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 @@ -2524,7 +2502,6 @@ try matching its doc string against `custom-guess-doc-alist'." (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)) @@ -2534,17 +2511,17 @@ try matching its doc string against `custom-guess-doc-alist'." (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) @@ -2557,21 +2534,36 @@ try matching its doc string against `custom-guess-doc-alist'." ((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) @@ -2581,15 +2573,6 @@ try matching its doc string against `custom-guess-doc-alist'." (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 @@ -2600,6 +2583,17 @@ try matching its doc string against `custom-guess-doc-alist'." 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) @@ -2612,19 +2606,10 @@ try matching its doc string against `custom-guess-doc-alist'." :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 @@ -2656,7 +2641,7 @@ try matching its doc string against `custom-guess-doc-alist'." ;; 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. @@ -2679,61 +2664,69 @@ try matching its doc string against `custom-guess-doc-alist'." (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)) @@ -3019,7 +3012,9 @@ to switch between two values." :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)) @@ -3130,7 +3125,7 @@ Also change :reverse-video to :inverse-video." (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))) @@ -3168,10 +3163,10 @@ OS/2 Presentation Manager.") :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.") @@ -3225,11 +3220,10 @@ Only match frames that support the specified face attributes.") ;;; 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." @@ -3241,7 +3235,7 @@ Only match frames that support the specified face attributes.") (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 @@ -3367,6 +3361,18 @@ SPEC must be a full face spec." (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)) @@ -3381,16 +3387,6 @@ SPEC must be a full face spec." :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 @@ -3813,8 +3809,7 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." (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) @@ -3829,8 +3824,7 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." (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." @@ -3889,7 +3883,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (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))) @@ -3943,8 +3938,11 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (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)) @@ -4002,22 +4000,30 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;; 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 "--------") @@ -4028,12 +4034,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (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 @@ -4044,8 +4045,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;; 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 @@ -4058,43 +4060,50 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ?\ )) ;; 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 @@ -4245,7 +4254,7 @@ and hence will not set `custom-file' to that file either." :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) @@ -4283,9 +4292,18 @@ if only the first line of the docstring is shown.")) (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)) @@ -4293,7 +4311,10 @@ if only the first line of the docstring is shown.")) (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 @@ -4595,7 +4616,7 @@ The format is suitable for use with `easy-menu-define'." ;;; `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.") @@ -4625,23 +4646,23 @@ If several parents are listed, go to the first of them." (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: \\\ 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] \\\ Complete content of editable text field. \\[widget-complete] \\\ @@ -4654,21 +4675,21 @@ Reset options to permanent settings. \\[Custom-reset-saved] 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 + :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) @@ -4695,7 +4716,15 @@ if that value is non-nil." (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 "