Initial revision

6 files changed, 5726 insertions, 2433 deletions

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
new file mode 100644
index 00000000000..0327c7aa286
--- /dev/null
+++ b/lisp/cus-edit.el
@@ -0,0 +1,1993 @@
+;;; cus-edit.el --- Tools for customization Emacs.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: help, faces
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `custom.el'.
+
+;;; Code:
+
+(require 'cus-face)
+(require 'wid-edit)
+(require 'easymenu)
+
+(define-widget-keywords :custom-prefixes :custom-menu :custom-show
+  :custom-magic :custom-state :custom-level :custom-form
+  :custom-set :custom-save :custom-reset-current :custom-reset-saved 
+  :custom-reset-factory)
+
+;;; Customization Groups.
+
+(defgroup emacs nil
+  "Customization of the One True Editor."
+  :link '(custom-manual "(emacs)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 frames nil
+  "Support for Emacs frames and window systems."
+  :group 'environment)
+
+(defgroup data nil
+  "Support editing files of data."
+  :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
+  :group 'faces)
+
+;;; Utilities.
+
+(defun custom-quote (sexp)
+  "Quote SEXP iff it is not self quoting."
+  (if (or (memq sexp '(t nil))
+          (and (symbolp sexp)
+               (eq (aref (symbol-name sexp) 0) ?:))
+          (and (listp sexp)
+               (memq (car sexp) '(lambda)))
+          (stringp sexp)
+          (numberp sexp)
+          (and (fboundp 'characterp)
+               (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)
+      (let ((start 0)
+            all)
+        (while (string-match "\\\\|" regexp start)
+          (setq all (cons (substring regexp start (match-beginning 0)) all)
+                start (match-end 0)))
+        (nreverse (cons (substring regexp start) all)))
+    regexp))
+
+(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 'customize
+  :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
+         (save-excursion
+           (set-buffer (get-buffer-create " *Custom-Work*"))
+           (erase-buffer)
+           (princ symbol (current-buffer))
+           (goto-char (point-min))
+           (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 'customize
+  :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))
+
+;;; The Custom Mode.
+
+(defvar custom-options nil
+  "Customization widgets in the current buffer.")
+
+(defvar custom-mode-map nil
+  "Keymap for `custom-mode'.")
+  
+(unless custom-mode-map
+  (setq custom-mode-map (make-sparse-keymap))
+  (set-keymap-parent custom-mode-map widget-keymap)
+  (define-key custom-mode-map "q" 'bury-buffer))
+
+(easy-menu-define custom-mode-menu 
+    custom-mode-map
+  "Menu used in customization buffers."
+    '("Custom"
+      ["Set" custom-set t]
+      ["Save" custom-save t]
+      ["Reset to Current" custom-reset-current t]
+      ["Reset to Saved" custom-reset-saved t]
+      ["Reset to Factory Settings" custom-reset-factory t]
+      ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
+
+(defcustom custom-mode-hook nil
+  "Hook called when entering custom-mode."
+  :type 'hook
+  :group 'customize)
+
+(defun custom-mode ()
+  "Major mode for editing customization buffers.
+
+The following commands are available:
+
+\\[widget-forward]              Move to next button or editable field.
+\\[widget-backward]             Move to previous button or editable field.
+\\[widget-button-click]         Activate button under the mouse pointer.
+\\[widget-button-press]         Activate button under point.
+\\[custom-set]                  Set all modifications.
+\\[custom-save]         Make all modifications default.
+\\[custom-reset-current]        Reset all modified options. 
+\\[custom-reset-saved]          Reset all modified or set options.
+\\[custom-reset-factory]        Reset all options.
+
+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)
+  (run-hooks 'custom-mode-hook))
+
+;;; Custom Mode Commands.
+
+(defun custom-set ()
+  "Set changes in all modified options."
+  (interactive)
+  (let ((children custom-options))
+    (mapcar (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))
+    (mapcar (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)
+    ("Factory Settings" . custom-reset-factory))
+  "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 ()
+  "Reset all modified group members to their current value."
+  (interactive)
+  (let ((children custom-options))
+    (mapcar (lambda (child)
+              (when (eq (widget-get child :custom-state) 'modified)
+                (widget-apply child :custom-reset-current)))
+            children)))
+
+(defun custom-reset-saved ()
+  "Reset all modified or set group members to their saved value."
+  (interactive)
+  (let ((children custom-options))
+    (mapcar (lambda (child)
+              (when (eq (widget-get child :custom-state) 'modified)
+                (widget-apply child :custom-reset-current)))
+            children)))
+
+(defun custom-reset-factory ()
+  "Reset all modified, set, or saved group members to their factory settings."
+  (interactive)
+  (let ((children custom-options))
+    (mapcar (lambda (child)
+              (when (eq (widget-get child :custom-state) 'modified)
+                (widget-apply child :custom-reset-current)))
+            children)))
+
+;;; The Customize Commands
+
+;;;###autoload
+(defun customize (symbol)
+  "Customize SYMBOL, which must be a customization group."
+  (interactive (list (completing-read "Customize group: (default emacs) "
+                                      obarray 
+                                      (lambda (symbol)
+                                        (get symbol 'custom-group))
+                                      t)))
+
+  (when (stringp symbol)
+    (if (string-equal "" symbol)
+        (setq symbol 'emacs)
+      (setq symbol (intern symbol))))
+  (custom-buffer-create (list (list symbol 'custom-group))))
+
+;;;###autoload
+(defun customize-variable (symbol)
+  "Customize SYMBOL, which must be a variable."
+  (interactive
+   ;; Code stolen from `help.el'.
+   (let ((v (variable-at-point))
+         (enable-recursive-minibuffers t)
+         val)
+     (setq val (completing-read 
+                (if v
+                    (format "Customize variable (default %s): " v)
+                  "Customize variable: ")
+                obarray 'boundp t))
+     (list (if (equal val "")
+               v (intern val)))))
+  (custom-buffer-create (list (list symbol 'custom-variable))))
+
+;;;###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 'custom-facep)))
+  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+      (let ((found nil))
+        (message "Looking for faces...")
+        (mapcar (lambda (symbol)
+                  (setq found (cons (list symbol 'custom-face) found)))
+                (face-list))
+        (custom-buffer-create found))
+    (if (stringp symbol)
+        (setq symbol (intern symbol)))
+    (unless (symbolp symbol)
+      (error "Should be a symbol %S" symbol))
+    (custom-buffer-create (list (list symbol 'custom-face)))))
+
+;;;###autoload
+(defun customize-customized ()
+  "Customize all already customized user options."
+  (interactive)
+  (let ((found nil))
+    (mapatoms (lambda (symbol)
+                (and (get symbol 'saved-face)
+                     (custom-facep symbol)
+                     (setq found (cons (list symbol 'custom-face) found)))
+                (and (get symbol 'saved-value)
+                     (boundp symbol)
+                     (setq found
+                           (cons (list symbol 'custom-variable) found)))))
+    (if found 
+        (custom-buffer-create found)
+      (error "No customized user options"))))
+
+;;;###autoload
+(defun customize-apropos (regexp &optional all)
+  "Customize all user options matching REGEXP.
+If ALL (e.g., started with a prefix key), include options which are not
+user-settable."
+  (interactive "sCustomize regexp: \nP")
+  (let ((found nil))
+    (mapatoms (lambda (symbol)
+                (when (string-match regexp (symbol-name symbol))
+                  (when (get symbol 'custom-group)
+                    (setq found (cons (list symbol 'custom-group) found)))
+                  (when (custom-facep symbol)
+                    (setq found (cons (list symbol 'custom-face) found)))
+                  (when (and (boundp symbol)
+                             (or (get symbol 'saved-value)
+                                 (get symbol 'factory-value)
+                                 (if all
+                                     (get symbol 'variable-documentation)
+                                   (user-variable-p symbol))))
+                    (setq found
+                          (cons (list symbol 'custom-variable) found))))))
+    (if found 
+        (custom-buffer-create found)
+      (error "No matches"))))
+
+;;;###autoload
+(defun custom-buffer-create (options)
+  "Create a buffer containing OPTIONS.
+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."
+  (message "Creating customization buffer...")
+  (kill-buffer (get-buffer-create "*Customization*"))
+  (switch-to-buffer (get-buffer-create "*Customization*"))
+  (custom-mode)
+  (widget-insert "This is a customization buffer.
+Push RET or click mouse-2 on the word ")
+  ;; (put-text-property 1 2 'start-open nil)
+  (widget-create 'info-link 
+                 :tag "help"
+                 :help-echo "Read the online help."
+                 "(custom)The Customization Buffer")
+  (widget-insert " for more information.\n\n")
+  (setq custom-options 
+        (if (= (length options) 1)
+            (mapcar (lambda (entry)
+                      (widget-create (nth 1 entry)
+                                     :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
+                            (message "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))
+                          (setq count (1+ count))
+                          (unless (eq (preceding-char) ?\n)
+                            (widget-insert "\n"))
+                          (widget-insert "\n")))
+                      options))))
+  (unless (eq (preceding-char) ?\n)
+    (widget-insert "\n"))
+  (widget-insert "\n")
+  (message "Creating customization magic...")
+  (mapcar 'custom-magic-reset custom-options)
+  (message "Creating customization buttons...")
+  (widget-create 'push-button
+                 :tag "Set"
+                 :help-echo "Set all modifications for this session."
+                 :action (lambda (widget &optional event)
+                           (custom-set)))
+  (widget-insert " ")
+  (widget-create 'push-button
+                 :tag "Save"
+                 :help-echo "\
+Make the modifications default for future sessions."
+                 :action (lambda (widget &optional event)
+                           (custom-save)))
+  (widget-insert " ")
+  (widget-create 'push-button
+                 :tag "Reset"
+                 :help-echo "Undo all modifications."
+                 :action (lambda (widget &optional event)
+                           (custom-reset event)))
+  (widget-insert " ")
+  (widget-create 'push-button
+                 :tag "Done"
+                 :help-echo "Bury the buffer."
+                 :action (lambda (widget &optional event)
+                           (bury-buffer)
+                           ;; Steal button release event.
+                           (if (and (fboundp 'button-press-event-p)
+                                    (fboundp 'next-command-event))
+                               ;; XEmacs
+                               (and event
+                                    (button-press-event-p event)
+                                    (next-command-event))
+                             ;; Emacs
+                             (when (memq 'down (event-modifiers event))
+                               (read-event)))))
+  (widget-insert "\n")
+  (message "Creating customization setup...")
+  (widget-setup)
+  (goto-char (point-min))
+  (message "Creating customization buffer...done"))
+
+;;; 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."
+  :help-echo "Read the manual entry for this option."
+  :tag "Manual")
+
+;;; The `custom-magic' Widget.
+
+(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.")
+
+(defface custom-rogue-face '((((class color))
+                              (:foreground "pink" :background "black"))
+                             (t
+                              (:underline t)))
+  "Face used when the customize item is not defined for customization.")
+
+(defface custom-modified-face '((((class color)) 
+                                 (:foreground "white" :background "blue"))
+                                (t
+                                 (:italic t :bold)))
+  "Face used when the customize item has been modified.")
+
+(defface custom-set-face '((((class color)) 
+                                (:foreground "blue" :background "white"))
+                               (t
+                                (:italic t)))
+  "Face used when the customize item has been set.")
+
+(defface custom-changed-face '((((class color)) 
+                                (:foreground "white" :background "blue"))
+                               (t
+                                (:italic t)))
+  "Face used when the customize item has been changed.")
+
+(defface custom-saved-face '((t (:underline t)))
+  "Face used when the customize item has been saved.")
+
+(defcustom custom-magic-alist '((nil "#" underline "\
+uninitialized, you should not see this.")
+                                (unknown "?" italic "\
+unknown, you should not see this.")
+                                (hidden "-" default "\
+hidden, press the state button to show.")
+                                (invalid "x" custom-invalid-face "\
+the value displayed for this item is invalid and cannot be set.")
+                                (modified "*" custom-modified-face "\
+you have edited the item, and can now set it.")
+                                (set "+" custom-set-face "\
+you have set this item, but not saved it.")
+                                (changed ":" custom-changed-face "\
+this item has been changed outside customize.")
+                                (saved "!" custom-saved-face "\
+this item has been saved.")
+                                (rogue "@" custom-rogue-face "\
+this item is not prepared for customization.")
+                                (factory " " nil "\
+this item is unchanged from its factory setting."))
+  "Alist of customize option states.
+Each entry is of the form (STATE MAGIC FACE DESCRIPTION), 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.
+`factory'
+   This item is unchanged from the factory default.
+
+MAGIC is a string used to present that state.
+
+FACE is a face used to present the state.
+
+DESCRIPTION is a string describing the state.
+
+The list should be sorted most significant first."
+  :type '(list (checklist :inline t
+                          (group (const nil)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const unknown)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const hidden)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const invalid)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const modified)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const set)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const changed)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const saved)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const rogue)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description"))
+                          (group (const factory)
+                                 (string :tag "Magic")
+                                 face 
+                                 (string :tag "Description")))
+               (editable-list :inline t
+                              (group symbol
+                                     (string :tag "Magic")
+                                     face
+                                     (string :tag "Description"))))
+  :group 'customize)
+
+(defcustom custom-magic-show 'long
+  "Show long description of the state of each customization option."
+  :type '(choice (const :tag "no" nil)
+                 (const short)
+                 (const long))
+  :group 'customize)
+
+(defcustom custom-magic-show-button t
+  "Show a magic button indicating the state of each customization option."
+  :type 'boolean
+  :group 'customize)
+
+(define-widget 'custom-magic 'default
+  "Show and manipulate state for a customization option."
+  :format "%v"
+  :action 'widget-choice-item-action
+  :value-get 'ignore
+  :value-create 'custom-magic-value-create
+  :value-delete 'widget-children-value-delete)
+
+(defun custom-magic-value-create (widget)
+  ;; Create compact status report for WIDGET.
+  (let* ((parent (widget-get widget :parent))
+         (state (widget-get parent :custom-state))
+         (entry (assq state custom-magic-alist))
+         (magic (nth 1 entry))
+         (face (nth 2 entry))
+         (text (nth 3 entry))
+         (lisp (eq (widget-get parent :custom-form) 'lisp))
+         children)
+    (when custom-magic-show
+      (push (widget-create-child-and-convert widget 'choice-item 
+                                             :help-echo "\
+Change the state of this item."
+                                             :format "%[%t%]"
+                                             :tag "State")
+            children)
+      (insert ": ")
+      (if (eq custom-magic-show 'long)
+          (insert text)
+        (insert (symbol-name state)))
+      (when lisp 
+        (insert " (lisp)"))
+      (insert "\n"))
+    (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 
+                                             :button-face face
+                                             :help-echo "Change the state."
+                                             :format "%[%t%]"
+                                             :tag (if lisp 
+                                                      (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-level' Widget.
+
+(define-widget 'custom-level 'item
+  "The custom level buttons."
+  :format "%[%t%]"
+  :help-echo "Expand or collapse this item."
+  :action 'custom-level-action)
+
+(defun custom-level-action (widget &optional event)
+  "Toggle visibility for parent to WIDGET."
+  (let* ((parent (widget-get widget :parent))
+         (state (widget-get parent :custom-state)))
+    (cond ((memq state '(invalid modified))
+           (error "There are unset changes"))
+          ((eq state 'hidden)
+           (widget-put parent :custom-state 'unknown))
+          (t
+           (widget-put parent :custom-state 'hidden)))
+    (custom-redraw parent)))
+
+;;; The `custom' Widget.
+
+(define-widget 'custom 'default
+  "Customize a user option."
+  :convert-widget 'custom-convert-widget
+  :format "%l%[%t%]: %v%m%h%a"
+  :format-handler 'custom-format-handler
+  :notify 'custom-notify
+  :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-item-value-get
+  :validate 'widget-editable-list-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-format-handler (widget escape)
+  ;; We recognize extra escape sequences.
+  (let* ((buttons (widget-get widget :buttons))
+         (state (widget-get widget :custom-state))
+         (level (widget-get widget :custom-level)))
+    (cond ((eq escape ?l)
+           (when level 
+             (push (widget-create-child-and-convert
+                    widget 'custom-level (make-string level ?*))
+                   buttons)
+             (widget-insert " ")
+             (widget-put widget :buttons buttons)))
+          ((eq escape ?L)
+           (when (eq state 'hidden)
+             (widget-insert " ...")))
+          ((eq escape ?m)
+           (and (eq (preceding-char) ?\n)
+                (widget-get widget :indent)
+                (insert-char ?  (widget-get widget :indent)))
+           (let ((magic (widget-create-child-and-convert
+                         widget 'custom-magic nil)))
+             (widget-put widget :custom-magic magic)
+             (push magic buttons)
+             (widget-put widget :buttons buttons)))
+          ((eq escape ?a)
+           (let* ((symbol (widget-get widget :value))
+                  (links (get symbol 'custom-links))
+                  (many (> (length links) 2)))
+             (when links
+               (and (eq (preceding-char) ?\n)
+                    (widget-get widget :indent)
+                    (insert-char ?  (widget-get widget :indent)))
+               (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))))
+          (t 
+           (widget-default-format-handler widget escape)))))
+
+(defun custom-notify (widget &rest args)
+  "Keep track of changes."
+  (unless (memq (widget-get widget :custom-state) '(nil unknown hidden))
+    (widget-put widget :custom-state 'modified))
+  (let ((buffer-undo-list t))
+    (custom-magic-reset widget))
+  (apply 'widget-default-notify widget args))
+
+(defun custom-redraw (widget)
+  "Redraw WIDGET with current settings."
+  (let ((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))
+      (goto-char pos))))
+
+(defun custom-redraw-magic (widget)
+  "Redraw WIDGET state with current settings."
+  (while widget 
+    (let ((magic (widget-get widget :custom-magic)))
+      (unless magic 
+        (debug))
+      (widget-value-set magic (widget-value magic))
+      (when (setq widget (widget-get widget :group))
+        (custom-group-state-update widget))))
+  (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)))))
+
+(defun custom-load-symbol (symbol)
+  "Load all dependencies for SYMBOL."
+  (let ((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)))
+            ((assoc load load-history))
+            (t
+             (condition-case nil
+                 (load-library load)
+               (error nil)))))))
+
+(defun custom-load-widget (widget)
+  "Load all dependencies for WIDGET."
+  (custom-load-symbol (widget-value widget)))
+
+;;; The `custom-variable' Widget.
+
+(defface custom-variable-sample-face '((t (:underline t)))
+  "Face used for unpushable variable tags."
+  :group 'customize)
+
+(defface custom-variable-button-face '((t (:underline t :bold t)))
+  "Face used for pushable variable tags."
+  :group 'customize)
+
+(define-widget 'custom-variable 'custom
+  "Customize variable."
+  :format "%l%v%m%h%a"
+  :help-echo "Set or reset this variable."
+  :documentation-property 'variable-documentation
+  :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-factory 'custom-variable-reset-factory)
+
+(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))
+         (options (get symbol 'custom-options))
+         (child-type (or (get symbol 'custom-type) 'sexp))
+         (tag (widget-get widget :tag))
+         (type (let ((tmp (if (listp child-type)
+                              (copy-list child-type)
+                            (list child-type))))
+                 (when options
+                   (widget-put tmp :options options))
+                 tmp))
+         (conv (widget-convert type))
+         (value (if (default-boundp symbol)
+                    (default-value 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 'lisp)))
+    ;; Now we can create the child widget.
+    (cond ((eq state 'hidden)
+           ;; Indicate hidden value.
+           (push (widget-create-child-and-convert 
+                  widget 'item
+                  :format "%{%t%}: ..."
+                  :sample-face 'custom-variable-sample-face
+                  :tag tag
+                  :parent widget)
+                 children))
+          ((eq form 'lisp)
+           ;; In lisp mode edit the saved value when possible.
+           (let* ((value (cond ((get symbol 'saved-value)
+                                (car (get symbol 'saved-value)))
+                               ((get symbol 'factory-value)
+                                (car (get symbol 'factory-value)))
+                               ((default-boundp symbol)
+                                (custom-quote (default-value symbol)))
+                               (t
+                                (custom-quote (widget-get conv :value))))))
+             (push (widget-create-child-and-convert 
+                    widget 'sexp 
+                    :button-face 'custom-variable-button-face
+                    :tag (symbol-name symbol)
+                    :parent widget
+                    :value value)
+                   children)))
+          (t
+           ;; Edit mode.
+           (push (widget-create-child-and-convert
+                  widget type 
+                  :tag tag
+                  :button-face 'custom-variable-button-face
+                  :sample-face 'custom-variable-sample-face
+                  :value value)
+                 children)))
+    ;; 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))
+    (widget-put widget :custom-form form)            
+    (widget-put widget :buttons buttons)
+    (widget-put widget :children children)))
+
+(defun custom-variable-state-set (widget)
+  "Set the state of WIDGET."
+  (let* ((symbol (widget-value widget))
+         (value (if (default-boundp symbol)
+                    (default-value 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 'factory-value))
+                       (if (condition-case nil
+                               (equal value (eval (car tmp)))
+                             (error nil))
+                           'factory
+                         'changed))
+                      (t 'rogue))))
+    (widget-put widget :custom-state state)))
+
+(defvar custom-variable-menu 
+  '(("Edit" . custom-variable-edit)
+    ("Edit Lisp" . custom-variable-edit-lisp)
+    ("Set" . custom-variable-set)
+    ("Save" . custom-variable-save)
+    ("Reset to Current" . custom-redraw)
+    ("Reset to Saved" . custom-variable-reset-saved)
+    ("Reset to Factory Settings" . custom-variable-reset-factory))
+  "Alist of actions for the `custom-variable' widget.
+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-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)
+      (progn 
+        (widget-put widget :custom-state 'unknown)
+        (custom-redraw widget))
+    (let* ((completion-ignore-case t)
+           (answer (widget-choose (custom-unlispify-tag-name
+                                   (widget-get widget :value))
+                                  custom-variable-menu
+                                  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))
+        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)))
+          ((eq form 'lisp)
+           (set symbol (eval (setq val (widget-value child))))
+           (put symbol 'customized-value (list val)))
+          (t
+           (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 the default 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))
+        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)))
+          ((eq form 'lisp)
+           (put symbol 'saved-value (list (widget-value child)))
+           (set symbol (eval (widget-value child))))
+          (t
+           (put symbol
+                'saved-value (list (custom-quote (widget-value
+                                                  child))))
+           (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)))
+    (if (get symbol 'saved-value)
+        (condition-case nil
+            (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-factory (widget)
+  "Restore the factory setting for the variable being edited by WIDGET."
+  (let ((symbol (widget-value widget)))
+    (if (get symbol 'factory-value)
+        (set symbol (eval (car (get symbol 'factory-value))))
+      (error "No factory default 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 'customize)
+
+(define-widget 'custom-face 'custom
+  "Customize face."
+  :format "%l%{%t%}: %s%m%h%a%v"
+  :format-handler 'custom-face-format-handler
+  :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-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-factory 'custom-face-reset-factory
+  :custom-menu 'custom-face-menu-create)
+
+(defun custom-face-format-handler (widget escape)
+  ;; We recognize extra escape sequences.
+  (let (child
+        (symbol (widget-get widget :value)))
+    (cond ((eq escape ?s)
+           (and (string-match "XEmacs" emacs-version)
+                ;; XEmacs cannot display initialized faces.
+                (not (custom-facep symbol))
+                (copy-face 'custom-face-empty symbol))
+           (setq child (widget-create-child-and-convert 
+                        widget 'item
+                        :format "(%{%t%})\n"
+                        :sample-face symbol
+                        :tag "sample")))
+          (t 
+           (custom-format-handler widget escape)))
+    (when child
+      (widget-put widget
+                  :buttons (cons child (widget-get widget :buttons))))))
+
+(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."
+  (and (listp value)
+       (eq (length value) 2)
+       (not (custom-display-match-frame 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.
+  (unless (eq (preceding-char) ?\n)
+    (insert "\n"))
+  (when (not (eq (widget-get widget :custom-state) 'hidden))
+    (message "Creating face editor...")
+    (custom-load-widget widget)
+    (let* ((symbol (widget-value widget))
+           (spec (or (get symbol 'saved-face)
+                     (get symbol 'factory-face)
+                     ;; Attempt to construct it.
+                     (list (list t (custom-face-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 
+  '(("Edit Selected" . custom-face-edit-selected)
+    ("Edit All" . custom-face-edit-all)
+    ("Edit Lisp" . custom-face-edit-lisp)
+    ("Set" . custom-face-set)
+    ("Save" . custom-face-save)
+    ("Reset to Saved" . custom-face-reset-saved)
+    ("Reset to Factory Setting" . custom-face-reset-factory))
+  "Alist of actions for the `custom-face' widget.
+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-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 'factory-face)
+                                            'factory)
+                                           (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)
+      (progn 
+        (widget-put widget :custom-state 'unknown)
+        (custom-redraw widget))
+    (let* ((completion-ignore-case t)
+           (symbol (widget-get widget :value))
+           (answer (widget-choose (custom-unlispify-tag-name symbol)
+                                  custom-face-menu 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)
+    (when (fboundp 'copy-face)
+      (copy-face 'custom-face-empty symbol))
+    (custom-face-display-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)))
+    (when (fboundp 'copy-face)
+      (copy-face 'custom-face-empty symbol))
+    (custom-face-display-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)
+    (when (fboundp 'copy-face)
+      (copy-face 'custom-face-empty symbol))
+    (custom-face-display-set symbol value)
+    (widget-value-set child value)
+    (custom-face-state-set widget)
+    (custom-redraw-magic widget)))
+
+(defun custom-face-reset-factory (widget)
+  "Restore WIDGET to the face's factory settings."
+  (let* ((symbol (widget-value widget))
+         (child (car (widget-get widget :children)))
+         (value (get symbol 'factory-face)))
+    (unless value
+      (error "No factory default for this face"))
+    (put symbol 'customized-face nil)
+    (when (get symbol 'saved-face)
+      (put symbol 'saved-face nil)
+      (custom-save-all))
+    (when (fboundp 'copy-face)
+      (copy-face 'custom-face-empty symbol))
+    (custom-face-display-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-item-convert-widget
+  :format "%[%t%]: %v"
+  :tag "Face"
+  :value 'default
+  :value-create 'widget-face-value-create
+  :value-delete 'widget-face-value-delete
+  :value-get 'widget-item-value-get
+  :validate 'widget-editable-list-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))
+         (child (widget-create-child-and-convert
+                 widget 'custom-face
+                 :format "%t %s%m%h%v"
+                 :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"
+  :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' Widget.
+
+(defcustom custom-group-tag-faces '(custom-group-tag-face-1)
+  ;; 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 'customize)
+
+(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 'customize)
+
+(define-widget 'custom-group 'custom
+  "Customize group."
+  :format "%l%{%t%}:%L\n%m%h%a%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-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-factory 'custom-group-reset-factory
+  :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))
+
+(defun custom-group-value-create (widget)
+  (let ((state (widget-get widget :custom-state)))
+    (unless (eq state 'hidden)
+      (message "Creating group...")
+      (custom-load-widget widget)
+      (let* ((level (widget-get widget :custom-level))
+             (symbol (widget-value widget))
+             (members (get symbol 'custom-group))
+             (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")
+                                 (message "Creating group members... %2d%%"
+                                          (/ (* 100.0 count) length))
+                                 (setq count (1+ count))
+                                 (prog1
+                                     (widget-create-child-and-convert
+                                      widget (nth 1 entry)
+                                      :group widget
+                                      :tag (custom-unlispify-tag-name
+                                            (nth 0 entry))
+                                      :custom-prefixes custom-prefix-list
+                                      :custom-level (1+ level)
+                                      :value (nth 0 entry))
+                                   (unless (eq (preceding-char) ?\n)
+                                     (widget-insert "\n"))))
+                               members)))
+        (message "Creating group magic...")
+        (mapcar 'custom-magic-reset children)
+        (message "Creating group state...")
+        (widget-put widget :children children)
+        (custom-group-state-update widget)
+        (message "Creating group... done")))))
+
+(defvar custom-group-menu 
+  '(("Set" . custom-group-set)
+    ("Save" . custom-group-save)
+    ("Reset to Current" . custom-group-reset-current)
+    ("Reset to Saved" . custom-group-reset-saved)
+    ("Reset to Factory" . custom-group-reset-factory))
+  "Alist of actions for the `custom-group' widget.
+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-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)
+      (progn 
+        (widget-put widget :custom-state 'unknown)
+        (custom-redraw widget))
+    (let* ((completion-ignore-case t)
+           (answer (widget-choose (custom-unlispify-tag-name
+                                   (widget-get widget :value))
+                                  custom-group-menu
+                                  event)))
+      (if answer
+          (funcall answer widget)))))
+
+(defun custom-group-set (widget)
+  "Set changes in all modified group members."
+  (let ((children (widget-get widget :children)))
+    (mapcar (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)))
+    (mapcar (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)))
+    (mapcar (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)))
+    (mapcar (lambda (child)
+              (when (memq (widget-get child :custom-state) '(modified set))
+                (widget-apply child :custom-reset-saved)))
+            children )))
+
+(defun custom-group-reset-factory (widget)
+  "Reset all modified, set, or saved group members."
+  (let ((children (widget-get widget :children)))
+    (mapcar (lambda (child)
+              (when (memq (widget-get child :custom-state)
+                          '(modified set saved))
+                (widget-apply child :custom-reset-factory)))
+            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 'factory))
+      (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.
+
+(defcustom custom-file "~/.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."
+  (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)))
+                    (when value
+                      (princ "\n '(")
+                      (princ symbol)
+                      (princ " ")
+                      (prin1 (car value))
+                      (if (or (get symbol 'factory-value)
+                              (and (not (boundp symbol))
+                                   (not (get symbol 'force-value))))
+                          (princ ")")
+                        (princ " t)"))))))
+      (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")
+      (mapatoms (lambda (symbol)
+                  (let ((value (get symbol 'saved-face)))
+                    (when value
+                      (princ "\n '(")
+                      (princ symbol)
+                      (princ " ")
+                      (prin1 value)
+                      (if (or (get symbol 'factory-face)
+                              (and (not (custom-facep symbol))
+                                   (not (get symbol 'force-face))))
+                          (princ ")")
+                        (princ " t)"))))))
+      (princ ")")
+      (unless (looking-at "\n")
+        (princ "\n")))))
+
+;;;###autoload
+(defun custom-save-all ()
+  "Save all customizations in `custom-file'."
+  (custom-save-variables)
+  (custom-save-faces)
+  (save-excursion
+    (set-buffer (find-file-noselect custom-file))
+    (save-buffer)))
+
+;;; The Customize Menu.
+
+(defcustom custom-menu-nesting 2
+  "Maximum nesting in custom menus."
+  :type 'integer
+  :group 'customize)
+
+(defun custom-face-menu-create (widget symbol)
+  "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
+  (vector (custom-unlispify-menu-entry symbol)
+          `(custom-buffer-create '((,symbol custom-face)))
+          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)
+              `(custom-buffer-create '((,symbol custom-variable)))
+              t))))
+
+(widget-put (get 'boolean 'widget-type)
+            :custom-menu (lambda (widget symbol)
+                           (vector (custom-unlispify-menu-entry symbol)
+                                   `(custom-buffer-create
+                                     '((,symbol custom-variable)))
+                                   ':style 'toggle
+                                   ':selected symbol)))
+
+(if (string-match "XEmacs" emacs-version)
+    ;; 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)
+                   (cdr (custom-menu-create ',symbol)))))
+  ;; But emacs can't.
+  (defun custom-group-menu-create (widget symbol)
+    "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
+    ;; Limit the nesting.
+    (let ((custom-menu-nesting (1- custom-menu-nesting)))
+      (custom-menu-create symbol))))
+
+(defun custom-menu-create (symbol &optional name)
+  "Create menu for customization group SYMBOL.
+If optional NAME is given, use that as the name of the menu. 
+Otherwise make up a name from SYMBOL.
+The menu is in a format applicable to `easy-menu-define'."
+  (unless name
+    (setq name (custom-unlispify-menu-entry symbol)))
+  (let ((item (vector name
+                      `(custom-buffer-create '((,symbol custom-group)))
+                      t)))
+    (if (and (>= custom-menu-nesting 0)
+             (< (length (get symbol 'custom-group)) widget-menu-max-size))
+        (let ((custom-prefix-list (custom-prefix-add symbol
+                                                     custom-prefix-list)))
+          (custom-load-symbol symbol)
+          `(,(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)))
+                      (get symbol 'custom-group))))
+      item)))
+
+;;;###autoload
+(defun custom-menu-update (event)
+  "Update customize menu."
+  (interactive "e")
+  (add-hook 'custom-define-hook 'custom-menu-reset)
+  (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
+         (menu `(,(car custom-help-menu)
+                 ,emacs
+                 ,@(cdr (cdr custom-help-menu)))))
+    (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
+      (define-key global-map [menu-bar help-menu customize-menu]
+        (cons (car menu) map)))))
+
+;;; Dependencies.
+
+;;;###autoload
+(defun custom-make-dependencies ()
+  "Batch function to extract custom dependencies from .el files.
+Usage: emacs -batch *.el -f custom-make-dependencies > deps.el"
+  (let ((buffers (buffer-list)))
+    (while buffers
+      (set-buffer (car buffers))
+      (setq buffers (cdr buffers))
+      (let ((file (buffer-file-name)))
+        (when (and file (string-match "\\`\\(.*\\)\\.el\\'" file))
+          (goto-char (point-min))
+          (condition-case nil
+              (let ((name (file-name-nondirectory (match-string 1 file))))
+                (while t
+                  (let ((expr (read (current-buffer))))
+                    (when (and (listp expr)
+                               (memq (car expr) '(defcustom defface defgroup)))
+                      (eval expr)
+                      (put (nth 1 expr) 'custom-where name)))))
+            (error nil))))))
+  (mapatoms (lambda (symbol)
+              (let ((members (get symbol 'custom-group))
+                    item where found)
+                (when members
+                  (princ "(put '")
+                  (princ symbol)
+                  (princ " 'custom-loads '(")
+                  (while members
+                    (setq item (car (car members))
+                          members (cdr members)
+                          where (get item 'custom-where))
+                    (unless (or (null where)
+                                (member where found))
+                      (when found
+                        (princ " "))
+                      (prin1 where)
+                      (push where found)))
+                  (princ "))\n"))))))
+
+;;; The End.
+
+(provide 'cus-edit)
+
+;; cus-edit.el ends here
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
new file mode 100644
index 00000000000..ae8e60b499f
--- /dev/null
+++ b/lisp/cus-face.el
@@ -0,0 +1,590 @@
+;;; cus-face.el -- XEmacs specific custom support.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: help, faces
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `custom.el'.
+
+;;; Code:
+
+(require 'custom)
+
+(eval-and-compile (require 'cl))
+
+;;; Compatibility.
+
+(if (string-match "XEmacs" emacs-version)
+    (defun custom-face-background (face &optional frame)
+      ;; Specifiers suck!
+      "Return the background color name of face FACE, or nil if unspecified."
+      (color-instance-name (specifier-instance (face-background face) frame)))
+  (defalias 'custom-face-background 'face-background))
+
+(if (string-match "XEmacs" emacs-version)
+    (defun custom-face-foreground (face &optional frame)
+      ;; Specifiers suck!
+      "Return the background color name of face FACE, or nil if unspecified."
+      (color-instance-name (specifier-instance (face-foreground face) frame)))
+  (defalias 'custom-face-foreground 'face-foreground))
+
+(defalias 'custom-face-font-name (if (string-match "XEmacs" emacs-version)
+                                     'face-font-name
+                                   'face-font))
+
+(eval-and-compile
+  (unless (fboundp 'frame-property)
+    ;; XEmacs function missing in Emacs 19.34.
+    (defun frame-property (frame property &optional default)
+      "Return FRAME's value for property PROPERTY."
+      (or (cdr (assq property (frame-parameters frame)))
+          default)))
+
+  (unless (fboundp 'face-doc-string)
+    ;; XEmacs function missing in Emacs.
+    (defun face-doc-string (face)
+      "Get the documentation string for FACE."
+      (get face 'face-doc-string)))
+
+  (unless (fboundp 'set-face-doc-string)
+    ;; XEmacs function missing in Emacs.
+    (defun set-face-doc-string (face string)
+      "Set the documentation string for FACE to STRING."
+      (put face 'face-doc-string string)))
+
+  (when (and (not (fboundp 'set-face-stipple))
+             (fboundp 'set-face-background-pixmap))
+    ;; Emacs function missing in XEmacs 19.15.
+    (defun set-face-stipple (face pixmap &optional frame)
+      ;; Written by Kyle Jones.
+      "Change the stipple pixmap of face FACE to PIXMAP.
+PIXMAP should be a string, the name of a file of pixmap data.
+The directories listed in the `x-bitmap-file-path' variable are searched.
+
+Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
+where WIDTH and HEIGHT are the size in pixels,
+and DATA is a string, containing the raw bits of the bitmap.  
+
+If the optional FRAME argument is provided, change only
+in that frame; otherwise change each frame."
+      (while (not (find-face face))
+        (setq face (signal 'wrong-type-argument (list 'facep face))))
+      (while (cond ((stringp pixmap)
+                    (unless (file-readable-p pixmap)
+                      (setq pixmap (vector 'xbm ':file pixmap)))
+                    nil)
+                   ((and (consp pixmap) (= (length pixmap) 3))
+                    (setq pixmap (vector 'xbm ':data pixmap))
+                    nil)
+                   (t t))
+        (setq pixmap (signal 'wrong-type-argument
+                             (list 'stipple-pixmap-p pixmap))))
+      (while (and frame (not (framep frame)))
+        (setq frame (signal 'wrong-type-argument (list 'framep frame))))
+      (set-face-background-pixmap face pixmap frame))))
+
+(unless (fboundp 'x-color-values)
+  ;; Emacs function missing in XEmacs 19.14.
+  (defun x-color-values  (color &optional frame)
+    "Return a description of the color named COLOR on frame FRAME.
+The value is a list of integer RGB values--(RED GREEN BLUE).
+These values appear to range from 0 to 65280 or 65535, depending
+on the system; white is (65280 65280 65280) or (65535 65535 65535).
+If FRAME is omitted or nil, use the selected frame."
+    (color-instance-rgb-components (make-color-instance color))))
+
+;; XEmacs and Emacs have different definitions of `facep'.  
+;; The Emacs definition is the useful one, so emulate that. 
+(cond ((not (fboundp 'facep))
+       (defun custom-facep (face) 
+         "No faces"
+         nil))
+      ((string-match "XEmacs" emacs-version)
+       (defalias 'custom-facep 'find-face))
+      (t
+       (defalias 'custom-facep 'facep)))
+
+(unless (fboundp 'make-empty-face)
+  ;; This should be moved to `faces.el'.
+  (if (string-match "XEmacs" emacs-version)
+      ;; Give up for old XEmacs pre 19.15/20.1.
+      (defalias 'make-empty-face 'make-face)
+    ;; Define for Emacs pre 19.35.
+    (defun make-empty-face (name)
+      "Define a new FACE on all frames, ignoring X resources."
+      (interactive "SMake face: ")
+      (or (internal-find-face name)
+          (let ((face (make-vector 8 nil)))
+            (aset face 0 'face)
+            (aset face 1 name)
+            (let* ((frames (frame-list))
+                   (inhibit-quit t)
+                   (id (internal-next-face-id)))
+              (make-face-internal id)
+              (aset face 2 id)
+              (while frames
+                (set-frame-face-alist (car frames)
+                                      (cons (cons name (copy-sequence face))
+                                            (frame-face-alist (car frames))))
+                (setq frames (cdr frames)))
+              (setq global-face-data (cons (cons name face) global-face-data)))
+            ;; add to menu
+            (if (fboundp 'facemenu-add-new-face)
+                (facemenu-add-new-face name))
+            face))
+      name)))
+
+(defcustom initialize-face-resources t
+  "If non nil, allow X resources to initialize face properties.
+This only affects faces declared with `defface', and only NT or X11 frames."
+  :group 'customize
+  :type 'boolean)
+
+(cond ((fboundp 'initialize-face-resources)
+       ;; Already bound, do nothing.
+       )
+      ((fboundp 'make-face-x-resource-internal)
+       ;; Emacs or new XEmacs.
+       (defun initialize-face-resources (face &optional frame)
+         "Initialize face according to the X11 resources.
+This might overwrite existing face properties.
+Does nothing when the variable initialize-face-resources is nil."
+         (when initialize-face-resources
+           (make-face-x-resource-internal face frame t))))
+      (t 
+       ;; Too hard to do right on XEmacs.
+       (defalias 'initialize-face-resources 'ignore)))
+
+;;(if (string-match "XEmacs" emacs-version)
+;;    ;; Xemacs.
+;;    (defun custom-invert-face (face &optional frame)
+;;      "Swap the foreground and background colors of face FACE.
+;;If the colors are not specified in the face, use the default colors."
+;;      (interactive (list (read-face-name "Reverse face: ")))
+;;      (let ((fg (color-name (face-foreground face frame) frame))
+;;          (bg (color-name (face-background face frame) frame)))
+;;      (set-face-foreground face bg frame)
+;;      (set-face-background face fg frame)))
+;;  ;; Emacs.
+;;  (defun custom-invert-face (face &optional frame)
+;;    "Swap the foreground and background colors of face FACE.
+;;If the colors are not specified in the face, use the default colors."
+;;    (interactive (list (read-face-name "Reverse face: ")))
+;;    (let ((fg (or (face-foreground face frame)
+;;                (face-foreground 'default frame)
+;;                (frame-property (or frame (selected-frame))
+;;                                'foreground-color)
+;;                "black"))
+;;        (bg (or (face-background face frame)
+;;                (face-background 'default frame)
+;;                (frame-property (or frame (selected-frame))
+;;                                'background-color)
+;;                "white")))
+;;      (set-face-foreground face bg frame)
+;;      (set-face-background face fg frame))))
+
+(defcustom custom-background-mode nil
+  "The brightness of the background.
+Set this to the symbol dark if your background color is dark, light if
+your background is light, or nil (default) if you want Emacs to
+examine the brightness for you."
+  :group 'customize
+  :type '(choice (choice-item dark) 
+                 (choice-item light)
+                 (choice-item :tag "default" nil)))
+
+(defun custom-background-mode (frame)
+  "Kludge to detect background mode for FRAME."
+  (let* ((bg-resource 
+          (condition-case ()
+              (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
+            (error nil)))
+         color
+         (mode (cond (bg-resource
+                      (intern (downcase bg-resource)))
+                     ((and (setq color (condition-case ()
+                                           (or (frame-property
+                                                frame
+                                                'background-color)
+                                               (custom-face-background
+                                                'default))
+                                         (error nil)))
+                           (or (string-match "XEmacs" emacs-version)
+                               window-system)
+                           (< (apply '+ (x-color-values color))
+                              (/ (apply '+ (x-color-values "white"))
+                                 3)))
+                      'dark)
+                     (t 'light))))
+    (modify-frame-parameters frame (list (cons 'background-mode mode)))
+    mode))
+
+(eval-and-compile
+  (if (string-match "XEmacs" emacs-version)
+      ;; XEmacs.
+      (defun custom-extract-frame-properties (frame)
+        "Return a plist with the frame properties of FRAME used by custom."
+        (list 'type (device-type (frame-device frame))
+              'class (device-class (frame-device frame))
+              'background (or custom-background-mode
+                              (frame-property frame
+                                              'background-mode)
+                              (custom-background-mode frame))))
+    ;; Emacs.
+    (defun custom-extract-frame-properties (frame)
+      "Return a plist with the frame properties of FRAME used by custom."
+      (list 'type window-system
+            'class (frame-property frame 'display-type)
+            'background (or custom-background-mode
+                            (frame-property frame 'background-mode)
+                            (custom-background-mode frame))))))  
+
+;;; Declaring a face.
+
+;;;###autoload
+(defun custom-declare-face (face spec doc &rest args)
+  "Like `defface', but FACE is evaluated as a normal argument."
+  (when (fboundp 'load-gc)
+    ;; This should be allowed, somehow.
+    (error "Attempt to declare a face during dump"))
+  (unless (get face 'factory-face)
+    (put face 'factory-face spec)
+    (when (fboundp 'facep)
+      (unless (custom-facep face)
+        ;; If the user has already created the face, respect that.
+        (let ((value (or (get face 'saved-face) spec))
+              (frames (custom-relevant-frames))
+              frame)
+          ;; Create global face.
+          (make-empty-face face)
+          (custom-face-display-set face value)
+          ;; Create frame local faces
+          (while frames
+            (setq frame (car frames)
+                  frames (cdr frames))
+            (custom-face-display-set face value frame))
+          (initialize-face-resources face))))
+    (when (and doc (null (face-doc-string face)))
+      (set-face-doc-string face doc))
+    (custom-handle-all-keywords face args 'custom-face)
+    (run-hooks 'custom-define-hook))
+  face)
+
+;;; Font Attributes.
+
+(defconst custom-face-attributes
+  '((:bold (toggle :format "Bold: %[%v%]\n"
+                   :help-echo "Control whether a bold font should be used.")
+           custom-set-face-bold 
+           custom-face-bold)
+    (:italic (toggle :format "Italic: %[%v%]\n"
+                     :help-echo "\
+Control whether an italic font should be used.")
+             custom-set-face-italic
+             custom-face-italic)
+    (:underline (toggle :format "Underline: %[%v%]\n"
+                        :help-echo "\
+Control whether the text should be underlined.")
+                set-face-underline-p
+                face-underline-p)
+    (:foreground (color :tag "Foreground"
+                        :value "black"
+                        :help-echo "Set foreground color.")
+                 set-face-foreground
+                 custom-face-foreground)
+    (:background (color :tag "Background"
+                        :value "white"
+                        :help-echo "Set background color.")
+                 set-face-background
+                 custom-face-background)
+    ;;    (:invert (const :format "Invert Face\n" 
+    ;;              :sibling-args (:help-echo "
+    ;;Reverse the foreground and background color.
+    ;;If you haven't specified them for the face, the default colors will be used.")
+    ;;              t)
+    ;;       (lambda (face value &optional frame)
+    ;;         ;; We don't use VALUE.
+    ;;         (custom-invert-face face frame)))
+    (:stipple (editable-field :format "Stipple: %v"
+                              :help-echo "Name of background bitmap file.")
+              set-face-stipple custom-face-stipple))
+  "Alist of face attributes. 
+
+The elements are of the form (KEY TYPE SET GET) where KEY is a symbol
+identifying the attribute, TYPE is a widget type for editing the
+attibute, SET is a function for setting the attribute value, and GET is a function for getiing the attribute value. 
+
+The SET function should take three arguments, the face to modify, the
+value of the attribute, and optionally the frame where the face should
+be changed.
+
+The GET function should take two arguments, the face to examine, and
+optonally the frame where the face should be examined.")
+
+(defun custom-face-attributes-set (face frame &rest atts)
+  "For FACE on FRAME set the attributes [KEYWORD VALUE]....
+Each keyword should be listed in `custom-face-attributes'.
+
+If FRAME is nil, set the default face."
+  (while atts 
+    (let* ((name (nth 0 atts))
+           (value (nth 1 atts))
+           (fun (nth 2 (assq name custom-face-attributes))))
+      (setq atts (cdr (cdr atts)))
+      (condition-case nil
+          (funcall fun face value frame)
+        (error nil)))))
+
+(defun custom-face-attributes-get (face frame)
+  "For FACE on FRAME get the attributes [KEYWORD VALUE]....
+Each keyword should be listed in `custom-face-attributes'.
+
+If FRAME is nil, use the default face."
+  (condition-case nil
+      ;; Attempt to get `font.el' from w3.
+      (require 'font)
+    (error nil))
+  (let ((atts custom-face-attributes)
+        att result get)
+    (while atts
+      (setq att (car atts)
+            atts (cdr atts)
+            get (nth 3 att))
+      (when get 
+        (let ((answer (funcall get face frame)))
+          (unless (equal answer (funcall get 'default frame))
+            (when (widget-apply (nth 1 att) :match answer)
+              (setq result (cons (nth 0 att) (cons answer result))))))))
+    result))
+
+(defun custom-set-face-bold (face value &optional frame)
+  "Set the bold property of FACE to VALUE."
+  (if value
+      (make-face-bold face frame)
+    (make-face-unbold face frame)))
+
+(defun custom-face-bold (face &rest args)
+  "Return non-nil if the font of FACE is bold."
+  (let* ((font (apply 'custom-face-font-name face args))
+         (fontobj (font-create-object font)))
+    (font-bold-p fontobj)))
+
+(defun custom-set-face-italic (face value &optional frame)
+  "Set the italic property of FACE to VALUE."
+  (if value
+      (make-face-italic face frame)
+    (make-face-unitalic face frame)))
+
+(defun custom-face-italic (face &rest args)
+  "Return non-nil if the font of FACE is italic."
+  (let* ((font (apply 'custom-face-font-name face args))
+         (fontobj (font-create-object font)))
+    (font-italic-p fontobj)))
+
+(defun custom-face-stipple (face &rest args)
+  "Return the name of the stipple file used for FACE."
+  (if (string-match "XEmacs" emacs-version)
+      (let ((image  (apply 'specifier-instance 
+                           (face-background-pixmap face) args)))
+        (when image 
+          (image-instance-file-name image)))
+    (apply 'face-stipple face args)))
+
+(when (string-match "XEmacs" emacs-version)
+  ;; Support for special XEmacs font attributes.
+  (autoload 'font-create-object "font" nil)
+
+  (defun custom-set-face-font-size (face size &rest args)
+    "Set the font of FACE to SIZE"
+    (let* ((font (apply 'custom-face-font-name face args))
+           (fontobj (font-create-object font)))
+      (set-font-size fontobj size)
+      (apply 'font-set-face-font face fontobj args)))
+
+  (defun custom-face-font-size (face &rest args)
+    "Return the size of the font of FACE as a string."
+    (let* ((font (apply 'custom-face-font-name face args))
+           (fontobj (font-create-object font)))
+      (format "%d" (font-size fontobj))))
+
+  (defun custom-set-face-font-family (face family &rest args)
+    "Set the font of FACE to FAMILY."
+    (let* ((font (apply 'custom-face-font-name face args))
+           (fontobj (font-create-object font)))
+      (set-font-family fontobj family)
+      (apply 'font-set-face-font face fontobj args)))
+
+  (defun custom-face-font-family (face &rest args)
+    "Return the name of the font family of FACE."
+    (let* ((font (apply 'custom-face-font-name face args))
+           (fontobj (font-create-object font)))
+      (font-family fontobj)))
+
+  (nconc custom-face-attributes
+         '((:family (editable-field :format "Font Family: %v"
+                                    :help-echo "\
+Name of font family to use (e.g. times).") 
+                    custom-set-face-font-family
+                    custom-face-font-family)
+           (:size (editable-field :format "Size: %v"
+                                  :help-echo "\
+Text size (e.g. 9pt or 2mm).")
+                  custom-set-face-font-size
+                  custom-face-font-size))))
+
+;;; Frames.
+
+(defun custom-face-display-set (face spec &optional frame)
+  "Set FACE to the attributes to the first matching entry in SPEC.
+Iff optional FRAME is non-nil, set it for that frame only.
+See `defface' for information about SPEC."
+  (when (fboundp 'make-face)
+    (while spec 
+      (let* ((entry (car spec))
+             (display (nth 0 entry))
+             (atts (nth 1 entry)))
+        (setq spec (cdr spec))
+        (when (custom-display-match-frame display frame)
+          ;; Avoid creating frame local duplicates of the global face.
+          (unless (and frame (eq display (get face 'custom-face-display)))
+            (apply 'custom-face-attributes-set face frame atts))
+          (unless frame
+            (put face 'custom-face-display display))
+          (setq spec nil))))))
+
+(defvar custom-default-frame-properties nil
+  "The frame properties used for the global faces.
+Frames who doesn't match these propertiess should have frame local faces.
+The value should be nil, if uninitialized, or a plist otherwise.  
+See `defface' for a list of valid keys and values for the plist.")
+
+(defun custom-get-frame-properties (&optional frame)
+  "Return a plist with the frame properties of FRAME used by custom.
+If FRAME is nil, return the default frame properties."
+  (cond (frame
+         ;; Try to get from cache.
+         (let ((cache (frame-property frame 'custom-properties)))
+           (unless cache
+             ;; Oh well, get it then.
+             (setq cache (custom-extract-frame-properties frame))
+             ;; and cache it...
+             (modify-frame-parameters frame 
+                                      (list (cons 'custom-properties cache))))
+           cache))
+        (custom-default-frame-properties)
+        (t
+         (setq custom-default-frame-properties
+               (custom-extract-frame-properties (selected-frame))))))
+
+(defun custom-display-match-frame (display frame)
+  "Non-nil iff DISPLAY matches FRAME.
+If FRAME is nil, the current FRAME is used."
+  ;; This is a kludge to get started, we really should use specifiers!
+  (if (eq display t)
+      t
+    (let* ((props (custom-get-frame-properties frame))
+           (type (plist-get props 'type))
+           (class (plist-get props 'class))
+           (background (plist-get props 'background))
+           (match t)
+           (entries display)
+           entry req options)
+      (while (and entries match)
+        (setq entry (car entries)
+              entries (cdr entries)
+              req (car entry)
+              options (cdr entry)
+              match (cond ((eq req 'type)
+                           (memq type options))
+                          ((eq req 'class)
+                           (memq class options))
+                          ((eq req 'background)
+                           (memq background options))
+                          (t
+                           (error "Unknown req `%S' with options `%S'" 
+                                  req options)))))
+      match)))
+
+(defun custom-relevant-frames ()
+  "List of frames whose custom properties differ from the default."
+  (let ((relevant nil)
+        (default (custom-get-frame-properties))
+        (frames (frame-list))
+        frame)
+    (while frames
+      (setq frame (car frames)
+            frames (cdr frames))
+      (unless (equal default (custom-get-frame-properties frame))
+        (push frame relevant)))
+    relevant))
+
+(defun custom-initialize-faces (&optional frame)
+  "Initialize all custom faces for FRAME.
+If FRAME is nil or omitted, initialize them for all frames."
+  (mapcar (lambda (symbol)
+            (let ((spec (or (get symbol 'saved-face)
+                            (get symbol 'factory-face))))
+              (when spec 
+                (custom-face-display-set symbol spec frame)
+                (initialize-face-resources symbol frame))))
+          (face-list)))
+
+(defun custom-initialize-frame (&optional frame)
+  "Initialize local faces for FRAME if necessary.
+If FRAME is missing or nil, the first member of (frame-list) is used."
+  (unless frame
+    (setq frame (car (frame-list))))
+  (unless (equal (custom-get-frame-properties) 
+                 (custom-get-frame-properties frame))
+    (custom-initialize-faces frame)))
+
+;; Enable.  This should go away when bundled with Emacs.
+(unless (string-match "XEmacs" emacs-version)
+  (add-hook 'after-make-frame-hook 'custom-initialize-frame))
+
+;;; Initializing.
+
+(and (fboundp 'make-face)
+     (make-face 'custom-face-empty))
+
+;;;###autoload
+(defun custom-set-faces (&rest args)
+  "Initialize faces according to user preferences.
+The arguments should be a list where each entry has the form:
+
+  (FACE SPEC [NOW])
+
+SPEC will be stored as the saved value for FACE.  If NOW is present
+and non-nil, FACE will also be created according to SPEC.
+
+See `defface' for the format of SPEC."
+  (while args
+    (let ((entry (car args)))
+      (if (listp entry)
+          (let ((face (nth 0 entry))
+                (spec (nth 1 entry))
+                (now (nth 2 entry)))
+            (put face 'saved-face spec)
+            (when now
+              (put face 'force-face t))
+            (when (or now (custom-facep face))
+              (when (fboundp 'copy-face)
+                (copy-face 'custom-face-empty face))
+              (custom-face-display-set face spec))
+            (setq args (cdr args)))
+        ;; Old format, a plist of FACE SPEC pairs.
+        (let ((face (nth 0 args))
+              (spec (nth 1 args)))
+          (put face 'saved-face spec))
+        (setq args (cdr (cdr args)))))))
+
+;;; The End.
+
+(provide 'cus-face)
+
+;; cus-face.el ends here
diff --git a/lisp/custom.el b/lisp/custom.el
index e747264583c..6d247ebb379 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,2472 +1,332 @@
-;;; custom.el --- User friendly customization support.
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: help
-;; Version: 0.5
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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 GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; WARNING: This package is still under construction and not all of
-;; the features below are implemented.
+;;; custom.el -- Tools for declaring and initializing options.
 ;;
-;; This package provides a framework for adding user friendly
-;; customization support to Emacs.  Having to do customization by
-;; editing a text file in some arcane syntax is user hostile in the
-;; extreme, and to most users emacs lisp definitely count as arcane.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 ;;
-;; The intent is that authors of emacs lisp packages declare the
-;; variables intended for user customization with `custom-declare'.
-;; Custom can then automatically generate a customization buffer with
-;; `custom-buffer-create' where the user can edit the package
-;; variables in a simple and intuitive way, as well as a menu with
-;; `custom-menu-create' where he can set the more commonly used
-;; variables interactively.
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: help, faces
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
 ;;
-;; It is also possible to use custom for modifying the properties of
-;; other objects than the package itself, by specifying extra optional
-;; arguments to `custom-buffer-create'.
+;; If you want to use this code, please visit the URL above.
 ;;
-;; Custom is inspired by OPEN LOOK property windows.
+;; This file only contain the code needed to declare and initialize
+;; user options.  The code to customize options is autoloaded from
+;; `cus-edit.el'. 
 
-;;; Todo:  
-;;
-;; - Toggle documentation in three states `none', `one-line', `full'.
-;; - Function to generate an XEmacs menu from a CUSTOM.
-;; - Write TeXinfo documentation.
-;; - Make it possible to hide sections by clicking at the level.
-;; - Declare AUC TeX variables.
-;; - Declare (ding) Gnus variables.
-;; - Declare Emacs variables.
-;; - Implement remaining types.
-;; - XEmacs port.
-;; - Allow `URL', `info', and internal hypertext buttons.
-;; - Support meta-variables and goal directed customization.
-;; - Make it easy to declare custom types independently.
-;; - Make it possible to declare default value and type for a single
-;;   variable, storing the data in a symbol property.
-;; - Syntactic sugar for CUSTOM declarations.
-;; - Use W3 for variable documentation.
+;; The code implementing face declarations is in `cus-face.el'
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
-
-;;; Compatibility:
-
-(defun custom-xmas-add-text-properties (start end props &optional object)
-  (add-text-properties start end props object)
-  (put-text-property start end 'start-open t object)
-  (put-text-property start end 'end-open t object))
-
-(defun custom-xmas-put-text-property (start end prop value &optional object)
-  (put-text-property start end prop value object)
-  (put-text-property start end 'start-open t object)
-  (put-text-property start end 'end-open t object))
-
-(defun custom-xmas-extent-start-open ()
-  (map-extents (lambda (extent arg)
-                 (set-extent-property extent 'start-open t))
-               nil (point) (min (1+ (point)) (point-max))))
-                  
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (progn
-      (fset 'custom-add-text-properties 'custom-xmas-add-text-properties)
-      (fset 'custom-put-text-property 'custom-xmas-put-text-property)
-      (fset 'custom-extent-start-open 'custom-xmas-extent-start-open)
-      (fset 'custom-set-text-properties
-            (if (fboundp 'set-text-properties)
-                'set-text-properties))
-      (fset 'custom-buffer-substring-no-properties
-            (if (fboundp 'buffer-substring-no-properties)
-                'buffer-substring-no-properties
-              'custom-xmas-buffer-substring-no-properties)))
-  (fset 'custom-add-text-properties 'add-text-properties)
-  (fset 'custom-put-text-property 'put-text-property)
-  (fset 'custom-extent-start-open 'ignore)
-  (fset 'custom-set-text-properties 'set-text-properties)
-  (fset 'custom-buffer-substring-no-properties 
-        'buffer-substring-no-properties))
-
-(defun custom-xmas-buffer-substring-no-properties (beg end)
-  "Return the text from BEG to END, without text properties, as a string."
-  (let ((string (buffer-substring beg end)))
-    (custom-set-text-properties 0 (length string) nil string)
-    string))
-
-(or (fboundp 'add-to-list)
-    ;; Introduced in Emacs 19.29.
-    (defun add-to-list (list-var element)
-      "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this.  In some cases
-other hooks, such as major mode hooks, can do the job."
-      (or (member element (symbol-value list-var))
-          (set list-var (cons element (symbol-value list-var))))))
-
-(or (fboundp 'plist-get)
-    ;; Introduced in Emacs 19.29.
-    (defun plist-get (plist prop)
-      "Extract a value from a property list.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
-corresponding to the given PROP, or nil if PROP is not
-one of the properties on the list."
-      (let (result)
-        (while plist
-          (if (eq (car plist) prop)
-              (setq result (car (cdr plist))
-                    plist nil)
-            (set plist (cdr (cdr plist)))))
-        result)))
-
-(or (fboundp 'plist-put)
-    ;; Introduced in Emacs 19.29.
-    (defun plist-put (plist prop val)    
-      "Change value in PLIST of PROP to VAL.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...).  PROP is a symbol and VAL is any object.
-If PROP is already a property on the list, its value is set to VAL,
-otherwise the new PROP VAL pair is added.  The new plist is returned;
-use `(setq x (plist-put x prop val))' to be sure to use the new value.
-The PLIST is modified by side effects."
-      (if (null plist)
-          (list prop val)
-        (let ((current plist))
-          (while current
-            (cond ((eq (car current) prop)
-                   (setcar (cdr current) val)
-                   (setq current nil))
-                  ((null (cdr (cdr current)))
-                   (setcdr (cdr current) (list prop val))
-                   (setq current nil))
-                  (t
-                   (setq current (cdr (cdr current)))))))
-        plist)))
-
-(or (fboundp 'match-string)
-    ;; Introduced in Emacs 19.29.
-    (defun match-string (num &optional string)
-  "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
-  (if (match-beginning num)
-      (if string
-          (substring string (match-beginning num) (match-end num))
-        (buffer-substring (match-beginning num) (match-end num))))))
-
-(or (fboundp 'facep)
-    ;; Introduced in Emacs 19.29.
-    (defun facep (x)
-      "Return t if X is a face name or an internal face vector."
-      (and (or (and (fboundp 'internal-facep) (internal-facep x))
-               (and 
-                (symbolp x) 
-                (assq x (and (boundp 'global-face-data) global-face-data))))
-           t)))
-
-;; XEmacs and Emacs 19.29 facep does different things.
-(if (fboundp 'find-face)
-    (fset 'custom-facep 'find-face)
-  (fset 'custom-facep 'facep))
-
-(if (custom-facep 'underline)
-    ()
-  ;; No underline face in XEmacs 19.12.
-  (and (fboundp 'make-face)
-       (funcall (intern "make-face") 'underline))
-  ;; Must avoid calling set-face-underline-p directly, because it
-  ;; is a defsubst in emacs19, and will make the .elc files non
-  ;; portable!
-  (or (and (fboundp 'face-differs-from-default-p)
-           (face-differs-from-default-p 'underline))
-      (and (fboundp 'set-face-underline-p)
-           (funcall 'set-face-underline-p 'underline t))))
-
-(defun custom-xmas-set-text-properties (start end props &optional buffer)
-  (if (null buffer)
-      (if props
-          (while props
-            (custom-put-text-property 
-             start end (car props) (nth 1 props) buffer)
-            (setq props (nthcdr 2 props)))
-        (remove-text-properties start end ()))))
-
-(or (fboundp 'event-point)
-    ;; Missing in Emacs 19.29.
-    (defun event-point (event)
-      "Return the character position of the given mouse-motion, button-press,
-or button-release event.  If the event did not occur over a window, or did
-not occur over text, then this returns nil.  Otherwise, it returns an index
-into the buffer visible in the event's window."
-      (posn-point (event-start event))))
-
-(eval-when-compile
-  (defvar x-colors nil)
-  (defvar custom-button-face nil)
-  (defvar custom-field-uninitialized-face nil)
-  (defvar custom-field-invalid-face nil)
-  (defvar custom-field-modified-face nil)
-  (defvar custom-field-face nil)
-  (defvar custom-mouse-face nil)
-  (defvar custom-field-active-face nil))
-
-;; We can't easily check for a working intangible.
-(defconst intangible (if (and (boundp 'emacs-minor-version)
-                              (or (> emacs-major-version 19)
-                                  (and (> emacs-major-version 18)
-                                       (> emacs-minor-version 28))))
-                         (setq intangible 'intangible)
-                       (setq intangible 'intangible-if-it-had-been-working))
-  "The symbol making text intangible.")
-
-(defconst rear-nonsticky (if (string-match "XEmacs" emacs-version)
-                             'end-open
-                           'rear-nonsticky)
-  "The symbol making text properties non-sticky in the rear end.")
-
-(defconst front-sticky (if (string-match "XEmacs" emacs-version)
-                           'front-closed
-                         'front-sticky)
-  "The symbol making text properties sticky in the front.")
-
-(defconst mouse-face (if (string-match "XEmacs" emacs-version)
-                         'highlight
-                       'mouse-face)
-  "Symbol used for highlighting text under mouse.")
-
-;; Put it in the Help menu, if possible.
-(if (string-match "XEmacs" emacs-version)
-    (if (featurep 'menubar)
-        ;; XEmacs (disabled because it doesn't work)
-        (and current-menubar
-             (add-menu-item '("Help") "Customize..." 'customize t)))
-  ;; Emacs 19.28 and earlier
-  (global-set-key [ menu-bar help customize ]
-                  '("Customize..." . customize))
-  ;; Emacs 19.29 and later
-  (global-set-key [ menu-bar help-menu customize ] 
-                  '("Customize..." . customize)))
-
-;; XEmacs popup-menu stolen from w3.el.
-(defun custom-x-really-popup-menu (pos title menudesc)
-  "My hacked up function to do a blocking popup menu..."
-  (let ((echo-keystrokes 0)
-        event menu)
-    (while menudesc
-      (setq menu (cons (vector (car (car menudesc))
-                               (list (car (car menudesc))) t) menu)
-            menudesc (cdr menudesc)))
-    (setq menu (cons title menu))
-    (popup-menu menu)
-    (catch 'popup-done
-      (while t
-        (setq event (next-command-event event))
-        (cond ((and (misc-user-event-p event) (stringp (car-safe                                                   (event-object event))))
-               (throw 'popup-done (event-object event)))
-              ((and (misc-user-event-p event)
-                    (or (eq (event-object event) 'abort)
-                        (eq (event-object event) 'menu-no-selection-hook)))
-               nil)
-              ((not (popup-menu-up-p))
-               (throw 'popup-done nil))
-              ((button-release-event-p event);; don't beep twice
-               nil)
+(require 'widget)
+
+(define-widget-keywords :prefix :tag :load :link :options :type :group)
+
+;; These autoloads should be deleted when the file is added to Emacs
+
+(unless (fboundp 'load-gc)
+  ;; From cus-edit.el
+  (autoload 'customize "cus-edit" nil t)
+  (autoload 'customize-variable "cus-edit" nil t)
+  (autoload 'customize-face "cus-edit" nil t)
+  (autoload 'customize-apropos "cus-edit" nil t)
+  (autoload 'customize-customized "cus-edit" nil t)
+  (autoload 'custom-buffer-create "cus-edit")
+  (autoload 'custom-menu-update "cus-edit")
+  (autoload 'custom-make-dependencies "cus-edit")
+  ;; From cus-face.el
+  (autoload 'custom-declare-face "cus-face")
+  (autoload 'custom-set-faces "cus-face"))
+
+;;; The `defcustom' Macro.
+
+(defun custom-declare-variable (symbol value doc &rest args)
+  "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
+  (unless (and (default-boundp symbol)
+               (not (get symbol 'saved-value)))
+    (set-default symbol (if (get symbol 'saved-value)
+                            (eval (car (get symbol 'saved-value)))
+                          (eval value))))
+  (put symbol 'factory-value (list value))
+  (when doc
+    (put symbol 'variable-documentation doc))
+  (while args 
+    (let ((arg (car args)))
+      (setq args (cdr args))
+      (unless (symbolp arg)
+        (error "Junk in args %S" args))
+      (let ((keyword arg)
+            (value (car args)))
+        (unless args
+          (error "Keyword %s is missing an argument" keyword))
+        (setq args (cdr args))
+        (cond ((eq keyword :type)
+               (put symbol 'custom-type value))
+              ((eq keyword :options)
+               (if (get symbol 'custom-options)
+                   ;; Slow safe code to avoid duplicates.
+                   (mapcar (lambda (option)
+                             (custom-add-option symbol option))
+                           value)
+                 ;; Fast code for the common case.
+                 (put symbol 'custom-options (copy-list value))))
               (t
-               (beep)
-               (message "please make a choice from the menu.")))))))
-
-;;; Categories:
-;;
-;; XEmacs use inheritable extents for the same purpose as Emacs uses
-;; the category text property.
-
-(if (string-match "XEmacs" emacs-version)
-    (progn 
-      ;; XEmacs categories.
-      (defun custom-category-create (name)
-        (set name (make-extent nil nil))
-        "Create a text property category named NAME.")
-
-      (defun custom-category-put (name property value)
-        "In CATEGORY set PROPERTY to VALUE."
-        (set-extent-property (symbol-value name) property value))
-      
-      (defun custom-category-get (name property)
-        "In CATEGORY get PROPERTY."
-        (extent-property (symbol-value name) property))
-      
-      (defun custom-category-set (from to category)
-        "Make text between FROM and TWO have category CATEGORY."
-        (let ((extent (make-extent from to)))
-          (set-extent-parent extent (symbol-value category)))))
-      
-  ;; Emacs categories.
-  (defun custom-category-create (name)
-    "Create a text property category named NAME."
-    (set name name))
-
-  (defun custom-category-put (name property value)
-    "In CATEGORY set PROPERTY to VALUE."
-    (put name property value))
-
-  (defun custom-category-get (name property)
-    "In CATEGORY get PROPERTY."
-    (get name property))
-
-  (defun custom-category-set (from to category)
-    "Make text between FROM and TWO have category CATEGORY."
-    (custom-put-text-property from to 'category category)))
-
-;;; External Data:
-;; 
-;; The following functions and variables defines the interface for
-;; connecting a CUSTOM with an external entity, by default an emacs
-;; lisp variable.
-
-(defvar custom-external 'default-value
-  "Function returning the external value of NAME.")
-
-(defvar custom-external-set 'set-default
-  "Function setting the external value of NAME to VALUE.")
-
-(defun custom-external (name)
-  "Get the external value associated with NAME."
-  (funcall custom-external name))
-
-(defun custom-external-set (name value)
-  "Set the external value associated with NAME to VALUE."
-  (funcall custom-external-set name value))
-
-(defvar custom-name-fields nil
-  "Alist of custom names and their associated editing field.")
-(make-variable-buffer-local 'custom-name-fields)
-
-(defun custom-name-enter (name field)
-  "Associate NAME with FIELD."
-  (if (null name)
-      ()
-    (custom-assert 'field)
-    (setq custom-name-fields (cons (cons name field) custom-name-fields))))
-
-(defun custom-name-field (name)
-  "The editing field associated with NAME."
-  (cdr (assq name custom-name-fields)))
-
-(defun custom-name-value (name)
-  "The value currently displayed for NAME in the customization buffer."
-  (let* ((field (custom-name-field name))
-         (custom (custom-field-custom field)))
-    (custom-field-parse field)
-    (funcall (custom-property custom 'export) custom
-             (car (custom-field-extract custom field)))))
-
-(defvar custom-save 'custom-save
-  "Function that will save current customization buffer.")
-
-;;; Custom Functions:
-;;
-;; The following functions are part of the public interface to the
-;; CUSTOM datastructure.  Each CUSTOM describes a group of variables,
-;; a single variable, or a component of a structured variable.  The
-;; CUSTOM instances are part of two hierarchies, the first is the
-;; `part-of' hierarchy in which each CUSTOM is a component of another
-;; CUSTOM, except for the top level CUSTOM which is contained in
-;; `custom-data'.  The second hierarchy is a `is-a' type hierarchy
-;; where each CUSTOM is a leaf in the hierarchy defined by the `type'
-;; property and `custom-type-properties'.
-
-(defvar custom-file "~/.custom.el"
-  "Name of file with customization information.")
-
-(defconst custom-data
-  '((tag . "Emacs")
-    (doc . "The extensible self-documenting text editor.")
-    (type . group)
-    (data "\n"
-          ((header . nil)
-           (compact . t)
-           (type . group)
-           (doc . "\
-Press [Save] to save any changes permanently after you are done editing.  
-You can load customization information from other files by editing the
-`File' field and pressing the [Load] button.  When you press [Save] the
-customization information of all files you have loaded, plus any
-changes you might have made manually, will be stored in the file 
-specified by the `File' field.")
-           (data ((tag . "Load")
-                  (type . button)
-                  (query . custom-load))
-                 ((tag . "Save")
-                  (type . button)
-                  (query . custom-save))
-                 ((name . custom-file)
-                  (default . "~/.custom.el")
-                  (doc . "Name of file with customization information.\n")
-                  (tag . "File")
-                  (type . file))))))
-  "The global customization information.  
-A custom association list.")
-
-(defun custom-declare (path custom)
-  "Declare variables for customization.  
-PATH is a list of tags leading to the place in the customization
-hierarchy the new entry should be added.  CUSTOM is the entry to add."
-  (custom-initialize custom)
-  (let ((current (custom-travel-path custom-data path)))
-    (or (member custom (custom-data current))
-        (nconc (custom-data current) (list custom)))))
-
-(put 'custom-declare 'lisp-indent-hook 1)
-
-(defconst custom-type-properties
-  '((repeat (type . default)
-            ;; See `custom-match'.
-            (import . custom-repeat-import)
-            (eval . custom-repeat-eval)
-            (quote . custom-repeat-quote)
-            (accept . custom-repeat-accept)
-            (extract . custom-repeat-extract)
-            (validate . custom-repeat-validate)
-            (insert . custom-repeat-insert)
-            (match . custom-repeat-match)
-            (query . custom-repeat-query)
-            (prefix . "")
-            (del-tag . "[DEL]")
-            (add-tag . "[INS]"))
-    (pair (type . group)
-          ;; A cons-cell.
-          (accept . custom-pair-accept)
-          (eval . custom-pair-eval)
-          (import . custom-pair-import)
-          (quote . custom-pair-quote)
-          (valid . (lambda (c d) (consp d)))
-          (extract . custom-pair-extract))
-    (list (type . group)
-          ;; A lisp list.
-          (quote . custom-list-quote)
-          (valid . (lambda (c d)
-                     (listp d)))
-          (extract . custom-list-extract))
-    (group (type . default)
-           ;; See `custom-match'.
-           (face-tag . nil)
-           (eval . custom-group-eval)
-           (import . custom-group-import)
-           (initialize . custom-group-initialize)
-           (apply . custom-group-apply)
-           (reset . custom-group-reset)
-           (factory-reset . custom-group-factory-reset)
-           (extract . nil)
-           (validate . custom-group-validate)
-           (query . custom-toggle-hide)
-           (accept . custom-group-accept)
-           (insert . custom-group-insert)
-           (find . custom-group-find))
-    (toggle (type . choice)
-            ;; Booleans.
-            (data ((type . const)
-                   (tag . "On ")
-                   (default . t))
-                  ((type . const)
-                   (tag . "Off")
-                   (default . nil))))
-    (triggle (type . choice)
-             ;; On/Off/Default.
-             (data ((type . const)
-                    (tag . "On ")
-                    (default . t))
-                   ((type . const)
-                    (tag . "Off")
-                    (default . nil))
-                   ((type . const)
-                    (tag . "Def")
-                    (default . custom:asis))))
-    (choice (type . default)
-            ;; See `custom-match'.
-            (query . custom-choice-query)
-            (accept . custom-choice-accept)
-            (extract . custom-choice-extract)
-            (validate . custom-choice-validate)
-            (insert . custom-choice-insert)
-            (none (tag . "Unknown")
-                  (default . __uninitialized__)
-                  (type . const)))
-    (const (type . default)
-           ;; A `const' only matches a single lisp value.
-           (extract . (lambda (c f) (list (custom-default c))))
-           (validate . (lambda (c f) nil))
-           (valid . custom-const-valid)
-           (update . custom-const-update)
-           (insert . custom-const-insert))
-    (face-doc (type . doc)
-              ;; A variable containing a face.
-              (doc . "\
-You can customize the look of Emacs by deciding which faces should be
-used when.  If you push one of the face buttons below, you will be
-given a choice between a number of standard faces.  The name of the
-selected face is shown right after the face button, and it is
-displayed its own face so you can see how it looks.  If you know of
-another standard face not listed and want to use it, you can select
-`Other' and write the name in the editing field.
-
-If none of the standard faces suits you, you can select `Customize' to
-create your own face.  This will make six fields appear under the face
-button.  The `Fg' and `Bg' fields are the foreground and background
-colors for the face, respectively.  You should type the name of the
-color in the field.  You can use any X11 color name.  A list of X11
-color names may be available in the file `/usr/lib/X11/rgb.txt' on
-your system.  The special color name `default' means that the face
-will not change the color of the text.  The `Stipple' field is weird,
-so just ignore it.  The three remaining fields are toggles, which will
-make the text `bold', `italic', or `underline' respectively.  For some
-fonts `bold' or `italic' will not make any visible change."))
-    (face (type . choice)
-          (eval . custom-face-eval)
-          (import . custom-face-import)
-          (data ((tag . "None")
-                 (default . nil)
-                 (type . const))
-                ((tag . "Default")
-                 (default . default)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Bold")
-                 (default . bold)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Bold-italic")
-                 (default . bold-italic)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Italic")
-                 (default . italic)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Underline")
-                 (default . underline)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Highlight")
-                 (default . highlight)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Modeline")
-                 (default . modeline)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Region")
-                 (default . region)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Secondary Selection")
-                 (default . secondary-selection)
-                 (face . custom-const-face)
-                 (type . const))
-                ((tag . "Customized")
-                 (compact . t)
-                 (face-tag . custom-face-hack)
-                 (eval . custom-face-eval)
-                 (data ((hidden . t)
-                        (tag . "")
-                        (doc . "\
-Select the properties you want this face to have.")
-                        (default . custom-face-lookup)
-                        (type . const))
-                       "\n"
-                       ((tag . "Fg")
-                        (hidden . t)
-                        (default . "default")
-                        (width . 20)
-                        (type . string))
-                       ((tag . "Bg")
-                        (default . "default")
-                        (width . 20)
-                        (type . string))
-                       ((tag . "Stipple")
-                        (default . "default")
-                        (width . 20)
-                        (type . string))
-                       "\n"
-                       ((tag . "Bold")
-                        (default . custom:asis)
-                        (type . triggle))
-                       "              "
-                       ((tag . "Italic")
-                        (default . custom:asis)
-                        (type . triggle))
-                       "             "
-                       ((tag . "Underline")
-                        (hidden . t)
-                        (default . custom:asis)
-                        (type . triggle)))
-                 (default . (custom-face-lookup "default" "default" "default"
-                                                nil nil nil))
-                 (type . list))
-                ((prompt . "Other")
-                 (face . custom-field-value)
-                 (default . __uninitialized__)
-                 (type . symbol))))
-    (file (type . string)
-          ;; A string containing a file or directory name.
-          (directory . nil)
-          (default-file . nil)
-          (query . custom-file-query))
-    (sexp (type . default)
-          ;; Any lisp expression.
-          (width . 40)
-          (default . (__uninitialized__ . "Uninitialized"))
-          (read . custom-sexp-read)
-          (write . custom-sexp-write))
-    (symbol (type . sexp)
-            ;; A lisp symbol.
-            (width . 40)
-            (valid . (lambda (c d) (symbolp d))))
-    (integer (type . sexp)
-             ;; A lisp integer.
-             (width . 10)
-             (valid . (lambda (c d) (integerp d))))
-    (string (type . default)
-            ;; A lisp string.
-            (width . 40) 
-            (valid . (lambda (c d) (stringp d)))
-            (read . custom-string-read)
-            (write . custom-string-write))
-    (button (type . default)
-            ;; Push me.
-            (accept . ignore)
-            (extract . nil)
-            (validate . ignore)
-            (insert . custom-button-insert))
-    (doc (type . default)
-         ;; A documentation only entry with no value.
-         (header . nil)
-         (reset . ignore)
-         (extract . nil)
-         (validate . ignore)
-         (insert . custom-documentation-insert))
-    (default (width . 20)
-             (valid . (lambda (c v) t))
-             (insert . custom-default-insert)
-             (update . custom-default-update)
-             (query . custom-default-query)
-             (tag . nil)
-             (prompt . nil)
-             (doc . nil)
-             (header . t)
-             (padding . ? )
-             (quote . custom-default-quote)
-             (eval . (lambda (c v) nil))
-             (export . custom-default-export)
-             (import . (lambda (c v) (list v)))
-             (synchronize . ignore)
-             (initialize . custom-default-initialize)
-             (extract . custom-default-extract)
-             (validate . custom-default-validate)
-             (apply . custom-default-apply)
-             (reset . custom-default-reset)
-             (factory-reset . custom-default-factory-reset)
-             (accept . custom-default-accept)
-             (match . custom-default-match)
-             (name . nil)
-             (compact . nil)
-             (hidden . nil)
-             (face . custom-default-face)
-             (data . nil)
-             (calculate . nil)
-             (default . __uninitialized__)))
-  "Alist of default properties for type symbols.
-The format is `((SYMBOL (PROPERTY . VALUE)... )... )'.")
-
-(defconst custom-local-type-properties nil
-  "Local type properties.
-Entries in this list take precedence over `custom-type-properties'.")
-
-(make-variable-buffer-local 'custom-local-type-properties)
-
-(defconst custom-nil '__uninitialized__
-  "Special value representing an uninitialized field.")
-
-(defconst custom-invalid '__invalid__
-  "Special value representing an invalid field.")
-
-(defconst custom:asis 'custom:asis)
-;; Bad, ugly, and horrible kludge.
-
-(defun custom-property (custom property)
-  "Extract from CUSTOM property PROPERTY."
-  (let ((entry (assq property custom)))
-    (while (null entry)
-      ;; Look in superclass.
-      (let ((type (custom-type custom)))
-        (setq custom (cdr (or (assq type custom-local-type-properties)
-                              (assq type custom-type-properties)))
-              entry (assq property custom))
-        (custom-assert 'custom)))
-    (cdr entry)))
-
-(defun custom-super (custom property)
-  "Extract from CUSTOM property PROPERTY.  Start with CUSTOM's superclass."
-  (let ((entry nil))
-    (while (null entry)
-      ;; Look in superclass.
-      (let ((type (custom-type custom)))
-        (setq custom (cdr (or (assq type custom-local-type-properties)
-                              (assq type custom-type-properties)))
-              entry (assq property custom))
-        (custom-assert 'custom)))
-    (cdr entry)))
-
-(defun custom-property-set (custom property value)
-  "Set CUSTOM PROPERTY to VALUE by side effect.
-CUSTOM must have at least one property already."
-  (let ((entry (assq property custom)))
-    (if entry
-        (setcdr entry value)
-      (setcdr custom (cons (cons property value) (cdr custom))))))
-
-(defun custom-type (custom)
-  "Extract `type' from CUSTOM."
-  (cdr (assq 'type custom)))
-
-(defun custom-name (custom)
-  "Extract `name' from CUSTOM."
-  (custom-property custom 'name))
-
-(defun custom-tag (custom)
-  "Extract `tag' from CUSTOM."
-  (custom-property custom 'tag))
-
-(defun custom-face-tag (custom)
-  "Extract `face-tag' from CUSTOM."
-  (custom-property custom 'face-tag))
-
-(defun custom-prompt (custom)
-  "Extract `prompt' from CUSTOM.  
-If none exist, default to `tag' or, failing that, `type'."
-  (or (custom-property custom 'prompt)
-      (custom-property custom 'tag)
-      (capitalize (symbol-name (custom-type custom)))))
-
-(defun custom-default (custom)
-  "Extract `default' from CUSTOM."
-  (let ((value (custom-property custom 'calculate)))
-    (if value
-        (eval value)
-      (custom-property custom 'default))))
-               
-(defun custom-data (custom)
-  "Extract the `data' from CUSTOM."
-  (custom-property custom 'data))
-
-(defun custom-documentation (custom)
-  "Extract `doc' from CUSTOM."
-  (custom-property custom 'doc))
-
-(defun custom-width (custom)
-  "Extract `width' from CUSTOM."
-  (custom-property custom 'width))
-
-(defun custom-compact (custom)
-  "Extract `compact' from CUSTOM."
-  (custom-property custom 'compact))
-
-(defun custom-padding (custom)
-  "Extract `padding' from CUSTOM."
-  (custom-property custom 'padding))
-
-(defun custom-valid (custom value)
-  "Non-nil if CUSTOM may validly be set to VALUE."
-  (and (not (and (listp value) (eq custom-invalid (car value))))
-       (funcall (custom-property custom 'valid) custom value)))
-
-(defun custom-import (custom value)
-  "Import CUSTOM VALUE from external variable.
-
-This function change VALUE into a form that makes it easier to edit 
-internally.  What the internal form is exactly depends on CUSTOM.  
-The internal form is returned."
-  (if (eq custom-nil value)
-      (list custom-nil)
-    (funcall (custom-property custom 'import) custom value)))
-
-(defun custom-eval (custom value)
-  "Return non-nil if CUSTOM's VALUE needs to be evaluated."
-  (funcall (custom-property custom 'eval) custom value))
-
-(defun custom-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (funcall (custom-property custom 'quote) custom value))
-
-(defun custom-write (custom value)
-  "Convert CUSTOM VALUE to a string."
-  (cond ((eq value custom-nil) 
-         "")
-        ((and (listp value) (eq (car value) custom-invalid))
-         (cdr value))
-        (t
-         (funcall (custom-property custom 'write) custom value))))
-
-(defun custom-read (custom string)
-  "Convert CUSTOM field content STRING into lisp."
-  (condition-case nil
-      (funcall (custom-property custom 'read) custom string)
-    (error (cons custom-invalid string))))
-
-(defun custom-match (custom values)
-  "Match CUSTOM with a list of VALUES.
-
-Return a cons-cell where the car is the sublist of VALUES matching CUSTOM,
-and the cdr is the remaining VALUES.
-
-A CUSTOM is actually a regular expression over the alphabet of lisp
-types.  Most CUSTOM types are just doing a literal match, e.g. the
-`symbol' type matches any lisp symbol.  The exceptions are:
-
-group:    which corresponds to a `(' and `)' group in a regular expression.
-choice:   which corresponds to a group of `|' in a regular expression.
-repeat:   which corresponds to a `*' in a regular expression.
-optional: which corresponds to a `?', and isn't implemented yet."
-  (if (memq values (list custom-nil nil))
-      ;; Nothing matches the uninitialized or empty list.
-      (cons custom-nil nil)
-    (funcall (custom-property custom 'match) custom values)))
-
-(defun custom-initialize (custom)
-  "Initialize `doc' and `default' attributes of CUSTOM."
-  (funcall (custom-property custom 'initialize) custom))
-
-(defun custom-find (custom tag)
-  "Find child in CUSTOM with `tag' TAG."
-  (funcall (custom-property custom 'find) custom tag))
-
-(defun custom-travel-path (custom path)
-  "Find decedent of CUSTOM by looking through PATH."
-  (if (null path)
-      custom
-    (custom-travel-path (custom-find custom (car path)) (cdr path))))
-
-(defun custom-field-extract (custom field)
-  "Extract CUSTOM's value in FIELD."
-  (if (stringp custom)
-      nil
-    (funcall (custom-property (custom-field-custom field) 'extract)
-             custom field)))
-
-(defun custom-field-validate (custom field)
-  "Validate CUSTOM's value in FIELD.
-Return nil if valid, otherwise return a cons-cell where the car is the
-position of the error, and the cdr is a text describing the error."
-  (if (stringp custom)
-      nil
-    (funcall (custom-property custom 'validate) custom field)))
-
-;;; Field Functions:
-;;
-;; This section defines the public functions for manipulating the
-;; FIELD datatype.  The FIELD instance hold information about a
-;; specific editing field in the customization buffer.
-;;
-;; Each FIELD can be seen as an instantiation of a CUSTOM.
-
-(defvar custom-field-last nil)
-;; Last field containing point.
-(make-variable-buffer-local 'custom-field-last)
-
-(defvar custom-modified-list nil)
-;; List of modified fields.
-(make-variable-buffer-local 'custom-modified-list)
-
-(defun custom-field-create (custom value)
-  "Create a field structure of type CUSTOM containing VALUE.
-
-A field structure is an array [ CUSTOM VALUE ORIGINAL START END ], where
-CUSTOM defines the type of the field, 
-VALUE is the current value of the field,
-ORIGINAL is the original value when created, and
-START and END are markers to the start and end of the field."
-  (vector custom value custom-nil nil nil))
-
-(defun custom-field-custom (field)
-  "Return the `custom' attribute of FIELD."
-  (aref field 0))
-  
-(defun custom-field-value (field)
-  "Return the `value' attribute of FIELD."
-  (aref field 1))
-
-(defun custom-field-original (field)
-  "Return the `original' attribute of FIELD."
-  (aref field 2))
-
-(defun custom-field-start (field)
-  "Return the `start' attribute of FIELD."
-  (aref field 3))
-
-(defun custom-field-end (field)
-  "Return the `end' attribute of FIELD."
-  (aref field 4))
-  
-(defun custom-field-value-set (field value)
-  "Set the `value' attribute of FIELD to VALUE."
-  (aset field 1 value))
-
-(defun custom-field-original-set (field original)
-  "Set the `original' attribute of FIELD to ORIGINAL."
-  (aset field 2 original))
-
-(defun custom-field-move (field start end)
-  "Set the `start'and `end' attributes of FIELD to START and END."
-  (set-marker (or (aref field 3) (aset field 3 (make-marker))) start)
-  (set-marker (or (aref field 4) (aset field 4 (make-marker))) end))
-
-(defun custom-field-query (field)
-  "Query user for content of current field."
-  (funcall (custom-property (custom-field-custom field) 'query) field))
+               (custom-handle-keyword symbol keyword value
+                                      'custom-variable))))))
+  (run-hooks 'custom-define-hook)
+  symbol)
 
-(defun custom-field-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE.
-If optional ORIGINAL is non-nil, consider VALUE for the original value."
-  (let ((inhibit-point-motion-hooks t))
-    (funcall (custom-property (custom-field-custom field) 'accept) 
-             field value original)))
+(defmacro defcustom (symbol value doc &rest args)
+  "Declare SYMBOL as a customizable variable that defaults to VALUE.
+DOC is the variable documentation.
 
-(defun custom-field-face (field)
-  "The face used for highlighting FIELD."
-  (let ((custom (custom-field-custom field)))
-    (if (stringp custom)
-        nil
-      (let ((face (funcall (custom-property custom 'face) field)))
-        (if (custom-facep face) face nil)))))
+Neither SYMBOL nor VALUE needs to be quoted.
+If SYMBOL is not already bound, initialize it to VALUE.
+The remaining arguments should have the form
 
-(defun custom-field-update (field)
-  "Update the screen appearance of FIELD to correspond with the field's value."
-  (let ((custom (custom-field-custom field)))
-    (if (stringp custom)
-        nil
-      (funcall (custom-property custom 'update) field))))
+   [KEYWORD VALUE]... 
 
-;;; Types:
-;;
-;; The following functions defines type specific actions.
-
-(defun custom-repeat-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (if (eq value custom-nil)
-      nil
-    (let ((child (custom-data custom))
-          (found nil))
-      (mapcar (lambda (v) (if (custom-eval child v) (setq found t)))
-              value))))
-
-(defun custom-repeat-quote (custom value)
-  "A list of CUSTOM's VALUEs quoted."
-  (let ((child (custom-data custom)))
-    (apply 'append (mapcar (lambda (v) (custom-quote child v))
-                           value))))
-
-  
-(defun custom-repeat-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((child (custom-data custom)))
-    (apply 'append (mapcar (lambda (v) (custom-import child v))
-                           value))))
-
-(defun custom-repeat-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let ((values (copy-sequence (custom-field-value field)))
-        (all (custom-field-value field))
-        (start (custom-field-start field))
-        current new)
-    (if original 
-        (custom-field-original-set field value))
-    (while (consp value)
-      (setq new (car value)
-            value (cdr value))
-      (if values
-          ;; Change existing field.
-          (setq current (car values)
-                values (cdr values))
-        ;; Insert new field if series has grown.
-        (goto-char start)
-        (setq current (custom-repeat-insert-entry field))
-        (setq all (custom-insert-before all nil current))
-        (custom-field-value-set field all))
-      (custom-field-accept current new original))
-    (while (consp values)
-      ;; Delete old field if series has scrunk.
-      (setq current (car values)
-            values (cdr values))
-      (let ((pos (custom-field-start current))
-            data)
-        (while (not data)
-          (setq pos (previous-single-property-change pos 'custom-data))
-          (custom-assert 'pos)
-          (setq data (get-text-property pos 'custom-data))
-          (or (and (arrayp data)
-                   (> (length data) 1)
-                   (eq current (aref data 1)))
-              (setq data nil)))
-        (custom-repeat-delete data)))))
-
-(defun custom-repeat-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-         (add-tag (custom-property custom 'add-tag))
-         (start (make-marker))
-         (data (vector field nil start nil)))
-    (custom-text-insert "\n")
-    (let ((pos (point)))
-      (custom-text-insert (custom-property custom 'prefix))
-      (custom-tag-insert add-tag 'custom-repeat-add data)
-      (set-marker start pos))
-    (custom-field-move field start (point))
-    (custom-documentation-insert custom)
-    field))
-
-(defun custom-repeat-insert-entry (repeat)
-  "Insert entry at point in the REPEAT field."
-  (let* ((inhibit-point-motion-hooks t)
-         (inhibit-read-only t)
-         (before-change-functions nil)
-         (after-change-functions nil)
-         (custom (custom-field-custom repeat))
-         (add-tag (custom-property custom 'add-tag))
-         (del-tag (custom-property custom 'del-tag))
-         (start (make-marker))
-         (end (make-marker))
-         (data (vector repeat nil start end))
-         field)
-    (custom-extent-start-open)
-    (insert-before-markers "\n")
-    (backward-char 1)
-    (set-marker start (point))
-    (custom-text-insert " ")
-    (aset data 1 (setq field (custom-insert (custom-data custom) nil)))
-    (custom-text-insert " ")
-    (set-marker end (point))
-    (goto-char start)
-    (custom-text-insert (custom-property custom 'prefix))
-    (custom-tag-insert add-tag 'custom-repeat-add data)
-    (custom-text-insert " ")
-    (custom-tag-insert del-tag 'custom-repeat-delete data)
-    (forward-char 1)
-    field))
-
-(defun custom-repeat-add (data)
-  "Add list entry."
-  (let ((parent (aref data 0))
-        (field (aref data 1))
-        (at (aref data 2))
-        new)
-    (goto-char at)
-    (setq new (custom-repeat-insert-entry parent))
-    (custom-field-value-set parent
-                            (custom-insert-before (custom-field-value parent)
-                                                  field new))))
-
-(defun custom-repeat-delete (data)
-  "Delete list entry."
-  (let ((inhibit-point-motion-hooks t)
-        (inhibit-read-only t)
-        (before-change-functions nil)
-        (after-change-functions nil)
-        (parent (aref data 0))
-        (field (aref data 1)))
-    (delete-region (aref data 2) (1+ (aref data 3)))
-    (custom-field-untouch (aref data 1))
-    (custom-field-value-set parent 
-                            (delq field (custom-field-value parent)))))
-
-(defun custom-repeat-match (custom values)
-  "Match CUSTOM with VALUES."
-  (let* ((child (custom-data custom))
-         (match (custom-match child values))
-         matches)
-    (while (not (eq (car match) custom-nil))
-      (setq matches (cons (car match) matches)
-            values (cdr match)
-            match (custom-match child values)))
-    (cons (nreverse matches) values)))
-
-(defun custom-repeat-extract (custom field)
-  "Extract list of children's values."
-  (let ((values (custom-field-value field))
-        (data (custom-data custom))
-        result)
-    (if (eq values custom-nil)
-        ()
-      (while values
-        (setq result (append result (custom-field-extract data (car values)))
-              values (cdr values))))
-    result))
-
-(defun custom-repeat-validate (custom field)
-  "Validate children."
-  (let ((values (custom-field-value field))
-        (data (custom-data custom))
-        result)
-    (if (eq values custom-nil)
-        (setq result (cons (custom-field-start field) "Uninitialized list")))
-    (while (and values (not result))
-      (setq result (custom-field-validate data (car values))
-            values (cdr values)))
-    result))
-
-(defun custom-pair-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (custom-group-accept field (list (car value) (cdr value)) original))
-
-(defun custom-pair-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (custom-group-eval custom (list (car value) (cdr value))))
-
-(defun custom-pair-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((result (car (custom-group-import custom 
-                                          (list (car value) (cdr value))))))
-    (custom-assert '(eq (length result) 2))
-    (list (cons (nth 0 result) (nth 1 result)))))
-
-(defun custom-pair-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (if (custom-eval custom value)
-      (let ((v (car (custom-group-quote custom 
-                                        (list (car value) (cdr value))))))
-        (list (list 'cons (nth 0 v) (nth 1 v))))
-    (custom-default-quote custom value)))
-
-(defun custom-pair-extract (custom field)
-  "Extract cons of children's values."
-  (let ((values (custom-field-value field))
-        (data (custom-data custom))
-        result)
-    (custom-assert '(eq (length values) (length data)))
-    (while values
-      (setq result (append result
-                           (custom-field-extract (car data) (car values)))
-            data (cdr data)
-            values (cdr values)))
-    (custom-assert '(null data))
-    (list (cons (nth 0 result) (nth 1 result)))))
-
-(defun custom-list-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (if (custom-eval custom value)
-      (let ((v (car (custom-group-quote custom value))))
-        (list (cons 'list v)))
-    (custom-default-quote custom value)))
-
-(defun custom-list-extract (custom field)
-  "Extract list of children's values."
-  (let ((values (custom-field-value field))
-        (data (custom-data custom))
-        result)
-    (custom-assert '(eq (length values) (length data)))
-    (while values
-      (setq result (append result
-                           (custom-field-extract (car data) (car values)))
-            data (cdr data)
-            values (cdr values)))
-    (custom-assert '(null data))
-    (list result)))
-
-(defun custom-group-validate (custom field)
-  "Validate children."
-  (let ((values (custom-field-value field))
-        (data (custom-data custom))
-        result)
-    (if (eq values custom-nil)
-        (setq result (cons (custom-field-start field) "Uninitialized list"))
-      (custom-assert '(eq (length values) (length data))))
-    (while (and values (not result))
-      (setq result (custom-field-validate (car data) (car values))
-            data (cdr data)
-            values (cdr values)))
-    result))
-
-(defun custom-group-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (let ((found nil))
-    (mapcar (lambda (c)
-              (or (stringp c)
-                  (let ((match (custom-match c value)))
-                    (if (custom-eval c (car match))
-                        (setq found t))
-                    (setq value (cdr match)))))
-            (custom-data custom))
-    found))
-
-(defun custom-group-quote (custom value)
-  "A list of CUSTOM's VALUE members, quoted."
-  (list (apply 'append 
-               (mapcar (lambda (c)
-                         (if (stringp c)
-                             ()
-                           (let ((match (custom-match c value)))
-                             (prog1 (custom-quote c (car match))
-                               (setq value (cdr match))))))
-                       (custom-data custom)))))
-
-(defun custom-group-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (list (apply 'append 
-               (mapcar (lambda (c)
-                         (if (stringp c)
-                             ()
-                           (let ((match (custom-match c value)))
-                             (prog1 (custom-import c (car match))
-                               (setq value (cdr match))))))
-                       (custom-data custom)))))
-
-(defun custom-group-initialize (custom)
-  "Initialize `doc' and `default' entries in CUSTOM."
-  (if (custom-name custom)
-      (custom-default-initialize custom)
-    (mapcar 'custom-initialize (custom-data custom))))
-
-(defun custom-group-apply (field)
-  "Reset `value' in FIELD to `original'."
-  (let ((custom (custom-field-custom field))
-        (values (custom-field-value field)))
-    (if (custom-name custom)
-        (custom-default-apply field)
-      (mapcar 'custom-field-apply values))))
-
-(defun custom-group-reset (field)
-  "Reset `value' in FIELD to `original'."
-  (let ((custom (custom-field-custom field))
-        (values (custom-field-value field)))
-    (if (custom-name custom)
-        (custom-default-reset field)
-      (mapcar 'custom-field-reset values))))
-
-(defun custom-group-factory-reset (field)
-  "Reset `value' in FIELD to `default'."
-  (let ((custom (custom-field-custom field))
-        (values (custom-field-value field)))
-    (if (custom-name custom)
-        (custom-default-factory-reset field)
-      (mapcar 'custom-field-factory-reset values))))
-
-(defun custom-group-find (custom tag)
-  "Find child in CUSTOM with `tag' TAG."
-  (let ((data (custom-data custom))
-        (result nil))
-    (while (not result)
-      (custom-assert 'data)
-      (if (equal (custom-tag (car data)) tag)
-          (setq result (car data))
-        (setq data (cdr data))))))
+The following KEYWORD's are defined:
 
-(defun custom-group-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let* ((values (custom-field-value field))
-         (custom (custom-field-custom field))
-         (from (custom-field-start field))
-         (face-tag (custom-face-tag custom))
-         current)
-    (if face-tag 
-        (custom-put-text-property from (+ from (length (custom-tag custom)))
-                           'face (funcall face-tag field value)))
-    (if original 
-        (custom-field-original-set field value))
-    (while values
-      (setq current (car values)
-            values (cdr values))
-      (if current
-          (let* ((custom (custom-field-custom current))
-                 (match (custom-match custom value)))
-            (setq value (cdr match))
-            (custom-field-accept current (car match) original))))))
+:type   VALUE should be a widget type.
+:options VALUE should be a list of valid members of the widget type.
+:group  VALUE should be a customization group.  
+        Add SYMBOL to that group.
 
-(defun custom-group-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-         fields hidden
-         (from (point))
-         (compact (custom-compact custom))
-         (tag (custom-tag custom))
-         (face-tag (custom-face-tag custom)))
-    (cond (face-tag (custom-text-insert tag))
-          (tag (custom-tag-insert tag field)))
-    (or compact (custom-documentation-insert custom))
-    (or compact (custom-text-insert "\n"))
-    (let ((data (custom-data custom)))
-      (while data
-        (setq fields (cons (custom-insert (car data) (if level (1+ level)))
-                           fields))
-        (setq hidden (or (stringp (car data))
-                         (custom-property (car data) 'hidden)))
-        (setq data (cdr data))
-        (if data (custom-text-insert (cond (hidden "")
-                                           (compact " ")
-                                           (t "\n"))))))
-    (if compact (custom-documentation-insert custom))
-    (custom-field-value-set field (nreverse fields))
-    (custom-field-move field from (point))
-    field))
+Read the section about customization in the emacs lisp manual for more
+information."
+  `(eval-and-compile
+     (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)))
 
-(defun custom-choice-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-         (from (point)))
-    (custom-text-insert "lars er en nisse")
-    (custom-field-move field from (point))
-    (custom-documentation-insert custom)
-    (custom-field-reset field)
-    field))
+;;; The `defface' Macro.
 
-(defun custom-choice-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let ((custom (custom-field-custom field))
-        (start (custom-field-start field))
-        (end (custom-field-end field))
-        (inhibit-read-only t)
-        (before-change-functions nil)
-        (after-change-functions nil)
-        from)
-    (cond (original 
-           (setq custom-modified-list (delq field custom-modified-list))
-           (custom-field-original-set field value))
-          ((equal value (custom-field-original field))
-           (setq custom-modified-list (delq field custom-modified-list)))
-          (t
-           (add-to-list 'custom-modified-list field)))
-    (custom-field-untouch (custom-field-value field))
-    (delete-region start end)
-    (goto-char start)
-    (setq from (point))
-    (insert-before-markers " ")
-    (backward-char 1)
-    (custom-category-set (point) (1+ (point)) 'custom-hidden-properties)
-    (custom-tag-insert (custom-tag custom) field)
-    (custom-text-insert ": ")
-    (let ((data (custom-data custom))
-          found begin)
-      (while (and data (not found))
-        (if (not (custom-valid (car data) value))
-            (setq data (cdr data))
-          (setq found (custom-insert (car data) nil))
-          (setq data nil)))
-      (if found 
-          ()
-        (setq begin (point)
-              found (custom-insert (custom-property custom 'none) nil))
-        (custom-add-text-properties 
-         begin (point)
-         (list rear-nonsticky t
-               'face custom-field-uninitialized-face)))
-      (or original
-          (custom-field-original-set found (custom-field-original field)))
-      (custom-field-accept found value original)
-      (custom-field-value-set field found)
-      (custom-field-move field from end))))
+(defmacro defface (face spec doc &rest args)
+  "Declare FACE as a customizable face that defaults to SPEC.
+FACE does not need to be quoted.
 
-(defun custom-choice-extract (custom field)
-  "Extract child's value."
-  (let ((value (custom-field-value field)))
-    (custom-field-extract (custom-field-custom value) value)))
+Third argument DOC is the face documentation.
 
-(defun custom-choice-validate (custom field)
-  "Validate child's value."
-  (let ((value (custom-field-value field))
-        (custom (custom-field-custom field)))
-    (if (or (eq value custom-nil)
-            (eq (custom-field-custom value) (custom-property custom 'none)))
-        (cons (custom-field-start field) "Make a choice")
-      (custom-field-validate (custom-field-custom value) value))))
+If FACE has been set with `custom-set-face', set the face attributes
+as specified by that function, otherwise set the face attributes
+according to SPEC.
 
-(defun custom-choice-query (field)
-  "Choose a child."
-  (let* ((custom (custom-field-custom field))
-         (old (custom-field-custom (custom-field-value field)))
-         (default (custom-prompt old))
-         (tag (custom-prompt custom))
-         (data (custom-data custom))
-         current alist)
-    (if (eq (length data) 2)
-        (custom-field-accept field (custom-default (if (eq (nth 0 data) old)
-                                                       (nth 1 data)
-                                                     (nth 0 data))))
-      (while data
-        (setq current (car data)
-              data (cdr data))
-        (setq alist (cons (cons (custom-prompt current) current) alist)))
-      (let ((answer (cond ((and (fboundp 'button-press-event-p)
-                                (fboundp 'popup-menu)
-                                (button-press-event-p last-input-event))
-                           (cdr (assoc (car (custom-x-really-popup-menu 
-                                             last-input-event tag 
-                                             (reverse alist)))
-                                       alist)))
-                          ((listp last-input-event)
-                           (x-popup-menu last-input-event
-                                         (list tag (cons "" (reverse alist)))))
-                          (t 
-                           (let ((choice (completing-read (concat tag
-                                                                  " (default "
-                                                                  default 
-                                                                  "): ") 
-                                                          alist nil t)))
-                             (if (or (null choice) (string-equal choice ""))
-                                 (setq choice default))
-                             (cdr (assoc choice alist)))))))
-        (if answer
-            (custom-field-accept field (custom-default answer)))))))
+The remaining arguments should have the form
 
-(defun custom-file-query (field)
-  "Prompt for a file name"
-  (let* ((value (custom-field-value field))
-         (custom (custom-field-custom field))
-         (valid (custom-valid custom value))
-         (directory (custom-property custom 'directory))
-         (default (and (not valid)
-                       (custom-property custom 'default-file)))
-         (tag (custom-tag custom))
-         (prompt (if default
-                     (concat tag " (" default "): ")
-                   (concat tag ": "))))
-    (custom-field-accept field 
-                         (if (custom-valid custom value)
-                             (read-file-name prompt 
-                                             (if (file-name-absolute-p value)
-                                                 ""
-                                               directory)
-                                             default nil value)
-                           (read-file-name prompt directory default)))))
+   [KEYWORD VALUE]...
 
-(defun custom-face-eval (custom value)
-  "Return non-nil if CUSTOM's VALUE needs to be evaluated."
-  (not (symbolp value)))
+The following KEYWORD's are defined:
 
-(defun custom-face-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((name (or (and (facep value) (symbol-name (face-name value)))
-                  (symbol-name value))))
-    (list (if (string-match "\
-custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)"
-                            name)
-              (list 'custom-face-lookup 
-                    (match-string 1 name)
-                    (match-string 2 name)
-                    (match-string 3 name)
-                    (intern (match-string 4 name))
-                    (intern (match-string 5 name))
-                    (intern (match-string 6 name)))
-            value))))
+:group  VALUE should be a customization group.
+        Add FACE to that group.
 
-(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
-  "Lookup or create a face with specified attributes."
-  (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
-                              (or fg "default")
-                              (or bg "default")
-                              (or stipple "default")
-                              bold italic underline))))
-    (if (and (custom-facep name)
-             (fboundp 'make-face))
-        ()
-      (copy-face 'default name)
-      (when (and fg
-                 (not (string-equal fg "default")))
-        (condition-case ()
-            (set-face-foreground name fg)
-          (error nil)))
-      (when (and bg
-                 (not (string-equal bg "default")))
-        (condition-case ()
-            (set-face-background name bg)
-          (error nil)))
-      (when (and stipple
-                 (not (string-equal stipple "default"))
-                 (not (eq stipple 'custom:asis))
-                 (fboundp 'set-face-stipple))
-        (set-face-stipple name stipple))
-      (when (and bold
-                 (not (eq bold 'custom:asis)))
-        (condition-case ()
-            (make-face-bold name)
-          (error nil)))
-      (when (and italic
-                 (not (eq italic 'custom:asis)))
-        (condition-case ()
-            (make-face-italic name)
-          (error nil)))
-      (when (and underline
-                 (not (eq underline 'custom:asis)))
-        (condition-case ()
-            (set-face-underline-p name t)
-          (error nil))))
-    name))
+SPEC should be an alist of the form ((DISPLAY ATTS)...).
 
-(defun custom-face-hack (field value)
-  "Face that should be used for highlighting FIELD containing VALUE."
-  (let* ((custom (custom-field-custom field))
-         (form (funcall (custom-property custom 'export) custom value))
-         (face (apply (car form) (cdr form))))
-    (if (custom-facep face) face nil)))
+ATTS is a list of face attributes and their values.  The possible
+attributes are defined in the variable `custom-face-attributes'.
+Alternatively, ATTS can be a face in which case the attributes of that
+face is used.
 
-(defun custom-const-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom custom-nil))
-         (face (custom-field-face field))
-         (from (point)))
-    (custom-text-insert (custom-tag custom))
-    (custom-add-text-properties from (point) 
-                         (list 'face face
-                               rear-nonsticky t))
-    (custom-documentation-insert custom)
-    (custom-field-move field from (point))
-    field))
+The ATTS of the first entry in SPEC where the DISPLAY matches the
+frame should take effect in that frame.  DISPLAY can either be the
+symbol t, which will match all frames, or an alist of the form
+\((REQ ITEM...)...)
 
-(defun custom-const-update (field)
-  "Update face of FIELD."
-  (let ((from (custom-field-start field))
-        (custom (custom-field-custom field)))
-    (custom-put-text-property from (+ from (length (custom-tag custom)))
-                       'face (custom-field-face field))))
+For the DISPLAY to match a FRAME, the REQ property of the frame must
+match one of the ITEM.  The following REQ are defined:
 
-(defun custom-const-valid (custom value)
-  "Non-nil if CUSTOM can validly have the value VALUE."
-  (equal (custom-default custom) value))
+`type' (the value of `window-system')
+  Should be one of `x' or `tty'.
 
-(defun custom-const-face (field)
-  "Face used for a FIELD."
-  (custom-default (custom-field-custom field)))
+`class' (the frame's color support)
+  Should be one of `color', `grayscale', or `mono'.
 
-(defun custom-sexp-read (custom string)
-  "Read from CUSTOM an STRING."
-  (save-match-data
-    (save-excursion
-      (set-buffer (get-buffer-create " *Custom Scratch*"))
-      (erase-buffer)
-      (insert string)
-      (goto-char (point-min))
-      (prog1 (read (current-buffer))
-        (or (looking-at
-             (concat (regexp-quote (char-to-string
-                                    (custom-padding custom)))
-                     "*\\'"))
-            (error "Junk at end of expression"))))))
+`background' (what color is used for the background text)
+  Should be one of `light' or `dark'.
 
-(autoload 'pp-to-string "pp")
+Read the section about customization in the emacs lisp manual for more
+information."
+  `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
 
-(defun custom-sexp-write (custom sexp)
-  "Write CUSTOM SEXP as string."
-  (let ((string (prin1-to-string sexp)))
-    (if (<= (length string) (custom-width custom))
-        string
-      (setq string (pp-to-string sexp))
-      (string-match "[ \t\n]*\\'" string)
-      (concat "\n" (substring string 0 (match-beginning 0))))))
+;;; The `defgroup' Macro.
 
-(defun custom-string-read (custom string)
-  "Read string by ignoring trailing padding characters."
-  (let ((last (length string))
-        (padding (custom-padding custom)))
-    (while (and (> last 0)
-                (eq (aref string (1- last)) padding))
-      (setq last (1- last)))
-    (substring string 0 last)))
-
-(defun custom-string-write (custom string)
-  "Write raw string."
-  string)
-
-(defun custom-button-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (custom-tag-insert (concat "[" (custom-tag custom) "]") 
-                     (custom-property custom 'query))
-  (custom-documentation-insert custom)
-  nil)
-
-(defun custom-default-export (custom value)
-  ;; Convert CUSTOM's VALUE to external representation.
-  ;; See `custom-import'.
-  (if (custom-eval custom value)
-      (eval (car (custom-quote custom value)))
-    value))
-
-(defun custom-default-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (list (if (and (not (custom-eval custom value))
-                 (or (and (symbolp value)
-                          value 
-                          (not (eq t value)))
-                     (and (listp value)
-                          value
-                          (not (memq (car value) '(quote function lambda))))))
-            (list 'quote value)
-          value)))
-
-(defun custom-default-initialize (custom)
-  "Initialize `doc' and `default' entries in CUSTOM."
-  (let ((name (custom-name custom)))
-    (if (null name)
-        ()
-      (let ((default (custom-default custom))
-            (doc (custom-documentation custom))
-            (vdoc (documentation-property name 'variable-documentation t)))
-        (if doc
-            (or vdoc (put name 'variable-documentation doc))
-          (if vdoc (custom-property-set custom 'doc vdoc)))
-        (if (eq default custom-nil)
-            (if (boundp name)
-                (custom-property-set custom 'default (symbol-value name)))
-          (or (boundp name)
-              (set name default)))))))
-
-(defun custom-default-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let ((field (custom-field-create custom custom-nil))
-        (tag (custom-tag custom)))
-    (if (null tag)
-        ()
-      (custom-tag-insert tag field)
-      (custom-text-insert ": "))
-    (custom-field-insert field)
-    (custom-documentation-insert custom)
-    field))
-
-(defun custom-default-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (if original 
-      (custom-field-original-set field value))
-  (custom-field-value-set field value)
-  (custom-field-update field))
-  
-(defun custom-default-apply (field)
-  "Apply any changes in FIELD since the last apply."
-  (let* ((custom (custom-field-custom field))
-         (name (custom-name custom)))
-    (if (null name)
-        (error "This field cannot be applied alone"))
-    (custom-external-set name (custom-name-value name))
-    (custom-field-reset field)))
-
-(defun custom-default-reset (field)
-  "Reset content of editing FIELD to `original'."
-  (custom-field-accept field (custom-field-original field) t))
-
-(defun custom-default-factory-reset (field)
-  "Reset content of editing FIELD to `default'."
-  (let* ((custom (custom-field-custom field))
-         (default (car (custom-import custom (custom-default custom)))))
-    (or (eq default custom-nil)
-        (custom-field-accept field default nil))))
-
-(defun custom-default-query (field)
-  "Prompt for a FIELD"
-  (let* ((custom (custom-field-custom field))
-         (value (custom-field-value field))
-         (initial (custom-write custom value))
-         (prompt (concat (custom-prompt custom) ": ")))
-    (custom-field-accept field 
-                         (custom-read custom 
-                                      (if (custom-valid custom value)
-                                          (read-string prompt (cons initial 1))
-                                        (read-string prompt))))))
-
-(defun custom-default-match (custom values)
-  "Match CUSTOM with VALUES."
-  values)
-
-(defun custom-default-extract (custom field)
-  "Extract CUSTOM's content in FIELD."
-  (list (custom-field-value field)))
-
-(defun custom-default-validate (custom field)
-  "Validate FIELD."
-  (let ((value (custom-field-value field))
-        (start (custom-field-start field)))
-    (cond ((eq value custom-nil)
-           (cons start "Uninitialized field"))
-          ((and (consp value) (eq (car value) custom-invalid))
-           (cons start "Unparsable field content"))
-          ((custom-valid custom value)
-           nil)
-          (t
-           (cons start "Wrong type of field content")))))
-
-(defun custom-default-face (field)
-  "Face used for a FIELD."
-  (let ((value (custom-field-value field)))
-    (cond ((eq value custom-nil)
-           custom-field-uninitialized-face)
-          ((not (custom-valid (custom-field-custom field) value))
-           custom-field-invalid-face)
-          ((not (equal (custom-field-original field) value))
-           custom-field-modified-face)
-          (t
-           custom-field-face))))
-
-(defun custom-default-update (field)
-  "Update the content of FIELD."
-  (let ((inhibit-point-motion-hooks t)
-        (before-change-functions nil)
-        (after-change-functions nil)
-        (start (custom-field-start field))
-        (end (custom-field-end field)) 
-        (pos (point)))
-    ;; Keep track of how many modified fields we have.
-    (cond ((equal (custom-field-value field) (custom-field-original field))
-           (setq custom-modified-list (delq field custom-modified-list)))
-          ((memq field custom-modified-list))
-          (t
-           (setq custom-modified-list (cons field custom-modified-list))))
-    ;; Update the field.
-    (goto-char end)
-    (insert-before-markers " ")
-    (delete-region start (1- end))
-    (goto-char start)
-    (custom-field-insert field)
-    (goto-char end)
-    (delete-char 1)
-    (goto-char pos)
-    (and (<= start pos) 
-         (<= pos end)
-         (custom-field-enter field))))
-
-;;; Create Buffer:
-;;
-;; Public functions to create a customization buffer and to insert
-;; various forms of text, fields, and buttons in it.
-
-(defun customize ()
-  "Customize GNU Emacs.
-Create a *Customize* buffer with editable customization information
-about GNU Emacs." 
-  (interactive)
-  (custom-buffer-create "*Customize*")
-  (custom-reset-all))
-
-(defun custom-buffer-create (name &optional custom types set get save)
-  "Create a customization buffer named NAME.
-If the optional argument CUSTOM is non-nil, use that as the custom declaration.
-If the optional argument TYPES is non-nil, use that as the local types.
-If the optional argument SET is non-nil, use that to set external data.
-If the optional argument GET is non-nil, use that to get external data.
-If the optional argument SAVE is non-nil, use that for saving changes."
-  (switch-to-buffer name)
-  (buffer-disable-undo (current-buffer))
-  (custom-mode)
-  (setq custom-local-type-properties types)
-  (if (null custom)
-      ()
-    (make-local-variable 'custom-data)
-    (setq custom-data custom))
-  (if (null set)
-      ()
-    (make-local-variable 'custom-external-set)
-    (setq custom-external-set set))
-  (if (null get)
-      ()
-    (make-local-variable 'custom-external)
-    (setq custom-external get))
-  (if (null save)
-      ()
-    (make-local-variable 'custom-save)
-    (setq custom-save save))
-  (let ((inhibit-point-motion-hooks t)
-        (before-change-functions nil)
-        (after-change-functions nil))
-    (erase-buffer)
-    (insert "\n")
-    (goto-char (point-min))
-    (custom-text-insert "This is a customization buffer.\n")
-    (custom-help-insert "\n")
-    (custom-help-button 'custom-forward-field)
-    (custom-help-button 'custom-backward-field)
-    (custom-help-button 'custom-enter-value)
-    (custom-help-button 'custom-field-factory-reset)
-    (custom-help-button 'custom-field-reset)
-    (custom-help-button 'custom-field-apply)
-    (custom-help-button 'custom-save-and-exit)
-    (custom-help-button 'custom-toggle-documentation)
-    (custom-help-insert "\nClick mouse-2 on any button to activate it.\n")
-    (custom-text-insert "\n")
-    (custom-insert custom-data 0)
-    (goto-char (point-min))))
-
-(defun custom-insert (custom level)
-  "Insert custom declaration CUSTOM in current buffer at level LEVEL."
-  (if (stringp custom)
-      (progn 
-        (custom-text-insert custom)
-        nil)
-    (and level (null (custom-property custom 'header))
-         (setq level nil))
-    (and level 
-         (> level 0)
-         (custom-text-insert (concat "\n" (make-string level ?*) " ")))
-    (let ((field (funcall (custom-property custom 'insert) custom level)))
-      (custom-name-enter (custom-name custom) field)
-      field)))
-
-(defun custom-text-insert (text)
-  "Insert TEXT in current buffer." 
-  (insert text))
-
-(defun custom-tag-insert (tag field &optional data)
-  "Insert TAG for FIELD in current buffer."
-  (let ((from (point)))
-    (insert tag)
-    (custom-category-set from (point) 'custom-button-properties)
-    (custom-put-text-property from (point) 'custom-tag field)
-    (if data
-        (custom-add-text-properties from (point) (list 'custom-data data)))))
-
-(defun custom-documentation-insert (custom &rest ignore)
-  "Insert documentation from CUSTOM in current buffer."
-  (let ((doc (custom-documentation custom)))
-    (if (null doc)
-        ()
-      (custom-help-insert "\n" doc))))
-
-(defun custom-help-insert (&rest args)
-  "Insert ARGS as documentation text."
-  (let ((from (point)))
-    (apply 'insert args)
-    (custom-category-set from (point) 'custom-documentation-properties)))
-
-(defun custom-help-button (command)
-  "Describe how to execute COMMAND."
-  (let ((from (point)))
-    (insert "`" (key-description (where-is-internal command nil t)) "'")
-    (custom-set-text-properties from (point)
-                                (list 'face custom-button-face
-                                      mouse-face custom-mouse-face
-                                      'custom-jump t ;Make TAB jump over it.
-                                      'custom-tag command
-                                      'start-open t
-                                      'end-open t))
-    (custom-category-set from (point) 'custom-documentation-properties))
-  (custom-help-insert ": " (custom-first-line (documentation command)) "\n"))
-
-;;; Mode:
-;;
-;; The Customization major mode and interactive commands. 
-
-(defvar custom-mode-map nil
-  "Keymap for Custom Mode.")
-(if custom-mode-map
-    nil
-  (setq custom-mode-map (make-sparse-keymap))
-  (define-key custom-mode-map (if (string-match "XEmacs" emacs-version) [button2] [mouse-2]) 'custom-push-button)
-  (define-key custom-mode-map "\t" 'custom-forward-field)
-  (define-key custom-mode-map "\M-\t" 'custom-backward-field)
-  (define-key custom-mode-map "\r" 'custom-enter-value)
-  (define-key custom-mode-map "\C-k" 'custom-kill-line)
-  (define-key custom-mode-map "\C-c\C-r" 'custom-field-reset)
-  (define-key custom-mode-map "\C-c\M-\C-r" 'custom-reset-all)
-  (define-key custom-mode-map "\C-c\C-z" 'custom-field-factory-reset)
-  (define-key custom-mode-map "\C-c\M-\C-z" 'custom-factory-reset-all)
-  (define-key custom-mode-map "\C-c\C-a" 'custom-field-apply)
-  (define-key custom-mode-map "\C-c\M-\C-a" 'custom-apply-all)
-  (define-key custom-mode-map "\C-c\C-c" 'custom-save-and-exit)
-  (define-key custom-mode-map "\C-c\C-d" 'custom-toggle-documentation))
-
-;; C-c keymap ideas: C-a field-beginning, C-e field-end, C-f
-;; forward-field, C-b backward-field, C-n next-field, C-p
-;; previous-field, ? describe-field.
-
-(defun custom-mode ()
-  "Major mode for doing customizations.
-
-\\{custom-mode-map}"
-  (kill-all-local-variables)
-  (setq major-mode 'custom-mode
-        mode-name "Custom")
-  (use-local-map custom-mode-map)
-  (make-local-variable 'before-change-functions)
-  (setq before-change-functions '(custom-before-change))
-  (make-local-variable 'after-change-functions)
-  (setq after-change-functions '(custom-after-change))
-  (if (not (fboundp 'make-local-hook))
-      ;; Emacs 19.28 and earlier.
-      (add-hook 'post-command-hook 
-                (lambda ()
-                  (if (eq major-mode 'custom-mode)
-                      (custom-post-command))))
-    ;; Emacs 19.29.
-    (make-local-hook 'post-command-hook)
-    (add-hook 'post-command-hook 'custom-post-command nil t)))
-
-(defun custom-forward-field (arg)
-  "Move point to the next field or button.
-With optional ARG, move across that many fields."
-  (interactive "p")
-  (while (> arg 0)
-    (let ((next (if (get-text-property (point) 'custom-tag)
-                    (next-single-property-change (point) 'custom-tag)
-                  (point))))
-      (setq next (or (next-single-property-change next 'custom-tag)
-                     (next-single-property-change (point-min) 'custom-tag)))
-      (if next
-          (goto-char next)
-        (error "No customization fields in this buffer.")))
-    (or (get-text-property (point) 'custom-jump)
-        (setq arg (1- arg))))
-  (while (< arg 0)
-    (let ((previous (if (get-text-property (1- (point)) 'custom-tag)
-                        (previous-single-property-change (point) 'custom-tag)
-                      (point))))
-      (setq previous
-            (or (previous-single-property-change previous 'custom-tag)
-                (previous-single-property-change (point-max) 'custom-tag)))
-      (if previous
-          (goto-char previous)
-        (error "No customization fields in this buffer.")))
-    (or (get-text-property (1- (point)) 'custom-jump)
-        (setq arg (1+ arg)))))
-
-(defun custom-backward-field (arg)
-  "Move point to the previous field or button.
-With optional ARG, move across that many fields."
-  (interactive "p")
-  (custom-forward-field (- arg)))
-
-(defun custom-toggle-documentation (&optional arg)
-  "Toggle display of documentation text.
-If the optional argument is non-nil, show text iff the argument is positive."
-  (interactive "P")
-  (let ((hide (or (and (null arg) 
-                       (null (custom-category-get 
-                              'custom-documentation-properties 'invisible)))
-                  (<= (prefix-numeric-value arg) 0))))
-    (custom-category-put 'custom-documentation-properties 'invisible hide)
-    (custom-category-put 'custom-documentation-properties intangible hide))
-  (redraw-display))
-
-(defun custom-enter-value (field data)
-  "Enter value for current customization field or push button."
-  (interactive (list (get-text-property (point) 'custom-tag)
-                     (get-text-property (point) 'custom-data)))
-  (cond (data
-         (funcall field data))
-        ((eq field 'custom-enter-value)
-         (error "Don't be silly"))
-        ((and (symbolp field) (fboundp field))
-         (call-interactively field))
-        (field
-         (custom-field-query field))
-        (t
-         (message "Nothing to enter here"))))
-
-(defun custom-kill-line ()
-  "Kill to end of field or end of line, whichever is first."
-  (interactive)
-  (let ((field (get-text-property (point) 'custom-field))
-        (newline (save-excursion (search-forward "\n")))
-        (next (next-single-property-change (point) 'custom-field)))
-    (if (and field (> newline next))
-        (kill-region (point) next)
-      (call-interactively 'kill-line))))
-
-(defun custom-push-button (event)
-  "Activate button below mouse pointer."
-  (interactive "@e")
-  (let* ((pos (event-point event))
-         (field (get-text-property pos 'custom-field))
-         (tag (get-text-property pos 'custom-tag))
-         (data (get-text-property pos 'custom-data)))
-    (cond (data
-            (funcall tag data))
-          ((and (symbolp tag) (fboundp tag))
-           (call-interactively tag))
-          (field
-           (call-interactively (lookup-key global-map (this-command-keys))))
-          (tag
-           (custom-enter-value tag data))
-          (t 
-           (error "Nothing to click on here.")))))
-
-(defun custom-reset-all ()
-  "Undo any changes since the last apply in all fields."
-  (interactive (and custom-modified-list
-                    (not (y-or-n-p "Discard all changes? "))
-                    (error "Reset aborted")))
-  (let ((all custom-name-fields)
-        current field)
-    (while all
-      (setq current (car all)
-            field (cdr current)
-            all (cdr all))
-      (custom-field-reset field))))
-
-(defun custom-field-reset (field)
-  "Undo any changes in FIELD since the last apply."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-                         (get-text-property (point) 'custom-tag))))
-  (if (arrayp field)
-      (let* ((custom (custom-field-custom field))
-             (name (custom-name custom)))
-        (save-excursion
-          (if name
-              (custom-field-original-set 
-               field (car (custom-import custom (custom-external name)))))
-          (if (not (custom-valid custom (custom-field-original field)))
-              (error "This field cannot be reset alone")
-            (funcall (custom-property custom 'reset) field)
-            (funcall (custom-property custom 'synchronize) field))))))
-
-(defun custom-factory-reset-all ()
-  "Reset all field to their default values."
-  (interactive (and custom-modified-list
-                    (not (y-or-n-p "Discard all changes? "))
-                    (error "Reset aborted")))
-  (let ((all custom-name-fields)
-        field)
-    (while all
-      (setq field (cdr (car all))
-            all (cdr all))
-      (custom-field-factory-reset field))))
-
-(defun custom-field-factory-reset (field)
-  "Reset FIELD to its default value."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-                         (get-text-property (point) 'custom-tag))))
-  (if (arrayp field)
-      (save-excursion
-        (funcall (custom-property (custom-field-custom field) 'factory-reset)
-                 field))))
-
-(defun custom-apply-all ()
-  "Apply any changes since the last reset in all fields."
-  (interactive (if custom-modified-list
-                   nil
-                 (error "No changes to apply.")))
-  (custom-field-parse custom-field-last)
-  (let ((all custom-name-fields)
-        field)
-    (while all
-      (setq field (cdr (car all))
-            all (cdr all))
-      (let ((error (custom-field-validate (custom-field-custom field) field)))
-        (if (null error)
-            ()
-          (goto-char (car error))
-          (error (cdr error))))))
-  (let ((all custom-name-fields)
-        field)
-    (while all
-      (setq field (cdr (car all))
-            all (cdr all))
-      (custom-field-apply field))))
-
-(defun custom-field-apply (field)
-  "Apply any changes in FIELD since the last apply."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-                         (get-text-property (point) 'custom-tag))))
-  (custom-field-parse custom-field-last)
-  (if (arrayp field)
-      (let* ((custom (custom-field-custom field))
-             (error (custom-field-validate custom field)))
-        (if error
-            (error (cdr error)))
-        (funcall (custom-property custom 'apply) field))))
-
-(defun custom-toggle-hide (&rest ignore)
-  "Hide or show entry."
-  (interactive)
-  (error "This button is not yet implemented"))
-
-(defun custom-save-and-exit ()
-  "Save and exit customization buffer."
-  (interactive "@")
-  (save-excursion
-   (funcall custom-save))
-  (kill-buffer (current-buffer)))
-
-(defun custom-save ()
-  "Save customization information."
-  (interactive)
-  (custom-apply-all)
-  (let ((new custom-name-fields))
-    (set-buffer (find-file-noselect custom-file))
-    (goto-char (point-min))
-    (save-excursion
-      (let ((old (condition-case nil
-                     (read (current-buffer))
-                   (end-of-file (append '(setq custom-dummy
-                                               'custom-dummy) ())))))
-        (or (eq (car old) 'setq)
-            (error "Invalid customization file: %s" custom-file))
-        (while new
-          (let* ((field (cdr (car new)))
-                 (custom (custom-field-custom field))
-                 (value (custom-field-original field))
-                 (default (car (custom-import custom (custom-default custom))))
-                 (name (car (car new))))
-            (setq new (cdr new))
-            (custom-assert '(eq name (custom-name custom)))
-            (if (equal default value)
-                (setcdr old (custom-plist-delq name (cdr old)))
-              (setcdr old (plist-put (cdr old) name 
-                                     (car (custom-quote custom value)))))))
-        (erase-buffer)
-        (insert ";; " custom-file "\
- --- Automatically generated customization information.
-;; 
-;; Feel free to edit by hand, but the entire content should consist of
-;; a single setq.  Any other lisp expressions will confuse the
-;; automatic configuration engine.
-
-\(setq ")
-        (setq old (cdr old))
-        (while old
-          (prin1 (car old) (current-buffer))
-          (setq old (cdr old))
-          (insert " ")
-          (pp (car old) (current-buffer))
-          (setq old (cdr old))
-          (if old (insert "\n      ")))
-        (insert ")\n")
-        (save-buffer)
-        (kill-buffer (current-buffer))))))
-
-(defun custom-load ()
-  "Save customization information."
-  (interactive (and custom-modified-list
-                    (not (equal (list (custom-name-field 'custom-file))
-                                custom-modified-list))
-                    (not (y-or-n-p "Discard all changes? "))
-                    (error "Load aborted")))
-  (load-file (custom-name-value 'custom-file))
-  (custom-reset-all))
-
-;;; Field Editing:
-;;
-;; Various internal functions for implementing the direct editing of
-;; fields in the customization buffer.
-
-(defun custom-field-untouch (field)
-  ;; Remove FIELD and its children from `custom-modified-list'.
-  (setq custom-modified-list (delq field custom-modified-list))
-  (if (arrayp field)
-      (let ((value (custom-field-value field)))
-        (cond ((null (custom-data (custom-field-custom field))))
-              ((arrayp value)
-               (custom-field-untouch value))
-              ((listp value)
-               (mapcar 'custom-field-untouch value))))))
-
-
-(defun custom-field-insert (field)
-  ;; Insert editing FIELD in current buffer.
-  (let ((from (point))
-        (custom (custom-field-custom field))
-        (value (custom-field-value field)))
-    (insert (custom-write custom value))
-    (insert-char (custom-padding custom)
-                 (- (custom-width custom) (- (point) from)))
-    (custom-field-move field from (point))
-    (custom-set-text-properties 
-     from (point)
-     (list 'custom-field field
-           'custom-tag field
-           'face (custom-field-face field)
-           'start-open t
-           'end-open t))))
-
-(defun custom-field-read (field)
-  ;; Read the screen content of FIELD.
-  (custom-read (custom-field-custom field)
-               (custom-buffer-substring-no-properties (custom-field-start field)
-                                               (custom-field-end field))))
-
-;; Fields are shown in a special `active' face when point is inside
-;; it.  You activate the field by moving point inside (entering) it
-;; and deactivate the field by moving point outside (leaving) it.
-
-(defun custom-field-leave (field)
-  ;; Deactivate FIELD.
-  (let ((before-change-functions nil)
-        (after-change-functions nil))
-    (custom-put-text-property (custom-field-start field) (custom-field-end field)
-                       'face (custom-field-face field))))
-
-(defun custom-field-enter (field)
-  ;; Activate FIELD.
-  (let* ((start (custom-field-start field)) 
-         (end (custom-field-end field))
-         (custom (custom-field-custom field))
-         (padding (custom-padding custom))
-         (before-change-functions nil)
-         (after-change-functions nil))
-    (or (eq this-command 'self-insert-command)
-        (let ((pos end))
-          (while (and (< start pos)
-                      (eq (char-after (1- pos)) padding))
-            (setq pos (1- pos)))
-          (if (< pos (point))
-              (goto-char pos))))
-    (custom-put-text-property start end 'face custom-field-active-face)))
-
-(defun custom-field-resize (field)
-  ;; Resize FIELD after change.
-  (let* ((custom (custom-field-custom field))
-         (begin (custom-field-start field))
-         (end (custom-field-end field))
-         (pos (point))
-         (padding (custom-padding custom))
-         (width (custom-width custom))
-         (size (- end begin)))
-    (cond ((< size width)
-           (goto-char end)
-           (if (fboundp 'insert-before-markers-and-inherit)
-               ;; Emacs 19.
-               (insert-before-markers-and-inherit
-                (make-string (- width size) padding))
-             ;; XEmacs:  BUG:  Doesn't work!
-             (insert-before-markers (make-string (- width size) padding)))
-           (goto-char pos))
-          ((> size width)
-           (let ((start (if (and (< (+ begin width) pos) (<= pos end))
-                            pos
-                          (+ begin width))))
-             (goto-char end)
-             (while (and (< start (point)) (= (preceding-char) padding))
-               (backward-delete-char 1))
-             (goto-char pos))))))
-
-(defvar custom-field-changed nil)
-;; List of fields changed on the screen but whose VALUE attribute has
-;; not yet been updated to reflect the new screen content.
-(make-variable-buffer-local 'custom-field-changed)
-
-(defun custom-field-parse (field)
-  ;; Parse FIELD content iff changed.
-  (if (memq field custom-field-changed)
-      (progn 
-        (setq custom-field-changed (delq field custom-field-changed))
-        (custom-field-value-set field (custom-field-read field))
-        (custom-field-update field))))
-
-(defun custom-post-command ()
-  ;; Keep track of their active field.
-  (custom-assert '(eq major-mode 'custom-mode))
-  (let ((field (custom-field-property (point))))
-    (if (eq field custom-field-last)
-        (if (memq field custom-field-changed)
-            (custom-field-resize field))
-      (custom-field-parse custom-field-last)
-      (if custom-field-last
-          (custom-field-leave custom-field-last))
-      (if field
-          (custom-field-enter field))
-      (setq custom-field-last field))
-    (set-buffer-modified-p (or custom-modified-list
-                               custom-field-changed))))
-
-(defvar custom-field-was nil)
-;; The custom data before the change.
-(make-variable-buffer-local 'custom-field-was)
-
-(defun custom-before-change (begin end)
-  ;; Check that we the modification is allowed.
-  (if (not (eq major-mode 'custom-mode))
-      (message "Aargh! Why is custom-before-change called here?")
-    (let ((from (custom-field-property begin))
-          (to (custom-field-property end)))
-      (cond ((or (null from) (null to))
-             (error "You can only modify the fields"))
-            ((not (eq from to))
-             (error "Changes must be limited to a single field."))
-            (t
-             (setq custom-field-was from))))))
-
-(defun custom-after-change (begin end length)
-  ;; Keep track of field content.
-  (if (not (eq major-mode 'custom-mode))
-      (message "Aargh! Why is custom-after-change called here?")
-    (let ((field custom-field-was))
-      (custom-assert '(prog1 field (setq custom-field-was nil)))
-      ;; Prevent mixing fields properties.
-      (custom-put-text-property begin end 'custom-field field)
-      ;; Update the field after modification.
-      (if (eq (custom-field-property begin) field)
-          (let ((field-end (custom-field-end field)))
-            (if (> end field-end)
-                (set-marker field-end end))
-            (add-to-list 'custom-field-changed field))
-        ;; We deleted the entire field, reinsert it.
-        (custom-assert '(eq begin end))
-        (save-excursion
-          (goto-char begin)
-          (custom-field-value-set field
-                                  (custom-read (custom-field-custom field) ""))
-          (custom-field-insert field))))))
-
-(defun custom-field-property (pos)
-  ;; The `custom-field' text property valid for POS.
-  (or (get-text-property pos 'custom-field)
-      (and (not (eq pos (point-min)))
-           (get-text-property (1- pos) 'custom-field))))
-
-;;; Generic Utilities:
-;;
-;; Some utility functions that are not really specific to custom.
-
-(defun custom-assert (expr)
-  "Assert that EXPR evaluates to non-nil at this point"
-  (or (eval expr)
-      (error "Assertion failed: %S" expr)))
-
-(defun custom-first-line (string)
-  "Return the part of STRING before the first newline."
-  (let ((pos 0)
-        (len (length string)))
-    (while (and (< pos len) (not (eq (aref string pos) ?\n)))
-      (setq pos (1+ pos)))
-    (if (eq pos len)
-        string
-    (substring string 0 pos))))
-
-(defun custom-insert-before (list old new)
-  "In LIST insert before OLD a NEW element."
-  (cond ((null list)
-         (list new))
-        ((null old)
-         (nconc list (list new)))
-        ((eq old (car list))
-         (cons new list))
+(defun custom-declare-group (symbol members doc &rest args)
+  "Like `defgroup', but SYMBOL is evaluated as a normal argument."
+  (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
+  (when doc
+    (put symbol 'group-documentation doc))
+  (while args 
+    (let ((arg (car args)))
+      (setq args (cdr args))
+      (unless (symbolp arg)
+        (error "Junk in args %S" args))
+      (let ((keyword arg)
+            (value (car args)))
+        (unless args
+          (error "Keyword %s is missing an argument" keyword))
+        (setq args (cdr args))
+        (cond ((eq keyword :prefix)
+               (put symbol 'custom-prefix value))
+              (t
+               (custom-handle-keyword symbol keyword value
+                                      'custom-group))))))
+  (run-hooks 'custom-define-hook)
+  symbol)
+
+(defmacro defgroup (symbol members doc &rest args)
+  "Declare SYMBOL as a customization group containing MEMBERS.
+SYMBOL does not need to be quoted.
+
+Third arg DOC is the group documentation.
+
+MEMBERS should be an alist of the form ((NAME WIDGET)...) where
+NAME is a symbol and WIDGET is a widget is a widget for editing that
+symbol.  Useful widgets are `custom-variable' for editing variables,
+`custom-face' for edit faces, and `custom-group' for editing groups.
+
+The remaining arguments should have the form
+
+   [KEYWORD VALUE]... 
+
+The following KEYWORD's are defined:
+
+:group  VALUE should be a customization group.
+        Add SYMBOL to that group.
+
+Read the section about customization in the emacs lisp manual for more
+information."
+  `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
+
+(defun custom-add-to-group (group option widget)
+  "To existing GROUP add a new OPTION of type WIDGET.
+If there already is an entry for that option, overwrite it."
+  (let* ((members (get group 'custom-group))
+         (old (assq option members)))
+    (if old
+        (setcar (cdr old) widget)
+      (put group 'custom-group (nconc members (list (list option widget)))))))
+
+;;; Properties.
+
+(defun custom-handle-all-keywords (symbol args type)
+  "For customization option SYMBOL, handle keyword arguments ARGS.
+Third argument TYPE is the custom option type."
+  (while args 
+    (let ((arg (car args)))
+      (setq args (cdr args))
+      (unless (symbolp arg)
+        (error "Junk in args %S" args))
+      (let ((keyword arg)
+            (value (car args)))
+        (unless args
+          (error "Keyword %s is missing an argument" keyword))
+        (setq args (cdr args))
+        (custom-handle-keyword symbol keyword value type)))))  
+
+(defun custom-handle-keyword (symbol keyword value type)
+  "For customization option SYMBOL, handle KEYWORD with VALUE.
+Fourth argument TYPE is the custom option type."
+  (cond ((eq keyword :group)
+         (custom-add-to-group value symbol type))
+        ((eq keyword :link)
+         (custom-add-link symbol value))
+        ((eq keyword :load)
+         (custom-add-load symbol value))
+        ((eq keyword :tag)
+         (put symbol 'custom-tag value))
         (t
-         (let ((list list))
-           (while (not (eq old (car (cdr list))))
-             (setq list (cdr list))
-             (custom-assert '(cdr list)))
-           (setcdr list (cons new (cdr list))))
-         list)))
-
-(defun custom-strip-padding (string padding)
-  "Remove padding from STRING."
-  (let ((regexp (concat (regexp-quote (char-to-string padding)) "+")))
-    (while (string-match regexp string)
-      (setq string (concat (substring string 0 (match-beginning 0))
-                           (substring string (match-end 0))))))
-  string)
-
-(defun custom-plist-memq (prop plist)
-  "Return non-nil if PROP is a property of PLIST.  Comparison done with EQ."
-  (let (result)
-    (while plist
-      (if (eq (car plist) prop)
-          (setq result plist
-                plist nil)
-        (setq plist (cdr (cdr plist)))))
-    result))
-
-(defun custom-plist-delq (prop plist)
-  "Delete property PROP from property list PLIST."
-  (while (eq (car plist) prop)
-    (setq plist (cdr (cdr plist))))
-  (let ((list plist)
-        (next (cdr (cdr plist))))
-    (while next
-      (if (eq (car next) prop)
-          (progn 
-            (setq next (cdr (cdr next)))
-            (setcdr (cdr list) next))
-        (setq list next
-              next (cdr (cdr next))))))
-  plist)
+         (error "Unknown keyword %s" symbol))))  
+
+(defun custom-add-option (symbol option)
+  "To the variable SYMBOL add OPTION.
+
+If SYMBOL is a hook variable, OPTION should be a hook member.
+For other types variables, the effect is undefined."
+  (let ((options (get symbol 'custom-options)))
+    (unless (member option options)
+      (put symbol 'custom-options (cons option options)))))
+
+(defun custom-add-link (symbol widget)
+  "To the custom option SYMBOL add the link WIDGET."
+  (let ((links (get symbol 'custom-links)))
+    (unless (member widget links)
+      (put symbol 'custom-links (cons widget links)))))
+
+(defun custom-add-load (symbol load)
+  "To the custom option SYMBOL add the dependency LOAD.
+LOAD should be either a library file name, or a feature name."
+  (let ((loads (get symbol 'custom-loads)))
+    (unless (member load loads)
+      (put symbol 'custom-loads (cons load loads)))))
+
+;;; Initializing.
+
+(defun custom-set-variables (&rest args)
+  "Initialize variables according to user preferences.  
+
+The arguments should be a list where each entry has the form:
+
+  (SYMBOL VALUE [NOW])
+
+The unevaluated VALUE is stored as the saved value for SYMBOL.
+If NOW is present and non-nil, VALUE is also evaluated and bound as
+the default value for the SYMBOL."
+  (while args 
+    (let ((entry (car args)))
+      (if (listp entry)
+          (let ((symbol (nth 0 entry))
+                (value (nth 1 entry))
+                (now (nth 2 entry)))
+            (put symbol 'saved-value (list value))
+            (when now 
+              (put symbol 'force-value t)
+              (set-default symbol (eval value)))
+            (setq args (cdr args)))
+        ;; Old format, a plist of SYMBOL VALUE pairs.
+        (let ((symbol (nth 0 args))
+              (value (nth 1 args)))
+          (put symbol 'saved-value (list value)))
+        (setq args (cdr (cdr args)))))))
+
+;;; Meta Customization
+
+(defcustom custom-define-hook nil
+  "Hook called after defining each customize option."
+  :group 'customize
+  :type 'hook)
+
+;;; Menu support
+
+(defconst custom-help-menu
+  `("Customize"
+    ,(if (string-match "XEmacs" emacs-version)
+         '("Emacs" :filter (lambda (&rest junk)
+                             (cdr (custom-menu-create 'emacs))))
+       ["Update menu..." custom-menu-update t])
+    ["Group..." customize t]
+    ["Variable..." customize-variable t]
+    ["Face..." customize-face t]
+    ["Saved..." customize-customized t]
+    ["Apropos..." customize-apropos t])
+  "Customize menu")
+
+(defun custom-menu-reset ()
+  "Reset customize menu."
+  (remove-hook 'custom-define-hook 'custom-menu-reset)
+  (if (string-match "XEmacs" emacs-version)
+      (when (fboundp 'add-submenu)
+        (add-submenu '("Options") custom-help-menu))
+    (define-key global-map [menu-bar help-menu customize-menu]
+      (cons (car custom-help-menu)
+            (easy-menu-create-keymaps (car custom-help-menu)
+                                      (cdr custom-help-menu))))))
 
-;;; Meta Customization:
-
-(custom-declare '()
-  '((tag . "Meta Customization")
-    (doc . "Customization of the customization support.")
-    (type . group)
-    (data ((type . face-doc))
-          ((tag . "Button Face")
-           (default . bold)
-           (doc . "Face used for tags in customization buffers.")
-           (name . custom-button-face)
-           (synchronize . (lambda (f)
-                            (custom-category-put 'custom-button-properties 
-                                                 'face custom-button-face)))
-           (type . face))
-          ((tag . "Mouse Face")
-           (default . highlight)
-           (doc . "\
-Face used when mouse is above a button in customization buffers.")
-           (name . custom-mouse-face)
-           (synchronize . (lambda (f)
-                            (custom-category-put 'custom-button-properties 
-                                                 mouse-face 
-                                                 custom-mouse-face)))
-           (type . face))
-          ((tag . "Field Face")
-           (default . italic)
-           (doc . "Face used for customization fields.")
-           (name . custom-field-face)
-           (type . face))
-          ((tag . "Uninitialized Face")
-           (default . modeline)
-           (doc . "Face used for uninitialized customization fields.")
-           (name . custom-field-uninitialized-face)
-           (type . face))
-          ((tag . "Invalid Face")
-           (default . highlight)
-           (doc . "\
-Face used for customization fields containing invalid data.")
-           (name . custom-field-invalid-face)
-           (type . face))
-          ((tag . "Modified Face")
-           (default . bold-italic)
-           (doc . "Face used for modified customization fields.")
-           (name . custom-field-modified-face)
-           (type . face))
-          ((tag . "Active Face")
-           (default . underline)
-           (doc . "\
-Face used for customization fields while they are being edited.")
-           (name . custom-field-active-face)
-           (type . face)))))
-
-;; custom.el uses two categories.
-
-(custom-category-create 'custom-documentation-properties)
-(custom-category-put 'custom-documentation-properties rear-nonsticky t)
-
-(custom-category-create 'custom-button-properties)
-(custom-category-put 'custom-button-properties 'face custom-button-face)
-(custom-category-put 'custom-button-properties mouse-face custom-mouse-face)
-(custom-category-put 'custom-button-properties rear-nonsticky t)
-
-(custom-category-create 'custom-hidden-properties)
-(custom-category-put 'custom-hidden-properties 'invisible
-                     (not (string-match "XEmacs" emacs-version)))
-(custom-category-put 'custom-hidden-properties intangible t)
+(if (string-match "XEmacs" emacs-version)
+    (autoload 'custom-menu-create "cus-edit")
+  (custom-menu-reset))
 
-(and init-file-user  ; Don't load any init file if -q was used.
-     (file-readable-p custom-file)
-     (load-file custom-file))
+;;; The End.
 
 (provide 'custom)
 
-;;; custom.el ends here
+;; custom.el ends here
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
new file mode 100644
index 00000000000..d90836c05c4
--- /dev/null
+++ b/lisp/wid-browse.el
@@ -0,0 +1,232 @@
+;;; wid-browse.el --- Functions for browsing widgets.
+;;
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: extensions
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; Widget browser.  See `widget.el'.
+
+;;; Code:
+
+(require 'easymenu)
+(require 'custom)
+(require 'wid-edit)
+(require 'cl)
+
+(defgroup widget-browse nil
+  "Customization support for browsing widgets."
+  :group 'widgets)
+
+;;; The Mode.
+
+(defvar widget-browse-mode-map nil
+  "Keymap for `widget-browse-mode'.")
+  
+(unless widget-browse-mode-map
+  (setq widget-browse-mode-map (make-sparse-keymap))
+  (set-keymap-parent widget-browse-mode-map widget-keymap))
+
+(easy-menu-define widget-browse-mode-menu 
+    widget-browse-mode-map
+  "Menu used in widget browser buffers."
+  '("Widget"
+    ["Browse" widget-browse t]
+    ["Browse At" widget-browse-at t]))
+
+(defcustom widget-browse-mode-hook nil
+  "Hook called when entering widget-browse-mode."
+  :type 'hook
+  :group 'widget-browse)
+
+(defun widget-browse-mode ()
+  "Major mode for widget browser buffers.
+
+The following commands are available:
+
+\\[widget-forward]              Move to next button or editable field.
+\\[widget-backward]             Move to previous button or editable field.
+\\[widget-button-click]         Activate button under the mouse pointer.
+\\[widget-button-press]         Activate button under point.
+
+Entry to this mode calls the value of `widget-browse-mode-hook'
+if that value is non-nil."
+  (kill-all-local-variables)
+  (setq major-mode 'widget-browse-mode
+        mode-name "Widget")
+  (use-local-map widget-browse-mode-map)
+  (easy-menu-add widget-browse-mode-menu)
+  (run-hooks 'widget-browse-mode-hook))
+
+;;; Commands.
+
+;;;###autoload
+(defun widget-browse-at (pos)
+  "Browse the widget under point."
+  (interactive "d")
+  (let* ((field (get-text-property pos 'field))
+         (button (get-text-property pos 'button))
+         (doc (get-text-property pos 'widget-doc))
+         (text (cond (field "This is an editable text area.")
+                     (button "This is an active area.")
+                     (doc "This is documentation text.")
+                     (t "This is unidentified text.")))
+         (widget (or field button doc)))
+    (when widget
+      (widget-browse widget))
+    (message text)))
+
+(defvar widget-browse-history nil)
+
+(defun widget-browse (widget)
+  "Create a widget browser for WIDGET."
+  (interactive (list (completing-read "Widget: " 
+                                      obarray
+                                      (lambda (symbol)
+                                        (get symbol 'widget-type))
+                                      t nil 'widget-browse-history)))
+  (if (stringp widget)
+      (setq widget (intern widget)))
+  (unless (if (symbolp widget)
+              (get widget 'widget-type)
+            (and (consp widget)
+                 (get (widget-type widget) 'widget-type)))
+    (error "Not a widget."))
+  ;; Create the buffer.
+  (if (symbolp widget)
+      (let ((buffer (format "*Browse %s Widget*" widget)))
+        (kill-buffer (get-buffer-create buffer))
+        (switch-to-buffer (get-buffer-create buffer)))
+    (kill-buffer (get-buffer-create "*Browse Widget*"))
+    (switch-to-buffer (get-buffer-create "*Browse Widget*")))
+  (widget-browse-mode)
+  
+  ;; Quick way to get out.
+  (widget-create 'push-button
+                 :action (lambda (widget &optional event)
+                           (bury-buffer))
+                 "Quit")
+  (widget-insert "\n")
+
+  ;; Top text indicating whether it is a class or object browser.
+  (if (listp widget)
+      (widget-insert "Widget object browser.\n\nClass: ")
+    (widget-insert "Widget class browser.\n\n")
+    (widget-create 'widget-browse
+                   :format "%[%v%]\n%d"
+                   :doc (get widget 'widget-documentation)
+                   widget)
+    (unless (eq (preceding-char) ?\n)
+      (widget-insert "\n"))
+    (widget-insert "\nSuper: ")
+    (setq widget (get widget 'widget-type)))
+
+  ;; Now show the attributes.
+  (let ((name (car widget))
+        (items (cdr widget))
+        key value printer)
+    (widget-create 'widget-browse
+                   :format "%[%v%]"
+                   name)
+    (widget-insert "\n")
+    (while items
+      (setq key (nth 0 items)
+            value (nth 1 items)
+            printer (or (get key 'widget-keyword-printer)
+                        'widget-browse-sexp)
+            items (cdr (cdr items)))
+      (widget-insert "\n" (symbol-name key) "\n\t")
+      (funcall printer widget key value)
+      (widget-insert "\n")))
+  (widget-setup)
+  (goto-char (point-min)))
+
+;;; The `widget-browse' Widget.
+
+(define-widget 'widget-browse 'push-button
+  "Button for creating a widget browser.
+The :value of the widget shuld be the widget to be browsed."
+  :format "%[[%v]%]"
+  :value-create 'widget-browse-value-create
+  :action 'widget-browse-action)
+
+(defun widget-browse-action (widget &optional event)
+  ;; Create widget browser for WIDGET's :value. 
+  (widget-browse (widget-get widget :value)))
+
+(defun widget-browse-value-create (widget)
+  ;; Insert type name.
+  (let ((value (widget-get widget :value)))
+    (cond ((symbolp value)
+           (insert (symbol-name value)))
+          ((consp value)
+           (insert (symbol-name (widget-type value))))
+          (t
+           (insert "strange")))))
+
+;;; Keyword Printer Functions.
+
+(defun widget-browse-widget (widget key value)
+  "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a widget."
+  (widget-create 'widget-browse value))
+
+(defun widget-browse-widgets (widget key value)
+  "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a list of widgets."
+  (while value
+    (widget-create 'widget-browse
+                   (car value))
+    (setq value (cdr value))
+    (when value
+      (widget-insert " "))))
+
+(defun widget-browse-sexp (widget key value)
+  "Insert description of WIDGET's KEY VALUE.
+Nothing is assumed about value."
+  (let ((pp (condition-case signal
+                (pp-to-string value)
+              (error (prin1-to-string signal)))))
+    (when (string-match "\n\\'" pp)
+      (setq pp (substring pp 0 (1- (length pp)))))
+    (if (cond ((string-match "\n" pp)
+               nil)
+              ((> (length pp) (- (window-width) (current-column)))
+               nil)
+              (t t))
+        (widget-insert pp)
+      (widget-create 'push-button
+                     :tag "show"
+                     :action (lambda (widget &optional event)
+                               (with-output-to-temp-buffer
+                                   "*Pp Eval Output*"
+                                 (princ (widget-get widget :value))))
+                     pp))))
+
+(defun widget-browse-sexps (widget key value)
+  "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a list of widgets."
+  (let ((target (current-column)))
+    (while value
+      (widget-browse-sexp widget key (car value))
+      (setq value (cdr value))
+      (when value
+        (widget-insert "\n" (make-string target ?\ ))))))
+
+;;; Keyword Printers.
+
+(put :parent 'widget-keyword-printer 'widget-browse-widget)
+(put :children 'widget-keyword-printer 'widget-browse-widgets)
+(put :buttons 'widget-keyword-printer 'widget-browse-widgets)
+(put :button 'widget-keyword-printer 'widget-browse-widget)
+(put :args 'widget-keyword-printer 'widget-browse-sexps)
+
+;;; The End:
+
+(provide 'wid-browse)
+
+;; wid-browse.el ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
new file mode 100644
index 00000000000..283981d42f4
--- /dev/null
+++ b/lisp/wid-edit.el
@@ -0,0 +1,2542 @@
+;;; wid-edit.el --- Functions for creating and using widgets.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: extensions
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `widget.el'.
+
+;;; Code:
+
+(require 'widget)
+
+(eval-and-compile
+  (require 'cl))
+
+;;; Compatibility.
+
+(eval-and-compile
+  (autoload 'pp-to-string "pp")
+  (autoload 'Info-goto-node "info")
+
+  (when (string-match "XEmacs" emacs-version)
+    (condition-case nil
+        (require 'overlay)
+      (error (load-library "x-overlay"))))
+  
+  (if (string-match "XEmacs" emacs-version)
+      ;; XEmacs spell `intangible' as `atomic'.
+      (defun widget-make-intangible (from to side)
+        "Make text between FROM and TO atomic with regard to movement.
+Third argument should be `start-open' if it should be sticky to the rear,
+and `end-open' if it should sticky to the front."
+        (require 'atomic-extents)
+        (let ((ext (make-extent from to)))
+           ;; XEmacs doesn't understant different kinds of read-only, so
+           ;; we have to use extents instead.  
+          (put-text-property from to 'read-only nil)
+          (set-extent-property ext 'read-only t)
+          (set-extent-property ext 'start-open nil)
+          (set-extent-property ext 'end-open nil)
+          (set-extent-property ext side t)
+          (set-extent-property ext 'atomic t)))
+    (defun widget-make-intangible (from to size)
+      "Make text between FROM and TO intangible."
+      (put-text-property from to 'intangible 'front)))
+          
+;; The following should go away when bundled with Emacs.
+  (condition-case ()
+      (require 'custom)
+    (error nil))
+
+  (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
+    ;; We have the old custom-library, hack around it!
+    (defmacro defgroup (&rest args) nil)
+    (defmacro defcustom (var value doc &rest args) 
+      `(defvar ,var ,value ,doc))
+    (defmacro defface (&rest args) nil)
+    (define-widget-keywords :prefix :tag :load :link :options :type :group)
+    (when (fboundp 'copy-face)
+      (copy-face 'default 'widget-documentation-face)
+      (copy-face 'bold 'widget-button-face)
+      (copy-face 'italic 'widget-field-face)))
+
+  (unless (fboundp 'event-point)
+    ;; XEmacs function missing in Emacs.
+    (defun event-point (event)
+      "Return the character position of the given mouse-motion, button-press,
+or button-release event.  If the event did not occur over a window, or did
+not occur over text, then this returns nil.  Otherwise, it returns an index
+into the buffer visible in the event's window."
+      (posn-point (event-start event))))
+
+  (unless (fboundp 'error-message-string)
+    ;; Emacs function missing in XEmacs.
+    (defun error-message-string (obj)
+      "Convert an error value to an error message."
+      (let ((buf (get-buffer-create " *error-message*")))
+        (erase-buffer buf)
+        (display-error obj buf)
+        (buffer-string buf)))))
+
+;;; Customization.
+
+(defgroup widgets nil
+  "Customization support for the Widget Library."
+  :link '(custom-manual "(widget)Top")
+  :link '(url-link :tag "Development Page" 
+                   "http://www.dina.kvl.dk/~abraham/custom/")
+  :prefix "widget-"
+  :group 'extensions
+  :group 'faces
+  :group 'hypermedia)
+
+(defface widget-documentation-face '((((class color)
+                                       (background dark))
+                                      (:foreground "lime green"))
+                                     (((class color)
+                                       (background light))
+                                      (:foreground "dark green"))
+                                     (t nil))
+  "Face used for documentation text."
+  :group 'widgets)
+
+(defface widget-button-face '((t (:bold t)))
+  "Face used for widget buttons."
+  :group 'widgets)
+
+(defcustom widget-mouse-face 'highlight
+  "Face used for widget buttons when the mouse is above them."
+  :type 'face
+  :group 'widgets)
+
+(defface widget-field-face '((((class grayscale color)
+                               (background light))
+                              (:background "light gray"))
+                             (((class grayscale color)
+                               (background dark))
+                              (:background "dark gray"))
+                             (t 
+                              (:italic t)))
+  "Face used for editable fields."
+  :group 'widgets)
+
+(defcustom widget-menu-max-size 40
+  "Largest number of items allowed in a popup-menu.
+Larger menus are read through the minibuffer."
+  :group 'widgets
+  :type 'integer)
+
+;;; Utility functions.
+;;
+;; These are not really widget specific.
+
+(defsubst widget-plist-member (plist prop)
+  ;; Return non-nil if PLIST has the property PROP.
+  ;; PLIST is a property list, which is a list of the form
+  ;; (PROP1 VALUE1 PROP2 VALUE2 ...).  PROP is a symbol.
+  ;; Unlike `plist-get', this allows you to distinguish between a missing
+  ;; property and a property with the value nil.
+  ;; The value is actually the tail of PLIST whose car is PROP.
+  (while (and plist (not (eq (car plist) prop)))
+    (setq plist (cdr (cdr plist))))
+  plist)
+
+(defun widget-princ-to-string (object)
+  ;; Return string representation of OBJECT, any Lisp object.
+  ;; No quoting characters are used; no delimiters are printed around
+  ;; the contents of strings.
+  (save-excursion
+    (set-buffer (get-buffer-create " *widget-tmp*"))
+    (erase-buffer)
+    (let ((standard-output (current-buffer)))
+      (princ object))
+    (buffer-string)))
+
+(defun widget-clear-undo ()
+  "Clear all undo information."
+  (buffer-disable-undo (current-buffer))
+  (buffer-enable-undo))
+
+(defun widget-choose (title items &optional event)
+  "Choose an item from a list.
+
+First argument TITLE is the name of the list.
+Second argument ITEMS is an alist (NAME . VALUE).
+Optional third argument EVENT is an input event.
+
+The user is asked to choose between each NAME from the items alist,
+and the VALUE of the chosen element will be returned.  If EVENT is a
+mouse event, and the number of elements in items is less than
+`widget-menu-max-size', a popup menu will be used, otherwise the
+minibuffer."
+  (cond ((and (< (length items) widget-menu-max-size)
+              event (fboundp 'x-popup-menu) window-system)
+         ;; We are in Emacs-19, pressed by the mouse
+         (x-popup-menu event
+                       (list title (cons "" items))))
+        ((and (< (length items) widget-menu-max-size)
+              event (fboundp 'popup-menu) window-system)
+         ;; We are in XEmacs, pressed by the mouse
+         (let ((val (get-popup-menu-response
+                     (cons title
+                           (mapcar
+                            (function
+                             (lambda (x)
+                               (vector (car x) (list (car x)) t)))
+                            items)))))
+           (setq val (and val
+                          (listp (event-object val))
+                          (stringp (car-safe (event-object val)))
+                          (car (event-object val))))
+           (cdr (assoc val items))))
+        (t
+         (let ((val (completing-read (concat title ": ") items nil t)))
+           (if (stringp val)
+               (let ((try (try-completion val items)))
+                 (when (stringp try)
+                   (setq val try))
+                 (cdr (assoc val items)))
+             nil)))))
+
+(defun widget-get-sibling (widget)
+  "Get the item WIDGET is assumed to toggle.
+This is only meaningful for radio buttons or checkboxes in a list."
+  (let* ((parent (widget-get widget :parent))
+         (children (widget-get parent :children))
+         child)
+    (catch 'child
+      (while children
+        (setq child (car children)
+              children (cdr children))
+        (when (eq (widget-get child :button) widget)
+          (throw 'child child)))
+      nil)))
+
+;;; Widget text specifications.
+;; 
+;; These functions are for specifying text properties. 
+
+(defun widget-specify-none (from to)
+  ;; Clear all text properties between FROM and TO.
+  (set-text-properties from to nil))
+
+(defun widget-specify-text (from to)
+  ;; Default properties.
+  (add-text-properties from to (list 'read-only t
+                                     'front-sticky t
+                                     'start-open t
+                                     'end-open t
+                                     'rear-nonsticky nil)))
+
+(defun widget-specify-field (widget from to)
+  ;; Specify editable button for WIDGET between FROM and TO.
+  (widget-specify-field-update widget from to)
+
+  ;; Make it possible to edit the front end of the field.
+  (add-text-properties (1- from) from (list 'rear-nonsticky t
+                                              'end-open t
+                                              'invisible t))
+  (when (or (string-match "\\(.\\|\n\\)%v" (widget-get widget :format))
+            (widget-get widget :hide-front-space))
+    ;; WARNING: This is going to lose horrible if the character just
+    ;; before the field can be modified (e.g. if it belongs to a
+    ;; choice widget).  We try to compensate by checking the format
+    ;; string, and hope the user hasn't changed the :create method.
+    (widget-make-intangible (- from 2) from 'end-open))
+  
+  ;; Make it possible to edit back end of the field.
+  (add-text-properties to (1+ to) (list 'front-sticky nil
+                                        'read-only t
+                                        'start-open t))
+
+  (cond ((widget-get widget :size)
+         (put-text-property to (1+ to) 'invisible t)
+         (when (or (string-match "%v\\(.\\|\n\\)" (widget-get widget :format))
+                   (widget-get widget :hide-rear-space))
+           ;; WARNING: This is going to lose horrible if the character just
+           ;; after the field can be modified (e.g. if it belongs to a
+           ;; choice widget).  We try to compensate by checking the format
+           ;; string, and hope the user hasn't changed the :create method.
+           (widget-make-intangible to (+ to 2) 'start-open)))
+        ((string-match "XEmacs" emacs-version)
+         ;; XEmacs does not allow you to insert before a read-only
+         ;; character, even if it is start.open.
+         ;; XEmacs does allow you to delete an read-only extent, so
+         ;; making the terminating newline read only doesn't help.
+         ;; I tried putting an invisible intangible read-only space
+         ;; before the newline, which gave really weird effects.
+         ;; So for now, we just have trust the user not to delete the
+         ;; newline.  
+         (put-text-property to (1+ to) 'read-only nil))))
+
+(defun widget-specify-field-update (widget from to)
+  ;; Specify editable button for WIDGET between FROM and TO.
+  (let ((map (widget-get widget :keymap))
+        (secret (widget-get widget :secret))
+        (secret-to to)
+        (size (widget-get widget :size))
+        (face (or (widget-get widget :value-face)
+                  'widget-field-face))
+        (help-echo (widget-get widget :help-echo))
+        (help-property (if (featurep 'balloon-help)
+                           'balloon-help
+                         'help-echo)))
+    (unless (or (stringp help-echo) (null help-echo))
+      (setq help-echo 'widget-mouse-help))
+
+    (when secret 
+      (while (and size
+                  (not (zerop size))
+                  (> secret-to from)
+                  (eq (char-after (1- secret-to)) ?\ ))
+        (setq secret-to (1- secret-to)))
+
+      (save-excursion
+        (goto-char from)
+        (while (< (point) secret-to)
+          (let ((old (get-text-property (point) 'secret)))
+            (when old
+              (subst-char-in-region (point) (1+ (point)) secret old)))
+          (forward-char))))
+
+    (set-text-properties from to (list 'field widget
+                                       'read-only nil
+                                       'keymap map
+                                       'local-map map
+                                       help-property help-echo
+                                       'face face))
+    
+    (when secret 
+      (save-excursion
+        (goto-char from)
+        (while (< (point) secret-to)
+          (let ((old (following-char)))
+            (subst-char-in-region (point) (1+ (point)) old secret)
+            (put-text-property (point) (1+ (point)) 'secret old))
+          (forward-char))))
+
+    (unless (widget-get widget :size)
+      (add-text-properties to (1+ to) (list 'field widget
+                                            help-property help-echo
+                                            'face face)))
+    (add-text-properties to (1+ to) (list 'local-map map
+                                          'keymap map))))
+
+(defun widget-specify-button (widget from to)
+  ;; Specify button for WIDGET between FROM and TO.
+  (let ((face (widget-apply widget :button-face-get))
+        (help-echo (widget-get widget :help-echo))
+        (help-property (if (featurep 'balloon-help)
+                           'balloon-help
+                         'help-echo)))
+    (unless (or (null help-echo) (stringp help-echo))
+      (setq help-echo 'widget-mouse-help))
+    (add-text-properties from to (list 'button widget
+                                       'mouse-face widget-mouse-face
+                                       'start-open t
+                                       'end-open t
+                                       help-property help-echo
+                                       'face face))))
+
+(defun widget-mouse-help (extent)
+  "Find mouse help string for button in extent."
+  (let* ((widget (widget-at (extent-start-position extent)))
+         (help-echo (and widget (widget-get widget :help-echo))))
+    (cond ((stringp help-echo)
+           help-echo)
+          ((and (symbolp help-echo) (fboundp help-echo)
+                (stringp (setq help-echo (funcall help-echo widget))))
+           help-echo)
+          (t
+           (format "(widget %S :help-echo %S)" widget help-echo)))))
+
+(defun widget-specify-sample (widget from to)
+  ;; Specify sample for WIDGET between FROM and TO.
+  (let ((face (widget-apply widget :sample-face-get)))
+    (when face
+      (add-text-properties from to (list 'start-open t
+                                         'end-open t
+                                         'face face)))))
+
+(defun widget-specify-doc (widget from to)
+  ;; Specify documentation for WIDGET between FROM and TO.
+  (add-text-properties from to (list 'widget-doc widget
+                                     'face 'widget-documentation-face)))
+
+(defmacro widget-specify-insert (&rest form)
+  ;; Execute FORM without inheriting any text properties.
+  `(save-restriction
+     (let ((inhibit-read-only t)
+           result
+           after-change-functions)
+       (insert "<>")
+       (narrow-to-region (- (point) 2) (point))
+       (widget-specify-none (point-min) (point-max))
+       (goto-char (1+ (point-min)))
+       (setq result (progn ,@form))
+       (delete-region (point-min) (1+ (point-min)))
+       (delete-region (1- (point-max)) (point-max))
+       (goto-char (point-max))
+       result)))
+
+(defface widget-inactive-face '((((class grayscale color)
+                                  (background dark))
+                                 (:foreground "light gray"))
+                                (((class grayscale color)
+                                  (background light))
+                                 (:foreground "dark gray"))
+                                (t 
+                                 (:italic t)))
+  "Face used for inactive widgets."
+  :group 'widgets)
+
+(defun widget-specify-inactive (widget from to)
+  "Make WIDGET inactive for user modifications."
+  (unless (widget-get widget :inactive)
+    (let ((overlay (make-overlay from to nil t nil)))
+      (overlay-put overlay 'face 'widget-inactive-face)
+      (overlay-put overlay 'evaporate 't)
+      (overlay-put overlay (if (string-match "XEmacs" emacs-version)
+                               'read-only
+                             'modification-hooks) '(widget-overlay-inactive))
+      (widget-put widget :inactive overlay))))
+
+(defun widget-overlay-inactive (&rest junk)
+  "Ignoring the arguments, signal an error."
+  (unless inhibit-read-only
+    (error "Attempt to modify inactive widget")))
+
+
+(defun widget-specify-active (widget)
+  "Make WIDGET active for user modifications."
+  (let ((inactive (widget-get widget :inactive)))
+    (when inactive
+      (delete-overlay inactive)
+      (widget-put widget :inactive nil))))
+
+;;; Widget Properties.
+
+(defsubst widget-type (widget)
+  "Return the type of WIDGET, a symbol."
+  (car widget))
+
+(defun widget-put (widget property value)
+  "In WIDGET set PROPERTY to VALUE.
+The value can later be retrived with `widget-get'."
+  (setcdr widget (plist-put (cdr widget) property value)))
+
+(defun widget-get (widget property)
+  "In WIDGET, get the value of PROPERTY.
+The value could either be specified when the widget was created, or
+later with `widget-put'."
+  (let ((missing t)
+        value tmp)
+    (while missing
+      (cond ((setq tmp (widget-plist-member (cdr widget) property))
+             (setq value (car (cdr tmp))
+                   missing nil))
+            ((setq tmp (car widget))
+             (setq widget (get tmp 'widget-type)))
+            (t 
+             (setq missing nil))))
+    value))
+
+(defun widget-member (widget property)
+  "Non-nil iff there is a definition in WIDGET for PROPERTY."
+  (cond ((widget-plist-member (cdr widget) property)
+         t)
+        ((car widget)
+         (widget-member (get (car widget) 'widget-type) property))
+        (t nil)))
+
+;;;###autoload
+(defun widget-apply (widget property &rest args)
+  "Apply the value of WIDGET's PROPERTY to the widget itself.
+ARGS are passed as extra arguments to the function."
+  (apply (widget-get widget property) widget args))
+
+(defun widget-value (widget)
+  "Extract the current value of WIDGET."
+  (widget-apply widget
+                :value-to-external (widget-apply widget :value-get)))
+
+(defun widget-value-set (widget value)
+  "Set the current value of WIDGET to VALUE."
+  (widget-apply widget
+                :value-set (widget-apply widget
+                                         :value-to-internal value)))
+
+(defun widget-match-inline (widget vals)
+  ;; In WIDGET, match the start of VALS.
+  (cond ((widget-get widget :inline)
+         (widget-apply widget :match-inline vals))
+        ((and vals
+              (widget-apply widget :match (car vals)))
+         (cons (list (car vals)) (cdr vals)))
+        (t nil)))
+
+(defun widget-apply-action (widget &optional event)
+  "Apply :action in WIDGET in response to EVENT."
+  (if (widget-apply widget :active)
+      (widget-apply widget :action event)
+    (error "Attempt to perform action on inactive widget")))
+    
+;;; Glyphs.
+
+(defcustom widget-glyph-directory (concat data-directory "custom/")
+  "Where widget glyphs are located.
+If this variable is nil, widget will try to locate the directory
+automatically. This does not work yet."
+  :group 'widgets
+  :type 'directory)
+
+(defcustom widget-glyph-enable t
+  "If non nil, use glyphs in images when available."
+  :group 'widgets
+  :type 'boolean)
+
+(defun widget-glyph-insert (widget tag image)
+  "In WIDGET, insert the text TAG or, if supported, IMAGE.
+IMAGE should either be a glyph, or a name sans extension of an xpm or
+xbm file located in `widget-glyph-directory'.
+
+WARNING: If you call this with a glyph, and you want the user to be
+able to activate the glyph, make sure it is unique.  If you use the
+same glyph for multiple widgets, activating any of the glyphs will
+cause the last created widget to be activated."
+  (cond ((not (and (string-match "XEmacs" emacs-version)
+                   widget-glyph-enable
+                   (fboundp 'make-glyph)
+                   image))
+         ;; We don't want or can't use glyphs.
+         (insert tag))
+        ((and (fboundp 'glyphp)
+              (glyphp image))
+         ;; Already a glyph.  Insert it.
+         (widget-glyph-insert-glyph widget tag image))
+        (t
+         ;; A string.  Look it up in.
+         (let ((file (concat widget-glyph-directory 
+                            (if (string-match "/\\'" widget-glyph-directory)
+                                ""
+                              "/")
+                            image
+                            (if (featurep 'xpm) ".xpm" ".xbm"))))
+           (if (file-readable-p file)
+               (widget-glyph-insert-glyph widget tag (make-glyph file))
+             ;; File not readable, give up.
+             (insert tag))))))
+
+(defun widget-glyph-insert-glyph (widget tag glyph)
+  "In WIDGET, with alternative text TAG, insert GLYPH."
+  (set-glyph-image glyph (cons 'tty tag))
+  (set-glyph-property glyph 'widget widget)
+  (insert "*")
+  (add-text-properties (1- (point)) (point) 
+                       (list 'invisible t
+                             'end-glyph glyph))
+  (let ((help-echo (widget-get widget :help-echo)))
+    (when help-echo
+      (let ((extent (extent-at (1- (point)) nil 'end-glyph))
+            (help-property (if (featurep 'balloon-help)
+                               'balloon-help
+                             'help-echo)))
+        (set-extent-property extent help-property (if (stringp help-echo)
+                                                      help-echo
+                                                    'widget-mouse-help))))))
+
+;;; Creating Widgets.
+
+;;;###autoload
+(defun widget-create (type &rest args)
+  "Create widget of TYPE.  
+The optional ARGS are additional keyword arguments."
+  (let ((widget (apply 'widget-convert type args)))
+    (widget-apply widget :create)
+    widget))
+
+(defun widget-create-child-and-convert (parent type &rest args)
+  "As part of the widget PARENT, create a child widget TYPE.
+The child is converted, using the keyword arguments ARGS."
+  (let ((widget (apply 'widget-convert type args)))
+    (widget-put widget :parent parent)
+    (unless (widget-get widget :indent)
+      (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+                                    (or (widget-get widget :extra-offset) 0)
+                                    (widget-get parent :offset))))
+    (widget-apply widget :create)
+    widget))
+
+(defun widget-create-child (parent type)
+  "Create widget of TYPE."
+  (let ((widget (copy-list type)))
+    (widget-put widget :parent parent)
+    (unless (widget-get widget :indent)
+      (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+                                    (or (widget-get widget :extra-offset) 0)
+                                    (widget-get parent :offset))))
+    (widget-apply widget :create)
+    widget))
+
+(defun widget-create-child-value (parent type value)
+  "Create widget of TYPE with value VALUE."
+  (let ((widget (copy-list type)))
+    (widget-put widget :value (widget-apply widget :value-to-internal value))
+    (widget-put widget :parent parent)
+    (unless (widget-get widget :indent)
+      (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+                                    (or (widget-get widget :extra-offset) 0)
+                                    (widget-get parent :offset))))
+    (widget-apply widget :create)
+    widget))
+
+;;;###autoload
+(defun widget-delete (widget)
+  "Delete WIDGET."
+  (widget-apply widget :delete))
+
+(defun widget-convert (type &rest args)
+  "Convert TYPE to a widget without inserting it in the buffer. 
+The optional ARGS are additional keyword arguments."
+  ;; Don't touch the type.
+  (let* ((widget (if (symbolp type) 
+                     (list type)
+                   (copy-list type)))
+         (current widget)
+         (keys args))
+    ;; First set the :args keyword.
+    (while (cdr current)                ;Look in the type.
+      (let ((next (car (cdr current))))
+        (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
+            (setq current (cdr (cdr current)))
+          (setcdr current (list :args (cdr current)))
+          (setq current nil))))
+    (while args                         ;Look in the args.
+      (let ((next (nth 0 args)))
+        (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
+            (setq args (nthcdr 2 args))
+          (widget-put widget :args args)
+          (setq args nil))))
+    ;; Then Convert the widget.
+    (setq type widget)
+    (while type
+      (let ((convert-widget (plist-get (cdr type) :convert-widget)))
+        (if convert-widget
+            (setq widget (funcall convert-widget widget))))
+      (setq type (get (car type) 'widget-type)))
+    ;; Finally set the keyword args.
+    (while keys 
+      (let ((next (nth 0 keys)))
+        (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
+            (progn 
+              (widget-put widget next (nth 1 keys))
+              (setq keys (nthcdr 2 keys)))
+          (setq keys nil))))
+    ;; Convert the :value to internal format.
+    (if (widget-member widget :value)
+        (let ((value (widget-get widget :value)))
+          (widget-put widget
+                      :value (widget-apply widget :value-to-internal value))))
+    ;; Return the newly create widget.
+    widget))
+
+(defun widget-insert (&rest args)
+  "Call `insert' with ARGS and make the text read only."
+  (let ((inhibit-read-only t)
+        after-change-functions
+        (from (point)))
+    (apply 'insert args)
+    (widget-specify-text from (point))))
+
+;;; Keymap and Commands.
+
+(defvar widget-keymap nil
+  "Keymap containing useful binding for buffers containing widgets.
+Recommended as a parent keymap for modes using widgets.")
+
+(unless widget-keymap 
+  (setq widget-keymap (make-sparse-keymap))
+  (define-key widget-keymap "\C-k" 'widget-kill-line)
+  (define-key widget-keymap "\t" 'widget-forward)
+  (define-key widget-keymap "\M-\t" 'widget-backward)
+  (define-key widget-keymap [(shift tab)] 'widget-backward)
+  (define-key widget-keymap [backtab] 'widget-backward)
+  (if (string-match "XEmacs" (emacs-version))
+      (progn 
+        (define-key widget-keymap [button2] 'widget-button-click)
+        (define-key widget-keymap [button1] 'widget-button1-click))
+    (define-key widget-keymap [mouse-2] 'ignore)
+    (define-key widget-keymap [down-mouse-2] 'widget-button-click))
+  (define-key widget-keymap "\C-m" 'widget-button-press))
+
+(defvar widget-global-map global-map
+  "Keymap used for events the widget does not handle themselves.")
+(make-variable-buffer-local 'widget-global-map)
+
+(defvar widget-field-keymap nil
+  "Keymap used inside an editable field.")
+
+(unless widget-field-keymap 
+  (setq widget-field-keymap (copy-keymap widget-keymap))
+  (unless (string-match "XEmacs" (emacs-version))
+    (define-key widget-field-keymap [menu-bar] 'nil))
+  (define-key widget-field-keymap "\C-m" 'widget-field-activate)
+  (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line)
+  (define-key widget-field-keymap "\C-e" 'widget-end-of-line)
+  (set-keymap-parent widget-field-keymap global-map))
+
+(defvar widget-text-keymap nil
+  "Keymap used inside a text field.")
+
+(unless widget-text-keymap 
+  (setq widget-text-keymap (copy-keymap widget-keymap))
+  (unless (string-match "XEmacs" (emacs-version))
+    (define-key widget-text-keymap [menu-bar] 'nil))
+  (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line)
+  (define-key widget-text-keymap "\C-e" 'widget-end-of-line)
+  (set-keymap-parent widget-text-keymap global-map))
+
+(defun widget-field-activate (pos &optional event)
+  "Activate the ediable field at point."
+  (interactive "@d")
+  (let ((field (get-text-property pos 'field)))
+    (if field
+        (widget-apply-action field event)
+      (call-interactively
+       (lookup-key widget-global-map (this-command-keys))))))
+
+(defun widget-button-click (event)
+  "Activate button below mouse pointer."
+  (interactive "@e")
+  (cond ((and (fboundp 'event-glyph)
+              (event-glyph event))
+         (let ((widget (glyph-property (event-glyph event) 'widget)))
+           (if widget
+               (widget-apply-action widget event)
+             (message "You clicked on a glyph."))))
+        ((event-point event)
+         (let ((button (get-text-property (event-point event) 'button)))
+           (if button
+               (widget-apply-action button event)
+             (call-interactively 
+              (or (lookup-key widget-global-map [ button2 ])
+                  (lookup-key widget-global-map [ down-mouse-2 ])
+                  (lookup-key widget-global-map [ mouse-2]))))))
+        (t
+         (message "You clicked somewhere weird."))))
+
+(defun widget-button1-click (event)
+  "Activate glyph below mouse pointer."
+  (interactive "@e")
+  (if (and (fboundp 'event-glyph)
+           (event-glyph event))
+      (let ((widget (glyph-property (event-glyph event) 'widget)))
+        (if widget
+            (widget-apply-action widget event)
+          (message "You clicked on a glyph.")))
+    (call-interactively (lookup-key widget-global-map (this-command-keys)))))
+
+(defun widget-button-press (pos &optional event)
+  "Activate button at POS."
+  (interactive "@d")
+  (let ((button (get-text-property pos 'button)))
+    (if button
+        (widget-apply-action button event)
+      (let ((command (lookup-key widget-global-map (this-command-keys))))
+        (when (commandp command)
+          (call-interactively command))))))
+
+(defun widget-move (arg)
+  "Move point to the ARG next field or button.
+ARG may be negative to move backward."
+  (while (> arg 0)
+    (setq arg (1- arg))
+    (let ((next (cond ((get-text-property (point) 'button)
+                       (next-single-property-change (point) 'button))
+                      ((get-text-property (point) 'field)
+                       (next-single-property-change (point) 'field))
+                      (t
+                       (point)))))
+      (if (null next)                   ; Widget extends to end. of buffer
+          (setq next (point-min)))
+      (let ((button (next-single-property-change next 'button))
+            (field (next-single-property-change next 'field)))
+        (cond ((or (get-text-property next 'button)
+                   (get-text-property next 'field))
+               (goto-char next))
+              ((and button field)
+               (goto-char (min button field)))
+              (button (goto-char button))
+              (field (goto-char field))
+              (t
+               (let ((button (next-single-property-change (point-min) 'button))
+                     (field (next-single-property-change (point-min) 'field)))
+                 (cond ((and button field) (goto-char (min button field)))
+                       (button (goto-char button))
+                       (field (goto-char field))
+                       (t
+                        (error "No buttons or fields found"))))))
+        (setq button (widget-at (point)))
+        (if (and button (widget-get button :tab-order)
+                 (< (widget-get button :tab-order) 0))
+            (setq arg (1+ arg))))))
+  (while (< arg 0)
+    (if (= (point-min) (point))
+        (forward-char 1))
+    (setq arg (1+ arg))
+    (let ((previous (cond ((get-text-property (1- (point)) 'button)
+                           (previous-single-property-change (point) 'button))
+                          ((get-text-property (1- (point)) 'field)
+                           (previous-single-property-change (point) 'field))
+                          (t
+                           (point)))))
+      (if (null previous)               ; Widget extends to beg. of buffer
+          (setq previous (point-max)))
+      (let ((button (previous-single-property-change previous 'button))
+            (field (previous-single-property-change previous 'field)))
+        (cond ((and button field)
+               (goto-char (max button field)))
+              (button (goto-char button))
+              (field (goto-char field))
+              (t
+               (let ((button (previous-single-property-change
+                              (point-max) 'button))
+                     (field (previous-single-property-change
+                             (point-max) 'field)))
+                 (cond ((and button field) (goto-char (max button field)))
+                       (button (goto-char button))
+                       (field (goto-char field))
+                       (t
+                        (error "No buttons or fields found"))))))))
+    (let ((button (previous-single-property-change (point) 'button))
+          (field (previous-single-property-change (point) 'field)))
+      (cond ((and button field)
+             (goto-char (max button field)))
+            (button (goto-char button))
+            (field (goto-char field)))
+      (setq button (widget-at (point)))
+      (if (and button (widget-get button :tab-order)
+               (< (widget-get button :tab-order) 0))
+          (setq arg (1- arg)))))
+  (widget-echo-help (point))
+  (run-hooks 'widget-move-hook))
+
+(defun widget-forward (arg)
+  "Move point to the next field or button.
+With optional ARG, move across that many fields."
+  (interactive "p")
+  (run-hooks 'widget-forward-hook)
+  (widget-move arg))
+
+(defun widget-backward (arg)
+  "Move point to the previous field or button.
+With optional ARG, move across that many fields."
+  (interactive "p")
+  (run-hooks 'widget-backward-hook)
+  (widget-move (- arg)))
+
+(defun widget-beginning-of-line ()
+  "Go to beginning of field or beginning of line, whichever is first."
+  (interactive)
+  (let ((bol (save-excursion (beginning-of-line) (point)))
+        (prev (previous-single-property-change (point) 'field)))
+    (goto-char (max bol (or prev bol)))))
+
+(defun widget-end-of-line ()
+  "Go to end of field or end of line, whichever is first."
+  (interactive)
+  (let ((bol (save-excursion (end-of-line) (point)))
+        (prev (next-single-property-change (point) 'field)))
+    (goto-char (min bol (or prev bol)))))
+
+(defun widget-kill-line ()
+  "Kill to end of field or end of line, whichever is first."
+  (interactive)
+  (let ((field (get-text-property (point) 'field))
+        (newline (save-excursion (search-forward "\n")))
+        (next (next-single-property-change (point) 'field)))
+    (if (and field (> newline next))
+        (kill-region (point) next)
+      (call-interactively 'kill-line))))
+
+;;; Setting up the buffer.
+
+(defvar widget-field-new nil)
+;; List of all newly created editable fields in the buffer.
+(make-variable-buffer-local 'widget-field-new)
+
+(defvar widget-field-list nil)
+;; List of all editable fields in the buffer.
+(make-variable-buffer-local 'widget-field-list)
+
+(defun widget-setup ()
+  "Setup current buffer so editing string widgets works."
+  (let ((inhibit-read-only t)
+        (after-change-functions nil)
+        field)
+    (while widget-field-new
+      (setq field (car widget-field-new)
+            widget-field-new (cdr widget-field-new)
+            widget-field-list (cons field widget-field-list))
+      (let ((from (widget-get field :value-from))
+            (to (widget-get field :value-to)))
+        (widget-specify-field field from to)
+        (move-marker from (1- from))
+        (move-marker to (1+ to)))))
+  (widget-clear-undo)
+  ;; We need to maintain text properties and size of the editing fields.
+  (make-local-variable 'after-change-functions)
+  (if widget-field-list
+      (setq after-change-functions '(widget-after-change))
+    (setq after-change-functions nil)))
+
+(defvar widget-field-last nil)
+;; Last field containing point.
+(make-variable-buffer-local 'widget-field-last)
+
+(defvar widget-field-was nil)
+;; The widget data before the change.
+(make-variable-buffer-local 'widget-field-was)
+
+(defun widget-field-find (pos)
+  ;; Find widget whose editing field is located at POS.
+  ;; Return nil if POS is not inside and editing field.
+  ;; 
+  ;; This is only used in `widget-field-modified', since ordinarily
+  ;; you would just test the field property.
+  (let ((fields widget-field-list)
+        field found)
+    (while fields
+      (setq field (car fields)
+            fields (cdr fields))
+      (let ((from (widget-get field :value-from))
+            (to (widget-get field :value-to)))
+        (if (and from to (< from pos) (> to  pos))
+            (setq fields nil
+                  found field))))
+    found))
+
+(defun widget-after-change (from to old)
+  ;; Adjust field size and text properties.
+  (condition-case nil
+      (let ((field (widget-field-find from))
+            (inhibit-read-only t))
+        (cond ((null field))
+              ((not (eq field (widget-field-find to)))
+               (debug)
+               (message "Error: `widget-after-change' called on two fields"))
+              (t
+               (let ((size (widget-get field :size)))
+                 (if size 
+                     (let ((begin (1+ (widget-get field :value-from)))
+                           (end (1- (widget-get field :value-to))))
+                       (widget-specify-field-update field begin end)
+                       (cond ((< (- end begin) size)
+                              ;; Field too small.
+                              (save-excursion
+                                (goto-char end)
+                                (insert-char ?\  (- (+ begin size) end))
+                                (widget-specify-field-update field 
+                                                             begin
+                                                             (+ begin size))))
+                             ((> (- end begin) size)
+                              ;; Field too large and
+                              (if (or (< (point) (+ begin size))
+                                      (> (point) end))
+                                  ;; Point is outside extra space.
+                                  (setq begin (+ begin size))
+                                ;; Point is within the extra space.
+                                (setq begin (point)))
+                              (save-excursion
+                                (goto-char end)
+                                (while (and (eq (preceding-char) ?\ )
+                                            (> (point) begin))
+                                  (delete-backward-char 1))))))
+                   (widget-specify-field-update field from to)))
+               (widget-apply field :notify field))))
+    (error (debug))))
+
+;;; Widget Functions
+;;
+;; These functions are used in the definition of multiple widgets. 
+
+(defun widget-children-value-delete (widget)
+  "Delete all :children and :buttons in WIDGET."
+  (mapcar 'widget-delete (widget-get widget :children))
+  (widget-put widget :children nil)
+  (mapcar 'widget-delete (widget-get widget :buttons))
+  (widget-put widget :buttons nil))
+
+(defun widget-types-convert-widget (widget)
+  "Convert :args as widget types in WIDGET."
+  (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
+  widget)
+
+;;; The `default' Widget.
+
+(define-widget 'default nil
+  "Basic widget other widgets are derived from."
+  :value-to-internal (lambda (widget value) value)
+  :value-to-external (lambda (widget value) value)
+  :create 'widget-default-create
+  :indent nil
+  :offset 0
+  :format-handler 'widget-default-format-handler
+  :button-face-get 'widget-default-button-face-get 
+  :sample-face-get 'widget-default-sample-face-get 
+  :delete 'widget-default-delete
+  :value-set 'widget-default-value-set
+  :value-inline 'widget-default-value-inline
+  :menu-tag-get 'widget-default-menu-tag-get
+  :validate (lambda (widget) nil)
+  :active 'widget-default-active
+  :activate 'widget-specify-active
+  :deactivate 'widget-default-deactivate
+  :action 'widget-default-action
+  :notify 'widget-default-notify)
+
+(defun widget-default-create (widget)
+  "Create WIDGET at point in the current buffer."
+  (widget-specify-insert
+   (let ((from (point))
+         (tag (widget-get widget :tag))
+         (glyph (widget-get widget :tag-glyph))
+         (doc (widget-get widget :doc))
+         button-begin button-end
+         sample-begin sample-end
+         doc-begin doc-end
+         value-pos)
+     (insert (widget-get widget :format))
+     (goto-char from)
+     ;; Parse escapes in format.
+     (while (re-search-forward "%\\(.\\)" nil t)
+       (let ((escape (aref (match-string 1) 0)))
+         (replace-match "" t t)
+         (cond ((eq escape ?%)
+                (insert "%"))
+               ((eq escape ?\[)
+                (setq button-begin (point)))
+               ((eq escape ?\])
+                (setq button-end (point)))
+               ((eq escape ?\{)
+                (setq sample-begin (point)))
+               ((eq escape ?\})
+                (setq sample-end (point)))
+               ((eq escape ?n)
+                (when (widget-get widget :indent)
+                  (insert "\n")
+                  (insert-char ?  (widget-get widget :indent))))
+               ((eq escape ?t)
+                (cond (glyph 
+                       (widget-glyph-insert widget (or tag "image") glyph))
+                      (tag
+                       (insert tag))
+                      (t
+                       (let ((standard-output (current-buffer)))
+                         (princ (widget-get widget :value))))))
+               ((eq escape ?d)
+                (when doc
+                  (setq doc-begin (point))
+                  (insert doc)
+                  (while (eq (preceding-char) ?\n)
+                    (delete-backward-char 1))
+                  (insert "\n")
+                  (setq doc-end (point))))
+               ((eq escape ?v)
+                (if (and button-begin (not button-end))
+                    (widget-apply widget :value-create)
+                  (setq value-pos (point))))
+               (t 
+                (widget-apply widget :format-handler escape)))))
+     ;; Specify button, sample, and doc, and insert value.
+     (and button-begin button-end
+          (widget-specify-button widget button-begin button-end))
+     (and sample-begin sample-end
+          (widget-specify-sample widget sample-begin sample-end))
+     (and doc-begin doc-end
+          (widget-specify-doc widget doc-begin doc-end))
+     (when value-pos
+       (goto-char value-pos)
+       (widget-apply widget :value-create)))
+   (let ((from (copy-marker (point-min)))
+         (to (copy-marker (point-max))))
+     (widget-specify-text from to)
+     (set-marker-insertion-type from t)
+     (set-marker-insertion-type to nil)
+     (widget-put widget :from from)
+     (widget-put widget :to to))))
+
+(defun widget-default-format-handler (widget escape)
+  ;; We recognize the %h escape by default.
+  (let* ((buttons (widget-get widget :buttons))
+         (doc-property (widget-get widget :documentation-property))
+         (doc-try (cond ((widget-get widget :doc))
+                        ((symbolp doc-property)
+                         (documentation-property (widget-get widget :value)
+                                                 doc-property))
+                        (t
+                         (funcall doc-property (widget-get widget :value)))))
+         (doc-text (and (stringp doc-try)
+                        (> (length doc-try) 1)
+                        doc-try)))
+    (cond ((eq escape ?h)
+           (when doc-text
+             (and (eq (preceding-char) ?\n)
+                  (widget-get widget :indent)
+                  (insert-char ?  (widget-get widget :indent)))
+             ;; The `*' in the beginning is redundant.
+             (when (eq (aref doc-text  0) ?*)
+               (setq doc-text (substring doc-text 1)))
+             ;; Get rid of trailing newlines.
+             (when (string-match "\n+\\'" doc-text)
+               (setq doc-text (substring doc-text 0 (match-beginning 0))))
+             (push (if (string-match "\n." doc-text)
+                       ;; Allow multiline doc to be hiden.
+                       (widget-create-child-and-convert
+                        widget 'widget-help 
+                        :doc (progn
+                               (string-match "\\`.*" doc-text)
+                               (match-string 0 doc-text))
+                        :widget-doc doc-text
+                        "?")
+                     ;; A single line is just inserted.
+                     (widget-create-child-and-convert
+                      widget 'item :format "%d" :doc doc-text nil))
+                   buttons)))
+          (t 
+           (error "Unknown escape `%c'" escape)))
+    (widget-put widget :buttons buttons)))
+
+(defun widget-default-button-face-get (widget)
+  ;; Use :button-face or widget-button-face
+  (or (widget-get widget :button-face) 'widget-button-face))
+
+(defun widget-default-sample-face-get (widget)
+  ;; Use :sample-face.
+  (widget-get widget :sample-face))
+
+(defun widget-default-delete (widget)
+  ;; Remove widget from the buffer.
+  (let ((from (widget-get widget :from))
+        (to (widget-get widget :to))
+        (inhibit-read-only t)
+        after-change-functions)
+    (widget-apply widget :value-delete)
+    (when (< from to)
+      ;; Kludge: this doesn't need to be true for empty formats.
+      (delete-region from to))
+    (set-marker from nil)
+    (set-marker to nil)))
+
+(defun widget-default-value-set (widget value)
+  ;; Recreate widget with new value.
+  (save-excursion
+    (goto-char (widget-get widget :from))
+    (widget-apply widget :delete)
+    (widget-put widget :value value)
+    (widget-apply widget :create)))
+
+(defun widget-default-value-inline (widget)
+  ;; Wrap value in a list unless it is inline.
+  (if (widget-get widget :inline)
+      (widget-value widget)
+    (list (widget-value widget))))
+
+(defun widget-default-menu-tag-get (widget)
+  ;; Use tag or value for menus.
+  (or (widget-get widget :menu-tag)
+      (widget-get widget :tag)
+      (widget-princ-to-string (widget-get widget :value))))
+
+(defun widget-default-active (widget)
+  "Return t iff this widget active (user modifiable)."
+  (and (not (widget-get widget :inactive))
+       (let ((parent (widget-get widget :parent)))
+         (or (null parent) 
+             (widget-apply parent :active)))))
+
+(defun widget-default-deactivate (widget)
+  "Make WIDGET inactive for user modifications."
+  (widget-specify-inactive widget
+                           (widget-get widget :from)
+                           (widget-get widget :to)))
+
+(defun widget-default-action (widget &optional event)
+  ;; Notify the parent when a widget change
+  (let ((parent (widget-get widget :parent)))
+    (when parent
+      (widget-apply parent :notify widget event))))
+
+(defun widget-default-notify (widget child &optional event)
+  ;; Pass notification to parent.
+  (widget-default-action widget event))
+
+;;; The `item' Widget.
+
+(define-widget 'item 'default
+  "Constant items for inclusion in other widgets."
+  :convert-widget 'widget-item-convert-widget
+  :value-create 'widget-item-value-create
+  :value-delete 'ignore
+  :value-get 'widget-item-value-get
+  :match 'widget-item-match
+  :match-inline 'widget-item-match-inline
+  :action 'widget-item-action
+  :format "%t\n")
+
+(defun widget-item-convert-widget (widget)
+  ;; Initialize :value 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 :args nil)))
+  widget)
+
+(defun widget-item-value-create (widget)
+  ;; Insert the printed representation of the value.
+  (let ((standard-output (current-buffer)))
+    (princ (widget-get widget :value))))
+
+(defun widget-item-match (widget value)
+  ;; Match if the value is the same.
+  (equal (widget-get widget :value) value))
+
+(defun widget-item-match-inline (widget values)
+  ;; Match if the value is the same.
+  (let ((value (widget-get widget :value)))
+    (and (listp value)
+         (<= (length value) (length values))
+         (let ((head (subseq values 0 (length value))))
+           (and (equal head value)
+                (cons head (subseq values (length value))))))))
+
+(defun widget-item-action (widget &optional event)
+  ;; Just notify itself.
+  (widget-apply widget :notify widget event))
+
+(defun widget-item-value-get (widget)
+  ;; Items are simple.
+  (widget-get widget :value))
+
+;;; The `push-button' Widget.
+
+(defcustom widget-push-button-gui t
+  "If non nil, use GUI push buttons when available."
+  :group 'widgets
+  :type 'boolean)
+
+;; Cache already created GUI objects.
+(defvar widget-push-button-cache nil)
+
+(define-widget 'push-button 'item
+  "A pushable button."
+  :value-create 'widget-push-button-value-create
+  :format "%[%v%]")
+
+(defun widget-push-button-value-create (widget)
+  ;; Insert text representing the `on' and `off' states.
+  (let* ((tag (or (widget-get widget :tag)
+                  (widget-get widget :value)))
+         (text (concat "[" tag "]"))
+         (gui (cdr (assoc tag widget-push-button-cache))))
+    (if (and (fboundp 'make-gui-button)
+             (fboundp 'make-glyph)
+             widget-push-button-gui
+             (fboundp 'device-on-window-system-p)
+             (device-on-window-system-p)
+             (string-match "XEmacs" emacs-version))
+        (progn 
+          (unless gui
+            (setq gui (make-gui-button tag 'widget-gui-action widget))
+            (push (cons tag gui) widget-push-button-cache))
+          (widget-glyph-insert-glyph widget text
+                                     (make-glyph (car (aref gui 1)))))
+      (insert text))))
+
+(defun widget-gui-action (widget)
+  "Apply :action for WIDGET."
+  (widget-apply-action widget (this-command-keys)))
+
+;;; The `link' Widget.
+
+(define-widget 'link 'item
+  "An embedded link."
+  :help-echo "Follow the link."
+  :format "%[_%t_%]")
+
+;;; The `info-link' Widget.
+
+(define-widget 'info-link 'link
+  "A link to an info file."
+  :action 'widget-info-link-action)
+
+(defun widget-info-link-action (widget &optional event)
+  "Open the info node specified by WIDGET."
+  (Info-goto-node (widget-value widget)))
+
+;;; The `url-link' Widget.
+
+(define-widget 'url-link 'link
+  "A link to an www page."
+  :action 'widget-url-link-action)
+
+(defun widget-url-link-action (widget &optional event)
+  "Open the url specified by WIDGET."
+  (require 'browse-url)
+  (funcall browse-url-browser-function (widget-value widget)))
+
+;;; The `editable-field' Widget.
+
+(define-widget 'editable-field 'default
+  "An editable text field."
+  :convert-widget 'widget-item-convert-widget
+  :keymap widget-field-keymap
+  :format "%v"
+  :value ""
+  :action 'widget-field-action
+  :validate 'widget-field-validate
+  :valid-regexp ""
+  :error "No match"
+  :value-create 'widget-field-value-create
+  :value-delete 'widget-field-value-delete
+  :value-get 'widget-field-value-get
+  :match 'widget-field-match)
+
+;; History of field minibuffer edits.
+(defvar widget-field-history nil)
+
+(defun widget-field-action (widget &optional event)
+  ;; Edit the value in the minibuffer.
+  (let ((tag (widget-apply widget :menu-tag-get))
+        (invalid (widget-apply widget :validate)))
+    (when invalid
+      (error (widget-get invalid :error)))
+    (widget-value-set widget 
+                      (widget-apply widget 
+                                    :value-to-external
+                                    (read-string (concat tag ": ") 
+                                                 (widget-apply 
+                                                  widget
+                                                  :value-to-internal
+                                                  (widget-value widget))
+                                                 'widget-field-history)))
+    (widget-apply widget :notify widget event)
+    (widget-setup)))
+
+(defun widget-field-validate (widget)
+  ;; Valid if the content matches `:valid-regexp'.
+  (save-excursion
+    (let ((value (widget-apply widget :value-get))
+          (regexp (widget-get widget :valid-regexp)))
+      (if (string-match regexp value)
+          nil
+        widget))))
+
+(defun widget-field-value-create (widget)
+  ;; Create an editable text field.
+  (insert " ")
+  (let ((size (widget-get widget :size))
+        (value (widget-get widget :value))
+        (from (point)))
+    (insert value)
+    (and size
+         (< (length value) size)
+         (insert-char ?\  (- size (length value))))
+    (unless (memq widget widget-field-list)
+      (setq widget-field-new (cons widget widget-field-new)))
+    (widget-put widget :value-to (copy-marker (point)))
+    (set-marker-insertion-type (widget-get widget :value-to) nil)
+    (if (null size)
+        (insert ?\n)
+      (insert ?\ ))
+    (widget-put widget :value-from (copy-marker from))
+    (set-marker-insertion-type (widget-get widget :value-from) t)))
+
+(defun widget-field-value-delete (widget)
+  ;; Remove the widget from the list of active editing fields.
+  (setq widget-field-list (delq widget widget-field-list))
+  ;; These are nil if the :format string doesn't contain `%v'.
+  (when (widget-get widget :value-from)
+    (set-marker (widget-get widget :value-from) nil))
+  (when (widget-get widget :value-from)
+    (set-marker (widget-get widget :value-to) nil)))
+
+(defun widget-field-value-get (widget)
+  ;; Return current text in editing field.
+  (let ((from (widget-get widget :value-from))
+        (to (widget-get widget :value-to))
+        (size (widget-get widget :size))
+        (secret (widget-get widget :secret))
+        (old (current-buffer)))
+    (if (and from to)
+        (progn 
+          (set-buffer (marker-buffer from))
+          (setq from (1+ from)
+                to (1- to))
+          (while (and size
+                      (not (zerop size))
+                      (> to from)
+                      (eq (char-after (1- to)) ?\ ))
+            (setq to (1- to)))
+          (let ((result (buffer-substring-no-properties from to)))
+            (when secret
+              (let ((index 0))
+                (while (< (+ from index) to)
+                  (aset result index
+                        (get-text-property (+ from index) 'secret))
+                  (setq index (1+ index)))))
+            (set-buffer old)
+            result))
+      (widget-get widget :value))))
+
+(defun widget-field-match (widget value)
+  ;; Match any string.
+  (stringp value))
+
+;;; The `text' Widget.
+
+(define-widget 'text 'editable-field
+  :keymap widget-text-keymap
+  "A multiline text area.")
+
+;;; The `menu-choice' Widget.
+
+(define-widget 'menu-choice 'default
+  "A menu of options."
+  :convert-widget  'widget-types-convert-widget
+  :format "%[%t%]: %v"
+  :case-fold t
+  :tag "choice"
+  :void '(item :format "invalid (%t)\n")
+  :value-create 'widget-choice-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-choice-value-get
+  :value-inline 'widget-choice-value-inline
+  :action 'widget-choice-action
+  :error "Make a choice"
+  :validate 'widget-choice-validate
+  :match 'widget-choice-match
+  :match-inline 'widget-choice-match-inline)
+
+(defun widget-choice-value-create (widget)
+  ;; Insert the first choice that matches the value.
+  (let ((value (widget-get widget :value))
+        (args (widget-get widget :args))
+        current)
+    (while args
+      (setq current (car args)
+            args (cdr args))
+      (when (widget-apply current :match value)
+        (widget-put widget :children (list (widget-create-child-value
+                                            widget current value)))
+        (widget-put widget :choice current)
+        (setq args nil
+              current nil)))
+    (when current
+      (let ((void (widget-get widget :void)))
+        (widget-put widget :children (list (widget-create-child-and-convert
+                                            widget void :value value)))
+        (widget-put widget :choice void)))))
+
+(defun widget-choice-value-get (widget)
+  ;; Get value of the child widget.
+  (widget-value (car (widget-get widget :children))))
+
+(defun widget-choice-value-inline (widget)
+  ;; Get value of the child widget.
+  (widget-apply (car (widget-get widget :children)) :value-inline))
+
+(defun widget-choice-action (widget &optional event)
+  ;; Make a choice.
+  (let ((args (widget-get widget :args))
+        (old (widget-get widget :choice))
+        (tag (widget-apply widget :menu-tag-get))
+        (completion-ignore-case (widget-get widget :case-fold))
+        current choices)
+    ;; Remember old value.
+    (if (and old (not (widget-apply widget :validate)))
+        (let* ((external (widget-value widget))
+               (internal (widget-apply old :value-to-internal external)))
+          (widget-put old :value internal)))
+    ;; Find new choice.
+    (setq current
+          (cond ((= (length args) 0)
+                 nil)
+                ((= (length args) 1)
+                 (nth 0 args))
+                ((and (= (length args) 2)
+                      (memq old args))
+                 (if (eq old (nth 0 args))
+                     (nth 1 args)
+                   (nth 0 args)))
+                (t
+                 (while args
+                   (setq current (car args)
+                         args (cdr args))
+                   (setq choices
+                         (cons (cons (widget-apply current :menu-tag-get)
+                                     current)
+                               choices)))
+                 (widget-choose tag (reverse choices) event))))
+    (when current
+      (widget-value-set widget 
+                        (widget-apply current :value-to-external
+                                      (widget-get current :value)))
+    (widget-apply widget :notify widget event)
+    (widget-setup)))
+  ;; Notify parent.
+  (widget-apply widget :notify widget event)
+  (widget-clear-undo))
+
+(defun widget-choice-validate (widget)
+  ;; Valid if we have made a valid choice.
+  (let ((void (widget-get widget :void))
+        (choice (widget-get widget :choice))
+        (child (car (widget-get widget :children))))
+    (if (eq void choice)
+        widget
+      (widget-apply child :validate))))
+
+(defun widget-choice-match (widget value)
+  ;; Matches if one of the choices matches.
+  (let ((args (widget-get widget :args))
+        current found)
+    (while (and args (not found))
+      (setq current (car args)
+            args (cdr args)
+            found (widget-apply current :match value)))
+    found))
+
+(defun widget-choice-match-inline (widget values)
+  ;; Matches if one of the choices matches.
+  (let ((args (widget-get widget :args))
+        current found)
+    (while (and args (null found))
+      (setq current (car args)
+            args (cdr args)
+            found (widget-match-inline current values)))
+    found))
+
+;;; The `toggle' Widget.
+
+(define-widget 'toggle 'item
+  "Toggle between two states."
+  :format "%[%v%]\n"
+  :value-create 'widget-toggle-value-create
+  :action 'widget-toggle-action
+  :match (lambda (widget value) t)
+  :on "on"
+  :off "off")
+
+(defun widget-toggle-value-create (widget)
+  ;; Insert text representing the `on' and `off' states.
+  (if (widget-value widget)
+      (widget-glyph-insert widget 
+                           (widget-get widget :on) 
+                           (widget-get widget :on-glyph))
+    (widget-glyph-insert widget
+                         (widget-get widget :off)
+                         (widget-get widget :off-glyph))))
+
+(defun widget-toggle-action (widget &optional event)
+  ;; Toggle value.
+  (widget-value-set widget (not (widget-value widget)))
+  (widget-apply widget :notify widget event))
+  
+;;; The `checkbox' Widget.
+
+(define-widget 'checkbox 'toggle
+  "A checkbox toggle."
+  :format "%[%v%]"
+  :on "[X]"
+  :on-glyph "check1"
+  :off "[ ]"
+  :off-glyph "check0"
+  :action 'widget-checkbox-action)
+
+(defun widget-checkbox-action (widget &optional event)
+  "Toggle checkbox, notify parent, and set active state of sibling."
+  (widget-toggle-action widget event)
+  (let ((sibling (widget-get-sibling widget)))
+    (when sibling
+      (if (widget-value widget)
+          (widget-apply sibling :activate)
+        (widget-apply sibling :deactivate)))))
+
+;;; The `checklist' Widget.
+
+(define-widget 'checklist 'default
+  "A multiple choice widget."
+  :convert-widget 'widget-types-convert-widget
+  :format "%v"
+  :offset 4
+  :entry-format "%b %v"
+  :menu-tag "checklist"
+  :greedy nil
+  :value-create 'widget-checklist-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-checklist-value-get
+  :validate 'widget-checklist-validate
+  :match 'widget-checklist-match
+  :match-inline 'widget-checklist-match-inline)
+
+(defun widget-checklist-value-create (widget)
+  ;; Insert all values
+  (let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
+        (args (widget-get widget :args)))
+    (while args 
+      (widget-checklist-add-item widget (car args) (assq (car args) alist))
+      (setq args (cdr args)))
+    (widget-put widget :children (nreverse (widget-get widget :children)))))
+
+(defun widget-checklist-add-item (widget type chosen)
+  ;; Create checklist item in WIDGET of type TYPE.
+  ;; If the item is checked, CHOSEN is a cons whose cdr is the value.
+  (and (eq (preceding-char) ?\n)
+       (widget-get widget :indent)
+       (insert-char ?  (widget-get widget :indent)))
+  (widget-specify-insert 
+   (let* ((children (widget-get widget :children))
+          (buttons (widget-get widget :buttons))
+          (button-args (or (widget-get type :sibling-args)
+                           (widget-get widget :button-args)))
+          (from (point))
+          child button)
+     (insert (widget-get widget :entry-format))
+     (goto-char from)
+     ;; Parse % escapes in format.
+     (while (re-search-forward "%\\([bv%]\\)" nil t)
+       (let ((escape (aref (match-string 1) 0)))
+         (replace-match "" t t)
+         (cond ((eq escape ?%)
+                (insert "%"))
+               ((eq escape ?b)
+                (setq button (apply 'widget-create-child-and-convert
+                                    widget 'checkbox
+                                    :value (not (null chosen))
+                                    button-args)))
+               ((eq escape ?v)
+                (setq child
+                      (cond ((not chosen)
+                             (let ((child (widget-create-child widget type)))
+                               (widget-apply child :deactivate)
+                               child))
+                            ((widget-get type :inline)
+                             (widget-create-child-value
+                              widget type (cdr chosen)))
+                            (t
+                             (widget-create-child-value
+                              widget type (car (cdr chosen)))))))
+               (t 
+                (error "Unknown escape `%c'" escape)))))
+     ;; Update properties.
+     (and button child (widget-put child :button button))
+     (and button (widget-put widget :buttons (cons button buttons)))
+     (and child (widget-put widget :children (cons child children))))))
+
+(defun widget-checklist-match (widget values)
+  ;; All values must match a type in the checklist.
+  (and (listp values)
+       (null (cdr (widget-checklist-match-inline widget values)))))
+
+(defun widget-checklist-match-inline (widget values)
+  ;; Find the values which match a type in the checklist.
+  (let ((greedy (widget-get widget :greedy))
+        (args (copy-list (widget-get widget :args)))
+        found rest)
+    (while values
+      (let ((answer (widget-checklist-match-up args values)))
+        (cond (answer 
+               (let ((vals (widget-match-inline answer values)))
+                 (setq found (append found (car vals))
+                       values (cdr vals)
+                       args (delq answer args))))
+              (greedy
+               (setq rest (append rest (list (car values)))
+                     values (cdr values)))
+              (t 
+               (setq rest (append rest values)
+                     values nil)))))
+    (cons found rest)))
+
+(defun widget-checklist-match-find (widget vals)
+  ;; Find the vals which match a type in the checklist.
+  ;; Return an alist of (TYPE MATCH).
+  (let ((greedy (widget-get widget :greedy))
+        (args (copy-list (widget-get widget :args)))
+        found)
+    (while vals
+      (let ((answer (widget-checklist-match-up args vals)))
+        (cond (answer 
+               (let ((match (widget-match-inline answer vals)))
+                 (setq found (cons (cons answer (car match)) found)
+                       vals (cdr match)
+                       args (delq answer args))))
+              (greedy
+               (setq vals (cdr vals)))
+              (t 
+               (setq vals nil)))))
+    found))
+
+(defun widget-checklist-match-up (args vals)
+  ;; Rerturn the first type from ARGS that matches VALS.
+  (let (current found)
+    (while (and args (null found))
+      (setq current (car args)
+            args (cdr args)
+            found (widget-match-inline current vals)))
+    (if found
+        current
+      nil)))
+
+(defun widget-checklist-value-get (widget)
+  ;; The values of all selected items.
+  (let ((children (widget-get widget :children))
+        child result)
+    (while children 
+      (setq child (car children)
+            children (cdr children))
+      (if (widget-value (widget-get child :button))
+          (setq result (append result (widget-apply child :value-inline)))))
+    result))
+
+(defun widget-checklist-validate (widget)
+  ;; Ticked chilren must be valid.
+  (let ((children (widget-get widget :children))
+        child button found)
+    (while (and children (not found))
+      (setq child (car children)
+            children (cdr children)
+            button (widget-get child :button)
+            found (and (widget-value button)
+                       (widget-apply child :validate))))
+    found))
+
+;;; The `option' Widget
+
+(define-widget 'option 'checklist
+  "An widget with an optional item."
+  :inline t)
+
+;;; The `choice-item' Widget.
+
+(define-widget 'choice-item 'item
+  "Button items that delegate action events to their parents."
+  :action 'widget-choice-item-action
+  :format "%[%t%] \n")
+
+(defun widget-choice-item-action (widget &optional event)
+  ;; Tell parent what happened.
+  (widget-apply (widget-get widget :parent) :action event))
+
+;;; The `radio-button' Widget.
+
+(define-widget 'radio-button 'toggle
+  "A radio button for use in the `radio' widget."
+  :notify 'widget-radio-button-notify
+  :format "%[%v%]"
+  :on "(*)"
+  :on-glyph "radio1"
+  :off "( )"
+  :off-glyph "radio0")
+
+(defun widget-radio-button-notify (widget child &optional event)
+  ;; Tell daddy.
+  (widget-apply (widget-get widget :parent) :action widget event))
+
+;;; The `radio-button-choice' Widget.
+
+(define-widget 'radio-button-choice 'default
+  "Select one of multiple options."
+  :convert-widget 'widget-types-convert-widget
+  :offset 4
+  :format "%v"
+  :entry-format "%b %v"
+  :menu-tag "radio"
+  :value-create 'widget-radio-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-radio-value-get
+  :value-inline 'widget-radio-value-inline
+  :value-set 'widget-radio-value-set
+  :error "You must push one of the buttons"
+  :validate 'widget-radio-validate
+  :match 'widget-choice-match
+  :match-inline 'widget-choice-match-inline
+  :action 'widget-radio-action)
+
+(defun widget-radio-value-create (widget)
+  ;; Insert all values
+  (let ((args (widget-get widget :args))
+        arg)
+    (while args 
+      (setq arg (car args)
+            args (cdr args))
+      (widget-radio-add-item widget arg))))
+
+(defun widget-radio-add-item (widget type)
+  "Add to radio widget WIDGET a new radio button item of type TYPE."
+  ;; (setq type (widget-convert type))
+  (and (eq (preceding-char) ?\n)
+       (widget-get widget :indent)
+       (insert-char ?  (widget-get widget :indent)))
+  (widget-specify-insert 
+   (let* ((value (widget-get widget :value))
+          (children (widget-get widget :children))
+          (buttons (widget-get widget :buttons))
+          (button-args (or (widget-get type :sibling-args)
+                           (widget-get widget :button-args)))
+          (from (point))
+          (chosen (and (null (widget-get widget :choice))
+                       (widget-apply type :match value)))
+          child button)
+     (insert (widget-get widget :entry-format))
+     (goto-char from)
+     ;; Parse % escapes in format.
+     (while (re-search-forward "%\\([bv%]\\)" nil t)
+       (let ((escape (aref (match-string 1) 0)))
+         (replace-match "" t t)
+         (cond ((eq escape ?%)
+                (insert "%"))
+               ((eq escape ?b)
+                (setq button (apply 'widget-create-child-and-convert
+                                    widget 'radio-button 
+                                    :value (not (null chosen))
+                                    button-args)))
+               ((eq escape ?v)
+                (setq child (if chosen
+                                (widget-create-child-value
+                                 widget type value)
+                              (widget-create-child widget type)))
+                (unless chosen 
+                  (widget-apply child :deactivate)))
+               (t 
+                (error "Unknown escape `%c'" escape)))))
+     ;; Update properties.
+     (when chosen
+       (widget-put widget :choice type))
+     (when button 
+       (widget-put child :button button)
+       (widget-put widget :buttons (nconc buttons (list button))))
+     (when child
+       (widget-put widget :children (nconc children (list child))))
+     child)))
+
+(defun widget-radio-value-get (widget)
+  ;; Get value of the child widget.
+  (let ((chosen (widget-radio-chosen widget)))
+    (and chosen (widget-value chosen))))
+
+(defun widget-radio-chosen (widget)
+  "Return the widget representing the chosen radio button."
+  (let ((children (widget-get widget :children))
+        current found)
+    (while children
+      (setq current (car children)
+            children (cdr children))
+      (let* ((button (widget-get current :button))
+             (value (widget-apply button :value-get)))
+        (when value
+          (setq found current
+                children nil))))
+    found))
+
+(defun widget-radio-value-inline (widget)
+  ;; Get value of the child widget.
+  (let ((children (widget-get widget :children))
+        current found)
+    (while children
+      (setq current (car children)
+            children (cdr children))
+      (let* ((button (widget-get current :button))
+             (value (widget-apply button :value-get)))
+        (when value
+          (setq found (widget-apply current :value-inline)
+                children nil))))
+    found))
+
+(defun widget-radio-value-set (widget value)
+  ;; We can't just delete and recreate a radio widget, since children
+  ;; can be added after the original creation and won't be recreated
+  ;; by `:create'.
+  (let ((children (widget-get widget :children))
+        current found)
+    (while children
+      (setq current (car children)
+            children (cdr children))
+      (let* ((button (widget-get current :button))
+             (match (and (not found)
+                         (widget-apply current :match value))))
+        (widget-value-set button match)
+        (if match 
+            (progn 
+              (widget-value-set current value)
+              (widget-apply current :activate))
+          (widget-apply current :deactivate))
+        (setq found (or found match))))))
+
+(defun widget-radio-validate (widget)
+  ;; Valid if we have made a valid choice.
+  (let ((children (widget-get widget :children))
+        current found button)
+    (while (and children (not found))
+      (setq current (car children)
+            children (cdr children)
+            button (widget-get current :button)
+            found (widget-apply button :value-get)))
+    (if found
+        (widget-apply current :validate)
+      widget)))
+
+(defun widget-radio-action (widget child event)
+  ;; Check if a radio button was pressed.
+  (let ((children (widget-get widget :children))
+        (buttons (widget-get widget :buttons))
+        current)
+    (when (memq child buttons)
+      (while children
+        (setq current (car children)
+              children (cdr children))
+        (let* ((button (widget-get current :button)))
+          (cond ((eq child button)
+                 (widget-value-set button t)
+                 (widget-apply current :activate))
+                ((widget-value button)
+                 (widget-value-set button nil)
+                 (widget-apply current :deactivate)))))))
+  ;; Pass notification to parent.
+  (widget-apply widget :notify child event))
+
+;;; The `insert-button' Widget.
+
+(define-widget 'insert-button 'push-button
+  "An insert button for the `editable-list' widget."
+  :tag "INS"
+  :help-echo "Insert a new item into the list at this position."
+  :action 'widget-insert-button-action)
+
+(defun widget-insert-button-action (widget &optional event)
+  ;; Ask the parent to insert a new item.
+  (widget-apply (widget-get widget :parent) 
+                :insert-before (widget-get widget :widget)))
+
+;;; The `delete-button' Widget.
+
+(define-widget 'delete-button 'push-button
+  "A delete button for the `editable-list' widget."
+  :tag "DEL"
+  :help-echo "Delete this item from the list."
+  :action 'widget-delete-button-action)
+
+(defun widget-delete-button-action (widget &optional event)
+  ;; Ask the parent to insert a new item.
+  (widget-apply (widget-get widget :parent) 
+                :delete-at (widget-get widget :widget)))
+
+;;; The `editable-list' Widget.
+
+(defcustom widget-editable-list-gui nil
+  "If non nil, use GUI push-buttons in editable list when available."
+  :type 'boolean
+  :group 'widgets)
+
+(define-widget 'editable-list 'default
+  "A variable list of widgets of the same type."
+  :convert-widget 'widget-types-convert-widget
+  :offset 12
+  :format "%v%i\n"
+  :format-handler 'widget-editable-list-format-handler
+  :entry-format "%i %d %v"
+  :menu-tag "editable-list"
+  :value-create 'widget-editable-list-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-editable-list-value-get
+  :validate 'widget-editable-list-validate
+  :match 'widget-editable-list-match
+  :match-inline 'widget-editable-list-match-inline
+  :insert-before 'widget-editable-list-insert-before
+  :delete-at 'widget-editable-list-delete-at)
+
+(defun widget-editable-list-format-handler (widget escape)
+  ;; We recognize the insert button.
+  (let ((widget-push-button-gui widget-editable-list-gui))
+    (cond ((eq escape ?i)
+           (and (widget-get widget :indent)
+                (insert-char ?  (widget-get widget :indent)))
+           (apply 'widget-create-child-and-convert 
+                  widget 'insert-button
+                  (widget-get widget :append-button-args)))
+          (t 
+           (widget-default-format-handler widget escape)))))
+
+(defun widget-editable-list-value-create (widget)
+  ;; Insert all values
+  (let* ((value (widget-get widget :value))
+         (type (nth 0 (widget-get widget :args)))
+         (inlinep (widget-get type :inline))
+         children)
+    (widget-put widget :value-pos (copy-marker (point)))
+    (set-marker-insertion-type (widget-get widget :value-pos) t)
+    (while value
+      (let ((answer (widget-match-inline type value)))
+        (if answer
+            (setq children (cons (widget-editable-list-entry-create
+                                  widget
+                                  (if inlinep
+                                      (car answer)
+                                    (car (car answer)))
+                                  t)
+                                 children)
+                  value (cdr answer))
+          (setq value nil))))
+    (widget-put widget :children (nreverse children))))
+
+(defun widget-editable-list-value-get (widget)
+  ;; Get value of the child widget.
+  (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline))
+                         (widget-get widget :children))))
+
+(defun widget-editable-list-validate (widget)
+  ;; All the chilren must be valid.
+  (let ((children (widget-get widget :children))
+        child found)
+    (while (and children (not found))
+      (setq child (car children)
+            children (cdr children)
+            found (widget-apply child :validate)))
+    found))
+
+(defun widget-editable-list-match (widget value)
+  ;; Value must be a list and all the members must match the type.
+  (and (listp value)
+       (null (cdr (widget-editable-list-match-inline widget value)))))
+
+(defun widget-editable-list-match-inline (widget value)
+  (let ((type (nth 0 (widget-get widget :args)))
+        (ok t)
+        found)
+    (while (and value ok)
+      (let ((answer (widget-match-inline type value)))
+        (if answer 
+            (setq found (append found (car answer))
+                  value (cdr answer))
+          (setq ok nil))))
+    (cons found value)))
+
+(defun widget-editable-list-insert-before (widget before)
+  ;; Insert a new child in the list of children.
+  (save-excursion
+    (let ((children (widget-get widget :children))
+          (inhibit-read-only t)
+          after-change-functions)
+      (cond (before 
+             (goto-char (widget-get before :entry-from)))
+            (t
+             (goto-char (widget-get widget :value-pos))))
+      (let ((child (widget-editable-list-entry-create 
+                    widget nil nil)))
+        (when (< (widget-get child :entry-from) (widget-get widget :from))
+          (set-marker (widget-get widget :from)
+                      (widget-get child :entry-from)))
+        (widget-specify-text (widget-get child :entry-from)
+                             (widget-get child :entry-to))
+        (if (eq (car children) before)
+            (widget-put widget :children (cons child children))
+          (while (not (eq (car (cdr children)) before))
+            (setq children (cdr children)))
+          (setcdr children (cons child (cdr children)))))))
+  (widget-setup)
+ widget (widget-apply widget :notify widget))
+
+(defun widget-editable-list-delete-at (widget child)
+  ;; Delete child from list of children.
+  (save-excursion
+    (let ((buttons (copy-list (widget-get widget :buttons)))
+          button
+          (inhibit-read-only t)
+          after-change-functions)
+      (while buttons
+        (setq button (car buttons)
+              buttons (cdr buttons))
+        (when (eq (widget-get button :widget) child)
+          (widget-put widget
+                      :buttons (delq button (widget-get widget :buttons)))
+          (widget-delete button))))
+    (let ((entry-from (widget-get child :entry-from))
+          (entry-to (widget-get child :entry-to))
+          (inhibit-read-only t)
+          after-change-functions)
+      (widget-delete child)
+      (delete-region entry-from entry-to)
+      (set-marker entry-from nil)
+      (set-marker entry-to nil))
+    (widget-put widget :children (delq child (widget-get widget :children))))
+  (widget-setup)
+  (widget-apply widget :notify widget))
+
+(defun widget-editable-list-entry-create (widget value conv)
+  ;; Create a new entry to the list.
+  (let ((type (nth 0 (widget-get widget :args)))
+        (widget-push-button-gui widget-editable-list-gui)
+        child delete insert)
+    (widget-specify-insert 
+     (save-excursion
+       (and (widget-get widget :indent)
+            (insert-char ?  (widget-get widget :indent)))
+       (insert (widget-get widget :entry-format)))
+     ;; Parse % escapes in format.
+     (while (re-search-forward "%\\(.\\)" nil t)
+       (let ((escape (aref (match-string 1) 0)))
+         (replace-match "" t t)
+         (cond ((eq escape ?%)
+                (insert "%"))
+               ((eq escape ?i)
+                (setq insert (apply 'widget-create-child-and-convert
+                                    widget 'insert-button
+                                    (widget-get widget :insert-button-args))))
+               ((eq escape ?d)
+                (setq delete (apply 'widget-create-child-and-convert
+                                    widget 'delete-button
+                                    (widget-get widget :delete-button-args))))
+               ((eq escape ?v)
+                (if conv
+                    (setq child (widget-create-child-value 
+                                 widget type value))
+                  (setq child (widget-create-child widget type))))
+               (t 
+                (error "Unknown escape `%c'" escape)))))
+     (widget-put widget 
+                 :buttons (cons delete 
+                                (cons insert
+                                      (widget-get widget :buttons))))
+     (let ((entry-from (copy-marker (point-min)))
+           (entry-to (copy-marker (point-max))))
+       (widget-specify-text entry-from entry-to)
+       (set-marker-insertion-type entry-from t)
+       (set-marker-insertion-type entry-to nil)
+       (widget-put child :entry-from entry-from)
+       (widget-put child :entry-to entry-to)))
+    (widget-put insert :widget child)
+    (widget-put delete :widget child)
+    child))
+
+;;; The `group' Widget.
+
+(define-widget 'group 'default
+  "A widget which group other widgets inside."
+  :convert-widget 'widget-types-convert-widget
+  :format "%v"
+  :value-create 'widget-group-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-editable-list-value-get
+  :validate 'widget-editable-list-validate
+  :match 'widget-group-match
+  :match-inline 'widget-group-match-inline)
+
+(defun widget-group-value-create (widget)
+  ;; Create each component.
+  (let ((args (widget-get widget :args))
+        (value (widget-get widget :value))
+        arg answer children)
+    (while args
+      (setq arg (car args)
+            args (cdr args)
+            answer (widget-match-inline arg value)
+            value (cdr answer))
+      (and (eq (preceding-char) ?\n)
+           (widget-get widget :indent)
+           (insert-char ?  (widget-get widget :indent)))
+      (push (cond ((null answer)
+                   (widget-create-child widget arg))
+                  ((widget-get arg :inline)
+                   (widget-create-child-value widget arg  (car answer)))
+                  (t
+                   (widget-create-child-value widget arg  (car (car answer)))))
+            children))
+    (widget-put widget :children (nreverse children))))
+
+(defun widget-group-match (widget values)
+  ;; Match if the components match.
+  (and (listp values)
+       (let ((match (widget-group-match-inline widget values)))
+         (and match (null (cdr match))))))
+
+(defun widget-group-match-inline (widget vals)
+  ;; Match if the components match.
+  (let ((args (widget-get widget :args))
+        argument answer found)
+    (while args
+      (setq argument (car args)
+            args (cdr args)
+            answer (widget-match-inline argument vals))
+      (if answer 
+          (setq vals (cdr answer)
+                found (append found (car answer)))
+        (setq vals nil
+              args nil)))
+    (if answer
+        (cons found vals)
+      nil)))
+
+;;; The `widget-help' Widget.
+
+(define-widget 'widget-help 'push-button
+  "The widget documentation button."
+  :format "%[[%t]%] %d"
+  :help-echo "Toggle display of documentation."
+  :action 'widget-help-action)
+
+(defun widget-help-action (widget &optional event)
+  "Toggle documentation for WIDGET."
+  (let ((old (widget-get widget :doc))
+        (new (widget-get widget :widget-doc)))
+    (widget-put widget :doc new)
+    (widget-put widget :widget-doc old))
+  (widget-value-set widget (widget-value widget)))
+
+;;; The Sexp Widgets.
+
+(define-widget 'const 'item
+  "An immutable sexp."
+  :format "%t\n%d")
+
+(define-widget 'function-item 'item
+  "An immutable function name."
+  :format "%v\n%h"
+  :documentation-property (lambda (symbol)
+                            (condition-case nil
+                                (documentation symbol t)
+                              (error nil))))
+
+(define-widget 'variable-item 'item
+  "An immutable variable name."
+  :format "%v\n%h"
+  :documentation-property 'variable-documentation)
+
+(define-widget 'string 'editable-field
+  "A string"
+  :tag "String"
+  :format "%[%t%]: %v")
+
+(define-widget 'regexp 'string
+  "A regular expression."
+  ;; Should do validation.
+  :tag "Regexp")
+
+(define-widget 'file 'string
+  "A file widget.  
+It will read a file name from the minibuffer when activated."
+  :format "%[%t%]: %v"
+  :tag "File"
+  :action 'widget-file-action)
+
+(defun widget-file-action (widget &optional event)
+  ;; Read a file name from the minibuffer.
+  (let* ((value (widget-value widget))
+         (dir (file-name-directory value))
+         (file (file-name-nondirectory value))
+         (menu-tag (widget-apply widget :menu-tag-get))
+         (must-match (widget-get widget :must-match))
+         (answer (read-file-name (concat menu-tag ": (default `" value "') ")
+                                 dir nil must-match file)))
+    (widget-value-set widget (abbreviate-file-name answer))
+    (widget-apply widget :notify widget event)
+    (widget-setup)))
+
+(define-widget 'directory 'file
+  "A directory widget.  
+It will read a directory name from the minibuffer when activated."
+  :tag "Directory")
+
+(define-widget 'symbol 'string
+  "A lisp symbol."
+  :value nil
+  :tag "Symbol"
+  :match (lambda (widget value) (symbolp value))
+  :value-to-internal (lambda (widget value)
+                       (if (symbolp value)
+                           (symbol-name value)
+                         value))
+  :value-to-external (lambda (widget value)
+                       (if (stringp value)
+                           (intern value)
+                         value)))
+
+(define-widget 'function 'sexp
+  ;; Should complete on functions.
+  "A lisp function."
+  :tag "Function")
+
+(define-widget 'variable 'symbol
+  ;; Should complete on variables.
+  "A lisp variable."
+  :tag "Variable")
+
+(define-widget 'sexp 'string
+  "An arbitrary lisp expression."
+  :tag "Lisp expression"
+  :value nil
+  :validate 'widget-sexp-validate
+  :match (lambda (widget value) t)
+  :value-to-internal 'widget-sexp-value-to-internal
+  :value-to-external (lambda (widget value) (read value)))
+
+(defun widget-sexp-value-to-internal (widget value)
+  ;; Use pp for printer representation.
+  (let ((pp (pp-to-string value)))
+    (while (string-match "\n\\'" pp)
+      (setq pp (substring pp 0 -1)))
+    (if (or (string-match "\n\\'" pp)
+            (> (length pp) 40))
+        (concat "\n" pp)
+      pp)))
+
+(defun widget-sexp-validate (widget)
+  ;; Valid if we can read the string and there is no junk left after it.
+  (save-excursion
+    (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*"))))
+      (erase-buffer)
+      (insert (widget-apply widget :value-get))
+      (goto-char (point-min))
+      (condition-case data
+          (let ((value (read buffer)))
+            (if (eobp)
+                (if (widget-apply widget :match value)
+                    nil
+                  (widget-put widget :error (widget-get widget :type-error))
+                  widget)
+              (widget-put widget
+                          :error (format "Junk at end of expression: %s"
+                                         (buffer-substring (point)
+                                                           (point-max))))
+              widget))
+        (error (widget-put widget :error (error-message-string data))
+               widget)))))
+
+(define-widget 'integer 'sexp
+  "An integer."
+  :tag "Integer"
+  :value 0
+  :type-error "This field should contain an integer"
+  :value-to-internal (lambda (widget value)
+                       (if (integerp value) 
+                           (prin1-to-string value)
+                         value))
+  :match (lambda (widget value) (integerp value)))
+
+(define-widget 'character 'string
+  "An character."
+  :tag "Character"
+  :value 0
+  :size 1 
+  :format "%{%t%}: %v\n"
+  :type-error "This field should contain a character"
+  :value-to-internal (lambda (widget value)
+                       (if (integerp value) 
+                           (char-to-string value)
+                         value))
+  :value-to-external (lambda (widget value)
+                       (if (stringp value)
+                           (aref value 0)
+                         value))
+  :match (lambda (widget value) (integerp value)))
+
+(define-widget 'number 'sexp
+  "A floating point number."
+  :tag "Number"
+  :value 0.0
+  :type-error "This field should contain a number"
+  :value-to-internal (lambda (widget value)
+                       (if (numberp value)
+                           (prin1-to-string value)
+                         value))
+  :match (lambda (widget value) (numberp value)))
+
+(define-widget 'list 'group
+  "A lisp list."
+  :tag "List"
+  :format "%{%t%}:\n%v")
+
+(define-widget 'vector 'group
+  "A lisp vector."
+  :tag "Vector"
+  :format "%{%t%}:\n%v"
+  :match 'widget-vector-match
+  :value-to-internal (lambda (widget value) (append value nil))
+  :value-to-external (lambda (widget value) (apply 'vector value)))
+
+(defun widget-vector-match (widget value) 
+  (and (vectorp value)
+       (widget-group-match widget
+                           (widget-apply :value-to-internal widget value))))
+
+(define-widget 'cons 'group
+  "A cons-cell."
+  :tag "Cons-cell"
+  :format "%{%t%}:\n%v"
+  :match 'widget-cons-match
+  :value-to-internal (lambda (widget value)
+                       (list (car value) (cdr value)))
+  :value-to-external (lambda (widget value)
+                       (cons (nth 0 value) (nth 1 value))))
+
+(defun widget-cons-match (widget value) 
+  (and (consp value)
+       (widget-group-match widget
+                           (widget-apply widget :value-to-internal value))))
+
+(define-widget 'choice 'menu-choice
+  "A union of several sexp types."
+  :tag "Choice"
+  :format "%[%t%]: %v")
+
+(define-widget 'radio 'radio-button-choice
+  "A union of several sexp types."
+  :tag "Choice"
+  :format "%{%t%}:\n%v")
+
+(define-widget 'repeat 'editable-list
+  "A variable length homogeneous list."
+  :tag "Repeat"
+  :format "%{%t%}:\n%v%i\n")
+
+(define-widget 'set 'checklist
+  "A list of members from a fixed set."
+  :tag "Set"
+  :format "%{%t%}:\n%v")
+
+(define-widget 'boolean 'toggle
+  "To be nil or non-nil, that is the question."
+  :tag "Boolean"
+  :format "%{%t%}: %[%v%]\n")
+
+;;; The `color' Widget.
+
+(define-widget 'color-item 'choice-item
+  "A color name (with sample)."
+  :format "%v (%{sample%})\n"
+  :sample-face-get 'widget-color-item-button-face-get)
+
+(defun widget-color-item-button-face-get (widget)
+  ;; We create a face from the value.
+  (require 'facemenu)
+  (condition-case nil
+      (facemenu-get-face (intern (concat "fg:" (widget-value widget))))
+    (error 'default)))
+
+(define-widget 'color 'push-button
+  "Choose a color name (with sample)."
+  :format "%[%t%]: %v"
+  :tag "Color"
+  :value "black"
+  :value-create 'widget-color-value-create
+  :value-delete 'widget-children-value-delete
+  :value-get 'widget-color-value-get
+  :value-set 'widget-color-value-set
+  :action 'widget-color-action
+  :match 'widget-field-match
+  :tag "Color")
+
+(defvar widget-color-choice-list nil)
+;; Variable holding the possible colors.
+
+(defun widget-color-choice-list ()
+  (unless widget-color-choice-list
+    (setq widget-color-choice-list 
+          (mapcar '(lambda (color) (list color))
+                  (x-defined-colors))))
+  widget-color-choice-list)
+
+(defun widget-color-value-create (widget)
+  (let ((child (widget-create-child-and-convert
+                widget 'color-item (widget-get widget :value))))
+    (widget-put widget :children (list child))))
+
+(defun widget-color-value-get (widget)
+  ;; Pass command to first child.
+  (widget-apply (car (widget-get widget :children)) :value-get))
+
+(defun widget-color-value-set (widget value)
+  ;; Pass command to first child.
+  (widget-apply (car (widget-get widget :children)) :value-set value))
+
+(defvar widget-color-history nil
+  "History of entered colors")
+
+(defun widget-color-action (widget &optional event)
+  ;; Prompt for a color.
+  (let* ((tag (widget-apply widget :menu-tag-get))
+         (prompt (concat tag ": "))
+         (answer (cond ((string-match "XEmacs" emacs-version)
+                        (read-color prompt))
+                       ((fboundp 'x-defined-colors)
+                        (completing-read (concat tag ": ")
+                                         (widget-color-choice-list) 
+                                         nil nil nil 'widget-color-history))
+                       (t
+                        (read-string prompt (widget-value widget))))))
+    (unless (zerop (length answer))
+      (widget-value-set widget answer)
+      (widget-apply widget :notify widget event)
+      (widget-setup))))
+
+;;; The Help Echo
+
+(defun widget-echo-help-mouse ()
+  "Display the help message for the widget under the mouse.
+Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)"
+  (let* ((pos (mouse-position))
+         (frame (car pos))
+         (x (car (cdr pos)))
+         (y (cdr (cdr pos)))
+         (win (window-at x y frame))
+         (where (coordinates-in-window-p (cons x y) win)))
+    (when (consp where)
+      (save-window-excursion
+        (progn ; save-excursion
+          (select-window win)
+          (let* ((result (compute-motion (window-start win)
+                                         '(0 . 0)
+                                         (window-end win)
+                                         where
+                                         (window-width win)
+                                         (cons (window-hscroll) 0)
+                                         win)))
+            (when (and (eq (nth 1 result) x)
+                       (eq (nth 2 result) y))
+              (widget-echo-help (nth 0 result))))))))
+  (unless track-mouse
+    (setq track-mouse t)
+    (add-hook 'post-command-hook 'widget-stop-mouse-tracking)))
+
+(defun widget-stop-mouse-tracking (&rest args)
+  "Stop the mouse tracking done while idle."
+  (remove-hook 'post-command-hook 'widget-stop-mouse-tracking)
+  (setq track-mouse nil))
+
+(defun widget-at (pos)
+  "The button or field at POS."
+  (or (get-text-property pos 'button)
+      (get-text-property pos 'field)))
+
+(defun widget-echo-help (pos)
+  "Display the help echo for widget at POS."
+  (let* ((widget (widget-at pos))
+         (help-echo (and widget (widget-get widget :help-echo))))
+    (cond ((stringp help-echo)
+           (message "%s" help-echo))
+          ((and (symbolp help-echo) (fboundp help-echo)
+                (stringp (setq help-echo (funcall help-echo widget))))
+           (message "%s" help-echo)))))
+
+;;; The End:
+
+(provide 'wid-edit)
+
+;; wid-edit.el ends here
diff --git a/lisp/widget.el b/lisp/widget.el
new file mode 100644
index 00000000000..4e1f2ca804c
--- /dev/null
+++ b/lisp/widget.el
@@ -0,0 +1,76 @@
+;;; widget.el --- a library of user interface components.
+;;
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: help, extensions, faces, hypermedia
+;; Version: 1.71
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; If you want to use this code, please visit the URL above.
+;;
+;; This file only contain the code needed to define new widget types.
+;; Everything else is autoloaded from `wid-edit.el'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defmacro define-widget-keywords (&rest keys)
+  (`
+   (eval-and-compile
+     (let ((keywords (quote (, keys))))
+       (while keywords
+         (or (boundp (car keywords))
+             (set (car keywords) (car keywords)))
+         (setq keywords (cdr keywords)))))))
+
+(define-widget-keywords :deactivate :active :inactive :activate
+  :sibling-args :delete-button-args
+  :insert-button-args :append-button-args :button-args 
+  :tag-glyph :off-glyph :on-glyph :valid-regexp
+  :secret :sample-face :sample-face-get :case-fold :widget-doc 
+  :create :convert-widget :format :value-create :offset :extra-offset
+  :tag :doc :from :to :args :value :value-from :value-to :action
+  :value-set :value-delete :match :parent :delete :menu-tag-get
+  :value-get :choice :void :menu-tag :on :off :on-type :off-type
+  :notify :entry-format :button :children :buttons :insert-before
+  :delete-at :format-handler :widget :value-pos :value-to-internal
+  :indent :size :value-to-external :validate :error :directory
+  :must-match :type-error :value-inline :inline :match-inline :greedy
+  :button-face-get :button-face :value-face :keymap :entry-from
+  :entry-to :help-echo :documentation-property :hide-front-space
+  :hide-rear-space :tab-order) 
+
+;; These autoloads should be deleted when the file is added to Emacs.
+(unless (fboundp 'load-gc)
+  (autoload 'widget-apply "wid-edit")
+  (autoload 'widget-create "wid-edit")
+  (autoload 'widget-insert "wid-edit")
+  (autoload 'widget-browse "wid-browse" nil t)
+  (autoload 'widget-browse-at "wid-browse" nil t))
+
+(defun define-widget (name class doc &rest args)
+  "Define a new widget type named NAME from CLASS.
+
+NAME and CLASS should both be symbols, CLASS should be one of the
+existing widget types, or nil to create the widget from scratch.
+
+After the new widget has been defined, the following two calls will
+create identical widgets:
+
+* (widget-create NAME)
+
+* (apply 'widget-create CLASS ARGS)
+
+The third argument DOC is a documentation string for the widget."
+  (put name 'widget-type (cons class args))
+  (put name 'widget-documentation doc))
+
+;;; The End.
+
+(provide 'widget)
+
+;; widget.el ends here