xemacs-beta: lisp/cus-edit.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:f427b8ec4379
+:41ff10fd062f
+;;; 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

Mercurial > hg > xemacs-beta

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