comparison lisp/cus-edit.el @ 25685:fc2bfab28ed7

Don't define-widget-keywords. (multimedia): New group. (custom-last): Function removed. (custom-quote): Add vectorp case, comment out characterp case. (custom-buffer-done-function, custom-raised-buttons): New option. (Custom-buffer-done): New function. (custom-buffer-create-internal): Obey custom-raised-buttons, Custom-buffer-done. (custom-button-face): Make it `released-button'. (custom-button-pressed-face): Make it `pressed-button' (custom-mode-map): Bind "q" to Custom-buffer-done. (custom-mode): Deal with raised/pressed buttons. Changes from Didier Verna: (custom-prompt-variable): Optional third arg makes prompt for a comment string. (customize-set-value, customize-set-variable, customize-save-variable): Optional prefix makes function handle variable comments. (customize-customized, customize-saved, custom-variable-state-set) (custom-variable-set, custom-variable-save, custom-face-state-set) (custom-variable-reset-saved, custom-variable-reset-standard) (custom-face-set, custom-face-save, custom-face-reset-saved) (custom-face-reset-standard, customize-save-customized): Handle custom comments. (custom-comment-face, custom-comment-tag-face): New face. (custom-comment): New widget. (custom-comment-create, custom-comment-delete) (custom-comment-value-set, custom-comment-show) ()custom-comment-invisible-p): New functions. (custom-variable-value-create, custom-face-value-create): Create a comment field widget. (custom-variable-menu, custom-face-menu): New entry for custom comment. (custom-face-value-create): Remove compatibility code. (custom-save-variables, custom-save-faces): Possibly save custom comments.

25684:e3ed0e86532c

;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: help, faces
;; Version: 1.9954
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(condition-case nil
    (require 'cus-start)
  (error nil))

(define-widget-keywords :custom-last :custom-prefix :custom-category
  :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-standard)

(put 'custom-define-hook 'custom-type 'hook)
(put 'custom-define-hook 'standard-value '(nil))
(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)

;;; Customization Groups.

(defgroup 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 "(elisp)Customization")
  :link '(url-link :tag "Development Page" 
		   "http://www.dina.kvl.dk/~abraham/custom/")
  :prefix "custom-"
  :group 'help)

(defgroup custom-faces nil

(defgroup windows nil
  "Windows within a frame."
  :group 'environment)

;;; Utilities.

(defun custom-last (x &optional n)
  ;; Stolen from `cl.el'.
  "Returns the last link in the list LIST.
With optional argument N, returns Nth-to-last link (default 1)."
  (if n
      (let ((m 0) (p x))
	(while (consp p) (incf m) (pop p))
	(if (<= n 0) p
	  (if (< n m) (nthcdr (- m n) x) x)))
    (while (consp (cdr x)) (pop x))
    x))

(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)

  "Prompt for a variable, defaulting to the variable at point.
Return a list suitable for use in `interactive'."
   (let ((v (variable-at-point))
	 (enable-recursive-minibuffers t)
	 val)
     (setq val (completing-read 
		(if (symbolp v)
		    (format "Customize option: (default %s) " v)
		  "Customize variable: ")
		obarray (lambda (symbol)
			  (and (boundp symbol)

  "Convert MENU to the form used by `widget-choose'.
MENU should be in the same format as `custom-variable-menu'.
WIDGET is the widget to apply the filter entries of MENU on."
  (let ((result nil)
	current name action filter)
    (while menu 
      (setq current (car menu)
	    name (nth 0 current)
	    action (nth 1 current)
	    filter (nth 2 current)
	    menu (cdr menu))

	       (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

    ("-functions\\'" (repeat function))
    ("-list\\'" (repeat sexp))
    ("-alist\\'" (repeat (cons sexp sexp))))
  "Alist of (MATCH TYPE).

MATCH should be a regexp matching the name of a symbol, and TYPE should 
be a widget suitable for editing the value of that symbol.  The TYPE
of the first entry where MATCH matches the name of the symbol will be
used. 

This is used for guessing the type of variables not declared with
customize."
  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
  :group 'customize)

  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
  :group 'customize)

(defun custom-guess-type (symbol)
  "Guess a widget suitable for editing the value of SYMBOL.
This is done by matching SYMBOL with `custom-guess-name-alist' and 
if that fails, the doc string with `custom-guess-doc-alist'."
  (let ((name (symbol-name symbol))
	(names custom-guess-name-alist)
	current found)
    (while names

	(setq found (nth 1 current)
	      names nil)))
    (unless found
      (let ((doc (documentation-property symbol 'variable-documentation))
	    (docs custom-guess-doc-alist))
	(when doc 
	  (while docs
	    (setq current (car docs)
		  docs (cdr docs))
	    (when (string-match (nth 0 current) doc)
	      (setq found (nth 1 current)

			  '(modified set changed rogue))
		(widget-apply child :custom-save)))
	    children))
  (custom-save-all))

(defvar custom-reset-menu 
  '(("Current" . Custom-reset-current)
    ("Saved" . Custom-reset-saved)
    ("Standard Settings" . Custom-reset-standard))
  "Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a

  "Reset all modified group members to their current value."
  (interactive)
  (let ((children custom-options))
    (mapcar (lambda (widget)
	      (and (default-boundp (widget-value widget))
		   (if (memq (widget-get widget :custom-state) 
			     '(modified changed))
		       (widget-apply widget :custom-reset-current))))
	    children)))

(defun Custom-reset-saved (&rest ignore)

		       (widget-apply widget :custom-reset-standard))))
	    children)))

;;; The Customize Commands

(defun custom-prompt-variable (prompt-var prompt-val)
  "Prompt for a variable and a value and return them as a list.
PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
prompt for the value.  The %s escape in PROMPT-VAL is replaced with
the name of the variable.

If the variable has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If the variable has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value."
  (let* ((var (read-variable prompt-var))
	 (minibuffer-help-form '(describe-variable var)))
    (list var
	  (let ((prop (get var 'variable-interactive))
		(type (get var 'custom-type))
		(prompt (format prompt-val var)))
	    (unless (listp type)
	      (setq type (list type)))

					prompt
					(if (boundp var)
					    (symbol-value var))
					(not (boundp var))))
		  (t
		   (eval-minibuffer prompt)))))))

;;;###autoload
(defun customize-set-value (var val)
  "Set VARIABLE to VALUE.  VALUE is a Lisp object.

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value." 
  (interactive (custom-prompt-variable "Set variable: "
				       "Set %s to value: "))
   
  (set var val))

;;;###autoload
(defun customize-set-variable (var val)
  "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.

If VARIABLE has a `custom-set' property, that is used for setting
VARIABLE, otherwise `set-default' is used.

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value. " 
  (interactive (custom-prompt-variable "Set variable: "
				       "Set customized value for %s to: "))
  (funcall (or (get var 'custom-set) 'set-default) var val)
  (put var 'customized-value (list (custom-quote val))))

;;;###autoload
(defun customize-save-variable (var val)
  "Set the default for VARIABLE to VALUE, and save it for future sessions.
If VARIABLE has a `custom-set' property, that is used for setting
VARIABLE, otherwise `set-default' is used.

The `customized-value' property of the VARIABLE will be set to a list

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value. " 
  (interactive (custom-prompt-variable "Set and ave variable: "
				       "Set and save value for %s as: "))
  (funcall (or (get var 'custom-set) 'set-default) var val)
  (put var 'saved-value (list (custom-quote val)))
  (custom-save-all))

;;;###autoload
(defun customize ()
  "Select a customization buffer which you can use to set user options.

;;;###autoload
(defun customize-group (group)
  "Customize GROUP, which must be a customization group."
  (interactive (list (let ((completion-ignore-case t))
		       (completing-read "Customize group: (default emacs) "
					obarray 
					(lambda (symbol)
					  (or (get symbol 'custom-loads)
					      (get symbol 'custom-group)))
					t))))
  (when (stringp group)

;;;###autoload
(defun customize-group-other-window (group)
  "Customize GROUP, which must be a customization group."
  (interactive (list (let ((completion-ignore-case t))
		       (completing-read "Customize group: (default emacs) "
					obarray 
					(lambda (symbol)
					  (or (get symbol 'custom-loads)
					      (get symbol 'custom-group)))
					t))))
  (when (stringp group)

			 (get symbol 'group-documentation))
		     (let ((version (get symbol 'custom-version)))
		       (and version
			    (or (null since-version)
				(customize-version-lessp since-version version))
			    (if (member version versions) 
				t
			      ;;; Collect all versions that we use.
			      (push version versions))))
		     (setq found
			   ;; We have to set the right thing here,
			   ;; depending if we have a group or a
			   ;; variable. 
			   (if (get  symbol 'group-documentation)
			       (cons (list symbol 'custom-group) found)
			     (cons (list symbol 'custom-variable) found))))))
    (if (not found)
	(error "No user option defaults have been changed since Emacs %s"
	       since-version)
      (let ((flist nil))
	(while versions
	  (push (copy-sequence 
		 (cdr (assoc (car versions)  custom-versions-load-alist)))
		flist)
	  (setq versions (cdr versions)))
	(put 'custom-versions-load-alist 'custom-loads 
	     ;; Get all the files that correspond to element from the
	     ;; VERSIONS list. This could use some simplification.
	     (apply 'nconc flist)))
      ;; Because we set all the files needed to be loaded as a
      ;; `custom-loads' property to `custom-versions-load-alist' this

;;;###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))))
      (custom-buffer-create (custom-sort-items
			     (mapcar (lambda (symbol)
				       (list symbol 'custom-face))

				  (custom-unlispify-tag-name symbol)))))

;;;###autoload
(defun customize-face-other-window (&optional symbol)
  "Show customization buffer for FACE in other window."
  (interactive (list (completing-read "Customize face: " 
				      obarray 'custom-facep)))
  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
      ()
    (if (stringp symbol)
	(setq symbol (intern symbol)))
    (unless (symbolp symbol)
      (error "Should be a symbol %S" symbol))
    (custom-buffer-create-other-window 
     (list (list symbol 'custom-face))
     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))

;;;###autoload
(defun customize-customized ()
  "Customize all user options set since the last save in this session."
  (interactive)
  (let ((found nil))
    (mapatoms (lambda (symbol)
		(and (get symbol 'customized-face)
		     (custom-facep symbol)
		     (push (list symbol 'custom-face) found))
		(and (get symbol 'customized-value)
		     (boundp symbol)
		     (push (list symbol 'custom-variable) found))))
    (if (not found)
	(error "No customized user options")
      (custom-buffer-create (custom-sort-items found t nil)

(defun customize-saved ()
  "Customize all already saved user options."
  (interactive)
  (let ((found nil))
    (mapatoms (lambda (symbol)
		(and (get symbol 'saved-face)
		     (custom-facep symbol)
		     (push (list symbol 'custom-face) found))
		(and (get symbol 'saved-value)
		     (boundp symbol)
		     (push (list symbol 'custom-variable) found))))
    (if (not found )
	(error "No saved user options")
      (custom-buffer-create (custom-sort-items found t nil)

links: groups have links to subgroups."
  :type '(radio (const brackets)
		(const links))
  :group 'custom-buffer)

(defcustom custom-buffer-indent 3
  "Number of spaces to indent nested groups."
  :type 'integer
  :group 'custom-buffer)

  "If non-nil, only show a single reset button in customize buffers.
This button will have a menu with all three reset operations."
  :type 'boolean
  :group 'custom-buffer)

(defun custom-buffer-create-internal (options &optional description)
  (message "Creating customization buffer...")
  (custom-mode)
  (widget-insert "This is a customization buffer")
  (if description
      (widget-insert description))
  (widget-insert ".
Square brackets show active fields; type RET or click mouse-1
on an active field to invoke its action.  Editing an option value
changes the text in the buffer; invoke the State button and
choose the Set operation to set the option value.
Invoke ")
  (widget-create 'info-link 
		 :tag "Help"
		 :help-echo "Read the online help."
		 "(emacs)Easy Customization")
  (widget-insert " for more information.\n\n")
  (message "Creating customization buttons...")

		   :help-echo "\
Reset all values in this buffer to their standard settings."
		   :action 'Custom-reset-standard))
  (widget-insert "   ")
  (widget-create 'push-button
		 :tag "Bury Buffer"
		 :help-echo "Bury the buffer."
		 :action (lambda (widget &optional event)
			   (bury-buffer)))
  (widget-insert "\n\n")
  (message "Creating customization items...")
  (setq custom-options 
	(if (= (length options) 1)
	    (mapcar (lambda (entry)
		      (widget-create (nth 1 entry)
				     :documentation-shown t
				     :custom-state 'unknown

on an active field to invoke its action.
Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
  (if custom-browse-only-groups
      (widget-insert "\
Invoke the [Group] button below to edit that item in another window.\n\n")
    (widget-insert "Invoke the ") 
    (widget-create 'item 
		   :format "%t"
		   :tag "[Group]"
		   :tag-glyph "folder")
    (widget-insert ", ")
    (widget-create 'item 
		   :format "%t"
		   :tag "[Face]"
		   :tag-glyph "face")
    (widget-insert ", and ")
    (widget-create 'item 
		   :format "%t"
		   :tag "[Option]"
		   :tag-glyph "option")
    (widget-insert " buttons below to edit that
item in another window.\n\n"))
  (let ((custom-buffer-style 'tree))
    (widget-create 'custom-group 
		   :custom-last t
		   :custom-state 'unknown
		   :tag (custom-unlispify-tag-name group)
		   :value group))
  (goto-char (point-min)))

			      (" |-" "middle")
			      (" `-" "bottom")))

(defun custom-browse-insert-prefix (prefix)
  "Insert PREFIX.  On XEmacs convert it to line graphics."
  (if nil ; (string-match "XEmacs" emacs-version)
      (progn 
	(insert "*")
	(while (not (string-equal prefix ""))
	  (let ((entry (substring prefix 0 3)))
	    (setq prefix (substring prefix 3))
	    (let ((overlay (make-overlay (1- (point)) (point) nil t nil))

			     (t
			      (:underline t)))
  "Face used when the customize item is not defined for customization."
  :group 'custom-magic-faces)

(defface custom-modified-face '((((class color)) 
				 (:foreground "white" :background "blue"))
				(t
				 (:italic t :bold)))
  "Face used when the customize item has been modified."
  :group 'custom-magic-faces)

(defface custom-set-face '((((class color)) 
				(:foreground "blue" :background "white"))
			       (t
				(:italic t)))
  "Face used when the customize item has been set."
  :group 'custom-magic-faces)

(defface custom-changed-face '((((class color)) 
				(:foreground "white" :background "blue"))
			       (t
				(:italic t)))
  "Face used when the customize item has been changed."
  :group 'custom-magic-faces)

something in this group is not prepared for customization.")
			       (standard " " nil "\
this %c is unchanged from its standard setting." "\
visible group members are all at standard settings."))
  "Alist of customize option states.
Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where 

STATE is one of the following symbols:

`nil'
   For internal use, should never occur.
`unknown'
   For internal use, should never occur.
`hidden'
   This item is not being displayed. 
`invalid'
   This item is modified, but has an invalid form.
`modified'
   This item is modified, and has a valid form.
`set'

  :value-create 'custom-magic-value-create
  :value-delete 'widget-children-value-delete)

(defun widget-magic-mouse-down-action (widget &optional event)
  ;; Non-nil unless hidden.
  (not (eq (widget-get (widget-get (widget-get widget :parent) :parent) 
		       :custom-state)
	   'hidden)))

(defun custom-magic-value-create (widget)
  ;; Create compact status report for WIDGET.

			(nth 4 entry))
		   (nth 3 entry)))
	 (form (widget-get parent :custom-form))
	 children)
    (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
      (setq text (concat (match-string 1 text) 
			 (symbol-name category)
			 (match-string 2 text))))
    (when (and custom-magic-show
	       (or (not hidden)
		   (memq category custom-magic-show-hidden)))

      (when (and (eq category 'group)
		 (not (and (eq custom-buffer-style 'links)
			   (> (widget-get parent :custom-level) 1))))
	(insert-char ?\  (* custom-buffer-indent
			    (widget-get parent :custom-level))))
      (push (widget-create-child-and-convert 
	     widget 'choice-item 
	     :help-echo "Change the state of this item."
	     :format (if hidden "%t" "%[%t%]")
	     :button-prefix 'widget-push-button-prefix
	     :button-suffix 'widget-push-button-suffix
	     :mouse-down-action 'widget-magic-mouse-down-action

    (when custom-magic-show-button
      (when custom-magic-show
	(let ((indent (widget-get parent :indent)))
	  (when indent
	    (insert-char ?  indent))))
      (push (widget-create-child-and-convert 
	     widget 'choice-item 
	     :mouse-down-action 'widget-magic-mouse-down-action
	     :button-face face
	     :button-prefix ""
	     :button-suffix ""
	     :help-echo "Change the state."

  (let ((magic (widget-get widget :custom-magic)))
    (widget-value-set magic (widget-value magic))))

;;; The `custom' Widget.

(defface custom-button-face nil
  "Face used for buttons in customization buffers."
  :group 'custom-faces)

(defface custom-documentation-face nil
  "Face used for documentation strings in customization buffers."
  :group 'custom-faces)

  :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)

    (save-excursion
      (widget-value-set widget (widget-value widget))
      (custom-redraw-magic widget))
    (when (and (>= pos from) (<= pos to))
      (condition-case nil
	  (progn 
	    (if (> column 0)
		(goto-line line)
	      (goto-line (1+ line)))
	    (move-to-column column))
	(error nil)))))

(defun custom-redraw-magic (widget)
  "Redraw WIDGET state with current settings."
  (while widget 
    (let ((magic (widget-get widget :custom-magic)))
      (cond (magic 
	     (widget-value-set magic (widget-value magic))
	     (when (setq widget (widget-get widget :group))
	       (custom-group-state-update widget)))
	    (t
	     (setq widget nil)))))

  "Hack to avoid recursive dependencies.")

(defun custom-load-symbol (symbol)
  "Load all dependencies for SYMBOL."
  (unless custom-load-recursion
    (let ((custom-load-recursion t) 
	  (loads (get symbol 'custom-loads))
	  load)
      (while loads
	(setq load (car loads)
	      loads (cdr loads))

  (let ((state (widget-get widget :custom-state)))
    (cond ((memq state '(invalid modified))
	   (error "There are unset changes"))
	  ((eq state 'hidden)
	   (widget-put widget :custom-state 'unknown))
	  (t 
	   (widget-put widget :documentation-shown nil)
	   (widget-put widget :custom-state 'hidden)))
    (custom-redraw widget)
    (widget-setup)))

	       (insert ".\n"))
	      ((null (cdr links))
	       (if many
		   (insert ", and ")
		 (insert " and ")))
	      (t 
	       (insert ", "))))
      (widget-put widget :buttons buttons))))

(defun custom-add-parent-links (widget &optional initial-string)
  "Add \"Parent groups: ...\" to WIDGET if the group has parents.

    (insert (or initial-string "Parent groups:"))
    (mapatoms (lambda (symbol)
		(let ((entry (assq name (get symbol 'custom-group))))
		  (when (eq (nth 1 entry) type)
		    (insert " ")
		    (push (widget-create-child-and-convert 
			   widget 'custom-group-link 
			   :tag (custom-unlispify-tag-name symbol)
			   symbol)
			  buttons)
		    (setq found t)))))
    (widget-put widget :buttons buttons)
    (if found
	(insert "\n")
      (delete-region start (point)))
    found))

;;; The `custom-variable' Widget.

(defface custom-variable-tag-face '((((class color)
				      (background dark))

  :custom-reset-saved 'custom-variable-reset-saved
  :custom-reset-standard 'custom-variable-reset-standard)

(defun custom-variable-type (symbol)
  "Return a widget suitable for editing the value of SYMBOL.
If SYMBOL has a `custom-type' property, use that.  
Otherwise, look up symbol in `custom-guess-type-alist'."
  (let* ((type (or (get symbol 'custom-type)
		   (and (not (get symbol 'standard-value))
			(custom-guess-type symbol))
		   'sexp))

		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq state 'hidden)
	   ;; Indicate hidden value.
	   (push (widget-create-child-and-convert 
		  widget 'item
		  :format "%{%t%}: "
		  :sample-face 'custom-variable-tag-face
		  :tag tag
		  :parent widget)
		 buttons)
	   (push (widget-create-child-and-convert 
		  widget 'visibility
		  :help-echo "Show the value of this option."
		  :action 'custom-toggle-parent
		  nil)
		 buttons))

			       ((default-boundp symbol)
				(custom-quote (funcall get symbol)))
			       (t
				(custom-quote (widget-get conv :value))))))
	     (insert (symbol-name symbol) ": ")
	     (push (widget-create-child-and-convert 
		    widget 'visibility
		    :help-echo "Hide the value of this option."
		    :action 'custom-toggle-parent
		    t)
		   buttons)
	     (insert " ")
	     (push (widget-create-child-and-convert 
		    widget 'sexp 
		    :button-face 'custom-variable-button-face
		    :format "%v"
		    :tag (symbol-name symbol)
		    :parent widget
		    :value value)

	     (unless (string-match ":" format)
	       (error "Bad format"))
	     (setq tag-format (substring format 0 (match-end 0)))
	     (setq value-format (substring format (match-end 0)))
	     (push (widget-create-child-and-convert
		    widget 'item 
		    :format tag-format
		    :action 'custom-tag-action
		    :help-echo "Change value of this option."
		    :mouse-down-action 'custom-tag-mouse-down-action
		    :button-face 'custom-variable-button-face
		    :sample-face 'custom-variable-tag-face
		    tag)
		   buttons)
	     (insert " ")
	     (push (widget-create-child-and-convert 
		  widget 'visibility
		  :help-echo "Hide the value of this option."
		  :action 'custom-toggle-parent
		  t)
		 buttons)	     
	     (push (widget-create-child-and-convert
		    widget type 
		    :format value-format
		    :value value)
		   children))))
    (unless (eq custom-buffer-style 'tree)
      ;; Now update the state.
      (unless (eq (preceding-char) ?\n)
	(widget-insert "\n"))
      (if (eq state 'hidden)
	  (widget-put widget :custom-state state)
	(custom-variable-state-set widget))
      ;; Create the magic button.
      (let ((magic (widget-create-child-and-convert
		    widget 'custom-magic nil)))
	(widget-put widget :custom-magic magic)
	(push magic buttons))
      ;; Update properties.
      (widget-put widget :custom-form form)	     
      (widget-put widget :buttons buttons)
      (widget-put widget :children children)
      ;; Insert documentation.
      (widget-default-format-handler widget ?h)
      ;; See also.
      (unless (eq state 'hidden)
	(when (eq (widget-get widget :custom-level) 1)
	  (custom-add-parent-links widget))
	(custom-add-see-also widget)))))

  (let* ((symbol (widget-value widget))
	 (get (or (get symbol 'custom-get) 'default-value))
	 (value (if (default-boundp symbol)
		    (funcall get symbol)
		  (widget-get widget :value)))
	 tmp
	 (state (cond ((setq tmp (get symbol 'customized-value))
		       (if (condition-case nil
			       (equal value (eval (car tmp)))
			     (error nil))
			   'set
			 'changed))
		      ((setq tmp (get symbol 'saved-value))
		       (if (condition-case nil
			       (equal value (eval (car tmp)))
			     (error nil))
			   'saved
			 'changed))
		      ((setq tmp (get symbol 'standard-value))
		       (if (condition-case nil
			       (equal value (eval (car tmp)))
			     (error nil))
			   'standard
			 'changed))
		      (t 'rogue))))
    (widget-put widget :custom-state state)))

(defvar custom-variable-menu 
  '(("Set for Current Session" custom-variable-set
     (lambda (widget)
       (eq (widget-get widget :custom-state) 'modified)))
    ("Save for Future Sessions" custom-variable-save
     (lambda (widget)

     (lambda (widget)
       (and (default-boundp (widget-value widget))
	    (memq (widget-get widget :custom-state) '(modified changed)))))
    ("Reset to Saved" custom-variable-reset-saved
     (lambda (widget)
       (and (get (widget-value widget) 'saved-value)
	    (memq (widget-get widget :custom-state)
		  '(modified set changed rogue)))))
    ("Reset to Standard Settings" custom-variable-reset-standard
     (lambda (widget)
       (and (get (widget-value widget) 'standard-value)
	    (memq (widget-get widget :custom-state)
		  '(modified set changed saved rogue)))))
    ("---" ignore ignore)
    ("Don't show as Lisp expression" custom-variable-edit 
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'lisp)))
    ("Show initial Lisp expression" custom-variable-edit-lisp
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'edit))))

  (let* ((form (widget-get widget :custom-form))
	 (state (widget-get widget :custom-state))
	 (child (car (widget-get widget :children)))
	 (symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	  val)
    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable"))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((memq form '(lisp mismatch))
	   (funcall set symbol (eval (setq val (widget-value child))))
	   (put symbol 'customized-value (list val)))
	  (t
	   (funcall set symbol (setq val (widget-value child)))
	   (put symbol 'customized-value (list (custom-quote val)))))
    (custom-variable-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-variable-save (widget)
  "Set and save the value for the variable being edited by WIDGET."
  (let* ((form (widget-get widget :custom-form))
	 (state (widget-get widget :custom-state))
	 (child (car (widget-get widget :children)))
	 (symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	 val)
    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable"))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((memq form '(lisp mismatch))
	   (put symbol 'saved-value (list (widget-value child)))
	   (funcall set symbol (eval (widget-value child))))
	  (t
	   (put symbol
		'saved-value (list (custom-quote (widget-value
						  child))))
	   (funcall set symbol (widget-value child))))
    (put symbol 'customized-value nil)
    (custom-save-all)
    (custom-variable-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-variable-reset-saved (widget)
  "Restore the saved value for the variable being edited by WIDGET."
  (let* ((symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default)))
    (if (get symbol 'saved-value)
	(condition-case nil
	    (funcall set symbol (eval (car (get symbol 'saved-value))))
	  (error nil))
      (error "No saved value for %s" symbol))
    (put symbol 'customized-value nil)
    (widget-put widget :custom-state 'unknown)
    (custom-redraw widget)))

(defun custom-variable-reset-standard (widget)
  "Restore the standard setting for the variable being edited by WIDGET."
  (let* ((symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default)))
    (if (get symbol 'standard-value)
	(funcall set symbol (eval (car (get symbol 'standard-value))))
      (error "No standard setting known for %S" symbol))
    (put symbol 'customized-value nil)
    (when (get symbol 'saved-value)
      (put symbol 'saved-value nil)
      (custom-save-all))
    (widget-put widget :custom-state 'unknown)
    (custom-redraw widget)))

;;; The `custom-face-edit' Widget.

(define-widget 'custom-face-edit 'checklist
  "Edit face attributes."
  :format "%t: %v"
  :tag "Attributes"
  :extra-offset 12
  :button-args '(:help-echo "Control whether this attribute have any effect.")
  :args (mapcar (lambda (att)
		  (list 'group 
			:inline t
			:sibling-args (widget-get (nth 1 att) :sibling-args)
			(list 'const :format "" :value (nth 0 att)) 
			(nth 1 att)))
		custom-face-attributes))

;;; The `custom-display' Widget.

  :custom-reset-current 'custom-redraw
  :custom-reset-saved 'custom-face-reset-saved
  :custom-reset-standard 'custom-face-reset-standard
  :custom-menu 'custom-face-menu-create)

(define-widget 'custom-face-all 'editable-list 
  "An editable list of display specifications and attributes."
  :entry-format "%i %d %v"
  :insert-button-args '(:help-echo "Insert new display specification here.")
  :append-button-args '(:help-echo "Append new display specification here.")
  :delete-button-args '(:help-echo "Delete this display specification.")

(defun custom-display-unselected-match (widget value)
  "Non-nil if VALUE is an unselected display specification."
  (not (face-spec-set-match-display value (selected-frame))))

(define-widget 'custom-face-selected 'group 
  "Edit the attributes of the selected display in a face specification."
  :args '((repeat :format ""
		  :inline t
		  (group custom-display-unselected sexp))
	  (group (sexp :format "") custom-face-edit)

  "Converted version of the `custom-face-selected' widget.")

(defun custom-face-value-create (widget)
  "Create a list of the display specifications for WIDGET."
  (let ((buttons (widget-get widget :buttons))
	(symbol (widget-get widget :value))
	(tag (widget-get widget :tag))
	(state (widget-get widget :custom-state))
	(begin (point))
	(is-last (widget-get widget :custom-last))

	   (if (eq custom-buffer-style 'face)
	       (insert " ")
	     (widget-specify-sample widget begin (point))
	     (insert ": "))
	   ;; Sample.
	   (and (string-match "XEmacs" emacs-version)
		;; XEmacs cannot display uninitialized faces.
		(not (custom-facep symbol))
		(copy-face 'custom-face-empty symbol))
	   (push (widget-create-child-and-convert widget 'item
						  :format "(%{%t%})"
						  :sample-face symbol
						  :tag "sample")
		 buttons)
	   ;; Visibility.
	   (insert " ")
	   (push (widget-create-child-and-convert 
		  widget 'visibility
		  :help-echo "Hide or show this face."
		  :action 'custom-toggle-parent
		  (not (eq state 'hidden)))
		 buttons)

	     (push magic buttons))
	   ;; Update buttons.
	   (widget-put widget :buttons buttons)
	   ;; Insert documentation.
	   (widget-default-format-handler widget ?h)
	   ;; See also.
	   (unless (eq state 'hidden)
	     (when (eq (widget-get widget :custom-level) 1)
	       (custom-add-parent-links widget))
	     (custom-add-see-also widget))

		 (widget-put widget :custom-form custom-face-default-form))
	     (let* ((symbol (widget-value widget))
		    (spec (or (get symbol 'saved-face)
			      (get symbol 'face-defface-spec)
			      ;; Attempt to construct it.
			      (list (list t (custom-face-attributes-get 
					     symbol (selected-frame))))))
		    (form (widget-get widget :custom-form))
		    (indent (widget-get widget :indent))
		    edit)
	       ;; If the user has changed this face in some other way,

	       (if (not (face-spec-match-p symbol spec (selected-frame)))
		   (setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
	       (setq edit (widget-create-child-and-convert
			   widget
			   (cond ((and (eq form 'selected)
				       (widget-apply custom-face-selected 
						     :match spec))
				  (when indent (insert-char ?\  indent))
				  'custom-face-selected)
				 ((and (not (eq form 'lisp))
				       (widget-apply custom-face-all
						     :match spec))
				  'custom-face-all)
				 (t 
				  (when indent (insert-char ?\  indent))
				  'sexp))
			   :value spec))
	       (custom-face-state-set widget)
	       (widget-put widget :children (list edit)))
	     (message "Creating face editor...done"))))))

(defvar custom-face-menu 
  '(("Set for Current Session" custom-face-set)
    ("Save for Future Sessions" custom-face-save-command)
    ("Reset to Saved" custom-face-reset-saved
     (lambda (widget)
       (get (widget-value widget) 'saved-face)))
    ("Reset to Standard Setting" custom-face-reset-standard
     (lambda (widget)
       (get (widget-value widget) 'face-defface-spec)))
    ("---" ignore ignore)
    ("Show all display specs" custom-face-edit-all
     (lambda (widget)
       (not (eq (widget-get widget :custom-form) 'all))))
    ("Just current attributes" custom-face-edit-selected

  (widget-put widget :custom-form 'lisp)
  (custom-redraw widget))

(defun custom-face-state-set (widget)
  "Set the state of WIDGET."
  (let ((symbol (widget-value widget)))
    (widget-put widget :custom-state (cond ((get symbol 'customized-face)
					    'set)
					   ((get symbol 'saved-face)
					    'saved)
					   ((get symbol 'face-defface-spec)
					    'standard)
					   (t 
					    'rogue)))))

(defun custom-face-action (widget &optional event)
  "Show the menu for `custom-face' WIDGET.
Optional EVENT is the location for the menu."
  (if (eq (widget-get widget :custom-state) 'hidden)

(defun custom-face-set (widget)
  "Make the face attributes in WIDGET take effect."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (widget-value child)))
    (put symbol 'customized-face value)
    (face-spec-set symbol value)
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-face-save-command (widget)
  "Save in `.emacs' the face attributes in WIDGET."

(defun custom-face-save (widget)
  "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (widget-value child)))
    (face-spec-set symbol value)
    (put symbol 'saved-face value)
    (put symbol 'customized-face nil)
    (custom-save-all)
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-face-reset-saved (widget)
  "Restore WIDGET to the face's default attributes."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (get symbol 'saved-face)))
    (unless value
      (error "No saved value for this face"))
    (put symbol 'customized-face nil)
    (face-spec-set symbol value)
    (widget-value-set child value)
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-face-reset-standard (widget)
  "Restore WIDGET to the face's standard settings."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (get symbol 'face-defface-spec)))
    (unless value
      (error "No standard setting for this face"))
    (put symbol 'customized-face nil)
    (when (get symbol 'saved-face)
      (put symbol 'saved-face nil)
      (custom-save-all))
    (face-spec-set symbol value)
    (widget-value-set child value)
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

;;; The `face' Widget.

  "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))))

  :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)

;;; The `custom-group' Widget.

(defcustom custom-group-tag-faces nil
  ;; In XEmacs, this ought to play games with font size.
  "Face used for group tags.
The first member is used for level 1 groups, the second for level 2,
and so forth.  The remaining group tags are shown with
`custom-group-tag-face'."
  :type '(repeat face)

    (cond ((and (eq custom-buffer-style 'tree)
		(eq state 'hidden)
		(or members (custom-unloaded-widget-p widget)))
	   (custom-browse-insert-prefix prefix)
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-visibility 
		  ;; :tag-glyph "plus"
		  :tag "+")
		 buttons)
	   (insert "-- ")
	   ;; (widget-glyph-insert nil "-- " "horizontal")

		(zerop (length members)))
	   (custom-browse-insert-prefix prefix)
	   (insert "[ ]-- ")
	   ;; (widget-glyph-insert nil "[ ]" "empty")
	   ;; (widget-glyph-insert nil "-- " "horizontal")
	   (push (widget-create-child-and-convert 
		  widget 'custom-browse-group-tag)
		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq custom-buffer-style 'tree)
	   (custom-browse-insert-prefix prefix)
	   (custom-load-widget widget)
	   (if (zerop (length members))
	       (progn 
		 (custom-browse-insert-prefix prefix)
		 (insert "[ ]-- ")
		 ;; (widget-glyph-insert nil "[ ]" "empty")
		 ;; (widget-glyph-insert nil "-- " "horizontal")
		 (push (widget-create-child-and-convert 
			widget 'custom-browse-group-tag)
		       buttons)
		 (insert " " tag "\n")
		 (widget-put widget :buttons buttons))
	     (push (widget-create-child-and-convert 
		    widget 'custom-browse-visibility 
		    ;; :tag-glyph "minus"
		    :tag "-")
		   buttons)
	     (insert "-\\ ")
	     ;; (widget-glyph-insert nil "-\\ " "top")
	     (push (widget-create-child-and-convert 
		    widget 'custom-browse-group-tag)
		   buttons)
	     (insert " " tag "\n")
	     (widget-put widget :buttons buttons)
	     (message "Creating group...")

	     (widget-specify-sample widget begin (point)))
	   (insert " group: ")
	   ;; Create link/visibility indicator.
	   (if (eq custom-buffer-style 'links)
	       (push (widget-create-child-and-convert
		      widget 'custom-group-link 
		      :tag "Go to Group"
		      symbol)
		     buttons)
	     (push (widget-create-child-and-convert 
		    widget 'custom-group-visibility
		    :help-echo "Show members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons))

	     (widget-specify-sample widget start (point)))
	   (insert " group: ")
	   ;; Create visibility indicator.
	   (unless (eq custom-buffer-style 'links)
	     (insert "--------")
	     (push (widget-create-child-and-convert 
		    widget 'visibility
		    :help-echo "Hide members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons)
	     (insert " "))
	   ;; Create more dashes.
	   ;; Use 76 instead of 75 to compensate for the temporary "<"
	   ;; added by `widget-insert'.  
	   (insert-char ?- (- 76 (current-column)
			      (* custom-buffer-indent level)))
	   (insert "\\\n")
	   ;; Create magic button.
	   (let ((magic (widget-create-child-and-convert
			 widget 'custom-magic 
			 :indent 0
			 nil)))
	     (widget-put widget :custom-magic magic)
	     (push magic buttons))
	   ;; Update buttons.

	   (if nil  ;;; This should test that the buffer
		    ;;; was not made to display a group.
	       (when (eq level 1)
		 (insert-char ?\  custom-buffer-indent)
		 (custom-add-parent-links widget)))
	   (custom-add-see-also widget 
				(make-string (* custom-buffer-indent level)
					     ?\ ))
	   ;; Members.
	   (message "Creating group...")
	   (custom-load-widget widget)

	   (insert-char ?\  (* custom-buffer-indent (1- level)))
	   (insert "\\- " (widget-get widget :tag) " group end ")
	   (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
	   (insert "/\n")))))

(defvar custom-group-menu 
  '(("Set for Current Session" custom-group-set
     (lambda (widget)
       (eq (widget-get widget :custom-state) 'modified)))
    ("Save for Future Sessions" custom-group-save
     (lambda (widget)

  "Alist of actions for the `custom-group' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-group'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")

(defun custom-group-action (widget &optional event)
  "Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
  (if (eq (widget-get widget :custom-state) 'hidden)

       (lambda (symbol)
	 (let ((value (get symbol 'saved-value))
	       (requests (get symbol 'custom-requests))
	       (now (not (or (get symbol 'standard-value)
			     (and (not (boundp symbol))
				  (not (get symbol 'force-value)))))))
	   (princ "\n '(")
	   (princ symbol)
	   (princ " ")
	   (prin1 (car value))
	   (cond (requests
		  (if now
		      (princ " t ")
		    (princ " nil "))
		  (prin1 requests)
		  (princ ")"))
		 (now
		  (princ " t)"))
		 (t
		  (princ ")")))))
       saved-list)
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

      (unless (bolp)
	(princ "\n"))
      (princ "(custom-set-faces")
      (mapcar
       (lambda (symbol)
	 (let ((value (get symbol 'saved-face)))
	   (unless (eq symbol 'default))
	   ;; Don't print default face here.
	   (princ "\n '(")
	   (princ symbol)
	   (princ " ")
	   (prin1 value)
	   (if (or (get symbol 'face-defface-spec)
		   (and (not (custom-facep symbol))
			(not (get symbol 'force-face))))
	       (princ ")")
	     (princ " t)"))))
       saved-list)
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

(defun customize-save-customized ()
  "Save all user options which have been set in this session."
  (interactive)
  (mapatoms (lambda (symbol)
	      (let ((face (get symbol 'customized-face))
		    (value (get symbol 'customized-value)))
		(when face 
		  (put symbol 'saved-face face)
		  (put symbol 'customized-face nil))
		(when value 
		  (put symbol 'saved-value value)
		  (put symbol 'customized-value nil)))))
  ;; We really should update all custom buffers here.
  (custom-save-all))

;;;###autoload
(defun custom-save-all ()

			   (vector (custom-unlispify-menu-entry symbol)
				   `(customize-variable ',symbol)
				   ':style 'toggle
				   ':selected symbol)))

(if (string-match "XEmacs" emacs-version)
    ;; XEmacs can create menus dynamically.
    (defun custom-group-menu-create (widget symbol)
      "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
      `( ,(custom-unlispify-menu-entry symbol t)
	 :filter (lambda (&rest junk)

      item)))

;;;###autoload
(defun customize-menu-create (symbol &optional name)
  "Return a customize menu for customization group SYMBOL.
If optional NAME is given, use that as the name of the menu. 
Otherwise the menu will be named `Customize'.
The format is suitable for use with `easy-menu-define'."
  (unless name
    (setq name "Customize"))
  (if (string-match "XEmacs" emacs-version)
      ;; We can delay it under XEmacs.
      `(,name
	:filter (lambda (&rest junk)
		  (cdr (custom-menu-create ',symbol))))
    ;; But we must create it now under Emacs.

  (setq custom-mode-map (make-sparse-keymap))
  (set-keymap-parent custom-mode-map widget-keymap)
  (suppress-keymap custom-mode-map)
  (define-key custom-mode-map " " 'scroll-up)
  (define-key custom-mode-map "\177" 'scroll-down)
  (define-key custom-mode-map "q" 'bury-buffer)
  (define-key custom-mode-map "u" 'Custom-goto-parent)
  (define-key custom-mode-map "n" 'widget-forward)
  (define-key custom-mode-map "p" 'widget-backward)
  (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke))

      (let* ((pos (widget-event-point event))
	     (button (get-char-property pos 'button)))
	(if button
	    (widget-button-click event)))))

(easy-menu-define Custom-mode-menu 
    custom-mode-map
  "Menu used in customization buffers."
  `("Custom"
    ,(customize-menu-create 'customize)
    ["Set" Custom-set t]

	(let* ((button (get-char-property (point) 'button))
	       (parent (downcase (widget-get  button :tag))))
	  (customize-group parent)))))

(defcustom custom-mode-hook nil
  "Hook called when entering custom-mode."
  :type 'hook
  :group 'custom-buffer )

(defun custom-state-buffer-message (widget)
  (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)

  (make-local-variable 'custom-options)
  (make-local-variable 'widget-documentation-face)
  (setq widget-documentation-face 'custom-documentation-face)
  (make-local-variable 'widget-button-face)
  (setq widget-button-face 'custom-button-face)
  (make-local-hook 'widget-edit-functions)
  (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
  (run-hooks 'custom-mode-hook))

;;; The End.

(provide 'cus-edit)

;; cus-edit.el ends here

25685:fc2bfab28ed7

;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
;;
;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: help, faces
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (probably obsolete)

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(condition-case nil
    (require 'cus-start)
  (error nil))

(put 'custom-define-hook 'custom-type 'hook)
(put 'custom-define-hook 'standard-value '(nil))
(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)

;;; Customization Groups.

(defgroup help nil
  "Support for on-line help systems."
  :group 'emacs)

(defgroup multimedia nil
  "Non-textual support, specifically images and sound."
  :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 "(elisp)Customization")
  :link '(url-link :tag "(Old?) Development Page"
		   "http://www.dina.kvl.dk/~abraham/custom/")
  :prefix "custom-"
  :group 'help)

(defgroup custom-faces nil

(defgroup windows nil
  "Windows within a frame."
  :group 'environment)

;;; Utilities.

(defun custom-quote (sexp)
  "Quote SEXP iff it is not self quoting."
  (if (or (memq sexp '(t nil))
	  (and (symbolp sexp)
	       (eq (aref (symbol-name sexp) 0) ?:))
	  (and (listp sexp)
	       (memq (car sexp) '(lambda)))
	  (stringp sexp)
	  (numberp sexp)
	  (vectorp 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)

  "Prompt for a variable, defaulting to the variable at point.
Return a list suitable for use in `interactive'."
   (let ((v (variable-at-point))
	 (enable-recursive-minibuffers t)
	 val)
     (setq val (completing-read
		(if (symbolp v)
		    (format "Customize option: (default %s) " v)
		  "Customize variable: ")
		obarray (lambda (symbol)
			  (and (boundp symbol)

  "Convert MENU to the form used by `widget-choose'.
MENU should be in the same format as `custom-variable-menu'.
WIDGET is the widget to apply the filter entries of MENU on."
  (let ((result nil)
	current name action filter)
    (while menu
      (setq current (car menu)
	    name (nth 0 current)
	    action (nth 1 current)
	    filter (nth 2 current)
	    menu (cdr menu))

	       (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

    ("-functions\\'" (repeat function))
    ("-list\\'" (repeat sexp))
    ("-alist\\'" (repeat (cons sexp sexp))))
  "Alist of (MATCH TYPE).

MATCH should be a regexp matching the name of a symbol, and TYPE should
be a widget suitable for editing the value of that symbol.  The TYPE
of the first entry where MATCH matches the name of the symbol will be
used.

This is used for guessing the type of variables not declared with
customize."
  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
  :group 'customize)

  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
  :group 'customize)

(defun custom-guess-type (symbol)
  "Guess a widget suitable for editing the value of SYMBOL.
This is done by matching SYMBOL with `custom-guess-name-alist' and
if that fails, the doc string with `custom-guess-doc-alist'."
  (let ((name (symbol-name symbol))
	(names custom-guess-name-alist)
	current found)
    (while names

	(setq found (nth 1 current)
	      names nil)))
    (unless found
      (let ((doc (documentation-property symbol 'variable-documentation))
	    (docs custom-guess-doc-alist))
	(when doc
	  (while docs
	    (setq current (car docs)
		  docs (cdr docs))
	    (when (string-match (nth 0 current) doc)
	      (setq found (nth 1 current)

			  '(modified set changed rogue))
		(widget-apply child :custom-save)))
	    children))
  (custom-save-all))

(defvar custom-reset-menu
  '(("Current" . Custom-reset-current)
    ("Saved" . Custom-reset-saved)
    ("Standard Settings" . Custom-reset-standard))
  "Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a

  "Reset all modified group members to their current value."
  (interactive)
  (let ((children custom-options))
    (mapcar (lambda (widget)
	      (and (default-boundp (widget-value widget))
		   (if (memq (widget-get widget :custom-state)
			     '(modified changed))
		       (widget-apply widget :custom-reset-current))))
	    children)))

(defun Custom-reset-saved (&rest ignore)

		       (widget-apply widget :custom-reset-standard))))
	    children)))

;;; The Customize Commands

(defun custom-prompt-variable (prompt-var prompt-val &optional comment)
  "Prompt for a variable and a value and return them as a list.
PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
prompt for the value.  The %s escape in PROMPT-VAL is replaced with
the name of the variable.

If the variable has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If the variable has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.

If optional COMMENT argument is non nil, also prompt for a comment and return
it as the third element in the list."
  (let* ((var (read-variable prompt-var))
	 (minibuffer-help-form '(describe-variable var))
	 (val
	  (let ((prop (get var 'variable-interactive))
		(type (get var 'custom-type))
		(prompt (format prompt-val var)))
	    (unless (listp type)
	      (setq type (list type)))

					prompt
					(if (boundp var)
					    (symbol-value var))
					(not (boundp var))))
		  (t
		   (eval-minibuffer prompt))))))
    (if comment
 	(list var val
 	      (read-string "Comment: " (get var 'variable-comment)))
      (list var val))))

;;;###autoload
(defun customize-set-value (var val &optional comment)
  "Set VARIABLE to VALUE.  VALUE is a Lisp object.

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.

If given a prefix (or a COMMENT argument), also prompt for a comment."
  (interactive (custom-prompt-variable "Set variable: "
				       "Set %s to value: "
				       current-prefix-arg))
   
  (set var val)
  (cond ((string= comment "")
 	 (put var 'variable-comment nil))
 	(comment
 	 (put var 'variable-comment comment))))

;;;###autoload
(defun customize-set-variable (var val &optional comment)
  "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.

If VARIABLE has a `custom-set' property, that is used for setting
VARIABLE, otherwise `set-default' is used.

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.

If given a prefix (or a COMMENT argument), also prompt for a comment."
  (interactive (custom-prompt-variable "Set variable: "
				       "Set customized value for %s to: "
				       current-prefix-arg))
  (funcall (or (get var 'custom-set) 'set-default) var val)
  (put var 'customized-value (list (custom-quote val)))
  (cond ((string= comment "")
 	 (put var 'variable-comment nil)
 	 (put var 'customized-variable-comment nil))
 	(comment
 	 (put var 'variable-comment comment)
 	 (put var 'customized-variable-comment comment))))

;;;###autoload
(defun customize-save-variable (var val &optional comment)
  "Set the default for VARIABLE to VALUE, and save it for future sessions.
If VARIABLE has a `custom-set' property, that is used for setting
VARIABLE, otherwise `set-default' is used.

The `customized-value' property of the VARIABLE will be set to a list

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read the value.

If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.

If given a prefix (or a COMMENT argument), also prompt for a comment."
  (interactive (custom-prompt-variable "Set and ave variable: "
				       "Set and save value for %s as: "
				       current-prefix-arg))
  (funcall (or (get var 'custom-set) 'set-default) var val)
  (put var 'saved-value (list (custom-quote val)))
  (cond ((string= comment "")
 	 (put var 'variable-comment nil)
 	 (put var 'saved-variable-comment nil))
 	(comment
 	 (put var 'variable-comment comment)
 	 (put var 'saved-variable-comment comment)))
  (custom-save-all))

;;;###autoload
(defun customize ()
  "Select a customization buffer which you can use to set user options.

;;;###autoload
(defun customize-group (group)
  "Customize GROUP, which must be a customization group."
  (interactive (list (let ((completion-ignore-case t))
		       (completing-read "Customize group: (default emacs) "
					obarray
					(lambda (symbol)
					  (or (get symbol 'custom-loads)
					      (get symbol 'custom-group)))
					t))))
  (when (stringp group)

;;;###autoload
(defun customize-group-other-window (group)
  "Customize GROUP, which must be a customization group."
  (interactive (list (let ((completion-ignore-case t))
		       (completing-read "Customize group: (default emacs) "
					obarray
					(lambda (symbol)
					  (or (get symbol 'custom-loads)
					      (get symbol 'custom-group)))
					t))))
  (when (stringp group)

			 (get symbol 'group-documentation))
		     (let ((version (get symbol 'custom-version)))
		       (and version
			    (or (null since-version)
				(customize-version-lessp since-version version))
			    (if (member version versions)
				t
			      ;;; Collect all versions that we use.
			      (push version versions))))
		     (setq found
			   ;; We have to set the right thing here,
			   ;; depending if we have a group or a
			   ;; variable.
			   (if (get  symbol 'group-documentation)
			       (cons (list symbol 'custom-group) found)
			     (cons (list symbol 'custom-variable) found))))))
    (if (not found)
	(error "No user option defaults have been changed since Emacs %s"
	       since-version)
      (let ((flist nil))
	(while versions
	  (push (copy-sequence
		 (cdr (assoc (car versions)  custom-versions-load-alist)))
		flist)
	  (setq versions (cdr versions)))
	(put 'custom-versions-load-alist 'custom-loads
	     ;; Get all the files that correspond to element from the
	     ;; VERSIONS list. This could use some simplification.
	     (apply 'nconc flist)))
      ;; Because we set all the files needed to be loaded as a
      ;; `custom-loads' property to `custom-versions-load-alist' this

;;;###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))))
      (custom-buffer-create (custom-sort-items
			     (mapcar (lambda (symbol)
				       (list symbol 'custom-face))

				  (custom-unlispify-tag-name symbol)))))

;;;###autoload
(defun customize-face-other-window (&optional symbol)
  "Show customization buffer for FACE in other window."
  (interactive (list (completing-read "Customize face: "
				      obarray 'custom-facep)))
  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
      ()
    (if (stringp symbol)
	(setq symbol (intern symbol)))
    (unless (symbolp symbol)
      (error "Should be a symbol %S" symbol))
    (custom-buffer-create-other-window
     (list (list symbol 'custom-face))
     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))

;;;###autoload
(defun customize-customized ()
  "Customize all user options set since the last save in this session."
  (interactive)
  (let ((found nil))
    (mapatoms (lambda (symbol)
		(and (or (get symbol 'customized-face)
			 (get symbol 'customized-face-comment))
		     (custom-facep symbol)
		     (push (list symbol 'custom-face) found))
		(and (or (get symbol 'customized-value)
			 (get symbol 'customized-variable-comment))
		     (boundp symbol)
		     (push (list symbol 'custom-variable) found))))
    (if (not found)
	(error "No customized user options")
      (custom-buffer-create (custom-sort-items found t nil)

(defun customize-saved ()
  "Customize all already saved user options."
  (interactive)
  (let ((found nil))
    (mapatoms (lambda (symbol)
		(and (or (get symbol 'saved-face)
			 (get symbol 'saved-face-comment))
		     (custom-facep symbol)
		     (push (list symbol 'custom-face) found))
		(and (or (get symbol 'saved-value)
			 (get symbol 'saved-variable-comment))
		     (boundp symbol)
		     (push (list symbol 'custom-variable) found))))
    (if (not found )
	(error "No saved user options")
      (custom-buffer-create (custom-sort-items found t nil)

links: groups have links to subgroups."
  :type '(radio (const brackets)
		(const links))
  :group 'custom-buffer)

(defcustom custom-buffer-done-function 'bury-buffer
  "*Function called to remove a Custom buffer when the user is done with it.
Called with one argument, the buffer to remove."
  :type '(choice (function-item bury-buffer)
		 (function-item kill-buffer)
		 (function :tag "Other"))
  :version "21.1"
  :group 'custom-buffer)

(defcustom custom-buffer-indent 3
  "Number of spaces to indent nested groups."
  :type 'integer
  :group 'custom-buffer)

  "If non-nil, only show a single reset button in customize buffers.
This button will have a menu with all three reset operations."
  :type 'boolean
  :group 'custom-buffer)

(defun Custom-buffer-done (&rest ignore)
  "Remove current buffer by calling `custom-buffer-done-function'."
  (interactive)
  (funcall custom-buffer-done-function (current-buffer)))

(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
					     '(("unspecified" . unspecified))))
  "If non-nil, indicate active buttons in a `raised-button' style.
Otherwise use brackets."
  :type 'boolean
  :version "21.1"
  :group 'custom-buffer)

(defun custom-buffer-create-internal (options &optional description)
  (message "Creating customization buffer...")
  (custom-mode)
  (widget-insert "This is a customization buffer")
  (if description
      (widget-insert description))
  (widget-insert (format ".
%s show active fields; type RET or click mouse-1
on an active field to invoke its action.  Editing an option value
changes the text in the buffer; invoke the State button and
choose the Set operation to set the option value.
Invoke " (if custom-raised-buttons
	     "`Raised' buttons"
	     "Square brackets")))
  (widget-create 'info-link
		 :tag "Help"
		 :help-echo "Read the online help."
		 "(emacs)Easy Customization")
  (widget-insert " for more information.\n\n")
  (message "Creating customization buttons...")

		   :help-echo "\
Reset all values in this buffer to their standard settings."
		   :action 'Custom-reset-standard))
  (widget-insert "   ")
  (widget-create 'push-button
		 :tag "Finish"
		 :help-echo "Bury or kill the buffer."
		 :action #'Custom-buffer-done)
  (widget-insert "\n\n")
  (message "Creating customization items...")
  (setq custom-options
	(if (= (length options) 1)
	    (mapcar (lambda (entry)
		      (widget-create (nth 1 entry)
				     :documentation-shown t
				     :custom-state 'unknown

on an active field to invoke its action.
Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
  (if custom-browse-only-groups
      (widget-insert "\
Invoke the [Group] button below to edit that item in another window.\n\n")
    (widget-insert "Invoke the ")
    (widget-create 'item
		   :format "%t"
		   :tag "[Group]"
		   :tag-glyph "folder")
    (widget-insert ", ")
    (widget-create 'item
		   :format "%t"
		   :tag "[Face]"
		   :tag-glyph "face")
    (widget-insert ", and ")
    (widget-create 'item
		   :format "%t"
		   :tag "[Option]"
		   :tag-glyph "option")
    (widget-insert " buttons below to edit that
item in another window.\n\n"))
  (let ((custom-buffer-style 'tree))
    (widget-create 'custom-group
		   :custom-last t
		   :custom-state 'unknown
		   :tag (custom-unlispify-tag-name group)
		   :value group))
  (goto-char (point-min)))

			      (" |-" "middle")
			      (" `-" "bottom")))

(defun custom-browse-insert-prefix (prefix)
  "Insert PREFIX.  On XEmacs convert it to line graphics."
  ;; Fixme: do graphics.
  (if nil ; (string-match "XEmacs" emacs-version)
      (progn
	(insert "*")
	(while (not (string-equal prefix ""))
	  (let ((entry (substring prefix 0 3)))
	    (setq prefix (substring prefix 3))
	    (let ((overlay (make-overlay (1- (point)) (point) nil t nil))

			     (t
			      (:underline t)))
  "Face used when the customize item is not defined for customization."
  :group 'custom-magic-faces)

(defface custom-modified-face '((((class color))
				 (:foreground "white" :background "blue"))
				(t
				 (:italic t :bold)))
  "Face used when the customize item has been modified."
  :group 'custom-magic-faces)

(defface custom-set-face '((((class color))
				(:foreground "blue" :background "white"))
			       (t
				(:italic t)))
  "Face used when the customize item has been set."
  :group 'custom-magic-faces)

(defface custom-changed-face '((((class color))
				(:foreground "white" :background "blue"))
			       (t
				(:italic t)))
  "Face used when the customize item has been changed."
  :group 'custom-magic-faces)

something in this group is not prepared for customization.")
			       (standard " " nil "\
this %c is unchanged from its standard setting." "\
visible group members are all at standard settings."))
  "Alist of customize option states.
Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where

STATE is one of the following symbols:

`nil'
   For internal use, should never occur.
`unknown'
   For internal use, should never occur.
`hidden'
   This item is not being displayed.
`invalid'
   This item is modified, but has an invalid form.
`modified'
   This item is modified, and has a valid form.
`set'

  :value-create 'custom-magic-value-create
  :value-delete 'widget-children-value-delete)

(defun widget-magic-mouse-down-action (widget &optional event)
  ;; Non-nil unless hidden.
  (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
		       :custom-state)
	   'hidden)))

(defun custom-magic-value-create (widget)
  ;; Create compact status report for WIDGET.

			(nth 4 entry))
		   (nth 3 entry)))
	 (form (widget-get parent :custom-form))
	 children)
    (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
      (setq text (concat (match-string 1 text)
			 (symbol-name category)
			 (match-string 2 text))))
    (when (and custom-magic-show
	       (or (not hidden)
		   (memq category custom-magic-show-hidden)))

      (when (and (eq category 'group)
		 (not (and (eq custom-buffer-style 'links)
			   (> (widget-get parent :custom-level) 1))))
	(insert-char ?\  (* custom-buffer-indent
			    (widget-get parent :custom-level))))
      (push (widget-create-child-and-convert
	     widget 'choice-item
	     :help-echo "Change the state of this item."
	     :format (if hidden "%t" "%[%t%]")
	     :button-prefix 'widget-push-button-prefix
	     :button-suffix 'widget-push-button-suffix
	     :mouse-down-action 'widget-magic-mouse-down-action

    (when custom-magic-show-button
      (when custom-magic-show
	(let ((indent (widget-get parent :indent)))
	  (when indent
	    (insert-char ?  indent))))
      (push (widget-create-child-and-convert
	     widget 'choice-item
	     :mouse-down-action 'widget-magic-mouse-down-action
	     :button-face face
	     :button-prefix ""
	     :button-suffix ""
	     :help-echo "Change the state."

  (let ((magic (widget-get widget :custom-magic)))
    (widget-value-set magic (widget-value magic))))

;;; The `custom' Widget.

(defface custom-button-face
  '((((type x) (class color))		; Like default modeline
     (:box (:line-width 2 :style released-button) :background "lightgrey"))
    (t
     nil))
  "Face used for buttons in customization buffers."
  :version "21.1"
  :group 'custom-faces)

(defface custom-button-pressed-face
  '((((type x) (class color))
     (:box (:line-width 2 :style pressed-button) :background "lightgrey"))
    (t
     (:inverse-video t)))
  "Face used for buttons in customization buffers."
  :version "21.1"
  :group 'custom-faces)

(defface custom-documentation-face nil
  "Face used for documentation strings in customization buffers."
  :group 'custom-faces)

  :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)

    (save-excursion
      (widget-value-set widget (widget-value widget))
      (custom-redraw-magic widget))
    (when (and (>= pos from) (<= pos to))
      (condition-case nil
	  (progn
	    (if (> column 0)
		(goto-line line)
	      (goto-line (1+ line)))
	    (move-to-column column))
	(error nil)))))

(defun custom-redraw-magic (widget)
  "Redraw WIDGET state with current settings."
  (while widget
    (let ((magic (widget-get widget :custom-magic)))
      (cond (magic
	     (widget-value-set magic (widget-value magic))
	     (when (setq widget (widget-get widget :group))
	       (custom-group-state-update widget)))
	    (t
	     (setq widget nil)))))

  "Hack to avoid recursive dependencies.")

(defun custom-load-symbol (symbol)
  "Load all dependencies for SYMBOL."
  (unless custom-load-recursion
    (let ((custom-load-recursion t)
	  (loads (get symbol 'custom-loads))
	  load)
      (while loads
	(setq load (car loads)
	      loads (cdr loads))

  (let ((state (widget-get widget :custom-state)))
    (cond ((memq state '(invalid modified))
	   (error "There are unset changes"))
	  ((eq state 'hidden)
	   (widget-put widget :custom-state 'unknown))
	  (t
	   (widget-put widget :documentation-shown nil)
	   (widget-put widget :custom-state 'hidden)))
    (custom-redraw widget)
    (widget-setup)))

	       (insert ".\n"))
	      ((null (cdr links))
	       (if many
		   (insert ", and ")
		 (insert " and ")))
	      (t
	       (insert ", "))))
      (widget-put widget :buttons buttons))))

(defun custom-add-parent-links (widget &optional initial-string)
  "Add \"Parent groups: ...\" to WIDGET if the group has parents.

    (insert (or initial-string "Parent groups:"))
    (mapatoms (lambda (symbol)
		(let ((entry (assq name (get symbol 'custom-group))))
		  (when (eq (nth 1 entry) type)
		    (insert " ")
		    (push (widget-create-child-and-convert
			   widget 'custom-group-link
			   :tag (custom-unlispify-tag-name symbol)
			   symbol)
			  buttons)
		    (setq found t)))))
    (widget-put widget :buttons buttons)
    (if found
	(insert "\n")
      (delete-region start (point)))
    found))

;;; The `custom-comment' Widget.

;; like the editable field
(defface custom-comment-face '((((class grayscale color)
				 (background light))
				(:background "gray85"))
			       (((class grayscale color)
				 (background dark))
				(:background "dim gray"))
			       (t
				(:italic t)))
  "Face used for comments on variables or faces"
  :version "21.1"
  :group 'custom-faces)

;; like font-lock-comment-face
(defface custom-comment-tag-face
  '((((class color) (background dark)) (:foreground "gray80"))
    (((class color) (background light)) (:foreground "blue4"))
    (((class grayscale) (background light))
     (:foreground "DimGray" :bold t :italic t))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :bold t :italic t))
    (t (:bold t)))
  "Face used for variables or faces comment tags"
  :group 'custom-faces)

(define-widget 'custom-comment 'string
  "User comment"
  :tag "Comment"
  :help-echo "Edit a comment here"
  :sample-face 'custom-comment-tag-face
  :value-face 'custom-comment-face
  :value-set 'custom-comment-value-set
  :create 'custom-comment-create
  :delete 'custom-comment-delete)

(defun custom-comment-create (widget)
  (let (overlay)
    (widget-default-create widget)
    (widget-put widget :comment-overlay
		(setq overlay (make-overlay (widget-get widget :from)
					    (widget-get widget :to))))
    ;;(overlay-put overlay 'start-open t)
    (when (equal (widget-get widget :value) "")
      (overlay-put overlay 'invisible t))))

(defun custom-comment-delete (widget)
  (widget-default-delete widget)
  (delete-overlay (widget-get widget :comment-overlay)))

(defun custom-comment-value-set (widget value)
  (widget-default-value-set widget value)
  (if (equal value "")
      (overlay-put (widget-get widget :comment-overlay) 'invisible t)
    (overlay-put (widget-get widget :comment-overlay) 'invisible nil)))

;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
;; the global custom one
(defun custom-comment-show (widget)
  (overlay-put
   (widget-get (widget-get widget :comment-widget) :comment-overlay)
   'invisible nil))

(defun custom-comment-invisible-p (widget)
  (overlay-get
   (widget-get (widget-get widget :comment-widget) :comment-overlay)
   'invisible))

;;; The `custom-variable' Widget.

(defface custom-variable-tag-face '((((class color)
				      (background dark))

  :custom-reset-saved 'custom-variable-reset-saved
  :custom-reset-standard 'custom-variable-reset-standard)

(defun custom-variable-type (symbol)
  "Return a widget suitable for editing the value of SYMBOL.
If SYMBOL has a `custom-type' property, use that.
Otherwise, look up symbol in `custom-guess-type-alist'."
  (let* ((type (or (get symbol 'custom-type)
		   (and (not (get symbol 'standard-value))
			(custom-guess-type symbol))
		   'sexp))

		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq state 'hidden)
	   ;; Indicate hidden value.
	   (push (widget-create-child-and-convert
		  widget 'item
		  :format "%{%t%}: "
		  :sample-face 'custom-variable-tag-face
		  :tag tag
		  :parent widget)
		 buttons)
	   (push (widget-create-child-and-convert
		  widget 'visibility
		  :help-echo "Show the value of this option."
		  :action 'custom-toggle-parent
		  nil)
		 buttons))

			       ((default-boundp symbol)
				(custom-quote (funcall get symbol)))
			       (t
				(custom-quote (widget-get conv :value))))))
	     (insert (symbol-name symbol) ": ")
	     (push (widget-create-child-and-convert
		    widget 'visibility
		    :help-echo "Hide the value of this option."
		    :action 'custom-toggle-parent
		    t)
		   buttons)
	     (insert " ")
	     (push (widget-create-child-and-convert
		    widget 'sexp
		    :button-face 'custom-variable-button-face
		    :format "%v"
		    :tag (symbol-name symbol)
		    :parent widget
		    :value value)

	     (unless (string-match ":" format)
	       (error "Bad format"))
	     (setq tag-format (substring format 0 (match-end 0)))
	     (setq value-format (substring format (match-end 0)))
	     (push (widget-create-child-and-convert
		    widget 'item
		    :format tag-format
		    :action 'custom-tag-action
		    :help-echo "Change value of this option."
		    :mouse-down-action 'custom-tag-mouse-down-action
		    :button-face 'custom-variable-button-face
		    :sample-face 'custom-variable-tag-face
		    tag)
		   buttons)
	     (insert " ")
	     (push (widget-create-child-and-convert
		  widget 'visibility
		  :help-echo "Hide the value of this option."
		  :action 'custom-toggle-parent
		  t)
		 buttons)
	     (push (widget-create-child-and-convert
		    widget type
		    :format value-format
		    :value value)
		   children))))
    (unless (eq custom-buffer-style 'tree)
      (unless (eq (preceding-char) ?\n)
	(widget-insert "\n"))
      ;; Create the magic button.
      (let ((magic (widget-create-child-and-convert
		    widget 'custom-magic nil)))
	(widget-put widget :custom-magic magic)
	(push magic buttons))
      ;; ### NOTE: this is ugly!!!! I need to do update the :buttons property
      ;; before the call to `widget-default-format-handler'. Otherwise, I
      ;; loose my current `buttons'. This function shouldn't be called like
      ;; this anyway. The doc string widget should be added like the others.
      ;; --dv
      (widget-put widget :buttons buttons)
      ;; Insert documentation.
      (widget-default-format-handler widget ?h)

      ;; The comment field
      (unless (eq state 'hidden)
	(let* ((comment (get symbol 'variable-comment))
	       (comment-widget
		(widget-create-child-and-convert
		 widget 'custom-comment
		 :parent widget
		 :value (or comment ""))))
	  (widget-put widget :comment-widget comment-widget)
	  ;; Don't push it !!! Custom assumes that the first child is the
	  ;; value one.
	  (setq children (append children (list comment-widget)))))
      ;; Update the rest of the properties properties.
      (widget-put widget :custom-form form)
      (widget-put widget :children children)
      ;; Now update the state.
      (if (eq state 'hidden)
	  (widget-put widget :custom-state state)
	(custom-variable-state-set widget))
      ;; See also.
      (unless (eq state 'hidden)
	(when (eq (widget-get widget :custom-level) 1)
	  (custom-add-parent-links widget))
	(custom-add-see-also widget)))))

  (let* ((symbol (widget-value widget))
	 (get (or (get symbol 'custom-get) 'default-value))
	 (value (if (default-boundp symbol)
		    (funcall get symbol)
		  (widget-get widget :value)))
	 (comment (get symbol 'variable-comment))
	 tmp
	 temp
	 (state (cond ((progn (setq tmp (get symbol 'customized-value))
			      (setq temp
				    (get symbol 'customized-variable-comment))
			      (or tmp temp))
		       (if (condition-case nil
			       (and (equal value (eval (car tmp)))
				    (equal comment temp))
			     (error nil))
			   'set
			 'changed))
		      ((progn (setq tmp (get symbol 'saved-value))
			      (setq temp (get symbol 'saved-variable-comment))
			      (or tmp temp))
		       (if (condition-case nil
			       (and (equal value (eval (car tmp)))
				    (equal comment temp))
			     (error nil))
			   'saved
			 'changed))
		      ((setq tmp (get symbol 'standard-value))
		       (if (condition-case nil
			       (and (equal value (eval (car tmp)))
				    (equal comment nil))
			     (error nil))
			   'standard
			 'changed))
		      (t 'rogue))))
    (widget-put widget :custom-state state)))

(defvar custom-variable-menu
  '(("Set for Current Session" custom-variable-set
     (lambda (widget)
       (eq (widget-get widget :custom-state) 'modified)))
    ("Save for Future Sessions" custom-variable-save
     (lambda (widget)

     (lambda (widget)
       (and (default-boundp (widget-value widget))
	    (memq (widget-get widget :custom-state) '(modified changed)))))
    ("Reset to Saved" custom-variable-reset-saved
     (lambda (widget)
       (and (or (get (widget-value widget) 'saved-value)
		(get (widget-value widget) 'saved-variable-comment))
	    (memq (widget-get widget :custom-state)
		  '(modified set changed rogue)))))
    ("Reset to Standard Settings" custom-variable-reset-standard
     (lambda (widget)
       (and (get (widget-value widget) 'standard-value)
	    (memq (widget-get widget :custom-state)
		  '(modified set changed saved rogue)))))
    ("---" ignore ignore)
    ("Add Comment" custom-comment-show custom-comment-invisible-p)
    ("---" ignore ignore)
    ("Don't show as Lisp expression" custom-variable-edit
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'lisp)))
    ("Show initial Lisp expression" custom-variable-edit-lisp
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'edit))))

  (let* ((form (widget-get widget :custom-form))
	 (state (widget-get widget :custom-state))
	 (child (car (widget-get widget :children)))
	 (symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	 (comment-widget (widget-get widget :comment-widget))
	 (comment (widget-value comment-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)))
	  ((memq form '(lisp mismatch))
	   (when (equal comment "")
	     (setq comment nil)
	     ;; Make the comment invisible by hand if it's empty
	     (overlay-put (widget-get comment-widget :comment-overlay)
			  'invisible t))
	   (funcall set symbol (eval (setq val (widget-value child))))
	   (put symbol 'customized-value (list val))
	   (put symbol 'variable-comment comment)
	   (put symbol 'customized-variable-comment comment))
	  (t
	   (when (equal comment "")
	     (setq comment nil)
	     ;; Make the comment invisible by hand if it's empty
	     (overlay-put (widget-get comment-widget :comment-overlay)
			  'invisible t))
	   (funcall set symbol (setq val (widget-value child)))
	   (put symbol 'customized-value (list (custom-quote val)))
	   (put symbol 'variable-comment comment)
	   (put symbol 'customized-variable-comment comment)))
    (custom-variable-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-variable-save (widget)
  "Set and save the value for the variable being edited by WIDGET."
  (let* ((form (widget-get widget :custom-form))
	 (state (widget-get widget :custom-state))
	 (child (car (widget-get widget :children)))
	 (symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	 (comment-widget (widget-get widget :comment-widget))
	 (comment (widget-value comment-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)))
	  ((memq form '(lisp mismatch))
	   (when (equal comment "")
	     (setq comment nil)
	     ;; Make the comment invisible by hand if it's empty
	     (overlay-put (widget-get comment-widget :comment-overlay)
			  'invisible t))
	   (put symbol 'saved-value (list (widget-value child)))
	   (funcall set symbol (eval (widget-value child)))
	   (put symbol 'variable-comment comment)
	   (put symbol 'saved-variable-comment comment))
	  (t
	   (when (equal comment "")
	     (setq comment nil)
	     ;; Make the comment invisible by hand if it's empty
	     (overlay-put (widget-get comment-widget :comment-overlay)
			  'invisible t))
	   (put symbol 'saved-value
		(list (custom-quote (widget-value child))))
	   (funcall set symbol (widget-value child))
	   (put symbol 'variable-comment comment)
	   (put symbol 'saved-variable-comment comment)))
    (put symbol 'customized-value nil)
    (put symbol 'customized-variable-comment nil)
    (custom-save-all)
    (custom-variable-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-variable-reset-saved (widget)
  "Restore the saved value for the variable being edited by WIDGET."
  (let* ((symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	 (comment-widget (widget-get widget :comment-widget))
	 (value (get symbol 'saved-value))
	 (comment (get symbol 'saved-variable-comment)))
    (cond ((or value comment)
	   (put symbol 'variable-comment comment)
	   (condition-case nil
	       (funcall set symbol (eval (car value)))
	     (error nil)))
	  (t
	   (error "No saved value for %s" symbol)))
    (put symbol 'customized-value nil)
    (put symbol 'customized-variable-comment nil)
    (widget-put widget :custom-state 'unknown)
    ;; This call will possibly make the comment invisible
    (custom-redraw widget)))

(defun custom-variable-reset-standard (widget)
  "Restore the standard setting for the variable being edited by WIDGET."
  (let* ((symbol (widget-value widget))
	 (set (or (get symbol 'custom-set) 'set-default))
	 (comment-widget (widget-get widget :comment-widget)))
    (if (get symbol 'standard-value)
	(funcall set symbol (eval (car (get symbol 'standard-value))))
      (error "No standard setting known for %S" symbol))
n    (put symbol 'variable-comment nil)
    (put symbol 'customized-value nil)
    (put symbol 'customized-variable-comment nil)
    (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
      (put symbol 'saved-value nil)
      (put symbol 'saved-variable-comment nil)
      (custom-save-all))
    (widget-put widget :custom-state 'unknown)
    ;; This call will possibly make the comment invisible
    (custom-redraw widget)))

;;; The `custom-face-edit' Widget.

(define-widget 'custom-face-edit 'checklist
  "Edit face attributes."
  :format "%t: %v"
  :tag "Attributes"
  :extra-offset 12
  :button-args '(:help-echo "Control whether this attribute has any effect.")
  :args (mapcar (lambda (att)
		  (list 'group
			:inline t
			:sibling-args (widget-get (nth 1 att) :sibling-args)
			(list 'const :format "" :value (nth 0 att))
			(nth 1 att)))
		custom-face-attributes))

;;; The `custom-display' Widget.

  :custom-reset-current 'custom-redraw
  :custom-reset-saved 'custom-face-reset-saved
  :custom-reset-standard 'custom-face-reset-standard
  :custom-menu 'custom-face-menu-create)

(define-widget 'custom-face-all 'editable-list
  "An editable list of display specifications and attributes."
  :entry-format "%i %d %v"
  :insert-button-args '(:help-echo "Insert new display specification here.")
  :append-button-args '(:help-echo "Append new display specification here.")
  :delete-button-args '(:help-echo "Delete this display specification.")

(defun custom-display-unselected-match (widget value)
  "Non-nil if VALUE is an unselected display specification."
  (not (face-spec-set-match-display value (selected-frame))))

(define-widget 'custom-face-selected 'group
  "Edit the attributes of the selected display in a face specification."
  :args '((repeat :format ""
		  :inline t
		  (group custom-display-unselected sexp))
	  (group (sexp :format "") custom-face-edit)

  "Converted version of the `custom-face-selected' widget.")

(defun custom-face-value-create (widget)
  "Create a list of the display specifications for WIDGET."
  (let ((buttons (widget-get widget :buttons))
	children
	(symbol (widget-get widget :value))
	(tag (widget-get widget :tag))
	(state (widget-get widget :custom-state))
	(begin (point))
	(is-last (widget-get widget :custom-last))

	   (if (eq custom-buffer-style 'face)
	       (insert " ")
	     (widget-specify-sample widget begin (point))
	     (insert ": "))
	   ;; Sample.
	   (push (widget-create-child-and-convert widget 'item
						  :format "(%{%t%})"
						  :sample-face symbol
						  :tag "sample")
		 buttons)
	   ;; Visibility.
	   (insert " ")
	   (push (widget-create-child-and-convert
		  widget 'visibility
		  :help-echo "Hide or show this face."
		  :action 'custom-toggle-parent
		  (not (eq state 'hidden)))
		 buttons)

	     (push magic buttons))
	   ;; Update buttons.
	   (widget-put widget :buttons buttons)
	   ;; Insert documentation.
	   (widget-default-format-handler widget ?h)
	   ;; The comment field
	   (unless (eq state 'hidden)
	     (let* ((comment (get symbol 'face-comment))
		    (comment-widget
		     (widget-create-child-and-convert
		      widget 'custom-comment
		      :parent widget
		      :value (or comment ""))))
	       (widget-put widget :comment-widget comment-widget)
	       (push comment-widget children)))
	   ;; See also.
	   (unless (eq state 'hidden)
	     (when (eq (widget-get widget :custom-level) 1)
	       (custom-add-parent-links widget))
	     (custom-add-see-also widget))

		 (widget-put widget :custom-form custom-face-default-form))
	     (let* ((symbol (widget-value widget))
		    (spec (or (get symbol 'saved-face)
			      (get symbol 'face-defface-spec)
			      ;; Attempt to construct it.
			      (list (list t (custom-face-attributes-get
					     symbol (selected-frame))))))
		    (form (widget-get widget :custom-form))
		    (indent (widget-get widget :indent))
		    edit)
	       ;; If the user has changed this face in some other way,

	       (if (not (face-spec-match-p symbol spec (selected-frame)))
		   (setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
	       (setq edit (widget-create-child-and-convert
			   widget
			   (cond ((and (eq form 'selected)
				       (widget-apply custom-face-selected
						     :match spec))
				  (when indent (insert-char ?\  indent))
				  'custom-face-selected)
				 ((and (not (eq form 'lisp))
				       (widget-apply custom-face-all
						     :match spec))
				  'custom-face-all)
				 (t
				  (when indent (insert-char ?\  indent))
				  'sexp))
			   :value spec))
	       (custom-face-state-set widget)
	       (push edit children)
	       (widget-put widget :children children))
	     (message "Creating face editor...done"))))))

(defvar custom-face-menu
  '(("Set for Current Session" custom-face-set)
    ("Save for Future Sessions" custom-face-save-command)
    ("Reset to Saved" custom-face-reset-saved
     (lambda (widget)
       (or (get (widget-value widget) 'saved-face)
	   (get (widget-value widget) 'saved-face-comment))))
    ("Reset to Standard Setting" custom-face-reset-standard
     (lambda (widget)
       (get (widget-value widget) 'face-defface-spec)))
    ("---" ignore ignore)
    ("Add Comment" custom-comment-show custom-comment-invisible-p)
    ("---" ignore ignore)
    ("Show all display specs" custom-face-edit-all
     (lambda (widget)
       (not (eq (widget-get widget :custom-form) 'all))))
    ("Just current attributes" custom-face-edit-selected

  (widget-put widget :custom-form 'lisp)
  (custom-redraw widget))

(defun custom-face-state-set (widget)
  "Set the state of WIDGET."
  (let* ((symbol (widget-value widget))
	 (comment (get symbol 'face-comment))
	 tmp temp)
    (widget-put widget :custom-state
		(cond ((progn
			 (setq tmp (get symbol 'customized-face))
			 (setq temp (get symbol 'customized-face-comment))
			 (or tmp temp))
		       (if (equal temp comment)
			   'set
			 'changed))
		      ((progn
			 (setq tmp (get symbol 'saved-face))
			 (setq temp (get symbol 'saved-face-comment))
			 (or tmp temp))
		       (if (equal temp comment)
			   'saved
			 'changed))
		      ((get symbol 'face-defface-spec)
		       (if (equal comment nil)
			   'standard
			 'changed))
		      (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)

(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))
	 (comment-widget (widget-get widget :comment-widget))
	 (comment (widget-value comment-widget)))
    (when (equal comment "")
      (setq comment nil)
      ;; Make the comment invisible by hand if it's empty
      (overlay-put (widget-get comment-widget :comment-overlay)
		   'invisible t))
    (put symbol 'customized-face value)
    (face-spec-set symbol value)
    (put symbol 'customized-face-comment comment)
    (put symbol 'face-comment comment)
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-face-save-command (widget)
  "Save in `.emacs' the face attributes in WIDGET."

(defun custom-face-save (widget)
  "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (widget-value child))
	 (comment-widget (widget-get widget :comment-widget))
	 (comment (widget-value comment-widget)))
    (when (equal comment "")
      (setq comment nil)
      ;; Make the comment invisible by hand if it's empty
      (overlay-put (widget-get comment-widget :comment-overlay)
		   'invisible t))
    (face-spec-set symbol value)
    (put symbol 'saved-face value)
    (put symbol 'customized-face nil)
    (put symbol 'face-comment comment)
    (put symbol 'customized-face-comment nil)
    (put symbol 'saved-face-comment comment)
    (custom-save-all)
    (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))
	 (comment (get symbol 'saved-face-comment))
	 (comment-widget (widget-get widget :comment-widget)))
    (unless (or value comment)
      (error "No saved value for this face"))
    (put symbol 'customized-face nil)
    (put symbol 'customized-face-comment nil)
    (face-spec-set symbol value)
    (put symbol 'face-comment comment)
    (widget-value-set child value)
    ;; This call manages the comment visibility
    (widget-value-set comment-widget (or comment ""))
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

(defun custom-face-reset-standard (widget)
  "Restore WIDGET to the face's standard settings."
  (let* ((symbol (widget-value widget))
	 (child (car (widget-get widget :children)))
	 (value (get symbol 'face-defface-spec))
	 (comment-widget (widget-get widget :comment-widget)))
    (unless value
      (error "No standard setting for this face"))
    (put symbol 'customized-face nil)
    (put symbol 'customized-face-comment nil)
    (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
      (put symbol 'saved-face nil)
      (put symbol 'saved-face-comment nil)
      (custom-save-all))
    (face-spec-set symbol value)
    (put symbol 'face-comment nil)
    (widget-value-set child value)
    ;; This call manages the comment visibility
    (widget-value-set comment-widget "")
    (custom-face-state-set widget)
    (custom-redraw-magic widget)))

;;; The `face' Widget.

  "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))))

  :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)

;;; The `custom-group' Widget.

(defcustom custom-group-tag-faces nil
  ;; In XEmacs, this ought to play games with font size.
  ;; Fixme: make it do so in Emacs.
  "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)

    (cond ((and (eq custom-buffer-style 'tree)
		(eq state 'hidden)
		(or members (custom-unloaded-widget-p widget)))
	   (custom-browse-insert-prefix prefix)
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-visibility
		  ;; :tag-glyph "plus"
		  :tag "+")
		 buttons)
	   (insert "-- ")
	   ;; (widget-glyph-insert nil "-- " "horizontal")

		(zerop (length members)))
	   (custom-browse-insert-prefix prefix)
	   (insert "[ ]-- ")
	   ;; (widget-glyph-insert nil "[ ]" "empty")
	   ;; (widget-glyph-insert nil "-- " "horizontal")
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-group-tag)
		 buttons)
	   (insert " " tag "\n")
	   (widget-put widget :buttons buttons))
	  ((eq custom-buffer-style 'tree)
	   (custom-browse-insert-prefix prefix)
	   (custom-load-widget widget)
	   (if (zerop (length members))
	       (progn
		 (custom-browse-insert-prefix prefix)
		 (insert "[ ]-- ")
		 ;; (widget-glyph-insert nil "[ ]" "empty")
		 ;; (widget-glyph-insert nil "-- " "horizontal")
		 (push (widget-create-child-and-convert
			widget 'custom-browse-group-tag)
		       buttons)
		 (insert " " tag "\n")
		 (widget-put widget :buttons buttons))
	     (push (widget-create-child-and-convert
		    widget 'custom-browse-visibility
		    ;; :tag-glyph "minus"
		    :tag "-")
		   buttons)
	     (insert "-\\ ")
	     ;; (widget-glyph-insert nil "-\\ " "top")
	     (push (widget-create-child-and-convert
		    widget 'custom-browse-group-tag)
		   buttons)
	     (insert " " tag "\n")
	     (widget-put widget :buttons buttons)
	     (message "Creating group...")

	     (widget-specify-sample widget begin (point)))
	   (insert " group: ")
	   ;; Create link/visibility indicator.
	   (if (eq custom-buffer-style 'links)
	       (push (widget-create-child-and-convert
		      widget 'custom-group-link
		      :tag "Go to Group"
		      symbol)
		     buttons)
	     (push (widget-create-child-and-convert
		    widget 'custom-group-visibility
		    :help-echo "Show members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons))

	     (widget-specify-sample widget start (point)))
	   (insert " group: ")
	   ;; Create visibility indicator.
	   (unless (eq custom-buffer-style 'links)
	     (insert "--------")
	     (push (widget-create-child-and-convert
		    widget 'visibility
		    :help-echo "Hide members of this group."
		    :action 'custom-toggle-parent
		    (not (eq state 'hidden)))
		   buttons)
	     (insert " "))
	   ;; Create more dashes.
	   ;; Use 76 instead of 75 to compensate for the temporary "<"
	   ;; added by `widget-insert'.
	   (insert-char ?- (- 76 (current-column)
			      (* custom-buffer-indent level)))
	   (insert "\\\n")
	   ;; Create magic button.
	   (let ((magic (widget-create-child-and-convert
			 widget 'custom-magic
			 :indent 0
			 nil)))
	     (widget-put widget :custom-magic magic)
	     (push magic buttons))
	   ;; Update buttons.

	   (if nil  ;;; This should test that the buffer
		    ;;; was not made to display a group.
	       (when (eq level 1)
		 (insert-char ?\  custom-buffer-indent)
		 (custom-add-parent-links widget)))
	   (custom-add-see-also widget
				(make-string (* custom-buffer-indent level)
					     ?\ ))
	   ;; Members.
	   (message "Creating group...")
	   (custom-load-widget widget)

	   (insert-char ?\  (* custom-buffer-indent (1- level)))
	   (insert "\\- " (widget-get widget :tag) " group end ")
	   (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
	   (insert "/\n")))))

(defvar custom-group-menu
  '(("Set for Current Session" custom-group-set
     (lambda (widget)
       (eq (widget-get widget :custom-state) 'modified)))
    ("Save for Future Sessions" custom-group-save
     (lambda (widget)

  "Alist of actions for the `custom-group' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-group'
widget as an argument, and returns non-nil if ACTION is valid on that
widget.  If FILTER is nil, ACTION is always valid.")

(defun custom-group-action (widget &optional event)
  "Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
  (if (eq (widget-get widget :custom-state) 'hidden)

       (lambda (symbol)
	 (let ((value (get symbol 'saved-value))
	       (requests (get symbol 'custom-requests))
	       (now (not (or (get symbol 'standard-value)
			     (and (not (boundp symbol))
				  (not (get symbol 'force-value))))))
	       (comment (get symbol 'saved-variable-comment))
	       sep)
	   (when (or value comment)
	     (princ "\n '(")
	     (prin1 symbol)
	     (princ " ")
	     (prin1 (car value))
	     (cond ((or now requests comment)
		    (princ " ")
		    (if now
			(princ "t")
		      (princ "nil"))
		    (cond ((or requests comment)
			   (princ " ")
			   (if requests
			       (prin1 requests)
			     (princ "nil"))
			   (cond (comment
				  (princ " ")
				  (prin1 comment)
				  (princ ")"))
				 (t
				  (princ ")"))))
			  (t
			   (princ ")"))))
		   (t
		    (princ ")"))))))
       saved-list)
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

      (unless (bolp)
	(princ "\n"))
      (princ "(custom-set-faces")
      (mapcar
       (lambda (symbol)
	 (let ((value (get symbol 'saved-face))
	       (now (not (or (get 'default 'face-defface-spec)
			     (and (not (custom-facep 'default))
				  (not (get 'default 'force-face))))))
	       (comment (get 'default 'saved-face-comment)))
	   (unless (eq symbol 'default))
	   ;; Don't print default face here.
	   (princ "\n '(")
	   (prin1 symbol)
	   (princ " ")
	   (prin1 value)
	   (cond ((or now comment)
		  (princ " ")
		  (if now
		      (princ "t")
		    (princ "nil"))
		  (cond (comment
			 (princ " ")
			 (prin1 comment)
			 (princ ")"))
			(t
			 (princ ")"))))
		 (t
		  (princ ")")))))
       saved-list)
      (princ ")")
      (unless (looking-at "\n")
	(princ "\n")))))

(defun customize-save-customized ()
  "Save all user options which have been set in this session."
  (interactive)
  (mapatoms (lambda (symbol)
	      (let ((face (get symbol 'customized-face))
		    (value (get symbol 'customized-value))
		    (face-comment (get symbol 'customized-face-comment))
		    (variable-comment
		     (get symbol 'customized-variable-comment)))
		(when face
		  (put symbol 'saved-face face)
		  (put symbol 'customized-face nil))
		(when value
		  (put symbol 'saved-value value)
		  (put symbol 'customized-value nil))
		(when variable-comment
		  (put symbol 'saved-variable-comment variable-comment)
		  (put symbol 'customized-variable-comment nil))
		(when face-comment
		  (put symbol 'saved-face-comment face-comment)
		  (put symbol 'customized-face-comment nil)))))
  ;; We really should update all custom buffers here.
  (custom-save-all))

;;;###autoload
(defun custom-save-all ()

			   (vector (custom-unlispify-menu-entry symbol)
				   `(customize-variable ',symbol)
				   ':style 'toggle
				   ':selected symbol)))

;; Fixme: sort out use of :filter in Emacs
(if nil ; (string-match "XEmacs" emacs-version)
    ;; XEmacs can create menus dynamically.
    (defun custom-group-menu-create (widget symbol)
      "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
      `( ,(custom-unlispify-menu-entry symbol t)
	 :filter (lambda (&rest junk)

      item)))

;;;###autoload
(defun customize-menu-create (symbol &optional name)
  "Return a customize menu for customization group SYMBOL.
If optional NAME is given, use that as the name of the menu.
Otherwise the menu will be named `Customize'.
The format is suitable for use with `easy-menu-define'."
  (unless name
    (setq name "Customize"))
  ;; Fixme: sort out use of :filter in Emacs
  (if nil ;(string-match "XEmacs" emacs-version)
      ;; We can delay it under XEmacs.
      `(,name
	:filter (lambda (&rest junk)
		  (cdr (custom-menu-create ',symbol))))
    ;; But we must create it now under Emacs.

  (setq custom-mode-map (make-sparse-keymap))
  (set-keymap-parent custom-mode-map widget-keymap)
  (suppress-keymap custom-mode-map)
  (define-key custom-mode-map " " 'scroll-up)
  (define-key custom-mode-map "\177" 'scroll-down)
  (define-key custom-mode-map "q" 'Custom-buffer-done)
  (define-key custom-mode-map "u" 'Custom-goto-parent)
  (define-key custom-mode-map "n" 'widget-forward)
  (define-key custom-mode-map "p" 'widget-backward)
  (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke))

      (let* ((pos (widget-event-point event))
	     (button (get-char-property pos 'button)))
	(if button
	    (widget-button-click event)))))

(easy-menu-define Custom-mode-menu
    custom-mode-map
  "Menu used in customization buffers."
  `("Custom"
    ,(customize-menu-create 'customize)
    ["Set" Custom-set t]

	(let* ((button (get-char-property (point) 'button))
	       (parent (downcase (widget-get  button :tag))))
	  (customize-group parent)))))

(defcustom custom-mode-hook nil
  "Hook called when entering Custom mode."
  :type 'hook
  :group 'custom-buffer )

(defun custom-state-buffer-message (widget)
  (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)

  (make-local-variable 'custom-options)
  (make-local-variable 'widget-documentation-face)
  (setq widget-documentation-face 'custom-documentation-face)
  (make-local-variable 'widget-button-face)
  (setq widget-button-face 'custom-button-face)
  (set (make-local-variable 'widget-button-pressed-face)
       'custom-button-pressed-face)
  (set (make-local-variable 'widget-mouse-face)
       'custom-button-pressed-face)	; buttons `depress' when moused
  ;; When possible, use relief for buttons, not bracketing.  This test
  ;; may not be optimal.
  (when custom-raised-buttons
    (set (make-local-variable 'widget-push-button-prefix) "")
    (set (make-local-variable 'widget-push-button-suffix) "")
    (set (make-local-variable 'widget-link-prefix) "")
    (set (make-local-variable 'widget-link-suffix) ""))
  (make-local-hook 'widget-edit-functions)
  (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
  (run-hooks 'custom-mode-hook))

;;; The End.

(provide 'cus-edit)

;;; cus-edit.el ends here