*** pub/rgnus/lisp/cus-edit.el	Sun Mar  2 04:47:24 1997
--- rgnus/lisp/cus-edit.el	Sun Mar  2 04:47:12 1997
***************
*** 0 ****
--- 1,1853 ----
+ ;;; 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.48
+ ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+ 
+ ;;; Commentary:
+ ;;
+ ;; See `custom.el'.
+ 
+ ;;; Code:
+ 
+ (require 'custom)
+ (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)
+ 			     (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 'cus-edit)
+ 
+ ;; cus-edit.el ends here
*** pub/rgnus/lisp/cus-face.el	Sun Mar  2 04:47:24 1997
--- rgnus/lisp/cus-face.el	Sun Mar  2 04:47:12 1997
***************
*** 0 ****
--- 1,378 ----
+ ;;; 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.48
+ ;; 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)))
+ 
+ ;; Overwrite Emacs definition.
+ (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 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)))
+   
+   (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 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)))
+ 
+ ;;; 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.
+ 	  (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)))))
+     (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)
+ 
+ ;;; 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.
+ 
+ (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)
+     (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)))
+ 	    (copy-face 'custom-face-empty face frame)
+ 	    (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)))
+ 			   (< (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."
+   (mapatoms (lambda (symbol)
+ 	      (let ((spec (or (get symbol 'saved-face)
+ 			      (get symbol 'factory-face))))
+ 		(when spec 
+ 		  (custom-face-display-set symbol spec frame))))))
+ 
+ (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)
+     (push frame custom-relevant-frames)))
+ 
+ ;; Enable.  This should go away when bundled with Emacs.
+ (add-hook 'after-make-frame-hook 'custom-initialize-frame)
+ 
+ ;;; Initializing.
+ 
+ ;;;###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)
+ 	      (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
*** pub/rgnus/lisp/custom.el	Sun Feb 16 18:16:34 1997
--- rgnus/lisp/custom.el	Sun Mar  2 04:47:12 1997
***************
*** 4,10 ****
  ;;
  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  ;; Keywords: help, faces
! ;; Version: 1.38
  ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
  
  ;;; Commentary:
--- 4,10 ----
  ;;
  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  ;; Keywords: help, faces
! ;; Version: 1.48
  ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
  
  ;;; Commentary:
***************
*** 13,19 ****
  ;;
  ;; This file only contain the code needed to declare and initialize
  ;; user options.  The code to customize options is autoloaded from
! ;; `custom-edit.el'. 
  
  ;;; Code:
  
--- 13,21 ----
  ;;
  ;; This file only contain the code needed to declare and initialize
  ;; user options.  The code to customize options is autoloaded from
! ;; `cus-edit.el'. 
! 
! ;; The code implementing face declarations is in `cus-face.el'
  
  ;;; Code:
  
***************
*** 24,101 ****
  ;; 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 'x-color-values)
!   ;; Emacs function missing in XEmacs 19.14.
!   (defun x-color-values  (color)
!     "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))))
! 
! (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 detext 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. 
! (cond ((not (fboundp 'facep))
!        (defun custom-facep (face) 
! 	 "No faces"
! 	 nil))
!       ((string-match "XEmacs" emacs-version)
!        (defun custom-facep (face) 
! 	 "Face symbol or object."
! 	 (or (facep face)
! 	     (find-face face))))
!       (t
!        (defalias 'custom-facep 'facep)))
  
  ;;; The `defcustom' Macro.
  
  (defun custom-declare-variable (symbol value doc &rest args)
!   "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
    (unless (and (default-boundp symbol)
  	       (not (get symbol 'saved-value)))
      (set-default symbol (if (get symbol 'saved-value)
--- 26,48 ----
  ;; These autoloads should be deleted when the file is added to Emacs
  
  (unless (fboundp 'load-gc)
!   ;; From cus-edit.el
!   (autoload 'customize "cus-edit" nil t)
!   (autoload 'customize-variable "cus-edit" nil t)
!   (autoload 'customize-face "cus-edit" nil t)
!   (autoload 'customize-apropos "cus-edit" nil t)
!   (autoload 'customize-customized "cus-edit" nil t)
!   (autoload 'custom-buffer-create "cus-edit")
!   (autoload 'custom-menu-update "cus-edit")
!   (autoload 'custom-make-dependencies "cus-edit")
!   ;; From cus-face.el
!   (autoload 'custom-declare-face "cus-face")
!   (autoload 'custom-set-faces "cus-face"))
  
  ;;; The `defcustom' Macro.
  
  (defun custom-declare-variable (symbol value doc &rest args)
!   "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
    (unless (and (default-boundp symbol)
  	       (not (get symbol 'saved-value)))
      (set-default symbol (if (get symbol 'saved-value)
***************
*** 154,174 ****
  
  ;;; The `defface' Macro.
  
- (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 doc
-     (put face 'face-documentation 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.
--- 101,106 ----
***************
*** 327,476 ****
      (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)
-     (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.")
- 
- (when (string-match "XEmacs" emacs-version)
-   ;; Support for special XEmacs font attributes.
-   (require 'font)
- 
-   (unless (fboundp 'face-font-name)
-     (defun face-font-name (face &rest args)
-       (apply 'face-font face args)))
- 
-   (defun 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 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") 
- 		    set-face-font-family)
- 	   (:size (editable-field :format "Size: %v")
- 		  set-face-font-size))))
- 
- (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)
- 	(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)
--- 259,264 ----
***************
*** 500,546 ****
  	  (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
  
- (defgroup emacs nil
-   "Customization of the One True Editor."
-   :link '(custom-manual "(emacs)Top"))
- 
- (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 'emacs)
- 
  (defcustom custom-define-hook nil
    "Hook called after defining each customize option."
    :group 'customize
--- 288,295 ----
***************
*** 560,580 ****
  (defun custom-menu-reset ()
    "Reset customize menu."
    (remove-hook 'custom-define-hook 'custom-menu-reset)
!   (cond ((fboundp 'add-submenu)
! 	 ;; XEmacs with menus.
! 	 (add-submenu '("Help") custom-help-menu))
! 	((string-match "XEmacs" emacs-version)
! 	 ;; XEmacs without menus.
! 	 )
! 	(t
! 	 ;; Emacs.
! 	 (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)))))))
! 
! (unless (fboundp 'load-gc)
!   (custom-menu-reset))
  
  ;;; The End.
  
--- 309,321 ----
  (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.
  
*** pub/rgnus/lisp/gnus-art.el	Tue Feb 18 23:28:57 1997
--- rgnus/lisp/gnus-art.el	Sun Mar  2 04:47:13 1997
***************
*** 1083,1088 ****
--- 1083,1116 ----
        (goto-char cur)
        nil)))
  
+ (eval-and-compile
+   (autoload 'w3-parse-buffer "w3-parse"))
+ 
+ (defun gnus-article-treat-html ()
+   "Render HTML."
+   (interactive)
+   (let ((cbuf (current-buffer)))
+     (set-buffer gnus-article-buffer)
+     (let (buf buffer-read-only b e)
+       (goto-char (point-min))
+       (narrow-to-region
+        (if (search-forward "\n\n" nil t)
+ 	   (setq b (point))
+ 	 (point-max))
+        (setq e (point-max)))
+       (nnheader-temp-write nil
+ 	(insert-buffer-substring gnus-article-buffer b e)
+ 	(save-window-excursion
+ 	  (setq buf (car (w3-parse-buffer (current-buffer))))))
+       (when buf
+ 	(delete-region (point-min) (point-max))
+ 	(insert-buffer-substring buf)
+ 	(kill-buffer buf))
+       (widen)
+       (goto-char (point-min))
+       (set-window-start (get-buffer-window (current-buffer)) (point-min))
+       (set-buffer cbuf))))
+ 
  (defun gnus-article-hidden-arg ()
    "Return the current prefix arg as a number, or 0 if no prefix."
    (list (if current-prefix-arg
***************
*** 1205,1211 ****
      (concat "Date: " date "\n"))
     ;; Let the user define the format.
     ((eq type 'user)
!     (concat 
       (format-time-string gnus-article-time-format
  			 (ignore-errors
  			   (gnus-encode-date
--- 1233,1240 ----
      (concat "Date: " date "\n"))
     ;; Let the user define the format.
     ((eq type 'user)
!     (concat
!      "Date: "
       (format-time-string gnus-article-time-format
  			 (ignore-errors
  			   (gnus-encode-date
***************
*** 1285,1291 ****
    (article-date-ut 'lapsed highlight))
  
  (defun article-date-user (&optional highlight)
!   "Convert the current article date to the user-defined format."
    (interactive (list t))
    (article-date-ut 'user highlight))
  
--- 1314,1321 ----
    (article-date-ut 'lapsed highlight))
  
  (defun article-date-user (&optional highlight)
!   "Convert the current article date to the user-defined format.
! This format is defined by the `gnus-article-time-format' variable."
    (interactive (list t))
    (article-date-ut 'user highlight))
  
***************
*** 1749,1754 ****
--- 1779,1785 ----
    (use-local-map gnus-article-mode-map)
    (gnus-update-format-specifications nil 'article-mode)
    (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
+   (set (make-local-variable 'gnus-button-marker-list) nil)
    (gnus-set-default-directory)
    (buffer-disable-undo (current-buffer))
    (setq buffer-read-only t)
***************
*** 2689,2696 ****
    (save-excursion
      (set-buffer gnus-article-buffer)
      ;; Remove all old markers.
!     (while gnus-button-marker-list
!       (set-marker (pop gnus-button-marker-list) nil))
      (let ((buffer-read-only nil)
  	  (inhibit-point-motion-hooks t)
  	  (case-fold-search t)
--- 2720,2733 ----
    (save-excursion
      (set-buffer gnus-article-buffer)
      ;; Remove all old markers.
!     (let (marker entry)
!       (while (setq marker (pop gnus-button-marker-list))
! 	(goto-char marker)
! 	(when (setq entry (gnus-button-entry))
! 	  (put-text-property (match-beginning (nth 1 entry))
! 			     (match-end (nth 1 entry))
! 			     'gnus-callback nil))
! 	(set-marker marker nil)))
      (let ((buffer-read-only nil)
  	  (inhibit-point-motion-hooks t)
  	  (case-fold-search t)
***************
*** 2710,2718 ****
  		 (from (match-beginning 0)))
  	    (when (and (or (eq t (nth 1 entry))
  			   (eval (nth 1 entry)))
! 		       (not (gnus-button-in-region-p from end 'gnus-callback)))
  	      ;; That optional form returned non-nil, so we add the
! 	      ;; button. 
  	      (gnus-article-add-button 
  	       start end 'gnus-button-push 
  	       (car (push (set-marker (make-marker) from)
--- 2747,2756 ----
  		 (from (match-beginning 0)))
  	    (when (and (or (eq t (nth 1 entry))
  			   (eval (nth 1 entry)))
! 		       (not (gnus-button-in-region-p
! 			     start end 'gnus-callback)))
  	      ;; That optional form returned non-nil, so we add the
! 	      ;; button.
  	      (gnus-article-add-button 
  	       start end 'gnus-button-push 
  	       (car (push (set-marker (make-marker) from)
*** pub/rgnus/lisp/gnus-cite.el	Sat Jan 25 10:08:02 1997
--- rgnus/lisp/gnus-cite.el	Sun Mar  2 04:47:13 1997
***************
*** 419,424 ****
--- 419,425 ----
  	  (inhibit-point-motion-hooks t)
  	  (marks (gnus-dissect-cited-text))
  	  (adaptive-fill-mode nil)
+ 	  (filladapt-mode nil)
  	  (fill-column (if width (prefix-numeric-value width) fill-column)))
        (save-restriction
  	(while (cdr marks)
*** pub/rgnus/lisp/gnus-cus.el	Fri Oct 11 12:07:35 1996
--- rgnus/lisp/gnus-cus.el	Sun Mar  2 04:47:13 1997
***************
*** 26,32 ****
  
  ;;; Code:
  
! (require 'widget-edit)
  (require 'gnus-score)
  
  ;;; Widgets:
--- 26,32 ----
  
  ;;; Code:
  
! (require 'wid-edit)
  (require 'gnus-score)
  
  ;;; Widgets:
*** pub/rgnus/lisp/gnus-group.el	Sat Mar  1 03:54:48 1997
--- rgnus/lisp/gnus-group.el	Sun Mar  2 04:47:14 1997
***************
*** 1544,1549 ****
--- 1544,1551 ----
      (gnus))
    (gnus-group-read-group nil nil group))
  
+ (defvar gnus-ephemeral-group-server 0)
+ 
  ;; Enter a group that is not in the group buffer.  Non-nil is returned
  ;; if selection was successful.
  (defun gnus-group-read-ephemeral-group (group method &optional activate 
***************
*** 1555,1560 ****
--- 1557,1569 ----
  If REQUEST-ONLY, don't actually read the group; just request it.
  
  Return the name of the group is selection was successful."
+   ;; Transform the select method into a unique server.
+   (let ((saddr (intern (format "%s-address" (car method)))))
+     (setq method (gnus-copy-sequence method))
+     (unless (assq saddr method)
+       (nconc method `((,saddr ,(cadr method)))))
+     (setf (cadr method) (format "%s-%d" (cadr method)
+ 				(incf gnus-ephemeral-group-server))))
    (let ((group (if (gnus-group-foreign-p group) group
  		 (gnus-group-prefixed-name group method))))
      (gnus-sethash
*** pub/rgnus/lisp/gnus-srvr.el	Sat Mar  1 03:54:48 1997
--- rgnus/lisp/gnus-srvr.el	Sun Mar  2 04:47:14 1997
***************
*** 207,222 ****
      (setq gnus-inserted-opened-servers nil)
      ;; First we do the real list of servers.
      (while alist
!       (unless (member (caar alist) done)
! 	(push (caar alist) done)
  	(cdr (setq server (pop alist))) 
  	(when (and server (car server) (cdr server))
  	  (gnus-server-insert-server-line (car server) (cdr server)))))
      ;; Then we insert the list of servers that have been opened in
      ;; this session.
      (while opened 
!       (unless (member (cadaar opened) done)
! 	(push (cadaar opened) done)
  	(gnus-server-insert-server-line 
  	 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
  	 (caar opened))
--- 207,222 ----
      (setq gnus-inserted-opened-servers nil)
      ;; First we do the real list of servers.
      (while alist
!       (unless (member (cdar alist) done)
! 	(push (cdar alist) done)
  	(cdr (setq server (pop alist))) 
  	(when (and server (car server) (cdr server))
  	  (gnus-server-insert-server-line (car server) (cdr server)))))
      ;; Then we insert the list of servers that have been opened in
      ;; this session.
      (while opened 
!       (unless (member (caar opened) done)
! 	(push (caar opened) done)
  	(gnus-server-insert-server-line 
  	 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
  	 (caar opened))
*** pub/rgnus/lisp/gnus-start.el	Sat Mar  1 03:54:49 1997
--- rgnus/lisp/gnus-start.el	Sun Mar  2 04:47:15 1997
***************
*** 394,400 ****
  ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
  (defvar gnus-init-inhibit nil)
  (defun gnus-read-init-file (&optional inhibit-next)
!   ;; Don't load .gnus if -q option was used.
    (when init-file-user
      (if gnus-init-inhibit
  	(setq gnus-init-inhibit nil)
--- 394,400 ----
  ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
  (defvar gnus-init-inhibit nil)
  (defun gnus-read-init-file (&optional inhibit-next)
!   ;; Don't load .gnus if the -q option was used.
    (when init-file-user
      (if gnus-init-inhibit
  	(setq gnus-init-inhibit nil)
*** pub/rgnus/lisp/gnus-sum.el	Sat Mar  1 03:54:50 1997
--- rgnus/lisp/gnus-sum.el	Sun Mar  2 04:47:16 1997
***************
*** 1282,1288 ****
      "r" gnus-summary-caesar-message
      "t" gnus-article-hide-headers
      "v" gnus-summary-verbose-headers
!     "m" gnus-summary-toggle-mime)
  
    (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
      "a" gnus-article-hide
--- 1282,1289 ----
      "r" gnus-summary-caesar-message
      "t" gnus-article-hide-headers
      "v" gnus-summary-verbose-headers
!     "m" gnus-summary-toggle-mime
!     "h" gnus-article-treat-html)
  
    (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
      "a" gnus-article-hide
***************
*** 2913,2919 ****
         header level nil (gnus-article-mark article)
         (memq article gnus-newsgroup-replied)
         (memq article gnus-newsgroup-expirable)
!        (mail-header-subject header)
         nil (cdr (assq article gnus-newsgroup-scored))
         (memq article gnus-newsgroup-processable))
        (when length
--- 2914,2932 ----
         header level nil (gnus-article-mark article)
         (memq article gnus-newsgroup-replied)
         (memq article gnus-newsgroup-expirable)
!        ;; Only insert the Subject string when it's different
!        ;; from the previous Subject string.
!        (unless (gnus-subject-equal
! 		(condition-case ()
! 		    (mail-header-subject
! 		     (gnus-data-header
! 		      (cadr 
! 		       (gnus-data-find-list
! 			article
! 			(gnus-data-list t)))))
! 		  (error ""))
! 		(mail-header-subject header))
! 	 (mail-header-subject header))
         nil (cdr (assq article gnus-newsgroup-scored))
         (memq article gnus-newsgroup-processable))
        (when length
***************
*** 3868,3882 ****
  		    (gnus-mode-string-quote
  		     (mail-header-subject gnus-current-headers))
  		  ""))
! 	       max-len
  	       gnus-tmp-header);; passed as argument to any user-format-funcs
  	  (setq mode-string (eval mformat))
  	  (setq max-len (max 4 (if gnus-mode-non-string-length
  				   (- (window-width)
  				      gnus-mode-non-string-length
! 				      (if (string-match "%%b" mode-string)
! 					  (length (buffer-name))
! 					0))
  				 (length mode-string))))
  	  ;; We might have to chop a bit of the string off...
  	  (when (> (length mode-string) max-len)
--- 3881,3901 ----
  		    (gnus-mode-string-quote
  		     (mail-header-subject gnus-current-headers))
  		  ""))
! 	       bufname-length max-len
  	       gnus-tmp-header);; passed as argument to any user-format-funcs
  	  (setq mode-string (eval mformat))
+ 	  (setq bufname-length (if (string-match "%b" mode-string)
+ 				   (- (length
+ 				       (buffer-name
+ 					(if (eq where 'summary)
+ 					    nil
+ 					  (get-buffer gnus-article-buffer))))
+ 				      2)
+ 				 0))
  	  (setq max-len (max 4 (if gnus-mode-non-string-length
  				   (- (window-width)
  				      gnus-mode-non-string-length
! 				      bufname-length)
  				 (length mode-string))))
  	  ;; We might have to chop a bit of the string off...
  	  (when (> (length mode-string) max-len)
***************
*** 6974,6982 ****
      (save-excursion
        (set-buffer gnus-article-buffer)
        (save-restriction
! 	(goto-char (point-min))
! 	(search-forward "\n\n")
! 	(narrow-to-region (point-min) (point))
  	(message "This message would go to %s"
  		 (mapconcat 'car (nnmail-article-group 'identity) ", "))))))
  
--- 6993,6999 ----
      (save-excursion
        (set-buffer gnus-article-buffer)
        (save-restriction
! 	(gnus-narrow-to-body)
  	(message "This message would go to %s"
  		 (mapconcat 'car (nnmail-article-group 'identity) ", "))))))
  
*** pub/rgnus/lisp/gnus-util.el	Sun Feb 16 18:16:39 1997
--- rgnus/lisp/gnus-util.el	Sun Mar  2 04:47:16 1997
***************
*** 777,784 ****
        (erase-buffer)
        (insert-buffer-substring artbuf)
        (goto-char (point-min))
!       (unless (looking-at "From ")
  	(insert "From nobody " (current-time-string) "\n"))
        ;; Decide whether to append to a file or to an Emacs buffer.
        (let ((outbuf (get-file-buffer filename)))
  	(if (not outbuf)
--- 777,789 ----
        (erase-buffer)
        (insert-buffer-substring artbuf)
        (goto-char (point-min))
!       (if (looking-at "From ")
! 	  (forward-line 1)
  	(insert "From nobody " (current-time-string) "\n"))
+       (let (case-fold-search)
+ 	(while (re-search-forward "^From " nil t)
+ 	  (beginning-of-line)
+ 	  (insert ">")))
        ;; Decide whether to append to a file or to an Emacs buffer.
        (let ((outbuf (get-file-buffer filename)))
  	(if (not outbuf)
*** pub/rgnus/lisp/gnus-uu.el	Mon Feb 10 14:27:20 1997
--- rgnus/lisp/gnus-uu.el	Sun Mar  2 04:47:17 1997
***************
*** 1695,1701 ****
  (defun gnus-quote-arg-for-sh-or-csh (arg)
    (let ((pos 0) new-pos accum)
      ;; *** bug: we don't handle newline characters properly
!     (while (setq new-pos (string-match "[!`\"$\\& \t]" arg pos))
        (push (substring arg pos new-pos) accum)
        (push "\\" accum)
        (push (list (aref arg new-pos)) accum)
--- 1695,1701 ----
  (defun gnus-quote-arg-for-sh-or-csh (arg)
    (let ((pos 0) new-pos accum)
      ;; *** bug: we don't handle newline characters properly
!     (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
        (push (substring arg pos new-pos) accum)
        (push "\\" accum)
        (push (list (aref arg new-pos)) accum)
*** pub/rgnus/lisp/gnus-xmas.el	Sat Mar  1 03:54:50 1997
--- rgnus/lisp/gnus-xmas.el	Sun Mar  2 04:47:17 1997
***************
*** 328,334 ****
    (let ((event (next-command-event)))
      (sit-for 0)
      ;; We junk all non-key events.  Is this naughty?
!     (while (not (key-press-event-p event))
        (setq event (next-command-event)))
      (cons (and (key-press-event-p event) 
  	       (event-to-character event)) 
--- 328,336 ----
    (let ((event (next-command-event)))
      (sit-for 0)
      ;; We junk all non-key events.  Is this naughty?
!     (while (not (or (key-press-event-p event)
! 		    (button-press-event-p event)))
!       (dispatch-event event)
        (setq event (next-command-event)))
      (cons (and (key-press-event-p event) 
  	       (event-to-character event)) 
***************
*** 437,446 ****
  	    (color-instance-rgb-components
  	     (make-color-instance color))))))
  
- (defun gnus-xmas-region-active-p ()
-   (and (fboundp 'region-active-p)
-        (region-active-p)))
- 
  (defun gnus-xmas-redefine ()
    "Redefine lots of Gnus functions for XEmacs."
    (fset 'gnus-summary-make-display-table 'ignore)
--- 439,444 ----
***************
*** 461,467 ****
    (fset 'gnus-mode-line-buffer-identification
  	'gnus-xmas-mode-line-buffer-identification)
    (fset 'gnus-key-press-event-p 'key-press-event-p)
!   (fset 'gnus-region-active-p 'gnus-xmas-region-active-p)
    
    (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
    (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
--- 459,465 ----
    (fset 'gnus-mode-line-buffer-identification
  	'gnus-xmas-mode-line-buffer-identification)
    (fset 'gnus-key-press-event-p 'key-press-event-p)
!   (fset 'gnus-region-active-p 'region-active-p)
    
    (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
    (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
*** pub/rgnus/lisp/gnus.el	Sat Mar  1 03:54:51 1997
--- rgnus/lisp/gnus.el	Sun Mar  2 04:47:17 1997
***************
*** 3,9 ****
  
  ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
! ;; Keywords: news
  
  ;; This file is part of GNU Emacs.
  
--- 3,9 ----
  
  ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
! ;; Keywords: news, mail
  
  ;; This file is part of GNU Emacs.
  
***************
*** 33,39 ****
  
  (defgroup gnus nil
    "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
!   :group 'emacs)
  
  (defgroup gnus-start nil
    "Starting your favorite newsreader."
--- 33,40 ----
  
  (defgroup gnus nil
    "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
!   :group 'news
!   :group 'mail)
  
  (defgroup gnus-start nil
    "Starting your favorite newsreader."
***************
*** 184,190 ****
  ;; Other
  (defgroup gnus-visual nil
    "Options controling the visual fluff."
!   :group 'gnus)
  
  (defgroup gnus-files nil
    "Files used by Gnus."
--- 185,192 ----
  ;; Other
  (defgroup gnus-visual nil
    "Options controling the visual fluff."
!   :group 'gnus
!   :group 'faces)
  
  (defgroup gnus-files nil
    "Files used by Gnus."
***************
*** 223,229 ****
    :link '(custom-manual "(gnus)Exiting Gnus")
    :group 'gnus)
  
! (defconst gnus-version-number "5.4.16"
    "Version number for this version of Gnus.")
  
  (defconst gnus-version (format "Gnus v%s" gnus-version-number)
--- 225,231 ----
    :link '(custom-manual "(gnus)Exiting Gnus")
    :group 'gnus)
  
! (defconst gnus-version-number "5.4.17"
    "Version number for this version of Gnus.")
  
  (defconst gnus-version (format "Gnus v%s" gnus-version-number)
***************
*** 2307,2312 ****
--- 2309,2323 ----
  	(setq name (concat foreign name group)
  	      group nil)))
      name))
+ 
+ (defun gnus-narrow-to-body ()
+   "Narrow to the body of an article."
+   (narrow-to-region
+    (progn
+      (goto-char (point-min))
+      (or (search-forward "\n\n" nil t)
+ 	 (point-max)))
+    (point-max)))
  
  
  ;;;
*** pub/rgnus/lisp/message.el	Thu Feb 20 04:19:54 1997
--- rgnus/lisp/message.el	Sun Mar  2 04:47:18 1997
***************
*** 45,51 ****
  		    (user-full-name custom-variable))
    "Mail and news message composing."
    :link '(custom-manual "(message)Top")
!   :group 'emacs)
  
  (put 'user-mail-address 'custom-type 'string)
  (put 'user-full-name 'custom-type 'string)
--- 45,52 ----
  		    (user-full-name custom-variable))
    "Mail and news message composing."
    :link '(custom-manual "(message)Top")
!   :group 'mail
!   :group 'news)
  
  (put 'user-mail-address 'custom-type 'string)
  (put 'user-full-name 'custom-type 'string)
***************
*** 2234,2240 ****
       ".fsf")))
  
  (defun message-number-base36 (num len)
!   (if (if (< len 0) (<= num 0) (= len 0))
        ""
      (concat (message-number-base36 (/ num 36) (1- len))
  	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
--- 2235,2243 ----
       ".fsf")))
  
  (defun message-number-base36 (num len)
!   (if (if (< len 0)
! 	  (<= num 0)
! 	(= len 0))
        ""
      (concat (message-number-base36 (/ num 36) (1- len))
  	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
***************
*** 2789,2795 ****
      (message-setup 
       (nconc
        `((To . ,(or to "")) (Subject . ,(or subject "")))
!       (when other-headers (list other-headers))))))
  
  ;;;###autoload
  (defun message-news (&optional newsgroups subject)
--- 2792,2798 ----
      (message-setup 
       (nconc
        `((To . ,(or to "")) (Subject . ,(or subject "")))
!       (when other-headers other-headers)))))
  
  ;;;###autoload
  (defun message-news (&optional newsgroups subject)
*** pub/rgnus/lisp/nndir.el	Thu Jan  9 11:59:34 1997
--- rgnus/lisp/nndir.el	Sun Mar  2 04:47:18 1997
***************
*** 92,98 ****
    (nnml-retrieve-headers 0 nndir-current-group 0 0)
    (nnmh-request-article 0 nndir-current-group 0 0)
    (nnmh-request-group nndir-current-group 0 0)
!   (nnmh-close-group nndir-current-group 0)
    (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
    (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
  
--- 92,98 ----
    (nnml-retrieve-headers 0 nndir-current-group 0 0)
    (nnmh-request-article 0 nndir-current-group 0 0)
    (nnmh-request-group nndir-current-group 0 0)
!   (nnml-close-group nndir-current-group 0)
    (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
    (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
  
*** pub/rgnus/lisp/nndoc.el	Thu Feb 20 04:19:54 1997
--- rgnus/lisp/nndoc.el	Sun Mar  2 04:47:18 1997
***************
*** 65,72 ****
       (body-end . "^-+ End of forwarded message -+$")
       (prepare-body-function . nndoc-unquote-dashes))
      (rfc934
!      (article-begin . "^-.*\n+")
!      (body-end . "^-.*$")
       (prepare-body-function . nndoc-unquote-dashes))
      (clari-briefs
       (article-begin . "^ \\*")
--- 65,72 ----
       (body-end . "^-+ End of forwarded message -+$")
       (prepare-body-function . nndoc-unquote-dashes))
      (rfc934
!      (article-begin . "^--.*\n+")
!      (body-end . "^--.*$")
       (prepare-body-function . nndoc-unquote-dashes))
      (clari-briefs
       (article-begin . "^ \\*")
*** pub/rgnus/lisp/nnfolder.el	Sat Mar  1 03:54:51 1997
--- rgnus/lisp/nnfolder.el	Sun Mar  2 04:47:19 1997
***************
*** 601,620 ****
      (nnmail-activate 'nnfolder)))
  
  (defun nnfolder-active-number (group)
!   (when group
!     (save-excursion 
!       ;; Find the next article number in GROUP.
!       (prog1
! 	  (let ((active (cadr (assoc group nnfolder-group-alist))))
! 	    (if active
! 		(setcdr active (1+ (cdr active)))
! 	      ;; This group is new, so we create a new entry for it.
! 	      ;; This might be a bit naughty... creating groups on the drop of
! 	      ;; a hat, but I don't know...
! 	      (push (list group (setq active (cons 1 1)))
! 		    nnfolder-group-alist))
! 	    (cdr active))
! 	(nnfolder-possibly-activate-groups group)))))
  
  
  ;; This method has a problem if you've accidentally let the active list get
--- 601,616 ----
      (nnmail-activate 'nnfolder)))
  
  (defun nnfolder-active-number (group)
!   ;; Find the next article number in GROUP.
!   (let ((active (cadr (assoc group nnfolder-group-alist))))
!     (if active
! 	(setcdr active (1+ (cdr active)))
!       ;; This group is new, so we create a new entry for it.
!       ;; This might be a bit naughty... creating groups on the drop of
!       ;; a hat, but I don't know...
!       (push (list group (setq active (cons 1 1)))
! 	    nnfolder-group-alist))
!     (cdr active)))
  
  
  ;; This method has a problem if you've accidentally let the active list get
*** pub/rgnus/lisp/nnmail.el	Sat Mar  1 03:54:52 1997
--- rgnus/lisp/nnmail.el	Sun Mar  2 04:47:19 1997
***************
*** 532,538 ****
        (delete-file nnmail-crash-box))
      (let ((inbox (file-truename (expand-file-name inbox)))
  	  (tofile (file-truename (expand-file-name nnmail-crash-box)))
! 	  movemail popmail errors)
        (if (setq popmail (string-match
  			 "^po:" (file-name-nondirectory inbox)))
  	  (setq inbox (file-name-nondirectory inbox))
--- 532,538 ----
        (delete-file nnmail-crash-box))
      (let ((inbox (file-truename (expand-file-name inbox)))
  	  (tofile (file-truename (expand-file-name nnmail-crash-box)))
! 	  movemail popmail errors result)
        (if (setq popmail (string-match
  			 "^po:" (file-name-nondirectory inbox)))
  	  (setq inbox (file-name-nondirectory inbox))
***************
*** 582,597 ****
  		(let ((default-directory "/"))
  		  (if (nnheader-functionp nnmail-movemail-program)
  		      (funcall nnmail-movemail-program inbox tofile)
! 		    (apply 
! 		     'call-process
! 		     (append
! 		      (list
! 		       (expand-file-name 
! 			nnmail-movemail-program exec-directory)
! 		       nil errors nil inbox tofile)
! 		      (when nnmail-internal-password
! 			(list nnmail-internal-password))))))
! 		(if (not (buffer-modified-p errors))
  		    ;; No output => movemail won
  		    (progn
  		      (unless popmail
--- 582,599 ----
  		(let ((default-directory "/"))
  		  (if (nnheader-functionp nnmail-movemail-program)
  		      (funcall nnmail-movemail-program inbox tofile)
! 		    (setq result
! 			  (apply 
! 			   'call-process
! 			   (append
! 			    (list
! 			     (expand-file-name 
! 			      nnmail-movemail-program exec-directory)
! 			     nil errors nil inbox tofile)
! 			    (when nnmail-internal-password
! 			      (list nnmail-internal-password)))))))
! 		(if (and (not (buffer-modified-p errors))
! 			 (zerop result))
  		    ;; No output => movemail won
  		    (progn
  		      (unless popmail
***************
*** 617,624 ****
  		    (when (looking-at "movemail: ")
  		      (delete-region (point-min) (match-end 0)))
  		    (unless (yes-or-no-p
! 			     (format "movemail: %s.  Continue? "
! 				     (buffer-string)))
  		      (error "%s" (buffer-string)))
  		    (setq tofile nil)))))))
  	(message "Getting mail from %s...done" inbox)
--- 619,626 ----
  		    (when (looking-at "movemail: ")
  		      (delete-region (point-min) (match-end 0)))
  		    (unless (yes-or-no-p
! 			     (format "movemail: %s (%d return).  Continue? "
! 				     (buffer-string) result))
  		      (error "%s" (buffer-string)))
  		    (setq tofile nil)))))))
  	(message "Getting mail from %s...done" inbox)
***************
*** 1573,1579 ****
      (unless nnmail-read-passwd
        (if (load "passwd" t)
  	  (setq nnmail-read-passwd 'read-passwd)
! 	(autoload 'ange-ftp-read-passwd "ange-ftp")
  	(setq nnmail-read-passwd 'ange-ftp-read-passwd)))
      (funcall nnmail-read-passwd prompt)))
  
--- 1575,1582 ----
      (unless nnmail-read-passwd
        (if (load "passwd" t)
  	  (setq nnmail-read-passwd 'read-passwd)
! 	(unless (fboundp 'ange-ftp-read-passwd)
! 	  (autoload 'ange-ftp-read-passwd "ange-ftp"))
  	(setq nnmail-read-passwd 'ange-ftp-read-passwd)))
      (funcall nnmail-read-passwd prompt)))
  
*** pub/rgnus/lisp/nnml.el	Sat Mar  1 03:54:52 1997
--- rgnus/lisp/nnml.el	Sun Mar  2 04:47:19 1997
***************
*** 106,112 ****
  	    (while sequence
  	      (setq article (car sequence))
  	      (setq file (nnml-article-to-file article))
! 	      (when (and (file-exists-p file)
  			 (not (file-directory-p file)))
  		(insert (format "221 %d Article retrieved.\n" article))
  		(setq beg (point))
--- 106,113 ----
  	    (while sequence
  	      (setq article (car sequence))
  	      (setq file (nnml-article-to-file article))
! 	      (when (and file
! 			 (file-exists-p file)
  			 (not (file-directory-p file)))
  		(insert (format "221 %d Article retrieved.\n" article))
  		(setq beg (point))
*** pub/rgnus/lisp/wid-browse.el	Sun Mar  2 04:47:36 1997
--- rgnus/lisp/wid-browse.el	Sun Mar  2 04:47:20 1997
***************
*** 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.48
+ ;; 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
*** pub/rgnus/lisp/wid-edit.el	Sun Mar  2 04:47:37 1997
--- rgnus/lisp/wid-edit.el	Sun Mar  2 04:47:20 1997
***************
*** 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.48
+ ;; 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
*** pub/rgnus/lisp/widget.el	Sun Feb 16 18:16:42 1997
--- rgnus/lisp/widget.el	Sun Mar  2 04:47:20 1997
***************
*** 4,10 ****
  ;;
  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  ;; Keywords: help, extensions, faces, hypermedia
! ;; Version: 1.38
  ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
  
  ;;; Commentary:
--- 4,10 ----
  ;;
  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  ;; Keywords: help, extensions, faces, hypermedia
! ;; Version: 1.48
  ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
  
  ;;; Commentary:
***************
*** 12,18 ****
  ;; 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'.
  
  ;;; Code:
  
--- 12,18 ----
  ;; If you want to use this code, please visit the URL above.
  ;;
  ;; This file only contain the code needed to define new widget types.
! ;; Everything else is autoloaded from `wid-edit.el'.
  
  ;;; Code:
  
***************
*** 42,53 ****
    :hide-rear-space) 
  
  ;; These autoloads should be deleted when the file is added to Emacs.
! (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
  (defun define-widget (name class doc &rest args)
    "Define a new widget type named NAME from CLASS.
  
--- 42,53 ----
    :hide-rear-space) 
  
  ;; These autoloads should be deleted when the file is added to Emacs.
! (unless (fboundp 'load-gc)
!   (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.
  
*** pub/rgnus/lisp/ChangeLog	Sat Mar  1 03:54:47 1997
--- rgnus/lisp/ChangeLog	Sun Mar  2 04:47:11 1997
***************
*** 1,3 ****
--- 1,94 ----
+ Sun Mar  2 04:40:48 1997  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+ 
+ 	* gnus.el: Gnus v5.4.17 is released.
+ 
+ Sun Mar  2 04:01:29 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* message.el (message-mail): Don't `list' other-headers.
+ 
+ Sat Mar  1 22:46:37 1997  Per Abrahamsen  <abraham@dina.kvl.dk>
+ 
+ 	* gnus.el: Added mail keyword.
+ 	(gnus): Add to mail and news customization groups.
+ 	(gnus-visual): Added to the faces customization group.
+ 	* message.el (message): Add to mail and news customization groups.
+ 
+ 	* gnus-cus.el (wid-edit): Changed from widget-edit.
+ 
+ Sun Mar  2 03:44:07 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus-sum.el (gnus-summary-respool-query): Use it.
+ 
+ 	* gnus.el (gnus-narrow-to-body): New function.
+ 
+ 	* nnfolder.el (nnfolder-active-number): Simplify.
+ 
+ Sun Mar  2 03:26:57 1997  Joev Dubach  <dubach1@husc.harvard.edu>
+ 
+ 	* gnus-art.el (article-make-date-line): Add "Date: ".
+ 
+ Sun Mar  2 02:54:13 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Also escape {}. 
+ 
+ 	* gnus-srvr.el (gnus-server-prepare): Don't insert servers twice.
+ 
+ 	* nnmail.el (nnmail-read-passwd): Conditionalize
+ 	`ange-ftp-read-passwd'.
+ 
+ Sat Mar  1 17:53:05 1997  Hrvoje Niksic  <hniksic@srce.hr>
+ 
+ 	* gnus-xmas.el (gnus-xmas-read-event-char): Exit on button-press
+ 	event.
+ 
+ 	* nnml.el (nnml-retrieve-headers): Make sure file is non-nil.
+ 
+ Sun Mar  2 02:43:46 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* nndoc.el (nndoc-type-alist): Have rfc934 separators handled
+ 	better. 
+ 
+ 	* nnmail.el (nnmail-move-inbox): Take heed of the return value
+ 	from movemail.
+ 
+ Fri Feb 21 19:54:24 1997  Hrvoje Niksic  <hniksic@srce.hr>
+ 
+ 	* gnus-xmas.el (gnus-xmas-redefine): Use `region-active-p'.
+ 	(gnus-xmas-region-active-p): Removed.
+ 
+ Sun Mar  2 02:16:38 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus-sum.el (gnus-summary-update-article-line): Only insert
+ 	Subject string when needed.
+ 
+ 	* gnus-util.el (gnus-output-to-mail): Quote all "From " lines. 
+ 
+ Sun Mar  2 02:13:17 1997  David Martin  <dm@cs.bu.edu>
+ 
+ 	* nndir.el (nndir): Use `nnml-close-group'.
+ 
+ Sun Mar  2 01:51:21 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus-start.el (gnus-init-file): Changed default.
+ 
+ 	* gnus-group.el (gnus-ephemeral-group-server): New server.
+ 	(gnus-group-read-ephemeral-group): Use it to use unique servers. 
+ 
+ Sat Mar  1 04:06:11 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus-art.el (gnus-article-mode): Made `gnus-button-marker-list'
+ 	buffer-local.
+ 	(gnus-article-add-buttons): Don't buttonize the same article
+ 	twice. 
+ 
+ 	* gnus-sum.el (gnus-set-mode-line): Chop better.
+ 
+ 	* gnus-art.el (gnus-article-treat-html): Not a new function.
+ 	Uh-uh.  No way.  I don't even exist.
+ 
+ 	* gnus-cite.el (gnus-article-fill-cited-article): Bind
+ 	filladapt-mode to nil.
+ 
  Sat Mar  1 03:51:18 1997  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
  
  	* gnus.el: Gnus v5.4.16 is released.
*** pub/rgnus/texi/custom.texi	Sun Feb 16 18:16:42 1997
--- rgnus/texi/custom.texi	Sun Mar  2 04:47:20 1997
***************
*** 13,19 ****
  @comment  node-name,  next,  previous,  up
  @top The Customization Library
  
! Version: 1.34
  
  @menu
  * Introduction::                
--- 13,19 ----
  @comment  node-name,  next,  previous,  up
  @top The Customization Library
  
! Version: 1.48
  
  @menu
  * Introduction::                
***************
*** 410,415 ****
--- 410,416 ----
  * Declaring Groups::            
  * Declaring Variables::         
  * Declaring Faces::             
+ * Usage for Package Authors::   
  @end menu
  
  All the customization declarations can be changes by keyword arguments.
***************
*** 510,516 ****
  member.  For other types variables, the effect is undefined."
  @end defun
  
! @node  Declaring Faces,  , Declaring Variables, Declarations
  @comment  node-name,  next,  previous,  up
  @subsection Declaring Faces
  
--- 511,517 ----
  member.  For other types variables, the effect is undefined."
  @end defun
  
! @node  Declaring Faces, Usage for Package Authors, Declaring Variables, Declarations
  @comment  node-name,  next,  previous,  up
  @subsection Declaring Faces
  
***************
*** 564,569 ****
--- 565,586 ----
  
  @end defun
  
+ @node Usage for Package Authors,  , Declaring Faces, Declarations
+ @comment  node-name,  next,  previous,  up
+ @subsection Usage for Package Authors
+ 
+ The recommended usage for the author of a typical emacs lisp package is
+ to create one group identifying the package, and make all user options
+ and faces members of that group.  If the package has more than around 20
+ such options, they should be divided into a number of subgroups, with
+ each subgroup being member of the top level group.
+ 
+ The top level group for the package should itself be member of one or
+ more of the standard customization groups.  There exists a group for
+ each @emph{finder} keyword.  Press @kbd{C-c p} to see a list of finder
+ keywords, and add you group to each of them, using the @code{:group}
+ keyword. 
+ 
  @node  Utilities, The Init File, Declarations, Top
  @comment  node-name,  next,  previous,  up
  @section Utilities
***************
*** 621,629 ****
  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. 
--- 638,643 ----
***************
*** 639,649 ****
  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}. 
  
--- 653,658 ----
***************
*** 652,657 ****
--- 661,672 ----
  @item
  Command to check if there are any customization options that
  does not belong to an existing group. 
+ 
+ @item
+ Optionally disable the point-cursor and instead highlight the selected
+ item in XEmacs.  This is like the *Completions* buffer in XEmacs.
+ Suggested by Jens Lautenbacher
+ @samp{<jens@@lemming0.lem.uni-karlsruhe.de>}.@refill
  
  @end itemize
  
*** pub/rgnus/texi/gnus.texi	Sat Mar  1 03:54:55 1997
--- rgnus/texi/gnus.texi	Sun Mar  2 04:47:22 1997
***************
*** 854,863 ****
  
  @vindex gnus-init-file
  When Gnus starts, it will read the @code{gnus-site-init-file}
! (@file{.../site-lisp/gnus.el} by default) and @code{gnus-init-file}
! (@file{~/.gnus.el} by default) files.  These are normal Emacs Lisp files
! and can be used to avoid cluttering your @file{.emacs} and
! @file{site-init} files with Gnus stuff.
  
  
  @node Auto Save
--- 854,868 ----
  
  @vindex gnus-init-file
  When Gnus starts, it will read the @code{gnus-site-init-file}
! (@file{.../site-lisp/gnus} by default) and @code{gnus-init-file}
! (@file{~/.gnus} by default) files.  These are normal Emacs Lisp files
! and can be used to avoid cluttering your @file{~/.emacs} and
! @file{site-init} files with Gnus stuff.  Gnus will also check for files
! with the same names as these, but with @file{.elc} and @file{.el}
! suffixes.  In other words, if you have set @code{gnus-init-file} to
! @file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el},
! and finally @file{~/.gnus} (in this order).
! 
  
  
  @node Auto Save
***************
*** 10957,10963 ****
  element}.  This date says when the last time this score entry matched,
  which provides a mechanism for expiring the score entries.  It this
  element is not present, the score entry is permanent.  The date is
! represented by the number of days since December 31, 1 ce.
  
  @item 
  If the fourth element is present, it should be a symbol---the @dfn{type
--- 10962,10968 ----
  element}.  This date says when the last time this score entry matched,
  which provides a mechanism for expiring the score entries.  It this
  element is not present, the score entry is permanent.  The date is
! represented by the number of days since December 31, 1 BCE.
  
  @item 
  If the fourth element is present, it should be a symbol---the @dfn{type
*** pub/rgnus/texi/widget.texi	Sat Mar  1 03:54:56 1997
--- rgnus/texi/widget.texi	Sun Mar  2 04:47:23 1997
***************
*** 1,6 ****
  \input texinfo.tex
  
! @c $Id: widget.texi,v 1.1.1.1 1997/02/27 01:36:06 larsi Exp $
  
  @c %**start of header
  @setfilename widget
--- 1,6 ----
  \input texinfo.tex
  
! @c $Id: widget.texi,v 1.76 1997/03/01 21:35:38 abraham Exp $
  
  @c %**start of header
  @setfilename widget
***************
*** 15,21 ****
  @comment  node-name,  next,  previous,  up
  @top The Emacs Widget Library
  
! Version: 1.34
  
  @menu
  * Introduction::                
--- 15,21 ----
  @comment  node-name,  next,  previous,  up
  @top The Emacs Widget Library
  
! Version: 1.48
  
  @menu
  * Introduction::                
***************
*** 115,121 ****
  @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
  Everything else is here, there is no reason to load it explicitly, as
  it will be autoloaded when needed.
  @end table
--- 115,121 ----
  @item widget.el
  This will declare the user variables, define the function
  @code{widget-define}, and autoload the function @code{widget-create}. 
! @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
***************
*** 236,243 ****
  selected and the previous selected radio button will become unselected. 
  @item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons.
  These are explicit buttons made with the @code{push-button} widget.  The main
! difference from the @code{link} widget is that the buttons are intended
! to be displayed more like buttons in a GUI, once Emacs grows powerful
  enough. 
  @end table
  
--- 236,243 ----
  selected and the previous selected radio button will become unselected. 
  @item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons.
  These are explicit buttons made with the @code{push-button} widget.  The main
! difference from the @code{link} widget is that the buttons are will be
! displayed as GUI buttons when possible.
  enough. 
  @end table
  
***************
*** 278,284 ****
  (require 'widget)
  
  (eval-when-compile
!   (require 'widget-edit))
  
  (defvar widget-example-repeat)
  
--- 278,284 ----
  (require 'widget)
  
  (eval-when-compile
!   (require 'wid-edit))
  
  (defvar widget-example-repeat)
  
***************
*** 1310,1316 ****
  @item
  Activate the item this is below the mouse when the button is
  released, not the item this is below the mouse when the button is
! pressed.  Dired and grep gets this right.
  
  @item
  Use @samp{@@deffn Widget} to document widgets. 
--- 1310,1316 ----
  @item
  Activate the item this is below the mouse when the button is
  released, not the item this is below the mouse when the button is
! pressed.  Dired and grep gets this right.  Give feedback if possible.
  
  @item
  Use @samp{@@deffn Widget} to document widgets. 
***************
*** 1335,1340 ****
--- 1335,1343 ----
  
  @item
  Document @code{widget-browse}.
+ 
+ @item
+ Make indentation work with glyphs and propertional fonts.
  
  @item
  Add object and class hierarchies to the browser.
*** pub/rgnus/texi/ChangeLog	Sat Mar  1 03:54:56 1997
--- rgnus/texi/ChangeLog	Sun Mar  2 04:47:23 1997
***************
*** 1,3 ****
--- 1,8 ----
+ Sun Mar  2 02:08:40 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+ 
+ 	* gnus.texi (Startup Files): Addition.
+ 	(Score File Format): Fix.
+ 
  Fri Feb 28 23:23:31 1997  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
  
  	* gnus.texi (Archived Messages): Clarify.