diff lisp/cus-edit.el @ 209:41ff10fd062f r20-4b3

Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents
children 78f53ef88e17
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cus-edit.el	Mon Aug 13 10:04:58 2007 +0200
@@ -0,0 +1,3234 @@
+;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Keywords: help, faces
+;; Version: 1.9960-x
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This file implements the code to create and edit customize buffers.
+;;
+;; See `custom.el'.
+
+;; No commands should have names starting with `custom-' because
+;; that interferes with completion.  Use `customize-' for commands
+;; that the user will run with M-x, and `Custom-' for interactive commands.
+
+
+;;; Code:
+
+(require 'cus-face)
+(require 'wid-edit)
+(require 'easymenu)
+
+(require 'cus-load)
+(require 'cus-start)
+
+;; Huh?  This looks dirty!
+(put 'custom-define-hook 'custom-type 'hook)
+(put 'custom-define-hook 'standard-value '(nil))
+(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
+
+;;; Customization Groups.
+
+(defgroup emacs nil
+  "Customization of the One True Editor."
+  :link '(custom-manual "(XEmacs)Top"))
+
+;; Most of these groups are stolen from `finder.el',
+(defgroup editing nil
+  "Basic text editing facilities."
+  :group 'emacs)
+
+(defgroup abbrev nil
+  "Abbreviation handling, typing shortcuts, macros."
+  :tag "Abbreviations"
+  :group 'editing)
+
+(defgroup matching nil
+  "Various sorts of searching and matching."
+  :group 'editing)
+
+(defgroup emulations nil
+  "Emulations of other editors."
+  :group 'editing)
+
+(defgroup mouse nil
+  "Mouse support."
+  :group 'editing)
+
+(defgroup outlines nil
+  "Support for hierarchical outlining."
+  :group 'editing)
+
+(defgroup external nil
+  "Interfacing to external utilities."
+  :group 'emacs)
+
+(defgroup bib nil
+  "Code related to the `bib' bibliography processor."
+  :tag "Bibliography"
+  :group 'external)
+
+(defgroup processes nil
+  "Process, subshell, compilation, and job control support."
+  :group 'external
+  :group 'development)
+
+(defgroup programming nil
+  "Support for programming in other languages."
+  :group 'emacs)
+
+(defgroup languages nil
+  "Specialized modes for editing programming languages."
+  :group 'programming)
+
+(defgroup lisp nil
+  "Lisp support, including Emacs Lisp."
+  :group 'languages
+  :group 'development)
+
+(defgroup c nil
+  "Support for the C language and related languages."
+  :group 'languages)
+
+(defgroup tools nil
+  "Programming tools."
+  :group 'programming)
+
+(defgroup oop nil
+  "Support for object-oriented programming."
+  :group 'programming)
+
+(defgroup applications nil
+  "Applications written in Emacs."
+  :group 'emacs)
+
+(defgroup calendar nil
+  "Calendar and time management support."
+  :group 'applications)
+
+(defgroup mail nil
+  "Modes for electronic-mail handling."
+  :group 'applications)
+
+(defgroup news nil
+  "Support for netnews reading and posting."
+  :group 'applications)
+
+(defgroup games nil
+  "Games, jokes and amusements."
+  :group 'applications)
+
+(defgroup development nil
+  "Support for further development of Emacs."
+  :group 'emacs)
+
+(defgroup docs nil
+  "Support for Emacs documentation."
+  :group 'development)
+
+(defgroup extensions nil
+  "Emacs Lisp language extensions."
+  :group 'development)
+
+(defgroup internal nil
+  "Code for Emacs internals, build process, defaults."
+  :group 'development)
+
+(defgroup maint nil
+  "Maintenance aids for the Emacs development group."
+  :tag "Maintenance"
+  :group 'development)
+
+(defgroup environment nil
+  "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."
+  :group 'environment)
+
+(defgroup terminals nil
+  "Support for terminal types."
+  :group 'environment)
+
+(defgroup unix nil
+  "Front-ends/assistants for, or emulators of, UNIX features."
+  :group 'environment)
+
+(defgroup vms nil
+  "Support code for vms."
+  :group 'environment)
+
+(defgroup i18n nil
+  "Internationalization and alternate character-set support."
+  :group 'environment
+  :group 'editing)
+
+(defgroup x nil
+  "The X Window system."
+  :group 'environment)
+
+(defgroup frames nil
+  "Support for Emacs frames and window systems."
+  :group 'environment)
+
+(defgroup data nil
+  "Support editing files of data."
+  :group 'emacs)
+
+(defgroup files nil
+  "Support editing files."
+  :group 'emacs)
+
+(defgroup wp nil
+  "Word processing."
+  :group 'emacs)
+
+(defgroup tex nil
+  "Code related to the TeX formatter."
+  :group 'wp)
+
+(defgroup faces nil
+  "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)
+
+(defgroup local nil
+  "Code local to your site."
+  :group 'emacs)
+
+(defgroup customize '((widgets custom-group))
+  "Customization of the Customization support."
+  :link '(custom-manual "(custom)Top")
+  :link '(url-link :tag "Development Page"
+		   "http://www.dina.kvl.dk/~abraham/custom/")
+  :prefix "custom-"
+  :group 'help)
+
+(defgroup custom-faces nil
+  "Faces used by customize."
+  :group 'customize
+  :group 'faces)
+
+(defgroup custom-browse nil
+  "Control customize browser."
+  :prefix "custom-"
+  :group 'customize)
+
+(defgroup custom-buffer nil
+  "Control customize buffers."
+  :prefix "custom-"
+  :group 'customize)
+
+(defgroup custom-menu nil
+  "Control customize menus."
+  :prefix "custom-"
+  :group 'customize)
+
+(defgroup abbrev-mode nil
+  "Word abbreviations mode."
+  :group 'abbrev)
+
+(defgroup alloc nil
+  "Storage allocation and gc for GNU Emacs Lisp interpreter."
+  :tag "Storage Allocation"
+  :group 'internal)
+
+(defgroup undo nil
+  "Undoing changes in buffers."
+  :group 'editing)
+
+(defgroup modeline nil
+  "Content of the modeline."
+  :group 'environment)
+
+(defgroup fill nil
+  "Indenting and filling text."
+  :group 'editing)
+
+(defgroup editing-basics nil
+  "Most basic editing facilities."
+  :group 'editing)
+
+(defgroup display nil
+  "How characters are displayed in buffers."
+  :group 'environment)
+
+(defgroup execute nil
+  "Executing external commands."
+  :group 'processes)
+
+(defgroup installation nil
+  "The Emacs installation."
+  :group 'environment)
+
+(defgroup dired nil
+  "Directory editing."
+  :group 'environment)
+
+(defgroup limits nil
+  "Internal Emacs limits."
+  :group 'internal)
+
+(defgroup debug nil
+  "Debugging Emacs itself."
+  :group 'development)
+
+(defgroup minibuffer nil
+  "Controling the behaviour of the minibuffer."
+  :group 'environment)
+
+(defgroup keyboard nil
+  "Input from the keyboard."
+  :group 'environment)
+
+(defgroup mouse nil
+  "Input from the mouse."
+  :group 'environment)
+
+(defgroup menu nil
+  "Input from the menus."
+  :group 'environment)
+
+(defgroup auto-save nil
+  "Preventing accidential loss of data."
+  :group 'files)
+
+(defgroup processes-basics nil
+  "Basic stuff dealing with processes."
+  :group 'processes)
+
+(defgroup mule nil
+  "MULE Emacs internationalization."
+  :group 'i18n)
+
+(defgroup windows nil
+  "Windows within a frame."
+  :group 'environment)
+
+
+;;; Utilities.
+
+(defun custom-quote (sexp)
+  "Quote SEXP iff it is not self quoting."
+  (if (or (memq sexp '(t nil))
+	  (keywordp sexp)
+	  (eq (car-safe sexp) 'lambda)
+	  (stringp sexp)
+	  (numberp sexp)
+	  (characterp sexp))
+      sexp
+    (list 'quote sexp)))
+
+(defun custom-split-regexp-maybe (regexp)
+  "If REGEXP is a string, split it to a list at `\\|'.
+You can get the original back with from the result with:
+  (mapconcat 'identity result \"\\|\")
+
+IF REGEXP is not a string, return it unchanged."
+  (if (stringp regexp)
+      (split-string regexp "\\\\|")
+    regexp))
+
+(defun custom-variable-prompt ()
+  ;; Code stolen from `help.el'.
+  "Prompt for a variable, defaulting to the variable at point.
+Return a list suitable for use in `interactive'."
+   (let ((v (variable-at-point))
+	 (enable-recursive-minibuffers t)
+	 val)
+     (setq val (completing-read
+		(if (symbolp v)
+		    (format "Customize variable: (default %s) " v)
+		  "Customize variable: ")
+		obarray (lambda (symbol)
+			  (and (boundp symbol)
+			       (or (get symbol 'custom-type)
+				   (user-variable-p symbol))))))
+     (list (if (equal val "")
+	       (if (symbolp v) v nil)
+	     (intern val)))))
+
+;; Here we take not only the actual groups, but the loads, too.
+(defun custom-group-prompt (prompt)
+  "Read group from minibuffer."
+  (let ((completion-ignore-case t))
+    (list (completing-read
+	   prompt obarray
+	   (lambda (symbol)
+	     (or (get symbol 'custom-group)
+		 (get symbol 'custom-loads)))
+	   t))))
+
+(defun custom-menu-filter (menu widget)
+  "Convert MENU to the form used by `widget-choose'.
+MENU should be in the same format as `custom-variable-menu'.
+WIDGET is the widget to apply the filter entries of MENU on."
+  (let ((result nil)
+	current name action filter)
+    (while menu
+      (setq current (car menu)
+	    name (nth 0 current)
+	    action (nth 1 current)
+	    filter (nth 2 current)
+	    menu (cdr menu))
+      (if (or (null filter) (funcall filter widget))
+	  (push (cons name action) result)
+	(push name result)))
+    (nreverse result)))
+
+
+;;; Unlispify.
+
+(defvar custom-prefix-list nil
+  "List of prefixes that should be ignored by `custom-unlispify'")
+
+(defcustom custom-unlispify-menu-entries t
+  "Display menu entries as words instead of symbols if non nil."
+  :group 'custom-menu
+  :type 'boolean)
+
+(defcustom custom-unlispify-remove-prefixes t
+  "Non-nil means remove group prefixes from option names in buffers and menus."
+  :group 'custom-menu
+  :type 'boolean)
+
+(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
+  "Convert symbol into a menu entry."
+  (cond ((not custom-unlispify-menu-entries)
+	 (symbol-name symbol))
+	((get symbol 'custom-tag)
+	 (if no-suffix
+	     (get symbol 'custom-tag)
+	   (concat (get symbol 'custom-tag) "...")))
+	(t
+	 (with-current-buffer (get-buffer-create " *Custom-Work*")
+	   (erase-buffer)
+	   (princ symbol (current-buffer))
+	   (goto-char (point-min))
+	   (when (and (eq (get symbol 'custom-type) 'boolean)
+		      (re-search-forward "-p\\'" nil t))
+	     (replace-match "" t t)
+	     (goto-char (point-min)))
+	   (when custom-unlispify-remove-prefixes
+	     (let ((prefixes custom-prefix-list)
+		   prefix)
+	       (while prefixes
+		 (setq prefix (car prefixes))
+		 (if (search-forward prefix (+ (point) (length prefix)) t)
+		     (progn
+		       (setq prefixes nil)
+		       (delete-region (point-min) (point)))
+		   (setq prefixes (cdr prefixes))))))
+	   (subst-char-in-region (point-min) (point-max) ?- ?\  t)
+	   (capitalize-region (point-min) (point-max))
+	   (unless no-suffix
+	     (goto-char (point-max))
+	     (insert "..."))
+	   (buffer-string)))))
+
+(defcustom custom-unlispify-tag-names t
+  "Display tag names as words instead of symbols if non nil."
+  :group 'custom-buffer
+  :type 'boolean)
+
+(defun custom-unlispify-tag-name (symbol)
+  "Convert symbol into a menu entry."
+  (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
+    (custom-unlispify-menu-entry symbol t)))
+
+(defun custom-prefix-add (symbol prefixes)
+  ;; Addd SYMBOL to list of ignored PREFIXES.
+  (cons (or (get symbol 'custom-prefix)
+	    (concat (symbol-name symbol) "-"))
+	prefixes))
+
+
+;;; Guess.
+
+(defcustom custom-guess-name-alist
+  '(("-p\\'" boolean)
+    ("-hooks?\\'" hook)
+    ("-face\\'" face)
+    ("-file\\'" file)
+    ("-function\\'" function)
+    ("-functions\\'" (repeat function))
+    ("-list\\'" (repeat sexp))
+    ("-alist\\'" (repeat (cons sexp sexp))))
+  "Alist of (MATCH TYPE).
+
+MATCH should be a regexp matching the name of a symbol, and TYPE should
+be a widget suitable for editing the value of that symbol.  The TYPE
+of the first entry where MATCH matches the name of the symbol will be
+used.
+
+This is used for guessing the type of variables not declared with
+customize."
+  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
+  :group 'customize)
+
+(defcustom custom-guess-doc-alist
+  '(("\\`\\*?Non-nil " boolean))
+  "Alist of (MATCH TYPE).
+
+MATCH should be a regexp matching a documentation string, and TYPE
+should be a widget suitable for editing the value of a variable with
+that documentation string.  The TYPE of the first entry where MATCH
+matches the name of the symbol will be used.
+
+This is used for guessing the type of variables not declared with
+customize."
+  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
+  :group 'customize)
+
+(defun custom-guess-type (symbol)
+  "Guess a widget suitable for editing the value of SYMBOL.
+This is done by matching SYMBOL with `custom-guess-name-alist' and
+if that fails, the doc string with `custom-guess-doc-alist'."
+  (let ((name (symbol-name symbol))
+	(names custom-guess-name-alist)
+	current found)
+    (while names
+      (setq current (car names)
+	    names (cdr names))
+      (when (string-match (nth 0 current) name)
+	(setq found (nth 1 current)
+	      names nil)))
+    (unless found
+      (let ((doc (documentation-property symbol 'variable-documentation))
+	    (docs custom-guess-doc-alist))
+	(when doc
+	  (while docs
+	    (setq current (car docs)
+		  docs (cdr docs))
+	    (when (string-match (nth 0 current) doc)
+	      (setq found (nth 1 current)
+		    docs nil))))))
+    found))
+
+
+;;; Sorting.
+
+(defcustom custom-browse-sort-alphabetically nil
+  "If non-nil, sort members of each customization group alphabetically."
+  :type 'boolean
+  :group 'custom-browse)
+
+(defcustom custom-browse-order-groups nil
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
+  :group 'custom-browse)
+
+(defcustom custom-browse-only-groups nil
+  "If non-nil, show group members only within each customization group."
+  :type 'boolean
+  :group 'custom-browse)
+
+(defcustom custom-buffer-sort-alphabetically nil
+  "If non-nil, sort members of each customization group alphabetically."
+  :type 'boolean
+  :group 'custom-buffer)
+
+(defcustom custom-buffer-order-groups 'last
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
+  :group 'custom-buffer)
+
+(defcustom custom-menu-sort-alphabetically nil
+  "If non-nil, sort members of each customization group alphabetically."
+  :type 'boolean
+  :group 'custom-menu)
+
+(defcustom custom-menu-order-groups 'first
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
+  :group 'custom-menu)
+
+(defun custom-sort-items (items sort-alphabetically order-groups)
+  "Return a sorted copy of ITEMS.
+ITEMS should be a `custom-group' property.
+If SORT-ALPHABETICALLY non-nil, sort alphabetically.
+If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
+groups after non-groups, if nil do not order groups at all."
+  (sort (copy-sequence items)
+   (lambda (a b)
+     (let ((typea (nth 1 a)) (typeb (nth 1 b))
+	   (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b))))
+       (cond ((not order-groups)
+	      ;; Since we don't care about A and B order, maybe sort.
+	      (when sort-alphabetically
+		(string-lessp namea nameb)))
+	     ((eq typea 'custom-group)
+	      ;; If B is also a group, maybe sort.  Otherwise, order A and B.
+	      (if (eq typeb 'custom-group)
+		  (when sort-alphabetically
+		    (string-lessp namea nameb))
+		(eq order-groups 'first)))
+	     ((eq typeb 'custom-group)
+	      ;; Since A cannot be a group, order A and B.
+	      (eq order-groups 'last))
+	     (sort-alphabetically
+	      ;; Since A and B cannot be groups, sort.
+	      (string-lessp namea nameb)))))))
+
+
+;;; Custom Mode Commands.
+
+(defvar custom-options nil
+  "Customization widgets in the current buffer.")
+
+(defun Custom-set ()
+  "Set changes in all modified options."
+  (interactive)
+  (let ((children custom-options))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-set)))
+	  children)))
+
+(defun Custom-save ()
+  "Set all modified group members and save them."
+  (interactive)
+  (let ((children custom-options))
+    (mapc (lambda (child)
+	    (when (memq (widget-get child :custom-state) '(modified set))
+	      (widget-apply child :custom-save)))
+	  children))
+  (custom-save-all))
+
+(defvar custom-reset-menu
+  '(("Current" . Custom-reset-current)
+    ("Saved" . Custom-reset-saved)
+    ("Standard Settings" . Custom-reset-standard))
+  "Alist of actions for the `Reset' button.
+The key is a string containing the name of the action, the value is a
+lisp function taking the widget as an element which will be called
+when the action is chosen.")
+
+(defun custom-reset (event)
+  "Select item from reset menu."
+  (let* ((completion-ignore-case t)
+	 (answer (widget-choose "Reset to"
+				custom-reset-menu
+				event)))
+    (if answer
+	(funcall answer))))
+
+(defun Custom-reset-current (&rest ignore)
+  "Reset all modified group members to their current value."
+  (interactive)
+  (let ((children custom-options))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-reset-current)))
+	  children)))
+
+(defun Custom-reset-saved (&rest ignore)
+  "Reset all modified or set group members to their saved value."
+  (interactive)
+  (let ((children custom-options))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-reset-saved)))
+	  children)))
+
+(defun Custom-reset-standard (&rest ignore)
+  "Reset all modified, set, or saved group members to their standard settings."
+  (interactive)
+  (let ((children custom-options))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-reset-standard)))
+	  children)))
+
+
+;;; The Customize Commands
+
+(defun custom-prompt-variable (prompt-var prompt-val)
+  "Prompt for a variable and a value and return them as a list.
+PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
+prompt for the value.  The %s escape in PROMPT-VAL is replaced with
+the name of the variable.
+
+If the variable has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If the variable has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value."
+  (let* ((var (read-variable prompt-var))
+	 (minibuffer-help-form '(describe-variable var)))
+    (list var
+	  (let ((prop (get var 'variable-interactive))
+		(type (get var 'custom-type))
+		(prompt (format prompt-val var)))
+	    (unless (listp type)
+	      (setq type (list type)))
+	    (cond (prop
+		   ;; Use VAR's `variable-interactive' property
+		   ;; as an interactive spec for prompting.
+		   (call-interactively (list 'lambda '(arg)
+					     (list 'interactive prop)
+					     'arg)))
+		  (type
+		   (widget-prompt-value type
+					prompt
+					(if (boundp var)
+					    (symbol-value var))
+					(not (boundp var))))
+		  (t
+		   (eval-minibuffer prompt)))))))
+
+;;;###autoload
+(defun customize-set-value (var val)
+  "Set VARIABLE to VALUE.  VALUE is a Lisp object.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value."
+  (interactive (custom-prompt-variable "Set variable: "
+				       "Set %s to value: "))
+
+  (set var val))
+
+;;;###autoload
+(defun customize-set-variable (var val)
+  "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.
+
+If VARIABLE has a `custom-set' property, that is used for setting
+VARIABLE, otherwise `set-default' is used.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value. "
+  (interactive (custom-prompt-variable "Set variable: "
+				       "Set customized value for %s to: "))
+  (funcall (or (get var 'custom-set) 'set-default) var val)
+  (put var 'customized-value (list (custom-quote val))))
+
+;;;###autoload
+(defun customize-save-variable (var val)
+  "Set the default for VARIABLE to VALUE, and save it for future sessions.
+If VARIABLE has a `custom-set' property, that is used for setting
+VARIABLE, otherwise `set-default' is used.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read the value.
+
+If VARIABLE has a `custom-type' property, it must be a widget and the
+`:prompt-value' property of that widget will be used for reading the value. "
+  (interactive (custom-prompt-variable "Set and ave variable: "
+				       "Set and save value for %s as: "))
+  (funcall (or (get var 'custom-set) 'set-default) var val)
+  (put var 'saved-value (list (custom-quote val)))
+  (custom-save-all))
+
+;;;###autoload
+(defun customize (group)
+  "Select a customization buffer which you can use to set user options.
+User options are structured into \"groups\".
+The default group is `Emacs'."
+  (interactive (custom-group-prompt
+		"Customize group: (default emacs) "))
+  (when (stringp group)
+    (if (string-equal "" group)
+	(setq group 'emacs)
+      (setq group (intern group))))
+  (let ((name (format "*Customize Group: %s*"
+		      (custom-unlispify-tag-name group))))
+    (if (get-buffer name)
+	(switch-to-buffer name)
+      (custom-buffer-create (list (list group 'custom-group))
+			    name
+			    (concat " for group "
+				    (custom-unlispify-tag-name group))))))
+
+;;;###autoload
+(defalias 'customize-group 'customize)
+
+;;;###autoload
+(defun customize-other-window (symbol)
+  "Customize SYMBOL, which must be a customization group."
+  (interactive (custom-group-prompt
+		"Customize group: (default emacs) "))
+  (when (stringp symbol)
+    (if (string-equal "" symbol)
+	(setq symbol 'emacs)
+      (setq symbol (intern symbol))))
+  (custom-buffer-create-other-window
+   (list (list symbol 'custom-group))
+   (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
+
+;;;###autoload
+(defalias 'customize-group-other-window 'customize-other-window)
+
+;;;###autoload
+(defalias 'customize-option 'customize-variable)
+
+;;;###autoload
+(defun customize-variable (symbol)
+  "Customize SYMBOL, which must be a user option variable."
+  (interactive (custom-variable-prompt))
+  (custom-buffer-create (list (list symbol 'custom-variable))
+			(format "*Customize Variable: %s*"
+				(custom-unlispify-tag-name symbol))))
+
+;;;###autoload
+(defalias 'customize-variable-other-window 'customize-option-other-window)
+
+;;;###autoload
+(defun customize-option-other-window (symbol)
+  "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))))
+
+;;;###autoload
+(defun customize-face (&optional symbol)
+  "Customize SYMBOL, which should be a face name or nil.
+If SYMBOL is nil, customize all faces."
+  (interactive (list (completing-read "Customize face: (default all) "
+				      obarray 'find-face)))
+  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+      (custom-buffer-create (custom-sort-items
+			     (mapcar (lambda (symbol)
+				       (list symbol 'custom-face))
+				     (face-list))
+			     t nil)
+			    "*Customize Faces*")
+    (when (stringp symbol)
+      (setq symbol (intern symbol)))
+    (unless (symbolp symbol)
+      (error "Should be a symbol %S" symbol))
+    (custom-buffer-create (list (list symbol 'custom-face))
+			  (format "*Customize Face: %s*"
+				  (custom-unlispify-tag-name symbol)))))
+
+;;;###autoload
+(defun customize-face-other-window (&optional symbol)
+  "Show customization buffer for FACE in other window."
+  (interactive (list (completing-read "Customize face: "
+				      obarray 'find-face)))
+  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+      ()
+    (if (stringp symbol)
+	(setq symbol (intern symbol)))
+    (unless (symbolp symbol)
+      (error "Should be a symbol %S" symbol))
+    (custom-buffer-create-other-window
+     (list (list symbol 'custom-face))
+     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
+
+;;;###autoload
+(defun customize-customized ()
+  "Customize all user options set since the last save in this session."
+  (interactive)
+  (let ((found nil))
+    (mapatoms (lambda (symbol)
+		(and (get symbol 'customized-face)
+		     (find-face symbol)
+		     (push (list symbol 'custom-face) found))
+		(and (get symbol 'customized-value)
+		     (boundp symbol)
+		     (push (list symbol 'custom-variable) found))))
+    (if (not found)
+	(error "No customized user options")
+      (custom-buffer-create (custom-sort-items found t nil)
+			    "*Customize Customized*"))))
+
+;;;###autoload
+(defun customize-saved ()
+  "Customize all already saved user options."
+  (interactive)
+  (let ((found nil))
+    (mapatoms (lambda (symbol)
+		(and (get symbol 'saved-face)
+		     (find-face symbol)
+		     (push (list symbol 'custom-face) found))
+		(and (get symbol 'saved-value)
+		     (boundp symbol)
+		     (push (list symbol 'custom-variable) found))))
+    (if (not found )
+	(error "No saved user options")
+      (custom-buffer-create (custom-sort-items found t nil)
+			    "*Customize Saved*"))))
+
+;;;###autoload
+(defun customize-apropos (regexp &optional all)
+  "Customize all user options 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 options which are not
+user-settable, as well as faces and groups."
+  (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)))
+			     (find-face symbol))
+		    (push (list symbol 'custom-face) found))
+		  (when (and (not (memq all '(groups faces)))
+			     (boundp symbol)
+			     (or (get symbol 'saved-value)
+				 (get symbol 'standard-value)
+				 (if (memq all '(nil options))
+				     (user-variable-p symbol)
+				   (get symbol 'variable-documentation))))
+		    (push (list symbol 'custom-variable) found)))))
+    (if (not found)
+	(error "No matches")
+      (custom-buffer-create (custom-sort-items found t
+					       custom-buffer-order-groups)
+			    "*Customize Apropos*"))))
+
+;;;###autoload
+(defun customize-apropos-options (regexp &optional arg)
+  "Customize all user options matching REGEXP.
+With prefix arg, include options which are not user-settable."
+  (interactive "sCustomize regexp: \nP")
+  (customize-apropos regexp (or arg 'options)))
+
+;;;###autoload
+(defun customize-apropos-faces (regexp)
+  "Customize all user faces matching REGEXP."
+  (interactive "sCustomize regexp: \n")
+  (customize-apropos regexp 'faces))
+
+;;;###autoload
+(defun customize-apropos-groups (regexp)
+  "Customize all user groups matching REGEXP."
+  (interactive "sCustomize regexp: \n")
+  (customize-apropos regexp 'groups))
+
+
+;;; Buffer.
+
+(defcustom custom-buffer-style 'links
+  "Control the presentation style for customization buffers.
+The value should be a symbol, one of:
+
+brackets: groups nest within each other with big horizontal brackets.
+links: groups have links to subgroups."
+  :type '(radio (const :tag "brackets: Groups nest within each others" brackets)
+		(const :tag "links: Group have links to subgroups" links))
+  :group 'custom-buffer)
+
+(defcustom custom-buffer-indent 3
+  "Number of spaces to indent nested groups."
+  :type 'integer
+  :group 'custom-buffer)
+
+;;;###autoload
+(defun custom-buffer-create (options &optional name description)
+  "Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option."
+  (unless name (setq name "*Customization*"))
+  (kill-buffer (get-buffer-create name))
+  (switch-to-buffer (get-buffer-create name))
+  (custom-buffer-create-internal options description))
+
+;;;###autoload
+(defun custom-buffer-create-other-window (options &optional name description)
+  "Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option."
+  (unless name (setq name "*Customization*"))
+  (kill-buffer (get-buffer-create name))
+  (let ((window (selected-window)))
+    (switch-to-buffer-other-window (get-buffer-create name))
+    (custom-buffer-create-internal options description)
+    (select-window window)))
+
+(defcustom custom-reset-button-menu t
+  "If non-nil, only show a single reset button in customize buffers.
+This button will have a menu with all three reset operations."
+  :type 'boolean
+  :group 'custom-buffer)
+
+(defconst custom-skip-messages 5)
+
+(defun custom-buffer-create-internal (options &optional description)
+  (message "Creating customization buffer...")
+  (custom-mode)
+  (widget-insert "This is a customization buffer")
+  (if description
+      (widget-insert description))
+  (widget-insert ".\n\
+Type RET or click button2 on an active field to invoke its action.
+Invoke ")
+  (widget-create 'info-link
+		 :tag "Help"
+		 :help-echo "Read the online help"
+		 "(XEmacs)Easy Customization")
+  (widget-insert " for more information.\n\n")
+  (message "Creating customization buttons...")
+  (widget-insert "Operate on everything in this buffer:\n ")
+  (widget-create 'push-button
+		 :tag "Set"
+		 :tag-glyph '("set-up" "set-down")
+		 :help-echo "\
+Make your editing in this buffer take effect for this session"
+		 :action (lambda (widget &optional event)
+			   (Custom-set)))
+  (widget-insert " ")
+  (widget-create 'push-button
+		 :tag "Save"
+		 :tag-glyph '("save-up" "save-down")
+		 :help-echo "\
+Make your editing in this buffer take effect for future Emacs sessions"
+		 :action (lambda (widget &optional event)
+			   (Custom-save)))
+  (if custom-reset-button-menu
+      (progn
+	(widget-insert " ")
+	(widget-create 'push-button
+		       :tag "Reset"
+		       :tag-glyph '("reset-up" "reset-down")
+		       :help-echo "Show a menu with reset operations"
+		       :mouse-down-action (lambda (&rest junk) t)
+		       :action (lambda (widget &optional event)
+				 (custom-reset event))))
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :tag "Reset"
+		   :help-echo "\
+Reset all edited text in this buffer to reflect current values"
+		   :action 'Custom-reset-current)
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :tag "Reset to Saved"
+		   :help-echo "\
+Reset all values in this buffer to their saved settings"
+		   :action 'Custom-reset-saved)
+    (widget-insert " ")
+    (widget-create 'push-button
+		   :tag "Reset to Standard"
+		   :help-echo "\
+Reset all values in this buffer to their standard settings"
+		   :action 'Custom-reset-standard))
+  (widget-insert "  ")
+  (widget-create 'push-button
+		 :tag "Done"
+		 :tag-glyph '("done-up" "done-down")
+		 :help-echo "Bury the buffer"
+		 :action (lambda (widget &optional event)
+			   (bury-buffer)))
+  (widget-insert "\n\n")
+  (message "Creating customization items...")
+  (setq custom-options
+	(if (= (length options) 1)
+	    (mapcar (lambda (entry)
+		      (widget-create (nth 1 entry)
+				     :documentation-shown t
+				     :custom-state 'unknown
+				     :tag (custom-unlispify-tag-name
+					   (nth 0 entry))
+				     :value (nth 0 entry)))
+		    options)
+	  (let ((count 0)
+		(length (length options)))
+	    (mapcar (lambda (entry)
+		      (prog2
+			  (display-message
+			   'progress
+			   (format "Creating customization items %2d%%..."
+				   (/ (* 100.0 count) length)))
+			  (widget-create (nth 1 entry)
+					 :tag (custom-unlispify-tag-name
+					       (nth 0 entry))
+					 :value (nth 0 entry))
+			(incf count)
+			(unless (eq (preceding-char) ?\n)
+			  (widget-insert "\n"))
+			(widget-insert "\n")))
+		    options))))
+  (unless (eq (preceding-char) ?\n)
+    (widget-insert "\n"))
+  (display-message 'progress
+		   (format
+		    "Creating customization items %2d%%...done" 100))
+  (unless (eq custom-buffer-style 'tree)
+    (mapc 'custom-magic-reset custom-options))
+  (message "Creating customization setup...")
+  (widget-setup)
+  (goto-char (point-min))
+  (message "Creating customization buffer...done"))
+
+
+;;; The Tree Browser.
+
+;;;###autoload
+(defun customize-browse (&optional group)
+  "Create a tree browser for the customize hierarchy."
+  (interactive)
+  (unless group
+    (setq group 'emacs))
+  (let ((name "*Customize Browser*"))
+    (kill-buffer (get-buffer-create name))
+    (switch-to-buffer (get-buffer-create name)))
+  (custom-mode)
+  (widget-insert "\
+Square brackets show active fields; type RET or click button2
+on an active field to invoke its action.
+Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
+  (if custom-browse-only-groups
+      (widget-insert "\
+Invoke the [Group] button below to edit that item in another window.\n\n")
+    (widget-insert "Invoke the ")
+    (widget-create 'item
+		   :format "%t"
+		   :tag "[Group]"
+		   :tag-glyph "folder")
+    (widget-insert ", ")
+    (widget-create 'item
+		   :format "%t"
+		   :tag "[Face]"
+		   :tag-glyph "face")
+    (widget-insert ", and ")
+    (widget-create 'item
+		   :format "%t"
+		   :tag "[Option]"
+		   :tag-glyph "option")
+    (widget-insert " buttons below to edit that
+item in another window.\n\n"))
+  (let ((custom-buffer-style 'tree))
+    (widget-create 'custom-group
+		   :custom-last t
+		   :custom-state 'unknown
+		   :tag (custom-unlispify-tag-name group)
+		   :value group))
+  (goto-char (point-min)))
+
+(define-widget 'custom-browse-visibility 'item
+  "Control visibility of of items in the customize tree browser."
+  :format "%[[%t]%]"
+  :action 'custom-browse-visibility-action)
+
+(defun custom-browse-visibility-action (widget &rest ignore)
+  (let ((custom-buffer-style 'tree))
+    (custom-toggle-parent widget)))
+
+(define-widget 'custom-browse-group-tag 'push-button
+  "Show parent in other window when activated."
+  :tag "Group"
+  :tag-glyph "folder"
+  :action 'custom-browse-group-tag-action)
+
+(defun custom-browse-group-tag-action (widget &rest ignore)
+  (let ((parent (widget-get widget :parent)))
+    (customize-group-other-window (widget-value parent))))
+
+(define-widget 'custom-browse-variable-tag 'push-button
+  "Show parent in other window when activated."
+  :tag "Option"
+  :tag-glyph "option"
+  :action 'custom-browse-variable-tag-action)
+
+(defun custom-browse-variable-tag-action (widget &rest ignore)
+  (let ((parent (widget-get widget :parent)))
+    (customize-variable-other-window (widget-value parent))))
+
+(define-widget 'custom-browse-face-tag 'push-button
+  "Show parent in other window when activated."
+  :tag "Face"
+  :tag-glyph "face"
+  :action 'custom-browse-face-tag-action)
+
+(defun custom-browse-face-tag-action (widget &rest ignore)
+  (let ((parent (widget-get widget :parent)))
+    (customize-face-other-window (widget-value parent))))
+
+(defconst custom-browse-alist '(("   " "space")
+				(" | " "vertical")
+				("-\\ " "top")
+				(" |-" "middle")
+				(" `-" "bottom")))
+
+(defun custom-browse-insert-prefix (prefix)
+  "Insert PREFIX.  On XEmacs convert it to line graphics."
+  ;; ### Unfinished.
+  (if nil ; (string-match "XEmacs" emacs-version)
+      (progn
+	(insert "*")
+	(while (not (string-equal prefix ""))
+	  (let ((entry (substring prefix 0 3)))
+	    (setq prefix (substring prefix 3))
+	    (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
+		  (name (nth 1 (assoc entry custom-browse-alist))))
+	      (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
+	      (overlay-put overlay 'start-open t)
+	      (overlay-put overlay 'end-open t)))))
+    (insert prefix)))
+
+
+;;; 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.
+;;
+;; We want simple widgets to be displayed by default, but complex
+;; widgets to be hidden.
+
+(widget-put (get 'item 'widget-type) :custom-show t)
+(widget-put (get 'editable-field 'widget-type)
+	    :custom-show (lambda (widget value)
+			   (let ((pp (pp-to-string value)))
+			     (cond ((string-match "\n" pp)
+				    nil)
+				   ((> (length pp) 40)
+				    nil)
+				   (t t)))))
+(widget-put (get 'menu-choice 'widget-type) :custom-show t)
+
+;;; The `custom-manual' Widget.
+
+(define-widget 'custom-manual 'info-link
+  "Link to the manual entry for this customization option."
+  :tag "Manual")
+
+;;; The `custom-magic' Widget.
+
+(defgroup custom-magic-faces nil
+  "Faces used by the magic button."
+  :group 'custom-faces
+  :group 'custom-buffer)
+
+(defface custom-invalid-face '((((class color))
+				(:foreground "yellow" :background "red"))
+			       (t
+				(:bold t :italic t :underline t)))
+  "Face used when the customize item is invalid."
+  :group 'custom-magic-faces)
+
+(defface custom-rogue-face '((((class color))
+			      (:foreground "pink" :background "black"))
+			     (t
+			      (:underline t)))
+  "Face used when the customize item is not defined for customization."
+  :group 'custom-magic-faces)
+
+(defface custom-modified-face '((((class color))
+				 (:foreground "white" :background "blue"))
+				(t
+				 (:italic t :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
+				(:italic t)))
+  "Face used when the customize item has been set."
+  :group 'custom-magic-faces)
+
+(defface custom-changed-face '((((class color))
+				(:foreground "white" :background "blue"))
+			       (t
+				(:italic t)))
+  "Face used when the customize item has been changed."
+  :group 'custom-magic-faces)
+
+(defface custom-saved-face '((t (:underline t)))
+  "Face used when the customize item has been saved."
+  :group 'custom-magic-faces)
+
+(defconst custom-magic-alist '((nil "#" underline "\
+uninitialized, you should not see this.")
+			       (unknown "?" italic "\
+unknown, you should not see this.")
+			       (hidden "-" default "\
+hidden, invoke \"Show\" button in the previous line to show." "\
+group now hidden, invoke the above \"Show\" button 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." "\
+something in this group has been changed outside customize.")
+			       (saved "!" custom-saved-face "\
+this %c has been set and saved." "\
+something in this group has been set and saved.")
+			       (rogue "@" custom-rogue-face "\
+this %c has not been changed with customize." "\
+something in this group is not prepared for customization.")
+			       (standard " " nil "\
+this %c is unchanged from its standard setting." "\
+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
+
+STATE is one of the following symbols:
+
+`nil'
+   For internal use, should never occur.
+`unknown'
+   For internal use, should never occur.
+`hidden'
+   This item is not being displayed.
+`invalid'
+   This item is modified, but has an invalid form.
+`modified'
+   This item is modified, and has a valid form.
+`set'
+   This item has been set but not saved.
+`changed'
+   The current value of this item has been changed temporarily.
+`saved'
+   This item is marked for saving.
+`rogue'
+   This item has no customization information.
+`standard'
+   This item is unchanged from the standard setting.
+
+MAGIC is a string used to present that state.
+
+FACE is a face used to present the state.
+
+ITEM-DESC is a string describing the state for options.
+
+GROUP-DESC is a string describing the state for groups.  If this is
+left out, ITEM-DESC will be used.
+
+The string %c in either description will be replaced with the
+category of the item.  These are `group'. `option', and `face'.
+
+The list should be sorted most significant first.")
+
+(defcustom custom-magic-show 'long
+  "If non-nil, show textual description of the state.
+If `long', show a full-line description, not just one word."
+  :type '(choice (const :tag "no" nil)
+		 (const short)
+		 (const long))
+  :group 'custom-buffer)
+
+(defcustom custom-magic-show-hidden '(option face)
+  "Control whether the State button is shown for hidden items.
+The value should be a list with the custom categories where the State
+button should be visible.  Possible categories are `group', `option',
+and `face'."
+  :type '(set (const group) (const option) (const face))
+  :group 'custom-buffer)
+
+(defcustom custom-magic-show-button nil
+  "Show a \"magic\" button indicating the state of each customization option."
+  :type 'boolean
+  :group 'custom-buffer)
+
+(define-widget 'custom-magic 'default
+  "Show and manipulate state for a customization option."
+  :format "%v"
+  :action 'widget-parent-action
+  :notify 'ignore
+  :value-get 'ignore
+  :value-create 'custom-magic-value-create
+  :value-delete 'widget-children-value-delete)
+
+(defun widget-magic-mouse-down-action (widget &optional event)
+  ;; Non-nil unless hidden.
+  (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
+		       :custom-state)
+	   'hidden)))
+
+(defun custom-magic-value-create (widget)
+  ;; Create compact status report for WIDGET.
+  (let* ((parent (widget-get widget :parent))
+	 (state (widget-get parent :custom-state))
+	 (hidden (eq state 'hidden))
+	 (entry (assq state custom-magic-alist))
+	 (magic (nth 1 entry))
+	 (face (nth 2 entry))
+	 (category (widget-get parent :custom-category))
+	 (text (or (and (eq category 'group)
+			(nth 4 entry))
+		   (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 "   ")
+      (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"
+	     ;;:tag-glyph (or hidden '("state-up" "state-down"))
+	     )
+	    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-face))
+      (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)))
+
+(defun custom-magic-reset (widget)
+  "Redraw the :custom-magic property of WIDGET."
+  (let ((magic (widget-get widget :custom-magic)))
+    (widget-value-set magic (widget-value magic))))
+
+;;; The `custom' Widget.
+
+(defface custom-button-face '((t (:bold t)))
+  "Face used for buttons in customization buffers."
+  :group 'custom-faces)
+
+(defface custom-documentation-face 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))
+  "Face used for State descriptions in the customize buffer."
+  :group 'custom-faces)
+
+(define-widget 'custom 'default
+  "Customize a user option."
+  :format "%v"
+  :convert-widget 'custom-convert-widget
+  :notify 'custom-notify
+  :custom-prefix ""
+  :custom-level 1
+  :custom-state 'hidden
+  :documentation-property 'widget-subclass-responsibility
+  :value-create 'widget-subclass-responsibility
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-value-value-get
+  :validate 'widget-children-validate
+  :match (lambda (widget value) (symbolp value)))
+
+(defun custom-convert-widget (widget)
+  ;; Initialize :value and :tag from :args in WIDGET.
+  (let ((args (widget-get widget :args)))
+    (when args
+      (widget-put widget :value (widget-apply widget
+					      :value-to-internal (car args)))
+      (widget-put widget :tag (custom-unlispify-tag-name (car args)))
+      (widget-put widget :args nil)))
+  widget)
+
+(defun custom-notify (widget &rest args)
+  "Keep track of changes."
+  (let ((state (widget-get widget :custom-state)))
+    (unless (eq state 'modified)
+      (unless (memq state '(nil unknown hidden))
+	(widget-put widget :custom-state 'modified))
+      (custom-magic-reset widget)
+      (apply 'widget-default-notify widget args))))
+
+(defun custom-redraw (widget)
+  "Redraw WIDGET with current settings."
+  (let ((line (count-lines (point-min) (point)))
+	(column (current-column))
+	(pos (point))
+	(from (marker-position (widget-get widget :from)))
+	(to (marker-position (widget-get widget :to))))
+    (save-excursion
+      (widget-value-set widget (widget-value widget))
+      (custom-redraw-magic widget))
+    (when (and (>= pos from) (<= pos to))
+      (condition-case nil
+	  (progn
+	    (if (> column 0)
+		(goto-line line)
+	      (goto-line (1+ line)))
+	    (move-to-column column))
+	(error nil)))))
+
+(defun custom-redraw-magic (widget)
+  "Redraw WIDGET state with current settings."
+  (while widget
+    (let ((magic (widget-get widget :custom-magic)))
+      (cond (magic
+	     (widget-value-set magic (widget-value magic))
+	     (when (setq widget (widget-get widget :group))
+	       (custom-group-state-update widget)))
+	    (t
+	     (setq widget nil)))))
+  (widget-setup))
+
+(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)))))
+
+(defvar custom-load-recursion nil
+  "Hack to avoid recursive dependencies.")
+
+(defun custom-load-symbol (symbol)
+  "Load all dependencies for SYMBOL."
+  (unless custom-load-recursion
+    (let ((custom-load-recursion t)
+	  (loads (get symbol 'custom-loads))
+	  load)
+      (while loads
+	(setq load (car loads)
+	      loads (cdr loads))
+	(cond ((symbolp load)
+	       (condition-case nil
+		   (require load)
+		 (error nil)))
+	      ;; Don't reload a file already loaded.
+	      ((and (boundp 'preloaded-file-list)
+		    (member load preloaded-file-list)))
+	      ((assoc load load-history))
+	      ((assoc (locate-library load) load-history))
+	      (t
+	       (condition-case nil
+		   ;; Without this, we would load cus-edit recursively.
+		   ;; We are still loading it when we call this,
+		   ;; and it is not in load-history yet.
+		   (or (equal load "cus-edit")
+		       (load-library load))
+		 (error nil))))))))
+
+(defun custom-load-widget (widget)
+  "Load all dependencies for WIDGET."
+  (custom-load-symbol (widget-value widget)))
+
+(defun custom-unloaded-symbol-p (symbol)
+  "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
+  (let ((found nil)
+	(loads (get symbol 'custom-loads))
+	load)
+    (while loads
+      (setq load (car loads)
+	    loads (cdr loads))
+      (cond ((symbolp load)
+	     (unless (featurep load)
+	       (setq found t)))
+	    ((assoc load load-history))
+	    ((assoc (locate-library load) load-history)
+	     ;; #### WTF???
+	     (message nil))
+	    (t
+	     (setq found t))))
+    found))
+
+(defun custom-unloaded-widget-p (widget)
+  "Return non-nil if the dependencies of WIDGET has not yet been loaded."
+  (custom-unloaded-symbol-p (widget-value widget)))
+
+(defun custom-toggle-hide (widget)
+  "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"))
+	  ((eq state 'hidden)
+	   (widget-put widget :custom-state 'unknown))
+	  (t
+	   (widget-put widget :documentation-shown nil)
+	   (widget-put widget :custom-state 'hidden)))
+    (custom-redraw widget)
+    (widget-setup)))
+
+(defun custom-toggle-parent (widget &rest ignore)
+  "Toggle visibility of parent of WIDGET."
+  (custom-toggle-hide (widget-get widget :parent)))
+
+(defun custom-add-see-also (widget &optional prefix)
+  "Add `See also ...' to WIDGET if there are any links.
+Insert PREFIX first if non-nil."
+  (let* ((symbol (widget-get widget :value))
+	 (links (get symbol 'custom-links))
+	 (many (> (length links) 2))
+	 (buttons (widget-get widget :buttons))
+	 (indent (widget-get widget :indent)))
+    (when links
+      (when indent
+	(insert-char ?\  indent))
+      (when prefix
+	(insert prefix))
+      (insert "See also ")
+      (while links
+	(push (widget-create-child-and-convert widget (car links))
+	      buttons)
+	(setq links (cdr links))
+	(cond ((null links)
+	       (insert ".\n"))
+	      ((null (cdr links))
+	       (if many
+		   (insert ", and ")
+		 (insert " and ")))
+	      (t
+	       (insert ", "))))
+      (widget-put widget :buttons buttons))))
+
+(defun custom-add-parent-links (widget &optional initial-string)
+  "Add \"Parent groups: ...\" to WIDGET if the group has parents.
+The value if non-nil if any parents were found.
+If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
+  (let ((name (widget-value widget))
+	(type (widget-type widget))
+	(buttons (widget-get widget :buttons))
+	(start (point))
+	found)
+    (insert (or initial-string "Parent groups:"))
+    (maphash (lambda (group ignore)
+	       (let ((entry (assq name (get group 'custom-group))))
+		 (when (eq (nth 1 entry) type)
+		   (insert " ")
+		   (push (widget-create-child-and-convert
+			  widget 'custom-group-link
+			  :tag (custom-unlispify-tag-name group)
+			  group)
+			 buttons)
+		   (setq found t))))
+	     custom-group-hash-table)
+    (widget-put widget :buttons buttons)
+    (if found
+	(insert "\n")
+      (delete-region start (point)))
+    found))
+
+;;; The `custom-variable' Widget.
+
+(defface custom-variable-tag-face '((((class color)
+				      (background dark))
+				     (:foreground "light blue" :underline t))
+				    (((class color)
+				      (background light))
+				     (:foreground "blue" :underline t))
+				    (t (:underline t)))
+  "Face used for unpushable variable tags."
+  :group 'custom-faces)
+
+(defface custom-variable-button-face '((t (:underline t :bold t)))
+  "Face used for pushable variable tags."
+  :group 'custom-faces)
+
+(define-widget 'custom-variable 'custom
+  "Customize variable."
+  :format "%v"
+  :help-echo "Set or reset this variable"
+  :documentation-property 'variable-documentation
+  :custom-category 'option
+  :custom-state nil
+  :custom-menu 'custom-variable-menu-create
+  :custom-form 'edit
+  :value-create 'custom-variable-value-create
+  :action 'custom-variable-action
+  :custom-set 'custom-variable-set
+  :custom-save 'custom-variable-save
+  :custom-reset-current 'custom-redraw
+  :custom-reset-saved 'custom-variable-reset-saved
+  :custom-reset-standard 'custom-variable-reset-standard)
+
+(defun custom-variable-type (symbol)
+  "Return a widget suitable for editing the value of SYMBOL.
+If SYMBOL has a `custom-type' property, use that.
+Otherwise, look up symbol in `custom-guess-type-alist'."
+  (let* ((type (or (get symbol 'custom-type)
+		   (and (not (get symbol 'standard-value))
+			(custom-guess-type symbol))
+		   'sexp))
+	 (options (get symbol 'custom-options))
+	 (tmp (if (listp type)
+		  (copy-sequence type)
+		(list type))))
+    (when options
+      (widget-put tmp :options options))
+    tmp))
+
+(defun custom-variable-value-create (widget)
+  "Here is where you edit the variables value."
+  (custom-load-widget widget)
+  (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))
+	 (conv (widget-convert type))
+	 (get (or (get symbol 'custom-get) 'default-value))
+	 (prefix (widget-get widget :custom-prefix))
+	 (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 determine whether it is hidden.
+    (cond (state)
+	  ((custom-show type value)
+	   (setq state 'unknown))
+	  (t
+	   (setq state 'hidden)))
+    ;; If we don't know the state, see if we need to edit it in lisp form.
+    (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)
+	   (insert prefix (if last " `--- " " |--- "))
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-variable-tag)
+		 buttons)
+	   (insert " " tag "\n")
+	   (widget-put widget :buttons buttons))
+	  ((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
+		  :help-echo "Show the value of this option"
+		  :action 'custom-toggle-parent
+		  nil)
+		 buttons))
+	  ((memq form '(lisp mismatch))
+	   ;; In lisp mode edit the saved value when possible.
+	   (let* ((value (cond ((get symbol 'saved-value)
+				(car (get symbol 'saved-value)))
+			       ((get symbol 'standard-value)
+				(car (get symbol 'standard-value)))
+			       ((default-boundp symbol)
+				(custom-quote (funcall get symbol)))
+			       (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"
+		    :action 'custom-toggle-parent
+		    t)
+		   buttons)
+	     (insert " ")
+	     (push (widget-create-child-and-convert
+		    widget 'sexp
+		    :button-face 'custom-variable-button-face
+		    :format "%v"
+		    :tag (symbol-name symbol)
+		    :parent widget
+		    :value value)
+		   children)))
+	  (t
+	   ;; Edit mode.
+	   (let* ((format (widget-get type :format))
+		  tag-format value-format)
+	     (unless (string-match ":" format)
+	       (error "Bad format."))
+	     (setq tag-format (substring format 0 (match-end 0)))
+	     (setq value-format (substring format (match-end 0)))
+	     (push (widget-create-child-and-convert
+		    widget 'item
+		    :format tag-format
+		    :action 'custom-tag-action
+		    :help-echo "Change value of this option"
+		    :mouse-down-action 'custom-tag-mouse-down-action
+		    :button-face 'custom-variable-button-face
+		    :sample-face 'custom-variable-tag-face
+		    tag)
+		   buttons)
+	     (insert " ")
+	     (push (widget-create-child-and-convert
+		  widget 'visibility
+		  :help-echo "Hide the value of this option"
+		  :action 'custom-toggle-parent
+		  t)
+		 buttons)
+	     (push (widget-create-child-and-convert
+		    widget type
+		    :format value-format
+		    :value value)
+		   children))))
+    (unless (eq custom-buffer-style 'tree)
+      ;; Now update the state.
+      (unless (eq (preceding-char) ?\n)
+	(widget-insert "\n"))
+      (if (eq state 'hidden)
+	  (widget-put widget :custom-state state)
+	(custom-variable-state-set widget))
+      ;; Create the magic button.
+      (let ((magic (widget-create-child-and-convert
+		    widget 'custom-magic nil)))
+	(widget-put widget :custom-magic magic)
+	(push magic buttons))
+      ;; Update properties.
+      (widget-put widget :custom-form form)
+      (widget-put widget :buttons buttons)
+      (widget-put widget :children children)
+      ;; Insert documentation.
+      (widget-default-format-handler widget ?h)
+      ;; See also.
+      (unless (eq state 'hidden)
+	(when (eq (widget-get widget :custom-level) 1)
+	  (custom-add-parent-links widget))
+	(custom-add-see-also widget)))))
+
+(defun custom-tag-action (widget &rest args)
+  "Pass :action to first child of WIDGET's parent."
+  (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+	 :action args))
+
+(defun custom-tag-mouse-down-action (widget &rest args)
+  "Pass :mouse-down-action to first child of WIDGET's parent."
+  (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))
+	 (value (if (default-boundp symbol)
+		    (funcall get symbol)
+		  (widget-get widget :value)))
+	 tmp
+	 (state (cond ((setq tmp (get symbol 'customized-value))
+		       (if (condition-case nil
+			       (equal value (eval (car tmp)))
+			     (error nil))
+			   'set
+			 'changed))
+		      ((setq tmp (get symbol 'saved-value))
+		       (if (condition-case nil
+			       (equal value (eval (car tmp)))
+			     (error nil))
+			   'saved
+			 'changed))
+		      ((setq tmp (get symbol 'standard-value))
+		       (if (condition-case nil
+			       (equal value (eval (car tmp)))
+			     (error nil))
+			   'standard
+			 'changed))
+		      (t 'rogue))))
+    (widget-put widget :custom-state state)))
+
+(defvar custom-variable-menu
+  '(("Set for Current Session" custom-variable-set
+     (lambda (widget)
+       (eq (widget-get widget :custom-state) 'modified)))
+    ("Save for Future Sessions" custom-variable-save
+     (lambda (widget)
+       (memq (widget-get widget :custom-state) '(modified set changed rogue))))
+    ("Reset to Current" custom-redraw
+     (lambda (widget)
+       (and (default-boundp (widget-value widget))
+	    (memq (widget-get widget :custom-state) '(modified changed)))))
+    ("Reset to Saved" custom-variable-reset-saved
+     (lambda (widget)
+       (and (get (widget-value widget) 'saved-value)
+	    (memq (widget-get widget :custom-state)
+		  '(modified set changed rogue)))))
+    ("Reset to Standard Settings" custom-variable-reset-standard
+     (lambda (widget)
+       (and (get (widget-value widget) 'standard-value)
+	    (memq (widget-get widget :custom-state)
+		  '(modified set changed saved rogue)))))
+    ("---" ignore ignore)
+    ("Don't show as Lisp expression" custom-variable-edit
+     (lambda (widget)
+       (eq (widget-get widget :custom-form) 'lisp)))
+    ("Show as Lisp expression" custom-variable-edit-lisp
+     (lambda (widget)
+       (eq (widget-get widget :custom-form) 'edit))))
+  "Alist of actions for the `custom-variable' widget.
+Each entry has the form (NAME ACTION FILTER) where NAME is the name of
+the menu entry, ACTION is the function to call on the widget when the
+menu is selected, and FILTER is a predicate which takes a `custom-variable'
+widget as an argument, and returns non-nil if ACTION is valid on that
+widget. If FILTER is nil, ACTION is always valid.")
+
+(defun custom-variable-action (widget &optional event)
+  "Show the menu for `custom-variable' WIDGET.
+Optional EVENT is the location for the menu."
+  (if (eq (widget-get widget :custom-state) 'hidden)
+      (custom-toggle-hide widget)
+    (unless (eq (widget-get widget :custom-state) 'modified)
+      (custom-variable-state-set widget))
+    ;; Redrawing magic also depresses the state glyph.
+    ;(custom-redraw-magic widget)
+    (let* ((completion-ignore-case t)
+	   (answer (widget-choose (concat "Operation on "
+					  (custom-unlispify-tag-name
+					   (widget-get widget :value)))
+				  (custom-menu-filter custom-variable-menu
+						      widget)
+				  event)))
+      (if answer
+	  (funcall answer widget)))))
+
+(defun custom-variable-edit (widget)
+  "Edit value of WIDGET."
+  (widget-put widget :custom-state 'unknown)
+  (widget-put widget :custom-form 'edit)
+  (custom-redraw widget))
+
+(defun custom-variable-edit-lisp (widget)
+  "Edit the lisp representation of the value of WIDGET."
+  (widget-put widget :custom-state 'unknown)
+  (widget-put widget :custom-form 'lisp)
+  (custom-redraw widget))
+
+(defun custom-variable-set (widget)
+  "Set the current value for the variable being edited by WIDGET."
+  (let* ((form (widget-get widget :custom-form))
+	 (state (widget-get widget :custom-state))
+	 (child (car (widget-get widget :children)))
+	 (symbol (widget-value widget))
+	 (set (or (get symbol 'custom-set) 'set-default))
+	  val)
+    (cond ((eq state 'hidden)
+	   (error "Cannot set hidden variable."))
+	  ((setq val (widget-apply child :validate))
+	   (goto-char (widget-get val :from))
+	   (error "%s" (widget-get val :error)))
+	  ((memq form '(lisp mismatch))
+	   (funcall set symbol (eval (setq val (widget-value child))))
+	   (put symbol 'customized-value (list val)))
+	  (t
+	   (funcall set symbol (setq val (widget-value child)))
+	   (put symbol 'customized-value (list (custom-quote val)))))
+    (custom-variable-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-variable-save (widget)
+  "Set and save the value for the variable being edited by WIDGET."
+  (let* ((form (widget-get widget :custom-form))
+	 (state (widget-get widget :custom-state))
+	 (child (car (widget-get widget :children)))
+	 (symbol (widget-value widget))
+	 (set (or (get symbol 'custom-set) 'set-default))
+	 val)
+    (cond ((eq state 'hidden)
+	   (error "Cannot set hidden variable."))
+	  ((setq val (widget-apply child :validate))
+	   (goto-char (widget-get val :from))
+	   (error "%s" (widget-get val :error)))
+	  ((memq form '(lisp mismatch))
+	   (put symbol 'saved-value (list (widget-value child)))
+	   (funcall set symbol (eval (widget-value child))))
+	  (t
+	   (put symbol
+		'saved-value (list (custom-quote (widget-value
+						  child))))
+	   (funcall set symbol (widget-value child))))
+    (put symbol 'customized-value nil)
+    (custom-save-all)
+    (custom-variable-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-variable-reset-saved (widget)
+  "Restore the saved value for the variable being edited by WIDGET."
+  (let* ((symbol (widget-value widget))
+	 (set (or (get symbol 'custom-set) 'set-default)))
+    (if (get symbol 'saved-value)
+	(condition-case nil
+	    (funcall set symbol (eval (car (get symbol 'saved-value))))
+	  (error nil))
+      (error "No saved value for %s" symbol))
+    (put symbol 'customized-value nil)
+    (widget-put widget :custom-state 'unknown)
+    (custom-redraw widget)))
+
+(defun custom-variable-reset-standard (widget)
+  "Restore the standard setting for the variable being edited by WIDGET."
+  (let* ((symbol (widget-value widget))
+	 (set (or (get symbol 'custom-set) 'set-default)))
+    (if (get symbol 'standard-value)
+	(funcall set symbol (eval (car (get symbol 'standard-value))))
+      (error "No standard setting known for %S" symbol))
+    (put symbol 'customized-value nil)
+    (when (get symbol 'saved-value)
+      (put symbol 'saved-value nil)
+      (custom-save-all))
+    (widget-put widget :custom-state 'unknown)
+    (custom-redraw widget)))
+
+;;; The `custom-face-edit' Widget.
+
+(define-widget 'custom-face-edit 'checklist
+  "Edit face attributes."
+  :format "%t: %v"
+  :tag "Attributes"
+  :extra-offset 12
+  :button-args '(:help-echo "Control whether this attribute have any effect")
+  :args (mapcar (lambda (att)
+		  (list 'group
+			:inline t
+			:sibling-args (widget-get (nth 1 att) :sibling-args)
+			(list 'const :format "" :value (nth 0 att))
+			(nth 1 att)))
+		custom-face-attributes))
+
+;;; The `custom-display' Widget.
+
+(define-widget 'custom-display 'menu-choice
+  "Select a display type."
+  :tag "Display"
+  :value t
+  :help-echo "Specify frames where the face attributes should be used"
+  :args '((const :tag "all" t)
+	  (checklist
+	   :offset 0
+	   :extra-offset 9
+	   :args ((group :sibling-args (:help-echo "\
+Only match the specified window systems")
+			 (const :format "Type: "
+				type)
+			 (checklist :inline t
+				    :offset 0
+				    (const :format "X "
+					   :sibling-args (:help-echo "\
+The X11 Window System")
+					   x)
+				    (const :format "PM "
+					   :sibling-args (:help-echo "\
+OS/2 Presentation Manager")
+					   pm)
+				    (const :format "Win32 "
+					   :sibling-args (:help-echo "\
+Windows NT/95/97")
+					   win32)
+				    (const :format "DOS "
+					   :sibling-args (:help-echo "\
+Plain MS-DOS")
+					   pc)
+				    (const :format "TTY%n"
+					   :sibling-args (:help-echo "\
+Plain text terminals")
+					   tty)))
+		  (group :sibling-args (:help-echo "\
+Only match the frames with the specified color support")
+			 (const :format "Class: "
+				class)
+			 (checklist :inline t
+				    :offset 0
+				    (const :format "Color "
+					   :sibling-args (:help-echo "\
+Match color frames")
+					   color)
+				    (const :format "Grayscale "
+					   :sibling-args (:help-echo "\
+Match grayscale frames")
+					   grayscale)
+				    (const :format "Monochrome%n"
+					   :sibling-args (:help-echo "\
+Match frames with no color support")
+					   mono)))
+		  (group :sibling-args (:help-echo "\
+Only match frames with the specified intensity")
+			 (const :format "\
+Background brightness: "
+				background)
+			 (checklist :inline t
+				    :offset 0
+				    (const :format "Light "
+					   :sibling-args (:help-echo "\
+Match frames with light backgrounds")
+					   light)
+				    (const :format "Dark\n"
+					   :sibling-args (:help-echo "\
+Match frames with dark backgrounds")
+					   dark)))))))
+
+;;; The `custom-face' Widget.
+
+(defface custom-face-tag-face '((t (:underline t)))
+  "Face used for face tags."
+  :group 'custom-faces)
+
+(define-widget 'custom-face 'custom
+  "Customize face."
+  :sample-face 'custom-face-tag-face
+  :help-echo "Set or reset this face"
+  :documentation-property '(lambda (face)
+			     (face-doc-string face))
+  :value-create 'custom-face-value-create
+  :action 'custom-face-action
+  :custom-category 'face
+  :custom-form 'selected
+  :custom-set 'custom-face-set
+  :custom-save 'custom-face-save
+  :custom-reset-current 'custom-redraw
+  :custom-reset-saved 'custom-face-reset-saved
+  :custom-reset-standard 'custom-face-reset-standard
+  :custom-menu 'custom-face-menu-create)
+
+(define-widget 'custom-face-all 'editable-list
+  "An editable list of display specifications and attributes."
+  :entry-format "%i %d %v"
+  :insert-button-args '(:help-echo "Insert new display specification here")
+  :append-button-args '(:help-echo "Append new display specification here")
+  :delete-button-args '(:help-echo "Delete this display specification")
+  :args '((group :format "%v" custom-display custom-face-edit)))
+
+(defconst custom-face-all (widget-convert 'custom-face-all)
+  "Converted version of the `custom-face-all' widget.")
+
+(define-widget 'custom-display-unselected 'item
+  "A display specification that doesn't match the selected display."
+  :match 'custom-display-unselected-match)
+
+(defun custom-display-unselected-match (widget value)
+  "Non-nil if VALUE is an unselected display specification."
+  (not (face-spec-set-match-display value (selected-frame))))
+
+(define-widget 'custom-face-selected 'group
+  "Edit the attributes of the selected display in a face specification."
+  :args '((repeat :format ""
+		  :inline t
+		  (group custom-display-unselected sexp))
+	  (group (sexp :format "") custom-face-edit)
+	  (repeat :format ""
+		  :inline t
+		  sexp)))
+
+(defconst custom-face-selected (widget-convert 'custom-face-selected)
+  "Converted version of the `custom-face-selected' widget.")
+
+(defun custom-face-value-create (widget)
+  "Create a list of the display specifications for WIDGET."
+  (let ((buttons (widget-get widget :buttons))
+	(symbol (widget-get widget :value))
+	(tag (widget-get widget :tag))
+	(state (widget-get widget :custom-state))
+	(begin (point))
+	(is-last (widget-get widget :custom-last))
+	(prefix (widget-get widget :custom-prefix)))
+    (unless tag
+      (setq tag (prin1-to-string symbol)))
+    (cond ((eq custom-buffer-style 'tree)
+	   (insert prefix (if is-last " `--- " " |--- "))
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-face-tag)
+		 buttons)
+	   (insert " " tag "\n")
+	   (widget-put widget :buttons buttons))
+	  (t
+	   ;; Create tag.
+	   (insert tag)
+	   (if (eq custom-buffer-style 'face)
+	       (insert " ")
+	     (widget-specify-sample widget begin (point))
+	     (insert ": "))
+	   ;; Sample.
+	   (and (not (find-face symbol))
+		;; XEmacs cannot display uninitialized faces.
+		(make-face symbol))
+	   (push (widget-create-child-and-convert widget 'item
+						  :format "(%{%t%})"
+						  :sample-face symbol
+						  :tag "sample")
+		 buttons)
+	   ;; Visibility.
+	   (insert " ")
+	   (push (widget-create-child-and-convert
+		  widget 'visibility
+		  :help-echo "Hide or show this face"
+		  :action 'custom-toggle-parent
+		  (not (eq state 'hidden)))
+		 buttons)
+	   ;; Magic.
+	   (insert "\n")
+	   (let ((magic (widget-create-child-and-convert
+			 widget 'custom-magic nil)))
+	     (widget-put widget :custom-magic magic)
+	     (push magic buttons))
+	   ;; Update buttons.
+	   (widget-put widget :buttons buttons)
+	   ;; Insert documentation.
+	   (widget-default-format-handler widget ?h)
+	   ;; See also.
+	   (unless (eq state 'hidden)
+	     (when (eq (widget-get widget :custom-level) 1)
+	       (custom-add-parent-links widget))
+	     (custom-add-see-also widget))
+	   ;; Editor.
+	   (unless (eq (preceding-char) ?\n)
+	     (insert "\n"))
+	   (unless (eq state 'hidden)
+	     (message "Creating face editor...")
+	     (custom-load-widget widget)
+	     (let* ((symbol (widget-value widget))
+		    (spec (or (get symbol 'saved-face)
+			      (get symbol 'face-defface-spec)
+			      ;; Attempt to construct it.
+			      (list (list t (face-custom-attributes-get
+					     symbol (selected-frame))))))
+		    (form (widget-get widget :custom-form))
+		    (indent (widget-get widget :indent))
+		    (edit (widget-create-child-and-convert
+			   widget
+			   (cond ((and (eq form 'selected)
+				       (widget-apply custom-face-selected
+						     :match spec))
+				  (when indent (insert-char ?\  indent))
+				  'custom-face-selected)
+				 ((and (not (eq form 'lisp))
+				       (widget-apply custom-face-all
+						     :match spec))
+				  'custom-face-all)
+				 (t
+				  (when indent (insert-char ?\  indent))
+				  'sexp))
+			   :value spec)))
+	       (custom-face-state-set widget)
+	       (widget-put widget :children (list edit)))
+	     (message "Creating face editor...done"))))))
+
+(defvar custom-face-menu
+  '(("Set for Current Session" custom-face-set)
+    ("Save for Future Sessions" custom-face-save)
+    ("Reset to Saved" custom-face-reset-saved
+     (lambda (widget)
+       (get (widget-value widget) 'saved-face)))
+    ("Reset to Standard Setting" custom-face-reset-standard
+     (lambda (widget)
+       (get (widget-value widget) 'face-defface-spec)))
+    ("---" ignore ignore)
+    ("Show all display specs" custom-face-edit-all
+     (lambda (widget)
+       (not (eq (widget-get widget :custom-form) 'all))))
+    ("Just current attributes" custom-face-edit-selected
+     (lambda (widget)
+       (not (eq (widget-get widget :custom-form) 'selected))))
+    ("Show as Lisp expression" custom-face-edit-lisp
+     (lambda (widget)
+       (not (eq (widget-get widget :custom-form) 'lisp)))))
+  "Alist of actions for the `custom-face' widget.
+Each entry has the form (NAME ACTION FILTER) where NAME is the name of
+the menu entry, ACTION is the function to call on the widget when the
+menu is selected, and FILTER is a predicate which takes a `custom-face'
+widget as an argument, and returns non-nil if ACTION is valid on that
+widget. If FILTER is nil, ACTION is always valid.")
+
+(defun custom-face-edit-selected (widget)
+  "Edit selected attributes of the value of WIDGET."
+  (widget-put widget :custom-state 'unknown)
+  (widget-put widget :custom-form 'selected)
+  (custom-redraw widget))
+
+(defun custom-face-edit-all (widget)
+  "Edit all attributes of the value of WIDGET."
+  (widget-put widget :custom-state 'unknown)
+  (widget-put widget :custom-form 'all)
+  (custom-redraw widget))
+
+(defun custom-face-edit-lisp (widget)
+  "Edit the lisp representation of the value of WIDGET."
+  (widget-put widget :custom-state 'unknown)
+  (widget-put widget :custom-form 'lisp)
+  (custom-redraw widget))
+
+(defun custom-face-state-set (widget)
+  "Set the state of WIDGET."
+  (let ((symbol (widget-value widget)))
+    (widget-put widget :custom-state (cond ((get symbol 'customized-face)
+					    'set)
+					   ((get symbol 'saved-face)
+					    'saved)
+					   ((get symbol 'face-defface-spec)
+					    'standard)
+					   (t
+					    'rogue)))))
+
+(defun custom-face-action (widget &optional event)
+  "Show the menu for `custom-face' WIDGET.
+Optional EVENT is the location for the menu."
+  (if (eq (widget-get widget :custom-state) 'hidden)
+      (custom-toggle-hide widget)
+    (let* ((completion-ignore-case t)
+	   (symbol (widget-get widget :value))
+	   (answer (widget-choose (concat "Operation on "
+					  (custom-unlispify-tag-name symbol))
+				  (custom-menu-filter custom-face-menu
+						      widget)
+				  event)))
+      (if answer
+	  (funcall answer widget)))))
+
+(defun custom-face-set (widget)
+  "Make the face attributes in WIDGET take effect."
+  (let* ((symbol (widget-value widget))
+	 (child (car (widget-get widget :children)))
+	 (value (widget-value child)))
+    (put symbol 'customized-face value)
+    (face-spec-set symbol value)
+    (custom-face-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-face-save (widget)
+  "Make the face attributes in WIDGET default."
+  (let* ((symbol (widget-value widget))
+	 (child (car (widget-get widget :children)))
+	 (value (widget-value child)))
+    (face-spec-set symbol value)
+    (put symbol 'saved-face value)
+    (put symbol 'customized-face nil)
+    (custom-face-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-face-reset-saved (widget)
+  "Restore WIDGET to the face's default attributes."
+  (let* ((symbol (widget-value widget))
+	 (child (car (widget-get widget :children)))
+	 (value (get symbol 'saved-face)))
+    (unless value
+      (error "No saved value for this face"))
+    (put symbol 'customized-face nil)
+    (face-spec-set symbol value)
+    (widget-value-set child value)
+    (custom-face-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-face-reset-standard (widget)
+  "Restore WIDGET to the face's standard settings."
+  (let* ((symbol (widget-value widget))
+	 (child (car (widget-get widget :children)))
+	 (value (get symbol 'face-defface-spec)))
+    (unless value
+      (error "No standard setting for this face"))
+    (put symbol 'customized-face nil)
+    (when (get symbol 'saved-face)
+      (put symbol 'saved-face nil)
+      (custom-save-all))
+    (face-spec-set symbol value)
+    (widget-value-set child value)
+    (custom-face-state-set widget)
+    (custom-redraw-magic widget)))
+
+;;; 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"
+  :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)))
+
+(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.
+
+(define-widget 'hook 'list
+  "A emacs lisp hook"
+  :value-to-internal (lambda (widget value)
+		       (if (symbolp value)
+			   (list value)
+			 value))
+  :match (lambda (widget value)
+	   (or (symbolp value)
+	       (widget-group-match widget value)))
+  :convert-widget 'custom-hook-convert-widget
+  :tag "Hook")
+
+(defun custom-hook-convert-widget (widget)
+  ;; Handle `:custom-options'.
+  (let* ((options (widget-get widget :options))
+	 (other `(editable-list :inline t
+				:entry-format "%i %d%v"
+				(function :format " %v")))
+	 (args (if options
+		   (list `(checklist :inline t
+				     ,@(mapcar (lambda (entry)
+						 `(function-item ,entry))
+					       options))
+			 other)
+		 (list other))))
+    (widget-put widget :args args)
+    widget))
+
+;;; The `custom-group-link' Widget.
+
+(define-widget 'custom-group-link 'link
+  "Show parent in other window when activated."
+  :help-echo 'custom-group-link-help-echo
+  :action 'custom-group-link-action)
+
+(defun custom-group-link-help-echo (widget)
+  (concat "Create customization buffer for the `"
+	  (custom-unlispify-tag-name (widget-value widget))
+	  "' group"))
+
+(defun custom-group-link-action (widget &rest ignore)
+  (customize-group (widget-value widget)))
+
+;;; The `custom-group' Widget.
+
+(defcustom custom-group-tag-faces nil
+  ;; In XEmacs, this ought to play games with font size.
+  "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'."
+  :type '(repeat face)
+  :group 'custom-faces)
+
+(defface custom-group-tag-face-1 '((((class color)
+				     (background dark))
+				    (:foreground "pink" :underline t))
+				   (((class color)
+				     (background light))
+				    (:foreground "red" :underline t))
+				   (t (:underline t)))
+  "Face used for group tags.")
+
+(defface custom-group-tag-face '((((class color)
+				   (background dark))
+				  (:foreground "light blue" :underline t))
+				 (((class color)
+				   (background light))
+				  (:foreground "blue" :underline t))
+				 (t (:underline t)))
+  "Face used for low level group tags."
+  :group 'custom-faces)
+
+(define-widget 'custom-group 'custom
+  "Customize group."
+  :format "%v"
+  :sample-face-get 'custom-group-sample-face-get
+  :documentation-property 'group-documentation
+  :help-echo "Set or reset all members of this group"
+  :value-create 'custom-group-value-create
+  :action 'custom-group-action
+  :custom-category 'group
+  :custom-set 'custom-group-set
+  :custom-save 'custom-group-save
+  :custom-reset-current 'custom-group-reset-current
+  :custom-reset-saved 'custom-group-reset-saved
+  :custom-reset-standard 'custom-group-reset-standard
+  :custom-menu 'custom-group-menu-create)
+
+(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))
+
+(define-widget 'custom-group-visibility 'visibility
+  "An indicator and manipulator for hidden group contents."
+  :create 'custom-group-visibility-create)
+
+(defun custom-group-visibility-create (widget)
+  (let ((visible (widget-value widget)))
+    (if visible
+	(insert "--------")))
+  (widget-default-create widget))
+
+(defun custom-group-members (symbol groups-only)
+  "Return SYMBOL's custom group members.
+If GROUPS-ONLY non-nil, return only those members that are groups."
+  (if (not groups-only)
+      (get symbol 'custom-group)
+    (let (members)
+      (dolist (entry (get symbol 'custom-group) (nreverse members))
+	(when (eq (nth 1 entry) 'custom-group)
+	  (push entry members))))))
+
+(defun custom-group-value-create (widget)
+  "Insert a customize group for WIDGET in the current buffer."
+  (let* ((state (widget-get widget :custom-state))
+	 (level (widget-get widget :custom-level))
+	 ;; (indent (widget-get widget :indent))
+	 (prefix (widget-get widget :custom-prefix))
+	 (buttons (widget-get widget :buttons))
+	 (tag (widget-get widget :tag))
+	 (symbol (widget-value widget))
+	 (members (custom-group-members symbol
+					(and (eq custom-buffer-style 'tree)
+					     custom-browse-only-groups))))
+    (cond ((and (eq custom-buffer-style 'tree)
+		(eq state 'hidden)
+		(or members (custom-unloaded-widget-p widget)))
+	   (custom-browse-insert-prefix prefix)
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-visibility
+		  ;; :tag-glyph "plus"
+		  :tag "+")
+		 buttons)
+	   (insert "-- ")
+	   ;; (widget-glyph-insert nil "-- " "horizontal")
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-group-tag)
+		 buttons)
+	   (insert " " tag "\n")
+	   (widget-put widget :buttons buttons))
+	  ((and (eq custom-buffer-style 'tree)
+		(zerop (length members)))
+	   (custom-browse-insert-prefix prefix)
+	   (insert "[ ]-- ")
+	   ;; (widget-glyph-insert nil "[ ]" "empty")
+	   ;; (widget-glyph-insert nil "-- " "horizontal")
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-group-tag)
+		 buttons)
+	   (insert " " tag "\n")
+	   (widget-put widget :buttons buttons))
+	  ((eq custom-buffer-style 'tree)
+	   (custom-browse-insert-prefix prefix)
+	   (custom-load-widget widget)
+	   (if (zerop (length members))
+	       (progn
+		 (custom-browse-insert-prefix prefix)
+		 (insert "[ ]-- ")
+		 ;; (widget-glyph-insert nil "[ ]" "empty")
+		 ;; (widget-glyph-insert nil "-- " "horizontal")
+		 (push (widget-create-child-and-convert
+			widget 'custom-browse-group-tag)
+		       buttons)
+		 (insert " " tag "\n")
+		 (widget-put widget :buttons buttons))
+	     (push (widget-create-child-and-convert
+		    widget 'custom-browse-visibility
+		    ;; :tag-glyph "minus"
+		    :tag "-")
+		   buttons)
+	     (insert "-\\ ")
+	     ;; (widget-glyph-insert nil "-\\ " "top")
+	     (push (widget-create-child-and-convert
+		    widget 'custom-browse-group-tag)
+		   buttons)
+	     (insert " " tag "\n")
+	     (widget-put widget :buttons buttons)
+	     (message "Creating group...")
+	     (let* ((members (custom-sort-items members
+			      custom-browse-sort-alphabetically
+			      custom-browse-order-groups))
+		    (prefixes (widget-get widget :custom-prefixes))
+		    (custom-prefix-list (custom-prefix-add symbol prefixes))
+		    (extra-prefix (if (widget-get widget :custom-last)
+				      "   "
+				    " | "))
+		    (prefix (concat prefix extra-prefix))
+		    children entry)
+	       (while members
+		 (setq entry (car members)
+		       members (cdr members))
+		 (push (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)
+			:custom-last (null members)
+			:value (nth 0 entry)
+			:custom-prefix prefix)
+		       children))
+	       (widget-put widget :children (reverse children)))
+	     (message "Creating group...done")))
+	  ;; Nested style.
+	  ((eq state 'hidden)
+	   ;; Create level indicator.
+	   (unless (eq custom-buffer-style 'links)
+	     (insert-char ?\  (* custom-buffer-indent (1- level)))
+	     (insert "-- "))
+	   ;; Create link indicator.
+	   (when (eq custom-buffer-style 'links)
+	     (insert " ")
+	     (push (widget-create-child-and-convert
+		    widget 'custom-group-link
+		    :tag "Open"
+		    :tag-glyph '("open-up" "open-down")
+		    symbol)
+		   buttons)
+	     (insert " "))
+	   ;; Create tag.
+	   (let ((begin (point)))
+	     (insert tag)
+	     (widget-specify-sample widget begin (point)))
+	   (insert " group")
+	   ;; Create visibility indicator.
+	   (unless (eq custom-buffer-style 'links)
+	     (insert ": ")
+	     (push (widget-create-child-and-convert
+		    widget 'custom-group-visibility
+		    :help-echo "Show members of this group"
+		    :action 'custom-toggle-parent
+		    (not (eq state 'hidden)))
+		   buttons))
+	   (insert " \n")
+	   ;; Create magic button.
+	   (let ((magic (widget-create-child-and-convert
+			 widget 'custom-magic nil)))
+	     (widget-put widget :custom-magic magic)
+	     (push magic buttons))
+	   ;; Update buttons.
+	   (widget-put widget :buttons buttons)
+	   ;; Insert documentation.
+	   (if (and (eq custom-buffer-style 'links) (> level 1))
+	       (widget-put widget :documentation-indent 0))
+	   (widget-default-format-handler widget ?h))
+	  ;; Nested style.
+	  (t				;Visible.
+	   (custom-load-widget widget)
+	   ;; Update members
+	   (setq members (custom-group-members
+			  symbol (and (eq custom-buffer-style 'tree)
+				      custom-browse-only-groups)))
+	   ;; 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
+					      "Go to parent group:")
+		     (insert "\n"))))
+	   ;; Create level indicator.
+	   (insert-char ?\  (* custom-buffer-indent (1- level)))
+	   (insert "/- ")
+	   ;; Create tag.
+	   (let ((start (point)))
+	     (insert tag)
+	     (widget-specify-sample widget start (point)))
+	   (insert " group: ")
+	   ;; Create visibility indicator.
+	   (unless (eq custom-buffer-style 'links)
+	     (insert "--------")
+	     (push (widget-create-child-and-convert
+		    widget 'visibility
+		    :help-echo "Hide members of this group"
+		    :action 'custom-toggle-parent
+		    (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")
+	   ;; Create magic button.
+	   (let ((magic (widget-create-child-and-convert
+			 widget 'custom-magic
+			 :indent 0
+			 nil)))
+	     (widget-put widget :custom-magic magic)
+	     (push magic buttons))
+	   ;; Update buttons.
+	   (widget-put widget :buttons buttons)
+	   ;; Insert documentation.
+	   (widget-default-format-handler widget ?h)
+	   ;; Parent groups.
+	   (if nil  ;;; This should test that the buffer
+		    ;;; was not made to display a group.
+	       (when (eq level 1)
+		 (insert-char ?\  custom-buffer-indent)
+		 (custom-add-parent-links widget)))
+	   (custom-add-see-also widget
+				(make-string (* custom-buffer-indent level)
+					     ?\ ))
+	   ;; Members.
+	   (message "Creating group...")
+	   (let* ((members (custom-sort-items members
+					      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))
+		  (count 0)
+		  (children (mapcar
+			     (lambda (entry)
+			       (widget-insert "\n")
+			       (when (zerop (% count custom-skip-messages))
+				 (display-message
+				  'progress
+				  (format "\
+Creating group members... %2d%%"
+					  (/ (* 100.0 count) length))))
+			       (incf 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...")
+	     (mapc 'custom-magic-reset children)
+	     (message "Creating group state...")
+	     (widget-put widget :children children)
+	     (custom-group-state-update widget)
+	     (message "Creating group... done"))
+	   ;; 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")))))
+
+(defvar custom-group-menu
+  '(("Set for Current Session" custom-group-set
+     (lambda (widget)
+       (eq (widget-get widget :custom-state) 'modified)))
+    ("Save for Future Sessions" custom-group-save
+     (lambda (widget)
+       (memq (widget-get widget :custom-state) '(modified set))))
+    ("Reset to Current" custom-group-reset-current
+     (lambda (widget)
+       (memq (widget-get widget :custom-state) '(modified))))
+    ("Reset to Saved" custom-group-reset-saved
+     (lambda (widget)
+       (memq (widget-get widget :custom-state) '(modified set))))
+    ("Reset to standard setting" custom-group-reset-standard
+     (lambda (widget)
+       (memq (widget-get widget :custom-state) '(modified set saved)))))
+  "Alist of actions for the `custom-group' widget.
+Each entry has the form (NAME ACTION FILTER) where NAME is the name of
+the menu entry, ACTION is the function to call on the widget when the
+menu is selected, and FILTER is a predicate which takes a `custom-group'
+widget as an argument, and returns non-nil if ACTION is valid on that
+widget. If FILTER is nil, ACTION is always valid.")
+
+(defun custom-group-action (widget &optional event)
+  "Show the menu for `custom-group' WIDGET.
+Optional EVENT is the location for the menu."
+  (if (eq (widget-get widget :custom-state) 'hidden)
+      (custom-toggle-hide widget)
+    (let* ((completion-ignore-case t)
+	   (answer (widget-choose (concat "Operation on "
+					  (custom-unlispify-tag-name
+					   (widget-get widget :value)))
+				  (custom-menu-filter custom-group-menu
+						      widget)
+				  event)))
+      (if answer
+	  (funcall answer widget)))))
+
+(defun custom-group-set (widget)
+  "Set changes in all modified group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-set)))
+	  children)))
+
+(defun custom-group-save (widget)
+  "Save all modified group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+	    (when (memq (widget-get child :custom-state) '(modified set))
+	      (widget-apply child :custom-save)))
+	  children)))
+
+(defun custom-group-reset-current (widget)
+  "Reset all modified group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+	    (when (eq (widget-get child :custom-state) 'modified)
+	      (widget-apply child :custom-reset-current)))
+	  children)))
+
+(defun custom-group-reset-saved (widget)
+  "Reset all modified or set group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+	    (when (memq (widget-get child :custom-state) '(modified set))
+	      (widget-apply child :custom-reset-saved)))
+	  children)))
+
+(defun custom-group-reset-standard (widget)
+  "Reset all modified, set, or saved group members."
+  (let ((children (widget-get widget :children)))
+    (mapc (lambda (child)
+	    (when (memq (widget-get child :custom-state)
+			'(modified set saved))
+	      (widget-apply child :custom-reset-standard)))
+	  children)))
+
+(defun custom-group-state-update (widget)
+  "Update magic."
+  (unless (eq (widget-get widget :custom-state) 'hidden)
+    (let* ((children (widget-get widget :children))
+	   (states (mapcar (lambda (child)
+			     (widget-get child :custom-state))
+			   children))
+	   (magics custom-magic-alist)
+	   (found 'standard))
+      (while magics
+	(let ((magic (car (car magics))))
+	  (if (and (not (eq magic 'hidden))
+		   (memq magic states))
+	      (setq found magic
+		    magics nil)
+	    (setq magics (cdr magics)))))
+      (widget-put widget :custom-state found)))
+  (custom-magic-reset widget))
+
+;;; The `custom-save-all' Function.
+;;;###autoload
+(defcustom custom-file (if (boundp 'emacs-user-extension-dir)
+			   (concat "~"
+				   init-file-user
+				   emacs-user-extension-dir
+				   "options.el")
+			 "~/.emacs")
+  "File used for storing customization information.
+If you change this from the default \"~/.emacs\" you need to
+explicitly load that file for the settings to take effect."
+  :type 'file
+  :group 'customize)
+
+(defun custom-save-delete (symbol)
+  "Delete the call to SYMBOL form `custom-file'.
+Leave point at the location of the call, or after the last expression."
+  (let ((find-file-hooks nil)
+	(auto-mode-alist nil))
+    (set-buffer (find-file-noselect custom-file)))
+  (goto-char (point-min))
+  (catch 'found
+    (while t
+      (let ((sexp (condition-case nil
+		      (read (current-buffer))
+		    (end-of-file (throw 'found nil)))))
+	(when (and (listp sexp)
+		   (eq (car sexp) symbol))
+	  (delete-region (save-excursion
+			   (backward-sexp)
+			   (point))
+			 (point))
+	  (throw 'found nil))))))
+
+(defun custom-save-variables ()
+  "Save all customized variables in `custom-file'."
+  (save-excursion
+    (custom-save-delete 'custom-set-variables)
+    (let ((standard-output (current-buffer)))
+      (unless (bolp)
+	(princ "\n"))
+      (princ "(custom-set-variables")
+      (mapatoms (lambda (symbol)
+		  (let ((value (get symbol 'saved-value))
+			(requests (get symbol 'custom-requests))
+			(now (not (or (get symbol 'standard-value)
+				      (and (not (boundp symbol))
+					   (not (get symbol 'force-value)))))))
+		    (when value
+		      (princ "\n '(")
+		      (princ symbol)
+		      (princ " ")
+		      (prin1 (car value))
+		      (cond (requests
+			     (if now
+				 (princ " t ")
+			       (princ " nil "))
+			     (prin1 requests)
+			     (princ ")"))
+			    (now
+			     (princ " t)"))
+			    (t
+			     (princ ")")))))))
+      (princ ")")
+      (unless (looking-at "\n")
+	(princ "\n")))))
+
+(defun custom-save-faces ()
+  "Save all customized faces in `custom-file'."
+  (save-excursion
+    (custom-save-delete 'custom-set-faces)
+    (let ((standard-output (current-buffer)))
+      (unless (bolp)
+	(princ "\n"))
+      (princ "(custom-set-faces")
+      (let ((value (get 'default 'saved-face)))
+	;; The default face must be first, since it affects the others.
+	(when value
+	  (princ "\n '(default ")
+	  (prin1 value)
+	  (if (or (get 'default 'face-defface-spec)
+		  (and (not (find-face 'default))
+		       (not (get 'default 'force-face))))
+	      (princ ")")
+	    (princ " t)"))))
+      (mapatoms (lambda (symbol)
+		  (let ((value (get symbol 'saved-face)))
+		    (when (and (not (eq symbol 'default))
+			       ;; Don't print default face here.
+			       value)
+		      (princ "\n '(")
+		      (princ symbol)
+		      (princ " ")
+		      (prin1 value)
+		      (if (or (get symbol 'face-defface-spec)
+			      (and (not (find-face symbol))
+				   (not (get symbol 'force-face))))
+			  (princ ")")
+			(princ " t)"))))))
+      (princ ")")
+      (unless (looking-at "\n")
+	(princ "\n")))))
+
+;;;###autoload
+(defun customize-save-customized ()
+  "Save all user options which have been set in this session."
+  (interactive)
+  (mapatoms (lambda (symbol)
+	      (let ((face (get symbol 'customized-face))
+		    (value (get symbol 'customized-value)))
+		(when face
+		  (put symbol 'saved-face face)
+		  (put symbol 'customized-face nil))
+		(when value
+		  (put symbol 'saved-value value)
+		  (put symbol 'customized-value 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)
+    (let ((find-file-hooks nil)
+	  (auto-mode-alist))
+      (with-current-buffer (find-file-noselect custom-file)
+	(save-buffer)))))
+
+
+;;; The Customize Menu.
+
+;;; Menu support
+
+(defun custom-face-menu-create (widget symbol)
+  "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
+  (vector (custom-unlispify-menu-entry symbol)
+	  `(customize-face ',symbol)
+	  t))
+
+(defun custom-variable-menu-create (widget symbol)
+  "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
+  (let ((type (get symbol 'custom-type)))
+    (unless (listp type)
+      (setq type (list type)))
+    (if (and type (widget-get type :custom-menu))
+	(widget-apply type :custom-menu symbol)
+      (vector (custom-unlispify-menu-entry symbol)
+	      `(customize-variable ',symbol)
+	      t))))
+
+;; Add checkboxes to boolean variable entries.
+(widget-put (get 'boolean 'widget-type)
+	    :custom-menu (lambda (widget symbol)
+			   `[,(custom-unlispify-menu-entry symbol)
+			     (customize-variable ',symbol)
+			     :style toggle
+			     :selected ,symbol]))
+
+;; XEmacs can create menus dynamically.
+(defun custom-group-menu-create (widget symbol)
+  "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
+  `( ,(custom-unlispify-menu-entry symbol t)
+     :filter (lambda (&rest junk)
+	       (let ((item (custom-menu-create ',symbol)))
+		 (if (listp item)
+		     (cdr item)
+		   (list item))))))
+
+;;;###autoload
+(defun custom-menu-create (symbol)
+  "Create menu for customization group SYMBOL.
+The menu is in a format applicable to `easy-menu-define'."
+  (let* ((item (vector (custom-unlispify-menu-entry symbol)
+		       `(customize-group ',symbol)
+		       t)))
+    ;; Item is the entry for creating a menu buffer for SYMBOL.
+    ;; We may nest, if the menu is not too big.
+    (custom-load-symbol symbol)
+    (if (< (length (get symbol 'custom-group)) widget-menu-max-size)
+	;; The menu is not too big.
+	(let ((custom-prefix-list (custom-prefix-add symbol
+						     custom-prefix-list))
+	      (members (custom-sort-items (get symbol 'custom-group)
+					  custom-menu-sort-alphabetically
+					  custom-menu-order-groups)))
+	  ;; Create the menu.
+	  `(,(custom-unlispify-menu-entry symbol t)
+	    ,item
+	    "--"
+	    ,@(mapcar (lambda (entry)
+			(widget-apply (if (listp (nth 1 entry))
+					  (nth 1 entry)
+					(list (nth 1 entry)))
+				      :custom-menu (nth 0 entry)))
+		      members)))
+      ;; The menu was too big.
+      item)))
+
+;;;###autoload
+(defun customize-menu-create (symbol &optional name)
+  "Return a customize menu for customization group SYMBOL.
+If optional NAME is given, use that as the name of the menu.
+Otherwise the menu will be named `Customize'.
+The format is suitable for use with `easy-menu-define'."
+  (unless name
+    (setq name "Customize"))
+  `(,name
+    :filter (lambda (&rest junk)
+	      (cdr (custom-menu-create ',symbol)))))
+
+;;; The Custom Mode.
+
+(defvar custom-mode-map nil
+  "Keymap for `custom-mode'.")
+
+(unless custom-mode-map
+  (setq custom-mode-map (make-sparse-keymap))
+  (set-keymap-parents 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 "q" 'bury-buffer)
+  (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)
+  )
+
+(defun Custom-move-and-invoke (event)
+  "Move to where you click, and if it is an active field, invoke it."
+  (interactive "e")
+  (mouse-set-point event)
+  (if (widget-event-point event)
+      (let* ((pos (widget-event-point event))
+	     (button (get-char-property pos 'button)))
+	(if button
+	    (widget-button-click event)))))
+
+(easy-menu-define Custom-mode-menu
+    custom-mode-map
+  "Menu used in customization buffers."
+  `("Custom"
+    ,(customize-menu-create 'customize)
+    ["Set" Custom-set t]
+    ["Save" Custom-save t]
+    ["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 "(xemacs)Easy Customization") t]))
+
+(defun Custom-goto-parent ()
+  "Go to the parent group listed at the top of this buffer.
+If several parents are listed, go to the first of them."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (if (search-forward "\nGo to parent group: " nil t)
+	(let* ((button (get-char-property (point) 'button))
+	       (parent (downcase (widget-get  button :tag))))
+	  (customize-group parent)))))
+
+(defcustom custom-mode-hook nil
+  "Hook called when entering custom-mode."
+  :type 'hook
+  :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")))
+
+(defun custom-mode ()
+  "Major mode for editing customization buffers.
+
+The following commands are available:
+
+Move to next button or editable field.     \\[widget-forward]
+Move to previous button or editable field. \\[widget-backward]
+\\<widget-field-keymap>\
+Complete content of editable text field.   \\[widget-complete]
+\\<custom-mode-map>\
+Invoke button under the mouse pointer.     \\[Custom-move-and-invoke]
+Invoke button under point.		   \\[widget-button-press]
+Set all modifications.			   \\[Custom-set]
+Make all modifications default.		   \\[Custom-save]
+Reset all modified options. 		   \\[Custom-reset-current]
+Reset all modified or set options.	   \\[Custom-reset-saved]
+Reset all options.			   \\[Custom-reset-standard]
+
+Entry to this mode calls the value of `custom-mode-hook'
+if that value is non-nil."
+  (kill-all-local-variables)
+  (setq major-mode 'custom-mode
+	mode-name "Custom")
+  (use-local-map custom-mode-map)
+  (easy-menu-add Custom-mode-menu)
+  (make-local-variable 'custom-options)
+  (make-local-variable 'widget-documentation-face)
+  (setq widget-documentation-face 'custom-documentation-face)
+  (make-local-variable 'widget-button-face)
+  (setq widget-button-face 'custom-button-face)
+  (make-local-hook 'widget-edit-functions)
+  (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
+  (run-hooks 'custom-mode-hook))
+
+
+;;; The End.
+
+(provide 'cus-edit)
+
+;; cus-edit.el ends here