--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/custom/custom-edit.el	Mon Aug 13 09:13:56 2007 +0200
@@ -0,0 +1,1650 @@
+;;; 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.40
+;; 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)
+
+;;; 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 (symbol)
+  "Customize FACE."
+  (interactive (list (completing-read "Customize face: " 
+				      obarray 'custom-facep)))
+  (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 (capitalize
+				   (symbol-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 'face-documentation
+  :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 (capitalize (symbol-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 (capitalize
+				   (symbol-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