changeset 106:8ff55ebd4be9 r20-1b5

Import from CVS: tag r20-1b5
author cvs
date Mon, 13 Aug 2007 09:17:26 +0200
parents e59cf502fb45
children 523141596bda
files CHANGES-beta ChangeLog lisp/ChangeLog lisp/custom/ChangeLog lisp/custom/cus-edit.el lisp/custom/cus-face.el lisp/custom/custom-edit.el lisp/custom/custom-xmas.el lisp/custom/custom.el lisp/custom/wid-browse.el lisp/custom/wid-edit.el lisp/custom/widget-browse.el lisp/custom/widget-edit.el lisp/custom/widget-example.el lisp/custom/widget.el lisp/gnus/gnus-cus.el lisp/gnus/gnus-load.el lisp/gnus/gnus-sum.el lisp/prim/auto-autoloads.el lisp/prim/faces.el lisp/prim/loadup.el lisp/tm/gnus-mime.el lisp/version.el lisp/x11/x-faces.el man/custom.texi man/widget.texi src/ChangeLog src/Makefile.in.in
diffstat 28 files changed, 5155 insertions(+), 4867 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGES-beta	Mon Aug 13 09:16:54 2007 +0200
+++ b/CHANGES-beta	Mon Aug 13 09:17:26 2007 +0200
@@ -1,4 +1,8 @@
 							-*- indented-text -*-
+to 20.1 beta5
+-- bug fix to gnus-mime.el
+-- custom-1.50
+
 to 20.1 beta4
 -- mine.el (almost) fully ported to XEmacs
 -- time.el updated for XEmacs Courtesy of Jens Lautenbacher
--- a/ChangeLog	Mon Aug 13 09:16:54 2007 +0200
+++ b/ChangeLog	Mon Aug 13 09:17:26 2007 +0200
@@ -1,3 +1,7 @@
+Mon Mar  3 23:57:56 1997  Steven L Baur  <steve@altair.xemacs.org>
+
+	* XEmacs 20.1-b5 is released.
+
 Mon Mar  3 18:09:17 1997  Steven L Baur  <steve@altair.xemacs.org>
 
 	* XEmacs 20.1-b4 is released.
--- a/lisp/ChangeLog	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/ChangeLog	Mon Aug 13 09:17:26 2007 +0200
@@ -1,5 +1,7 @@
 Mon Mar  3 14:45:16 1997  Steven L Baur  <steve@altair.xemacs.org>
 
+	* prim/loadup.el: Remove custom.elc.
+
 	* prim/simple.el (newline): Attempt to not add newline to a
 	previous end-open extent.
 
--- a/lisp/custom/ChangeLog	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/custom/ChangeLog	Mon Aug 13 09:17:26 2007 +0200
@@ -1,3 +1,80 @@
+Mon Mar 03 18:29:27 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* Version 1.50 released.
+
+Mon Mar  3 15:01:25 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* cus-face.el (face-documentation): Renamed from
+	`get-face-documentation'. 
+	(custom-declare-face): Change caller.
+	* cus-edit.el (custom-face): Ditto.
+
+	* cus-face.el (make-empty-face): New function.
+	(initialize-face-resources): New option.
+	(initialize-face-resources): New function.
+	(custom-declare-face): Call them here.
+	(custom-face-display-set): Don't create face here.
+	(custom-set-faces): Clear face.
+	* cus-edit.el (custom-face-set): Ditto.
+	(custom-face-save): Ditto.
+	(custom-face-reset-saved): Ditto.
+	(custom-face-reset-factory): Ditto.
+
+Mon Mar 03 10:36:40 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* Version 1.49 released.
+
+Mon Mar  3 10:34:44 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* cus-face.el (custom-background-mode): Don't call
+	`x-color-values' on Emacs tty frame.
+	Patch by Katsumi Yamaoka <yamaoka@ga.sony.co.jp>.
+
+Sat Mar  1 22:55:17 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* cus-edit.el (cus-face): Require.
+
+Sat Mar 01 22:35:07 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* Version 1.48 released.
+
+Sat Mar  1 21:45:44 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* wid-edit.el: Renamed from widget-edit.el
+	* wid-browse.el: Renamed from widget-browse.el
+	* cus-edit.el: Renamed from custom-edit.el
+	* cus-face.el: New file.
+	* custom-xmas.el: Deleted.
+	* custom.el: Updated autoloads.
+	* widget.el: Ditto
+	* widget.texi: Updated examples.
+	* widget-example.el: Updated require.
+
+Fri Feb 28 02:04:49 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* custom.el (custom-declare-face): Ignore already declared faces.
+
+	* Version 1.47 released.
+
+Fri Feb 28 01:46:22 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* custom.el (custom-background-mode): Take a frame argument.
+	(custom-declare-face): Create frame local faces where relevant. 
+	(custom-declare-face): Whine when called during dump.
+	(custom-face-display-set): Don'e create frame local face if the
+	display is identical to the global face.
+	(custom-default-frame-properties): New variable and function.
+	(custom-extract-frame-properties): New function.
+	(custom-get-frame-properties): New function.
+	(custom-display-match-frame): Use it.
+	(custom-relevant-frames): New variable and function.
+	(custom-initialize-frame): New function.
+	(after-make-frame-hook): Enable it.
+
+Thu Feb 27 18:58:45 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+	* custom-edit.el (custom-buffer-create): Read up event when 
+
 Wed Feb 26 22:17:38 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
 
 	* Version 1.46 released.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/custom/cus-edit.el	Mon Aug 13 09:17:26 2007 +0200
@@ -0,0 +1,1861 @@
+;;; 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.50
+;; 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))
+
+(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))
+	(message "Creating customization buffer...")
+	(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."
+  (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 ")
+  (widget-create 'info-link 
+		 :tag "help"
+		 :help-echo "Push me for help."
+		 "(custom)The Customization Buffer")
+  (widget-insert " for more information.\n\n")
+  (setq custom-options 
+	(mapcar (lambda (entry)
+		  (prog1 
+		      (if (> (length options) 1)
+			  (widget-create (nth 1 entry)
+					 :tag (custom-unlispify-tag-name
+					       (nth 0 entry))
+					 :value (nth 0 entry))
+			;; If there is only one entry, don't hide it!
+			(widget-create (nth 1 entry)
+				       :custom-state 'unknown
+				       :tag (custom-unlispify-tag-name
+					       (nth 0 entry))
+				       :value (nth 0 entry)))
+		    (unless (eq (preceding-char) ?\n)
+		      (widget-insert "\n"))
+		    (widget-insert "\n")))
+		options))
+  (mapcar 'custom-magic-reset custom-options)
+  (widget-create 'push-button
+		 :tag "Set"
+		 :help-echo "Push me to set all modifications."
+		 :action (lambda (widget &optional event)
+			   (custom-set)))
+  (widget-insert " ")
+  (widget-create 'push-button
+		 :tag "Save"
+		 :help-echo "Push me to make the modifications default."
+		 :action (lambda (widget &optional event)
+			   (custom-save)))
+  (widget-insert " ")
+  (widget-create 'push-button
+		 :tag "Reset"
+		 :help-echo "Push me to undo all modifications."
+		 :action (lambda (widget &optional event)
+			   (custom-reset event)))
+  (widget-insert " ")
+  (widget-create 'push-button
+		 :tag "Done"
+		 :help-echo "Push me to 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")
+  (widget-setup))
+
+;;; 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 "Push me to read the manual."
+  :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 "\
+Push me to 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 "\
+Push me to 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 "Push me to 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."
+  (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 "Push me to 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.
+
+(defvar custom-face-edit-args
+  (mapcar (lambda (att)
+	    (list 'group 
+		  :inline t
+		  (list 'const :format "" :value (nth 0 att)) 
+		  (nth 1 att)))
+	  custom-face-attributes))
+
+(define-widget 'custom-face-edit 'checklist
+  "Edit face attributes."
+  :format "%t: %v"
+  :tag "Attributes"
+  :extra-offset 12
+  :args (mapcar (lambda (att)
+		  (list 'group 
+			:inline t
+			(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
+  :args '((const :tag "all" t)
+	  (checklist :offset 0
+		     :extra-offset 9
+		     :args ((group (const :format "Type: " type)
+				   (checklist :inline t
+					      :offset 0
+					      (const :format "X "
+						     x)
+					      (const :format "PM "
+						     pm)
+					      (const :format "Win32 "
+						     win32)
+					      (const :format "DOS "
+						     pc)
+					      (const :format "TTY%n"
+						     tty)))
+			    (group (const :format "Class: " class)
+				   (checklist :inline t
+					      :offset 0
+					      (const :format "Color "
+						     color)
+					      (const :format
+						     "Grayscale "
+						     grayscale)
+					      (const :format "Monochrome%n"
+						     mono)))
+			    (group  (const :format "Background: " background)
+				    (checklist :inline t
+					       :offset 0
+					       (const :format "Light "
+						      light)
+					       (const :format "Dark\n"
+						      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 "Push me to set or reset this face."
+  :documentation-property '(lambda (face)
+			     (face-documentation face))
+  :value-create 'custom-face-value-create
+  :action 'custom-face-action
+  :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))))))
+
+(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))
+    (custom-load-widget widget)
+    (let* ((symbol (widget-value widget))
+	   (edit (widget-create-child-and-convert
+		  widget 'editable-list
+		  :entry-format "%i %d %v"
+		  :value (or (get symbol 'saved-face)
+			     (get symbol 'factory-face))
+		  '(group :format "%v"
+			  custom-display custom-face-edit))))
+      (custom-face-state-set widget)
+      (widget-put widget :children (list edit)))))
+
+(defvar custom-face-menu 
+  '(("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-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 "Push me to 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)
+      (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))
+	     (children (mapcar (lambda (entry)
+				 (widget-insert "\n")
+				 (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)))
+	(mapcar 'custom-magic-reset children)
+	(widget-put widget :children children)
+	(custom-group-state-update widget)))))
+
+(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 (eolp)
+	(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 (eolp)
+	(princ "\n")))))
+
+(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)))
+
+(defun custom-group-menu-create (widget symbol)
+  "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
+  (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-menu-nesting (1- custom-menu-nesting))
+	      (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 ()
+  "Update customize menu."
+  (interactive)
+  (add-hook 'custom-define-hook 'custom-menu-reset)
+  (let ((menu `(,(car custom-help-menu)
+		,(widget-apply '(custom-group) :custom-menu 'emacs)
+		,@(cdr (cdr custom-help-menu)))))
+    (if (fboundp 'add-submenu)
+	(add-submenu '("Help") menu)
+      (define-key global-map [menu-bar help-menu customize-menu]
+	(cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu)))))))
+
+;;; 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/custom/cus-face.el	Mon Aug 13 09:17:26 2007 +0200
@@ -0,0 +1,434 @@
+;;; 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.50
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `custom.el'.
+
+;;; Code:
+
+(require 'custom)
+
+;;; Compatibility.
+
+(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 '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)
+      (defalias 'make-empty-face 'make-face)
+    (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
+  ;; Not implemented in XEmacs.
+  "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)
+    (progn 
+      (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))))
+
+(defun face-documentation (face)
+	"Get the documentation string for FACE."
+	(face-property face 'doc-string))
+
+      (defun set-face-documentation (face string)
+	"Set the documentation string for FACE to STRING."
+	(set-face-property face 'doc-string string)))
+  
+  (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))))  
+
+  (defun face-documentation (face)
+    "Get the documentation string for FACE."
+    (get face 'face-documentation))
+
+  (defun set-face-documentation (face string)
+    "Set the documentation string for FACE to STRING."
+    (put face 'face-documentation string)))
+
+;;; 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 (and (custom-facep face)
+		   (not (get face 'saved-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-documentation face)))
+      (set-face-documentation face doc))
+    (custom-handle-all-keywords face args 'custom-face)
+    (run-hooks 'custom-define-hook))
+  face)
+
+;;; Font Attributes.
+
+(defun custom-face-attribites-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)))))
+
+(defconst custom-face-attributes
+  '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
+    (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
+    (:underline
+     (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
+    (:foreground (color :tag "Foreground") set-face-foreground)
+    (:background (color :tag "Background") set-face-background)
+    (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
+  "Alist of face attributes. 
+
+The elements are of the form (KEY TYPE SET) 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.
+
+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.")
+
+(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-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)))
+
+(when (string-match "XEmacs" emacs-version)
+  ;; Support for special XEmacs font attributes.
+  (autoload 'font-create-object "font" nil)
+
+  (unless (fboundp 'face-font-name)
+    (defun face-font-name (face &rest args)
+      (apply 'face-font face args)))
+
+  (defun custom-set-face-font-size (face size &rest args)
+    "Set the font of FACE to SIZE"
+    (let* ((font (apply 'face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (set-font-size fontobj size)
+      (apply 'set-face-font face fontobj args)))
+
+  (defun custom-set-face-font-family (face family &rest args)
+    "Set the font of FACE to FAMILY"
+    (let* ((font (apply 'face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (set-font-family fontobj family)
+      (apply 'set-face-font face fontobj args)))
+
+  (nconc custom-face-attributes
+	 '((:family (editable-field :format "Family: %v") 
+		    custom-set-face-font-family)
+	   (:size (editable-field :format "Size: %v")
+		  custom-set-face-font-size)))
+
+  ;; Disable frame local faces.
+  (setq custom-relevant-frames nil)
+  (remove-hook 'after-make-frame-hook 'custom-initialize-frame))
+
+;;; 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-attribites-set face frame atts))
+	  (unless frame
+	    (put face 'custom-face-display display))
+	  (setq spec nil))))))
+
+(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)
+					       (color-instance-name
+						(specifier-instance
+						 (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))
+
+(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)))
+
+(defvar custom-relevant-frames t
+  "List of frames whose custom properties differ from the default.")
+
+(defun custom-relevant-frames ()
+  "List of frames whose custom properties differ from the default."
+  (when (eq custom-relevant-frames t)
+    (setq custom-relevant-frames nil)
+    (let ((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 custom-relevant-frames)))))
+  custom-relevant-frames)
+
+(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 (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)
+    (custom-relevant-frames)
+    (push frame custom-relevant-frames)))
+
+;; Enable.  This should go away when bundled with Emacs.
+(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 (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
--- a/lisp/custom/custom-edit.el	Mon Aug 13 09:16:54 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1843 +0,0 @@
-;;; custom-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.46
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
-
-;;; Commentary:
-;;
-;; See `custom.el'.
-
-;;; Code:
-
-(require 'custom)
-(require 'widget-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))
-
-(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))
-	(message "Creating customization buffer...")
-	(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."
-  (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 ")
-  (widget-create 'info-link 
-		 :tag "help"
-		 :help-echo "Push me for help."
-		 "(custom)The Customization Buffer")
-  (widget-insert " for more information.\n\n")
-  (setq custom-options 
-	(mapcar (lambda (entry)
-		  (prog1 
-		      (if (> (length options) 1)
-			  (widget-create (nth 1 entry)
-					 :tag (custom-unlispify-tag-name
-					       (nth 0 entry))
-					 :value (nth 0 entry))
-			;; If there is only one entry, don't hide it!
-			(widget-create (nth 1 entry)
-				       :custom-state 'unknown
-				       :tag (custom-unlispify-tag-name
-					       (nth 0 entry))
-				       :value (nth 0 entry)))
-		    (unless (eq (preceding-char) ?\n)
-		      (widget-insert "\n"))
-		    (widget-insert "\n")))
-		options))
-  (mapcar 'custom-magic-reset custom-options)
-  (widget-create 'push-button
-		 :tag "Set"
-		 :help-echo "Push me to set all modifications."
-		 :action (lambda (widget &optional event)
-			   (custom-set)))
-  (widget-insert " ")
-  (widget-create 'push-button
-		 :tag "Save"
-		 :help-echo "Push me to make the modifications default."
-		 :action (lambda (widget &optional event)
-			   (custom-save)))
-  (widget-insert " ")
-  (widget-create 'push-button
-		 :tag "Reset"
-		 :help-echo "Push me to undo all modifications."
-		 :action (lambda (widget &optional event)
-			   (custom-reset event)))
-  (widget-insert " ")
-  (widget-create 'push-button
-		 :tag "Done"
-		 :help-echo "Push me to bury the buffer."
-		 :action (lambda (widget &optional event)
-			   (bury-buffer)))
-  (widget-insert "\n")
-  (widget-setup))
-
-;;; 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 "Push me to read the manual."
-  :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 "\
-Push me to 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 "\
-Push me to 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 "Push me to 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."
-  (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 "Push me to 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.
-
-(defvar custom-face-edit-args
-  (mapcar (lambda (att)
-	    (list 'group 
-		  :inline t
-		  (list 'const :format "" :value (nth 0 att)) 
-		  (nth 1 att)))
-	  custom-face-attributes))
-
-(define-widget 'custom-face-edit 'checklist
-  "Edit face attributes."
-  :format "%t: %v"
-  :tag "Attributes"
-  :extra-offset 12
-  :args (mapcar (lambda (att)
-		  (list 'group 
-			:inline t
-			(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
-  :args '((const :tag "all" t)
-	  (checklist :offset 0
-		     :extra-offset 9
-		     :args ((group (const :format "Type: " type)
-				   (checklist :inline t
-					      :offset 0
-					      (const :format "X "
-						     x)
-					      (const :format "PM "
-						     pm)
-					      (const :format "Win32 "
-						     win32)
-					      (const :format "DOS "
-						     pc)
-					      (const :format "TTY%n"
-						     tty)))
-			    (group (const :format "Class: " class)
-				   (checklist :inline t
-					      :offset 0
-					      (const :format "Color "
-						     color)
-					      (const :format
-						     "Grayscale "
-						     grayscale)
-					      (const :format "Monochrome%n"
-						     mono)))
-			    (group  (const :format "Background: " background)
-				    (checklist :inline t
-					       :offset 0
-					       (const :format "Light "
-						      light)
-					       (const :format "Dark\n"
-						      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 "Push me to set or reset this face."
-  :documentation-property '(lambda (face)
-			     (get-face-documentation face))
-  :value-create 'custom-face-value-create
-  :action 'custom-face-action
-  :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))))))
-
-(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))
-    (custom-load-widget widget)
-    (let* ((symbol (widget-value widget))
-	   (edit (widget-create-child-and-convert
-		  widget 'editable-list
-		  :entry-format "%i %d %v"
-		  :value (or (get symbol 'saved-face)
-			     (get symbol 'factory-face))
-		  '(group :format "%v"
-			  custom-display custom-face-edit))))
-      (custom-face-state-set widget)
-      (widget-put widget :children (list edit)))))
-
-(defvar custom-face-menu 
-  '(("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-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)
-    (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)))
-    (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)
-    (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))
-    (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 "Push me to 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)
-      (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))
-	     (children (mapcar (lambda (entry)
-				 (widget-insert "\n")
-				 (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)))
-	(mapcar 'custom-magic-reset children)
-	(widget-put widget :children children)
-	(custom-group-state-update widget)))))
-
-(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 (eolp)
-	(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 (eolp)
-	(princ "\n")))))
-
-(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)))
-
-(defun custom-group-menu-create (widget symbol)
-  "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
-  (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-menu-nesting (1- custom-menu-nesting))
-	      (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 ()
-  "Update customize menu."
-  (interactive)
-  (add-hook 'custom-define-hook 'custom-menu-reset)
-  (let ((menu `(,(car custom-help-menu)
-		,(widget-apply '(custom-group) :custom-menu 'emacs)
-		,@(cdr (cdr custom-help-menu)))))
-    (if (fboundp 'add-submenu)
-	(add-submenu '("Help") menu)
-      (define-key global-map [menu-bar help-menu customize-menu]
-	(cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu)))))))
-
-;;; 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 'custom-edit)
-
-;; custom-edit.el ends here
--- a/lisp/custom/custom-xmas.el	Mon Aug 13 09:16:54 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,75 +0,0 @@
-;;; custom-xmas.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.46
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
-
-;;; Commentary:
-;;
-;; See `custom.el'.
-
-;;; Code:
-
-(unless (featurep 'custom)
-  (error "Load `custom.el' instead"))
-
-;; Emacs function missing in XEmacs 19.14.
-(unless (fboundp 'x-color-values)
-  (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))))
-
-;; Overwrite Emacs definition.
-(defalias 'custom-facep 'find-face)
-
-;; Support for special XEmacs font attributes.
-(autoload 'font-create-object "font" nil)
-
-(unless (fboundp 'face-font-name)
-  (defun face-font-name (face &rest args)
-    (apply 'face-font face args)))
-
-(defun custom-set-face-font-size (face size &rest args)
-  "Set the font of FACE to SIZE"
-  (let* ((font (apply 'face-font-name face args))
-	 (fontobj (font-create-object font)))
-    (set-font-size fontobj size)
-    (apply 'set-face-font face fontobj args)))
-
-(defun custom-set-face-font-family (face family &rest args)
-  "Set the font of FACE to FAMILY"
-  (let* ((font (apply 'face-font-name face args))
-	 (fontobj (font-create-object font)))
-    (set-font-family fontobj family)
-    (apply 'set-face-font face fontobj args)))
-
-(nconc custom-face-attributes
-       '((:family (editable-field :format "Family: %v") 
-		  custom-set-face-font-family)
-	 (:size (editable-field :format "Size: %v")
-		custom-set-face-font-size)))
-
-;; Overwrite Emacs definition.
-(defun custom-menu-reset ()
-  "Reset customize menu."
-  (remove-hook 'custom-define-hook 'custom-menu-reset)
-  (when (fboundp 'add-submenu)
-    ;; XEmacs with menus.
-    (add-submenu '("Help") custom-help-menu)))
-
-(defun get-face-documentation (face)
-  "Get the documentation string for FACE."
-  (face-property face 'doc-string))
-
-(defun set-face-documentation (face string)
-  "Set the documentation string for FACE to STRING."
-  (set-face-property face 'doc-string string))
-
-;; custom-xmas.el ends here
--- a/lisp/custom/custom.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/custom/custom.el	Mon Aug 13 09:17:26 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.46
+;; Version: 1.50
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -13,7 +13,9 @@
 ;;
 ;; This file only contain the code needed to declare and initialize
 ;; user options.  The code to customize options is autoloaded from
-;; `custom-edit.el'. 
+;; `cus-edit.el'. 
+
+;; The code implementing face declarations is in `cus-face.el'
 
 ;;; Code:
 
@@ -24,57 +26,18 @@
 ;; These autoloads should be deleted when the file is added to Emacs
 
 (unless (fboundp 'load-gc)
-  (autoload 'customize "custom-edit" nil t)
-  (autoload 'customize-variable "custom-edit" nil t)
-  (autoload 'customize-face "custom-edit" nil t)
-  (autoload 'customize-apropos "custom-edit" nil t)
-  (autoload 'customize-customized "custom-edit" nil t)
-  (autoload 'custom-buffer-create "custom-edit")
-  (autoload 'custom-menu-update "custom-edit")
-  (autoload 'custom-make-dependencies "custom-edit"))
-
-;;; Compatibility.
-
-(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)))
-
-(defun custom-background-mode ()
-  "Kludge to detect background mode."
-  (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
-						(selected-frame)
-						'background-color)
-					       (color-instance-name
-						(specifier-instance
-						 (face-background 'default))))
-					 (error nil)))
-			   (< (apply '+ (x-color-values color))
-			      (/ (apply '+ (x-color-values "white"))
-				 3)))
-		      'dark)
-		     (t 'light))))
-    (modify-frame-parameters (selected-frame)
-			     (list (cons 'background-mode mode)))
-    mode))
-
-;; XEmacs and Emacs have different definitions of `facep'.  
-;; The Emacs definition is the useful one, so emulate that. 
-(if (fboundp 'facep)
-    (defalias 'custom-facep 'facep)
-  (defun custom-facep (face) 
-    "No faces"
-    nil))
+  ;; 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.
 
@@ -138,30 +101,6 @@
 
 ;;; The `defface' Macro.
 
-
-;(defun get-face-documentation (face)
-;  "Get the documentation string for FACE."
-;  (get face 'face-documentation))
-
-;(defun set-face-documentation (face string)
-;  "Set the documentation string for FACE to STRING."
-;  (put face 'face-documentation string))
-
-(defun custom-declare-face (face spec doc &rest args)
-  "Like `defface', but FACE is evaluated as a normal argument."
-  (put face 'factory-face spec)
-  (when (fboundp 'facep)
-    (unless (and (custom-facep face)
-		 (not (get face 'saved-face)))
-      ;; If the user has already created the face, respect that.
-      (let ((value (or (get face 'saved-face) spec)))
-	(custom-face-display-set face value))))
-  (when (and doc (null (get-face-documentation face)))
-    (set-face-documentation face doc))
-  (custom-handle-all-keywords face args 'custom-face)
-  (run-hooks 'custom-define-hook)
-  face)
-
 (defmacro defface (face spec doc &rest args)
   "Declare FACE as a customizable face that defaults to SPEC.
 FACE does not need to be quoted.
@@ -320,122 +259,6 @@
     (unless (member load loads)
       (put symbol 'custom-loads (cons load loads)))))
 
-;;; Face Utilities.
-
-(and (fboundp 'make-face)
-     (make-face 'custom-face-empty))
-
-(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 'copy-face)
-    (copy-face 'custom-face-empty face frame)
-    (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)
-	  (apply 'custom-face-attribites-set face frame atts)
-	  (setq spec nil))))))
-
-(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-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!
-  (unless frame 
-    (setq frame (selected-frame)))
-  (if (eq display t)
-      t
-    (let ((match t))
-      (while (and display match)
-	(let* ((entry (car display))
-	       (req (car entry))
-	       (options (cdr entry)))
-	  (setq display (cdr display))
-	  (cond ((eq req 'type)
-		 (let ((type (if (fboundp 'device-type)
-				 (device-type (frame-device frame))
-			       window-system)))
-		   (setq match (memq type options))))
-		((eq req 'class)
-		 (let ((class (if (fboundp 'device-class)
-				  (device-class (frame-device frame))
-				(frame-property frame 'display-type))))
-		   (setq match (memq class options))))
-		((eq req 'background)
-		 (let ((background (or custom-background-mode
-				       (frame-property frame 'background-mode)
-				       (custom-background-mode))))
-		   (setq match (memq background options))))
-		(t
-		 (error "Unknown req `%S' with options `%S'" req options)))))
-      match)))
-
-(defconst custom-face-attributes
-  '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
-    (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
-    (:underline
-     (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
-    (:foreground (color :tag "Foreground") set-face-foreground)
-    (:background (color :tag "Background") set-face-background)
-    (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
-  "Alist of face attributes. 
-
-The elements are of the form (KEY TYPE SET) 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.
-
-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.")
-
-(defun custom-face-attribites-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-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-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-initialize-faces (&optional frame)
-  "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
-  (mapatoms (lambda (symbol)
-	      (let ((spec (or (get symbol 'saved-face)
-			      (get symbol 'factory-face))))
-		(when spec 
-		  (custom-face-display-set symbol spec frame))))))
-
 ;;; Initializing.
 
 (defun custom-set-variables (&rest args)
@@ -465,33 +288,6 @@
 	  (put symbol 'saved-value (list value)))
 	(setq args (cdr (cdr args)))))))
 
-(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)
-	      (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)))))))
-
 ;;; Meta Customization
 
 (defcustom custom-define-hook nil
@@ -510,24 +306,19 @@
 			     ["Apropos..." customize-apropos t])
   "Customize menu")
 
-;(defun custom-menu-reset ()
-;  "Reset customize menu."
-;  (remove-hook 'custom-define-hook 'custom-menu-reset)
-;  (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)))))
+(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 '("Help") 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))))))
 
 ;;; The End.
 
 (provide 'custom)
 
-(when (and (not (fboundp 'load-gc))
-	   (string-match "XEmacs" emacs-version))
-  ;; Overwrite definitions for XEmacs.
-  (load-library "custom-xmas"))
-
-(unless (fboundp 'load-gc)
-  (custom-menu-reset))
-
 ;; custom.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/custom/wid-browse.el	Mon Aug 13 09:17:26 2007 +0200
@@ -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.50
+;; 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/custom/wid-edit.el	Mon Aug 13 09:17:26 2007 +0200
@@ -0,0 +1,2383 @@
+;;; 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.50
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; See `widget.el'.
+
+;;; Code:
+
+(require 'widget)
+(require 'cl)
+(autoload 'pp-to-string "pp")
+(autoload 'Info-goto-node "info")
+
+(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.
+(eval-and-compile
+  (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))))
+
+;;; Compatibility.
+
+(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
+	 (cdr (assoc (completing-read (concat title ": ")
+				      items nil t)
+		     items)))))
+
+(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)))
+
+    (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
+				       '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
+					    '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)))
+    (add-text-properties from to (list 'button widget
+				       'mouse-face widget-mouse-face
+				       'start-open t
+				       'end-open t
+				       'face face))))
+
+(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)))
+
+;;; 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)))
+
+(defun widget-apply (widget property &rest args)
+  "Apply the value of WIDGET's PROPERTY to the widget itself.
+ARGS are passed as extra argments 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)))
+
+;;; 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 be a name sans extension of an xpm or xbm file located in 
+`widget-glyph-directory'"
+  (if (and (string-match "XEmacs" emacs-version)
+	   widget-glyph-enable
+	   (fboundp 'make-glyph)
+	   image)
+      (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)))
+    ;; We don't want or can't use glyphs.
+    (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)))
+
+;;; 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 Comands.
+
+(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 field :action 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 widget :action event)
+	     (message "You clicked on a glyph."))))
+	((event-point event)
+	 (let ((button (get-text-property (event-point event) 'button)))
+	   (if button
+	       (widget-apply button :action 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 widget :action 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 button :action 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")))))))))
+  (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)))))
+  (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)
+  :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)
+    (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-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 widget :action (this-command-keys)))
+
+;;; The `link' Widget.
+
+(define-widget 'link 'item
+  "An embedded link."
+  :help-echo "Push me to 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")
+
+;;; 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))
+	  (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 (widget-create-child-and-convert
+			      widget 'checkbox :value (not (null chosen)))))
+	       ((eq escape ?v)
+		(setq child
+		      (cond ((not chosen)
+			     (widget-create-child widget type))
+			    ((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))
+	  (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 (widget-create-child-and-convert
+			      widget 'radio-button 
+			      :value (not (null chosen)))))
+	       ((eq escape ?v)
+		(setq child (if chosen
+				(widget-create-child-value
+				 widget type value)
+			      (widget-create-child widget type))))
+	       (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 
+	    (widget-value-set current value))
+	(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-value button)
+		 (widget-value-set button nil)))))))
+  ;; 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"
+  :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"
+  :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)))
+	   (widget-create-child-and-convert widget 'insert-button))
+	  (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-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 (widget-create-child-and-convert
+			      widget 'insert-button)))
+	       ((eq escape ?d)
+		(setq delete (widget-create-child-and-convert
+			      widget 'delete-button)))
+	       ((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 "Push me to toggle the 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 ": (defalt `" 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"
+  :button-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 "default"
+  :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
--- a/lisp/custom/widget-browse.el	Mon Aug 13 09:16:54 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,232 +0,0 @@
-;;; widget-browse.el --- Functions for browsing widgets.
-;;
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-;;
-;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Keywords: extensions
-;; Version: 1.46
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
-
-;;; Commentary:
-;;
-;; Widget browser.  See `widget.el'.
-
-;;; Code:
-
-(require 'easymenu)
-(require 'custom)
-(require 'widget-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 'widget-browse)
-
-;; widget-browse.el ends here
--- a/lisp/custom/widget-edit.el	Mon Aug 13 09:16:54 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,2384 +0,0 @@
-;;; widget-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.46
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
-
-;;; Commentary:
-;;
-;; See `widget.el'.
-
-;;; Code:
-
-(require 'widget)
-(require 'cl)
-(autoload 'pp-to-string "pp")
-(autoload 'Info-goto-node "info")
-
-(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.
-(eval-and-compile
-  (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))))
-
-;;; Compatibility.
-
-(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 'help
-  :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
-	 (cdr (assoc (completing-read (concat title ": ")
-				      items nil t)
-		     items)))))
-
-(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)))
-
-    (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
-				       '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
-					    '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)))
-    (add-text-properties from to (list 'button widget
-				       'mouse-face widget-mouse-face
-				       'start-open t
-				       'end-open t
-				       'face face))))
-
-(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)))
-
-;;; 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)))
-
-(defun widget-apply (widget property &rest args)
-  "Apply the value of WIDGET's PROPERTY to the widget itself.
-ARGS are passed as extra argments 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)))
-
-;;; 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 be a name sans extension of an xpm or xbm file located in 
-`widget-glyph-directory'"
-  (if (and (string-match "XEmacs" emacs-version)
-	   widget-glyph-enable
-	   (fboundp 'make-glyph)
-	   image)
-      (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)))
-    ;; We don't want or can't use glyphs.
-    (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)))
-
-;;; 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 Comands.
-
-(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 field :action 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 widget :action event)
-	     (message "You clicked on a glyph."))))
-	((event-point event)
-	 (let ((button (get-text-property (event-point event) 'button)))
-	   (if button
-	       (widget-apply button :action 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 widget :action 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 button :action 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")))))))))
-  (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)))))
-  (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)
-  :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)
-    (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-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 widget :action (this-command-keys)))
-
-;;; The `link' Widget.
-
-(define-widget 'link 'item
-  "An embedded link."
-  :help-echo "Push me to 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")
-
-;;; 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))
-	  (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 (widget-create-child-and-convert
-			      widget 'checkbox :value (not (null chosen)))))
-	       ((eq escape ?v)
-		(setq child
-		      (cond ((not chosen)
-			     (widget-create-child widget type))
-			    ((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))
-	  (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 (widget-create-child-and-convert
-			      widget 'radio-button 
-			      :value (not (null chosen)))))
-	       ((eq escape ?v)
-		(setq child (if chosen
-				(widget-create-child-value
-				 widget type value)
-			      (widget-create-child widget type))))
-	       (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 
-	    (widget-value-set current value))
-	(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-value button)
-		 (widget-value-set button nil)))))))
-  ;; 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"
-  :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"
-  :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)))
-	   (widget-create-child-and-convert widget 'insert-button))
-	  (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-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 (widget-create-child-and-convert
-			      widget 'insert-button)))
-	       ((eq escape ?d)
-		(setq delete (widget-create-child-and-convert
-			      widget 'delete-button)))
-	       ((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 "Push me to toggle the 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 ": (defalt `" 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"
-  :button-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 "default"
-  :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 'widget-edit)
-
-;; widget-edit.el ends here
--- a/lisp/custom/widget-example.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/custom/widget-example.el	Mon Aug 13 09:17:26 2007 +0200
@@ -4,13 +4,13 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.46
+;; Version: 1.50
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 (require 'widget)
 
 (eval-when-compile
-  (require 'widget-edit))
+  (require 'wid-edit))
 
 (defvar widget-example-repeat)
 
--- a/lisp/custom/widget.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/custom/widget.el	Mon Aug 13 09:17:26 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.46
+;; Version: 1.50
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -12,7 +12,7 @@
 ;; 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 `widget-edit.el'.
+;; Everything else is autoloaded from `wid-edit.el'.
 
 ;;; Code:
 
@@ -43,10 +43,10 @@
 
 ;; These autoloads should be deleted when the file is added to Emacs.
 (unless (fboundp 'load-gc)
-  (autoload 'widget-create "widget-edit")
-  (autoload 'widget-insert "widget-edit")
-  (autoload 'widget-browse "widget-browse" nil t)
-  (autoload 'widget-browse-at "widget-browse" nil t))
+  (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.
--- a/lisp/gnus/gnus-cus.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/gnus/gnus-cus.el	Mon Aug 13 09:17:26 2007 +0200
@@ -26,7 +26,7 @@
 
 ;;; Code:
 
-(require 'widget-edit)
+(require 'wid-edit)
 (require 'gnus-score)
 
 ;;; Widgets:
--- a/lisp/gnus/gnus-load.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/gnus/gnus-load.el	Mon Aug 13 09:17:26 2007 +0200
@@ -27,14 +27,14 @@
 (put 'gnus-mail 'custom-loads '("nnmail"))
 (put 'message-interface 'custom-loads '("message"))
 (put 'gnus-edit-form 'custom-loads '("gnus-eform"))
-(put 'emacs 'custom-loads '("custom" "widget-edit" "message" "gnus" "custom-opt"))
+(put 'emacs 'custom-loads '("custom" "wid-edit" "message" "gnus" "custom-opt"))
 (put 'gnus-summary-mail 'custom-loads '("gnus-sum"))
 (put 'gnus-topic 'custom-loads '("gnus-topic"))
 (put 'gnus-summary-choose 'custom-loads '("gnus-sum"))
 (put 'message-headers 'custom-loads '("message"))
 (put 'message-forwarding 'custom-loads '("message"))
 (put 'gnus-duplicate 'custom-loads '("gnus-dup"))
-(put 'widgets 'custom-loads '("widget-edit"))
+(put 'widgets 'custom-loads '("wid-edit"))
 (put 'earcon 'custom-loads '("earcon"))
 (put 'gnus-summary-format 'custom-loads '("gnus-sum"))
 (put 'gnus-windows 'custom-loads '("gnus-win"))
@@ -47,7 +47,7 @@
 (put 'message-sending 'custom-loads '("message"))
 (put 'message-insertion 'custom-loads '("message"))
 (put 'gnus-summary-sort 'custom-loads '("gnus-sum"))
-(put 'customize 'custom-loads '("custom" "custom-edit"))
+(put 'customize 'custom-loads '("custom" "cus-edit"))
 (put 'gnus-asynchronous 'custom-loads '("gnus-async"))
 (put 'article-mime 'custom-loads '("gnus-sum"))
 (put 'gnus-extract 'custom-loads '("gnus-uu" "gnus-sum"))
--- a/lisp/gnus/gnus-sum.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/gnus/gnus-sum.el	Mon Aug 13 09:17:26 2007 +0200
@@ -2074,7 +2074,7 @@
 
 ;; Some summary mode macros.
 
-(defun gnus-summary-article-number ()
+(defmacro gnus-summary-article-number ()
   "The article number of the article on the current line.
 If there isn's an article number here, then we return the current
 article number."
--- a/lisp/prim/auto-autoloads.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/prim/auto-autoloads.el	Mon Aug 13 09:17:26 2007 +0200
@@ -999,55 +999,73 @@
 
 ;;;***
 
-;;;### (autoloads (custom-make-dependencies custom-menu-update custom-buffer-create customize-apropos customize-customized customize-face customize-variable customize) "custom-edit" "custom/custom-edit.el")
-
-(autoload 'customize "custom-edit" "\
+;;;### (autoloads (custom-make-dependencies custom-menu-update custom-buffer-create customize-apropos customize-customized customize-face customize-variable customize) "cus-edit" "custom/cus-edit.el")
+
+(autoload 'customize "cus-edit" "\
 Customize SYMBOL, which must be a customization group." t nil)
 
-(autoload 'customize-variable "custom-edit" "\
+(autoload 'customize-variable "cus-edit" "\
 Customize SYMBOL, which must be a variable." t nil)
 
-(autoload 'customize-face "custom-edit" "\
+(autoload 'customize-face "cus-edit" "\
 Customize SYMBOL, which should be a face name or nil.
 If SYMBOL is nil, customize all faces." t nil)
 
-(autoload 'customize-customized "custom-edit" "\
+(autoload 'customize-customized "cus-edit" "\
 Customize all already customized user options." t nil)
 
-(autoload 'customize-apropos "custom-edit" "\
+(autoload 'customize-apropos "cus-edit" "\
 Customize all user options matching REGEXP.
 If ALL (e.g., started with a prefix key), include options which are not
 user-settable." t nil)
 
-(autoload 'custom-buffer-create "custom-edit" "\
+(autoload 'custom-buffer-create "cus-edit" "\
 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." nil nil)
 
-(autoload 'custom-menu-update "custom-edit" "\
+(autoload 'custom-menu-update "cus-edit" "\
 Update customize menu." t nil)
 
-(autoload 'custom-make-dependencies "custom-edit" "\
+(autoload 'custom-make-dependencies "cus-edit" "\
 Batch function to extract custom dependencies from .el files.
 Usage: emacs -batch *.el -f custom-make-dependencies > deps.el" nil nil)
 
 ;;;***
 
-;;;### (autoloads (widget-browse-at) "widget-browse" "custom/widget-browse.el")
-
-(autoload 'widget-browse-at "widget-browse" "\
+;;;### (autoloads (custom-set-faces custom-declare-face) "cus-face" "custom/cus-face.el")
+
+(autoload 'custom-declare-face "cus-face" "\
+Like `defface', but FACE is evaluated as a normal argument." nil nil)
+
+(autoload 'custom-set-faces "cus-face" "\
+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." nil nil)
+
+;;;***
+
+;;;### (autoloads (widget-browse-at) "wid-browse" "custom/wid-browse.el")
+
+(autoload 'widget-browse-at "wid-browse" "\
 Browse the widget under point." t nil)
 
 ;;;***
 
-;;;### (autoloads (widget-delete widget-create) "widget-edit" "custom/widget-edit.el")
-
-(autoload 'widget-create "widget-edit" "\
+;;;### (autoloads (widget-delete widget-create) "wid-edit" "custom/wid-edit.el")
+
+(autoload 'widget-create "wid-edit" "\
 Create widget of TYPE.  
 The optional ARGS are additional keyword arguments." nil nil)
 
-(autoload 'widget-delete "widget-edit" "\
+(autoload 'widget-delete "wid-edit" "\
 Delete WIDGET." nil nil)
 
 ;;;***
@@ -3736,7 +3754,7 @@
 ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el")
 
 (autoload 'ksh-mode "ksh-mode" "\
-ksh-mode $Revision: 1.12 $ - Major mode for editing (Bourne, Korn or Bourne again)
+ksh-mode $Revision: 1.13 $ - Major mode for editing (Bourne, Korn or Bourne again)
 shell scripts.
 Special key bindings and commands:
 \\{ksh-mode-map}
@@ -5088,7 +5106,7 @@
 
 (autoload 'vhdl-mode "vhdl-mode" "\
 Major mode for editing VHDL code.
-vhdl-mode $Revision: 1.12 $
+vhdl-mode $Revision: 1.13 $
 To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a
 vhdl-mode buffer.  This automatically sets up a mail buffer with version
 information already added.  You just need to add a description of the
--- a/lisp/prim/faces.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/prim/faces.el	Mon Aug 13 09:17:26 2007 +0200
@@ -1067,52 +1067,68 @@
   (font-proportional-p (face-font face) domain charset))
 
 
+(defvar init-face-from-resources t
+  "If non-nil, attempt to initialize faces from the reseource database.")
+
+(defun make-empty-face (name &optional doc-string temporary)
+  "Like `make-face', but doesn't query the reseource database."
+  (let ((init-face-from-resources nil))
+    (make-face name doc-string temporary)))
+
 (defun init-face-from-resources (face &optional locale)
   "Initialize FACE from the resource database.
 If LOCALE is specified, it should be a frame, device, or 'global, and
 the face will be resourced over that locale.  Otherwise, the face will
 be resourced over all possible locales (i.e. all frames, all devices,
 and 'global)."
-  (if (not locale)
-      (progn
-	(init-face-from-resources face 'global)
-	(let ((devices (device-list)))
-	  (while devices
-	    (init-face-from-resources face (car devices))
-	    (setq devices (cdr devices))))
-	(let ((frames (frame-list)))
-	  (while frames
-	    (init-face-from-resources face (car frames))
-	    (setq frames (cdr frames)))))
-    (let ((devtype (cond ((devicep locale) (device-type locale))
-			 ((framep locale) (frame-type locale))
-			 (t nil))))
-      (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
-	     (x-init-face-from-resources face locale))
-	    ((or (not devtype) (eq 'tty devtype))
-	     ;; Nothing to do for TTYs?
-	     )))))
+  (cond ((null init-face-from-resources)
+	 ;; Do nothing.
+	 )
+	((not locale)
+	 ;; Global, set for all frames.
+	 (progn
+	   (init-face-from-resources face 'global)
+	   (let ((devices (device-list)))
+	     (while devices
+	       (init-face-from-resources face (car devices))
+	       (setq devices (cdr devices))))
+	   (let ((frames (frame-list)))
+	     (while frames
+	       (init-face-from-resources face (car frames))
+	       (setq frames (cdr frames))))))
+	(t
+	 ;; Specific.
+	 (let ((devtype (cond ((devicep locale) (device-type locale))
+			      ((framep locale) (frame-type locale))
+			      (t nil))))
+	   (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
+		  (x-init-face-from-resources face locale))
+		 ((or (not devtype) (eq 'tty devtype))
+		  ;; Nothing to do for TTYs?
+		  ))))))
 
 (defun init-device-faces (device)
   ;; First, add any device-local face resources.
-  (loop for face in (face-list) do
-	(init-face-from-resources face device))
-  ;; Then do any device-specific initialization.
-  (cond ((eq 'x (device-type device))
-	 (x-init-device-faces device))
-	;; Nothing to do for TTYs?
-	)
-  (init-other-random-faces device))
+  (when init-face-from-resources
+    (loop for face in (face-list) do
+	  (init-face-from-resources face device))
+    ;; Then do any device-specific initialization.
+    (cond ((eq 'x (device-type device))
+	   (x-init-device-faces device))
+	  ;; Nothing to do for TTYs?
+	  )
+    (init-other-random-faces device)))
 
 (defun init-frame-faces (frame)
-  ;; First, add any frame-local face resources.
-  (loop for face in (face-list) do
-	(init-face-from-resources face frame))
-  ;; Then do any frame-specific initialization.
-  (cond ((eq 'x (frame-type frame))
-	 (x-init-frame-faces frame))
-	;; Is there anything which should be done for TTY's?
-	))
+  (when init-face-from-resources
+    ;; First, add any frame-local face resources.
+    (loop for face in (face-list) do
+	  (init-face-from-resources face frame))
+    ;; Then do any frame-specific initialization.
+    (cond ((eq 'x (frame-type frame))
+	   (x-init-frame-faces frame))
+	  ;; Is there anything which should be done for TTY's?
+	  )))
 
 ;; #### This is somewhat X-specific, and is called when the first
 ;; X device is created (even if there were TTY devices created
--- a/lisp/prim/loadup.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/prim/loadup.el	Mon Aug 13 09:17:26 2007 +0200
@@ -110,7 +110,6 @@
      ;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs"))
      (load-gc "widget")
      (load-gc "custom") ; Before loaddefs so that defcustom exists
-     (load-gc "custom-xmas")
      (load-gc "loaddefs") ; <=== autoloads get put here
      (load-gc "misc")
      (load-gc "profile")
--- a/lisp/tm/gnus-mime.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/tm/gnus-mime.el	Mon Aug 13 09:17:26 2007 +0200
@@ -4,7 +4,7 @@
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1996/8/6
-;; Version: $Revision: 1.3 $
+;; Version: $Revision: 1.4 $
 ;; Keywords: news, MIME, multimedia, multilingual, encoded-word
 
 ;; This file is not part of GNU Emacs yet.
@@ -33,7 +33,7 @@
 ;;;
 
 (defconst gnus-mime-RCS-ID
-  "$Id: gnus-mime.el,v 1.3 1997/02/15 22:21:26 steve Exp $")
+  "$Id: gnus-mime.el,v 1.4 1997/03/04 08:01:31 steve Exp $")
 
 (defconst gnus-mime-version
   (get-version-string gnus-mime-RCS-ID))
@@ -65,7 +65,7 @@
 
 (require 'gnus)
 (require 'gnus-charset)
-
+(require 'gnus-sum)
 
 ;;; @ for tm-partial
 ;;;
--- a/lisp/version.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/version.el	Mon Aug 13 09:17:26 2007 +0200
@@ -25,7 +25,7 @@
 (defconst emacs-version "20.1"
   "Version numbers of this version of Emacs.")
 
-(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta4)")))
+(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta5)")))
 
 (defconst emacs-major-version
   (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/x11/x-faces.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/x11/x-faces.el	Mon Aug 13 09:17:26 2007 +0200
@@ -372,7 +372,8 @@
 ;;; state where signalling an error or entering the debugger would likely
 ;;; result in a crash.
 
-(defun x-init-face-from-resources (face locale)
+(defun x-init-face-from-resources (face &optional locale set-anyway)
+
   ;;
   ;; These are things like "attributeForeground" instead of simply
   ;; "foreground" because people tend to do things like "*foreground",
@@ -385,7 +386,8 @@
   ;; "face.attributeForeground", but they're the way they are for
   ;; hysterical reasons. (jwz)
 
-  (let* ((face-sym (face-name face))
+  (let* ((append (if set-anyway nil 'append))
+	 (face-sym (face-name face))
 	 (name (symbol-name face-sym))
 	 (fn (x-get-resource-and-maybe-bogosity-check
 	      (concat name ".attributeFont")
@@ -460,30 +462,33 @@
     ;; done when the instancing actually happens, but I'm not
     ;; sure how it should actually be dealt with.
     (if fn
-	(set-face-font face fn locale nil 'append))
+	(set-face-font face fn locale nil append))
     ;; Kludge-o-rooni.  Set the foreground and background resources for
     ;; X devices only -- otherwise things tend to get all messed up
     ;; if you start up an X frame and then later create a TTY frame.
     (if fg
-	(set-face-foreground face fg locale 'x 'append))
+	(set-face-foreground face fg locale 'x append))
     (if bg
-	(set-face-background face bg locale 'x 'append))
+	(set-face-background face bg locale 'x append))
     (if bgp
-	(set-face-background-pixmap face bgp locale nil 'append))
+	(set-face-background-pixmap face bgp locale nil append))
     (if ulp
-	(set-face-underline-p face ulp locale nil 'append))
+	(set-face-underline-p face ulp locale nil append))
     (if stp
-	(set-face-strikethru-p face stp locale nil 'append))
+	(set-face-strikethru-p face stp locale nil append))
     (if hp
-	(set-face-highlight-p face hp locale nil 'append))
+	(set-face-highlight-p face hp locale nil append))
     (if dp
-	(set-face-dim-p face dp locale nil 'append))
+	(set-face-dim-p face dp locale nil append))
     (if bp
-	(set-face-blinking-p face bp locale nil 'append))
+	(set-face-blinking-p face bp locale nil append))
     (if rp
-	(set-face-reverse-p face rp locale nil 'append))
+	(set-face-reverse-p face rp locale nil append))
     ))
 
+;; GNU Emacs compatibility. (move to obsolete.el?)
+(defalias 'make-face-x-resource-internal 'x-init-face-from-resources)
+
 ;;; x-init-global-faces is responsible for ensuring that the
 ;;; default face has some reasonable fallbacks if nothing else is
 ;;; specified.
--- a/man/custom.texi	Mon Aug 13 09:16:54 2007 +0200
+++ b/man/custom.texi	Mon Aug 13 09:17:26 2007 +0200
@@ -13,7 +13,7 @@
 @comment  node-name,  next,  previous,  up
 @top The Customization Library
 
-Version: 1.46
+Version: 1.50
 
 @menu
 * Introduction::                
@@ -638,9 +638,6 @@
 customize buffer.
 
 @item
-Support real specifiers under XEmacs.
-
-@item
 Integrate with @file{w3} so you can customization buffers with much
 better formatting.  I'm thinking about adding a <custom>name</custom>
 tag. 
@@ -656,11 +653,6 @@
 Make it possible to append to `choice', `radio', and `set' options.
 
 @item
-There should be a way to exit the buffer.
-
-An @sc{open look} pushpin would do wonders.
-
-@item
 Ask whether set or modified variables should be saved in
 @code{kill-buffer-hook}. 
 
--- a/man/widget.texi	Mon Aug 13 09:16:54 2007 +0200
+++ b/man/widget.texi	Mon Aug 13 09:17:26 2007 +0200
@@ -1,6 +1,6 @@
 \input texinfo.tex
 
-@c $Id: widget.texi,v 1.4 1997/02/27 06:08:38 steve Exp $
+@c $Id: widget.texi,v 1.5 1997/03/04 08:01:33 steve Exp $
 
 @c %**start of header
 @setfilename widget
@@ -15,7 +15,7 @@
 @comment  node-name,  next,  previous,  up
 @top The Emacs Widget Library
 
-Version: 1.46
+Version: 1.50
 
 @menu
 * Introduction::                
@@ -115,7 +115,7 @@
 @item widget.el
 This will declare the user variables, define the function
 @code{widget-define}, and autoload the function @code{widget-create}. 
-@item widget-edit.el
+@item wid-edit.el
 Everything else is here, there is no reason to load it explicitly, as
 it will be autoloaded when needed.
 @end table
@@ -278,7 +278,7 @@
 (require 'widget)
 
 (eval-when-compile
-  (require 'widget-edit))
+  (require 'wid-edit))
 
 (defvar widget-example-repeat)
 
--- a/src/ChangeLog	Mon Aug 13 09:16:54 2007 +0200
+++ b/src/ChangeLog	Mon Aug 13 09:17:26 2007 +0200
@@ -1,3 +1,7 @@
+Mon Mar  3 20:37:54 1997  Steven L Baur  <steve@altair.xemacs.org>
+
+	* Makefile.in.in (lisp): Remove custom-xmas.elc.
+
 Sat Mar  1 01:20:39 1997  Steven L Baur  <steve@altair.xemacs.org>
 
 	* doc.c (weird_doc): Don't print `duplicate' messages as they are
--- a/src/Makefile.in.in	Mon Aug 13 09:16:54 2007 +0200
+++ b/src/Makefile.in.in	Mon Aug 13 09:17:26 2007 +0200
@@ -1273,7 +1273,7 @@
         ${lispdir}prim/itimer.elc ${lispdir}prim/itimer-autosave.elc \
 	${lispdir}ediff/ediff-hook.elc \
 	${lispdir}custom/widget.elc \
-	${lispdir}custom/custom.elc ${lispdir}custom/custom-xmas.elc \
+	${lispdir}custom/custom.elc \
 	${lispdir}packages/fontl-hooks.elc SCROLLBAR_LISP \
 	${lispdir}prim/buffer.elc MENUBAR_LISP \
 	${lispdir}packages/buff-menu.elc DIALOG_LISP MULE_LISP NOMULE_LISP \