--- a/lisp/custom/cus-edit.el	Mon Aug 13 09:26:04 2007 +0200
+++ b/lisp/custom/cus-edit.el	Mon Aug 13 09:26:39 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.74
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -206,9 +206,90 @@
   :link '(url-link :tag "Development Page" 
 		   "http://www.dina.kvl.dk/~abraham/custom/")
   :prefix "custom-"
-  :group 'help
+  :group 'help)
+
+(defgroup custom-faces nil
+  "Faces used by customize."
+  :group 'customize
   :group 'faces)
 
+(defgroup abbrev-mode nil
+  "Word abbreviations mode."
+  :group 'abbrev)
+
+(defgroup alloc nil
+  "Storage allocation and gc for GNU Emacs Lisp interpreter."
+  :tag "Storage Allocation"
+  :group 'internal)
+
+(defgroup undo nil
+  "Undoing changes in buffers."
+  :group 'editing)
+
+(defgroup modeline nil
+  "Content of the modeline."
+  :group 'environment)
+
+(defgroup fill nil
+  "Indenting and filling text."
+  :group 'editing)
+
+(defgroup editing-basics nil
+  "Most basic editing facilities."
+  :group 'editing)
+
+(defgroup display nil
+  "How characters are displayed in buffers."
+  :group 'environment)
+
+(defgroup execute nil
+  "Executing external commands."
+  :group 'processes)
+
+(defgroup installation nil
+  "The Emacs installation."
+  :group 'environment)
+
+(defgroup dired nil
+  "Directory editing."
+  :group 'environment)
+
+(defgroup limits nil
+  "Internal Emacs limits."
+  :group 'internal)
+
+(defgroup debug nil
+  "Debugging Emacs itself."
+  :group 'development)
+
+(defgroup minibuffer nil
+  "Controling the behaviour of the minibuffer."
+  :group 'environment)
+
+(defgroup keyboard nil
+  "Input from the keyboard."
+  :group 'environment)
+
+(defgroup mouse nil
+  "Input from the mouse."
+  :group 'environment)
+
+(defgroup menu nil
+  "Input from the menus."
+  :group 'environment)
+
+(defgroup auto-save nil
+  "Preventing accidential loss of data."
+  :group 'data)
+
+(defgroup processes-basics nil
+  "Basic stuff dealing with processes."
+  :group 'processes)
+
+(defgroup windows nil
+  "Windows within a frame."
+  :group 'processes)
+
 ;;; Utilities.
 
 (defun custom-quote (sexp)
@@ -240,6 +321,23 @@
 	(nreverse (cons (substring regexp start) all)))
     regexp))
 
+(defun custom-variable-prompt ()
+  ;; Code stolen from `help.el'.
+  "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 v
+		    (format "Customize variable (default %s): " v)
+		  "Customize variable: ")
+		obarray 'boundp t))
+     (list (if (equal val "")
+	       v (intern val)))))
+
+;;; Unlispify.
+
 (defvar custom-prefix-list nil
   "List of prefixes that should be ignored by `custom-unlispify'")
 
@@ -298,7 +396,9 @@
 	    (concat (symbol-name symbol) "-"))
 	prefixes))
 
-(defcustom custom-guess-type-alist
+;;; Guess.
+
+(defcustom custom-guess-name-alist
   '(("-p\\'" boolean)
     ("-hook\\'" hook)
     ("-face\\'" face)
@@ -316,79 +416,53 @@
 
 This is used for guessing the type of variables not declared with
 customize."
-  :type '(repeat (group regexp sexp))
+  :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
+  :group 'customize)
+
+(defcustom custom-guess-doc-alist
+  '(("\\`\\*?Non-nil " boolean))
+  "Alist of (MATCH TYPE).
+
+MATCH should be a regexp matching a documentation string, and TYPE
+should be a widget suitable for editing the value of a variable with
+that documentation string.  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)
 
 (defun custom-guess-type (symbol)
   "Guess a widget suitable for editing the value of SYMBOL.
-This is done by matching SYMBOL with `custom-guess-type-alist'."
+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))
-	(alist custom-guess-type-alist)
+	(names custom-guess-name-alist)
 	current found)
-    (while alist
-      (setq current (car alist)
-	    alist (cdr alist))
+    (while names
+      (setq current (car names)
+	    names (cdr names))
       (when (string-match (nth 0 current) name)
 	(setq found (nth 1 current)
-	      alist nil)))
+	      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)
+		    docs nil))))))
     found))
 
-;;; The Custom Mode.
+;;; Custom Mode Commands.
 
 (defvar custom-options nil
   "Customization widgets in the current buffer.")
 
-(defvar custom-mode-map nil
-  "Keymap for `custom-mode'.")
-  
-(unless custom-mode-map
-  (setq custom-mode-map (make-sparse-keymap))
-  (set-keymap-parent custom-mode-map widget-keymap)
-  (define-key custom-mode-map "q" 'bury-buffer))
-
-(easy-menu-define custom-mode-menu 
-    custom-mode-map
-  "Menu used in customization buffers."
-    '("Custom"
-      ["Set" custom-set t]
-      ["Save" custom-save t]
-      ["Reset to Current" custom-reset-current t]
-      ["Reset to Saved" custom-reset-saved t]
-      ["Reset to Factory Settings" custom-reset-factory t]
-      ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
-
-(defcustom custom-mode-hook nil
-  "Hook called when entering custom-mode."
-  :type 'hook
-  :group 'customize)
-
-(defun custom-mode ()
-  "Major mode for editing customization buffers.
-
-The following commands are available:
-
-\\[widget-forward]		Move to next button or editable field.
-\\[widget-backward]		Move to previous button or editable field.
-\\[widget-button-click]		Activate button under the mouse pointer.
-\\[widget-button-press]		Activate button under point.
-\\[custom-set]			Set all modifications.
-\\[custom-save]		Make all modifications default.
-\\[custom-reset-current]        Reset all modified options. 
-\\[custom-reset-saved]		Reset all modified or set options.
-\\[custom-reset-factory]	Reset all options.
-
-Entry to this mode calls the value of `custom-mode-hook'
-if that value is non-nil."
-  (kill-all-local-variables)
-  (setq major-mode 'custom-mode
-	mode-name "Custom")
-  (use-local-map custom-mode-map)
-  (easy-menu-add custom-mode-menu)
-  (make-local-variable 'custom-options)
-  (run-hooks 'custom-mode-hook))
-
-;;; Custom Mode Commands.
-
 (defun custom-set ()
   "Set changes in all modified options."
   (interactive)
@@ -473,21 +547,17 @@
 ;;;###autoload
 (defun customize-variable (symbol)
   "Customize SYMBOL, which must be a variable."
-  (interactive
-   ;; Code stolen from `help.el'.
-   (let ((v (variable-at-point))
-	 (enable-recursive-minibuffers t)
-	 val)
-     (setq val (completing-read 
-		(if v
-		    (format "Customize variable (default %s): " v)
-		  "Customize variable: ")
-		obarray 'boundp t))
-     (list (if (equal val "")
-	       v (intern val)))))
+  (interactive (custom-variable-prompt))
   (custom-buffer-create (list (list symbol 'custom-variable))))
 
 ;;;###autoload
+(defun customize-variable-other-window (symbol)
+  "Customize SYMBOL, which must be a variable.
+Show the buffer in another window, but don't select it."
+  (interactive (custom-variable-prompt))
+  (custom-buffer-create-other-window (list (list symbol 'custom-variable))))
+
+;;;###autoload
 (defun customize-face (&optional symbol)
   "Customize SYMBOL, which should be a face name or nil.
 If SYMBOL is nil, customize all faces."
@@ -498,7 +568,10 @@
 	(message "Looking for faces...")
 	(mapcar (lambda (symbol)
 		  (setq found (cons (list symbol 'custom-face) found)))
-		(face-list))
+		(nreverse (mapcar 'intern 
+				  (sort (mapcar 'symbol-name (face-list))
+					'string<))))
+			
 	(custom-buffer-create found))
     (if (stringp symbol)
 	(setq symbol (intern symbol)))
@@ -507,6 +580,19 @@
     (custom-buffer-create (list (list symbol 'custom-face)))))
 
 ;;;###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)))))
+
+;;;###autoload
 (defun customize-customized ()
   "Customize all already customized user options."
   (interactive)
@@ -554,9 +640,24 @@
 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
 SYMBOL is a customization option, and WIDGET is a widget for editing
 that option."
-  (message "Creating customization buffer...")
   (kill-buffer (get-buffer-create "*Customization*"))
   (switch-to-buffer (get-buffer-create "*Customization*"))
+  (custom-buffer-create-internal options))
+
+(defun custom-buffer-create-other-window (options)
+  "Create a buffer containing OPTIONS.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option."
+  (kill-buffer (get-buffer-create "*Customization*"))
+  (let ((window (selected-window)))
+    (switch-to-buffer-other-window (get-buffer-create "*Customization*"))
+    (custom-buffer-create-internal options)
+    (select-window window)))
+  
+
+(defun custom-buffer-create-internal (options)
+  (message "Creating customization buffer...")
   (custom-mode)
   (widget-insert "This is a customization buffer.
 Push RET or click mouse-2 on the word ")
@@ -634,6 +735,7 @@
   (message "Creating customization setup...")
   (widget-setup)
   (goto-char (point-min))
+  (forward-char)			;Kludge: bob is writable in XEmacs.
   (message "Creating customization buffer...done"))
 
 ;;; Modification of Basic Widgets.
@@ -796,7 +898,8 @@
 				     (string :tag "Magic")
 				     face
 				     (string :tag "Description"))))
-  :group 'customize)
+  :group 'customize
+  :group 'custom-faces)
 
 (defcustom custom-magic-show 'long
   "Show long description of the state of each customization option."
@@ -999,22 +1102,27 @@
 	  (t
 	   (funcall show widget value)))))
 
+(defvar custom-load-recursion nil
+  "Hack to avoid recursive dependencies.")
+
 (defun custom-load-symbol (symbol)
   "Load all dependencies for SYMBOL."
-  (let ((loads (get symbol 'custom-loads))
-	load)
-    (while loads
-      (setq load (car loads)
-	    loads (cdr loads))
-      (cond ((symbolp load)
-	     (condition-case nil
-		 (require load)
-	       (error nil)))
-	    ((assoc load load-history))
-	    (t
-	     (condition-case nil
-		 (load-library load)
-	       (error nil)))))))
+  (unless custom-load-recursion
+    (let ((custom-load-recursion t) 
+	  (loads (get symbol 'custom-loads))
+	  load)
+      (while loads
+	(setq load (car loads)
+	      loads (cdr loads))
+	(cond ((symbolp load)
+	       (condition-case nil
+		   (require load)
+		 (error nil)))
+	      ((assoc load load-history))
+	      (t
+	       (condition-case nil
+		   (load-library load)
+		 (error nil))))))))
 
 (defun custom-load-widget (widget)
   "Load all dependencies for WIDGET."
@@ -1024,11 +1132,11 @@
 
 (defface custom-variable-sample-face '((t (:underline t)))
   "Face used for unpushable variable tags."
-  :group 'customize)
+  :group 'custom-faces)
 
 (defface custom-variable-button-face '((t (:underline t :bold t)))
   "Face used for pushable variable tags."
-  :group 'customize)
+  :group 'custom-faces)
 
 (define-widget 'custom-variable 'custom
   "Customize variable."
@@ -1051,7 +1159,8 @@
 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)
-		   (custom-guess-type symbol)
+		   (and (not (get symbol 'factory-value))
+			(custom-guess-type symbol))
 		   'sexp))
 	 (options (get symbol 'custom-options))
 	 (tmp (if (listp type)
@@ -1213,10 +1322,10 @@
 	   (goto-char (widget-get val :from))
 	   (error "%s" (widget-get val :error)))
 	  ((eq form 'lisp)
-	   (set symbol (eval (setq val (widget-value child))))
+	   (set-default symbol (eval (setq val (widget-value child))))
 	   (put symbol 'customized-value (list val)))
 	  (t
-	   (set symbol (setq val (widget-value child)))
+	   (set-default symbol (setq val (widget-value child)))
 	   (put symbol 'customized-value (list (custom-quote val)))))
     (custom-variable-state-set widget)
     (custom-redraw-magic widget)))
@@ -1235,12 +1344,12 @@
 	   (error "%s" (widget-get val :error)))
 	  ((eq form 'lisp)
 	   (put symbol 'saved-value (list (widget-value child)))
-	   (set symbol (eval (widget-value child))))
+	   (set-default symbol (eval (widget-value child))))
 	  (t
 	   (put symbol
 		'saved-value (list (custom-quote (widget-value
 						  child))))
-	   (set symbol (widget-value child))))
+	   (set-default symbol (widget-value child))))
     (put symbol 'customized-value nil)
     (custom-save-all)
     (custom-variable-state-set widget)
@@ -1251,7 +1360,7 @@
   (let ((symbol (widget-value widget)))
     (if (get symbol 'saved-value)
 	(condition-case nil
-	    (set symbol (eval (car (get symbol 'saved-value))))
+	    (set-default symbol (eval (car (get symbol 'saved-value))))
 	  (error nil))
       (error "No saved value for %s" symbol))
     (put symbol 'customized-value nil)
@@ -1262,7 +1371,7 @@
   "Restore the factory setting for the variable being edited by WIDGET."
   (let ((symbol (widget-value widget)))
     (if (get symbol 'factory-value)
-	(set symbol (eval (car (get symbol 'factory-value))))
+	(set-default symbol (eval (car (get symbol 'factory-value))))
       (error "No factory default for %S" symbol))
     (put symbol 'customized-value nil)
     (when (get symbol 'saved-value)
@@ -1362,7 +1471,7 @@
 
 (defface custom-face-tag-face '((t (:underline t)))
   "Face used for face tags."
-  :group 'customize)
+  :group 'custom-faces)
 
 (define-widget 'custom-face 'custom
   "Customize face."
@@ -1664,7 +1773,7 @@
 and so forth.  The remaining group tags are shown with
 `custom-group-tag-face'."
   :type '(repeat face)
-  :group 'customize)
+  :group 'custom-faces)
 
 (defface custom-group-tag-face-1 '((((class color)
 				     (background dark))
@@ -1683,7 +1792,7 @@
 				  (:foreground "blue" :underline t))
 				 (t (:underline t)))
   "Face used for low level group tags."
-  :group 'customize)
+  :group 'custom-faces)
 
 (define-widget 'custom-group 'custom
   "Customize group."
@@ -2004,16 +2113,12 @@
       (custom-menu-create symbol))))
 
 ;;;###autoload
-(defun custom-menu-create (symbol &optional name)
+(defun custom-menu-create (symbol)
   "Create menu for customization group SYMBOL.
-If optional NAME is given, use that as the name of the menu. 
-Otherwise make up a name from SYMBOL.
 The menu is in a format applicable to `easy-menu-define'."
-  (unless name
-    (setq name (custom-unlispify-menu-entry symbol)))
-  (let ((item (vector name
-		      `(custom-buffer-create '((,symbol custom-group)))
-		      t)))
+  (let* ((item (vector (custom-unlispify-menu-entry symbol)
+		       `(custom-buffer-create '((,symbol custom-group)))
+		       t)))
     (if (and (or (not (boundp 'custom-menu-nesting))
 		 (>= custom-menu-nesting 0))
 	     (< (length (get symbol 'custom-group)) widget-menu-max-size))
@@ -2031,46 +2136,78 @@
 		      (get symbol 'custom-group))))
       item)))
 
-;;; Dependencies.
+;;;###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.
+    (cons name (cdr (custom-menu-create symbol)))))
+
+;;; The Custom Mode.
+
+(defvar custom-mode-map nil
+  "Keymap for `custom-mode'.")
+  
+(unless custom-mode-map
+  (setq custom-mode-map (make-sparse-keymap))
+  (set-keymap-parent custom-mode-map widget-keymap)
+  (define-key custom-mode-map "q" 'bury-buffer))
+
+(easy-menu-define custom-mode-customize-menu 
+    custom-mode-map
+  "Menu used in customization buffers."
+  (customize-menu-create 'customize))
 
-;;;###autoload
-(defun custom-make-dependencies ()
-  "Batch function to extract custom dependencies from .el files.
-Usage: emacs -batch *.el -f custom-make-dependencies > deps.el"
-  (let ((buffers (buffer-list)))
-    (while buffers
-      (set-buffer (car buffers))
-      (setq buffers (cdr buffers))
-      (let ((file (buffer-file-name)))
-	(when (and file (string-match "\\`\\(.*\\)\\.el\\'" file))
-	  (goto-char (point-min))
-	  (condition-case nil
-	      (let ((name (file-name-nondirectory (match-string 1 file))))
-		(while t
-		  (let ((expr (read (current-buffer))))
-		    (when (and (listp expr)
-			       (memq (car expr) '(defcustom defface defgroup)))
-		      (eval expr)
-		      (put (nth 1 expr) 'custom-where name)))))
-	    (error nil))))))
-  (mapatoms (lambda (symbol)
-	      (let ((members (get symbol 'custom-group))
-		    item where found)
-		(when members
-		  (princ "(put '")
-		  (princ symbol)
-		  (princ " 'custom-loads '(")
-		  (while members
-		    (setq item (car (car members))
-			  members (cdr members)
-			  where (get item 'custom-where))
-		    (unless (or (null where)
-				(member where found))
-		      (when found
-			(princ " "))
-		      (prin1 where)
-		      (push where found)))
-		  (princ "))\n"))))))
+(easy-menu-define custom-mode-menu 
+    custom-mode-map
+  "Menu used in customization buffers."
+  `("Custom"
+    ["Set" custom-set t]
+    ["Save" custom-save t]
+    ["Reset to Current" custom-reset-current t]
+    ["Reset to Saved" custom-reset-saved t]
+    ["Reset to Factory Settings" custom-reset-factory t]
+    ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
+
+(defcustom custom-mode-hook nil
+  "Hook called when entering custom-mode."
+  :type 'hook
+  :group 'customize)
+
+(defun custom-mode ()
+  "Major mode for editing customization buffers.
+
+The following commands are available:
+
+Move to next button or editable field.     \\[widget-forward]
+Move to previous button or editable field. \\[widget-backward]
+Activate button under the mouse pointer.   \\[widget-button-click]
+Activate button under point.		   \\[widget-button-press]
+Set all modifications.			   \\[custom-set]
+Make all modifications default.		   \\[custom-save]
+Reset all modified options. 		   \\[custom-reset-current]
+Reset all modified or set options.	   \\[custom-reset-saved]
+Reset all options.			   \\[custom-reset-factory]
+
+Entry to this mode calls the value of `custom-mode-hook'
+if that value is non-nil."
+  (kill-all-local-variables)
+  (setq major-mode 'custom-mode
+	mode-name "Custom")
+  (use-local-map custom-mode-map)
+  (easy-menu-add custom-mode-customize-menu)
+  (easy-menu-add custom-mode-menu)
+  (make-local-variable 'custom-options)
+  (run-hooks 'custom-mode-hook))
 
 ;;; The End.