Synched with 1.9914.

3 files changed, 220 insertions, 97 deletions

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 7d545ba68ec..701a5a8c0f5 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9908
+;; Version: 1.9914
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -246,6 +246,16 @@
   :group 'customize
   :group 'faces)
 
+(defgroup custom-buffer nil
+  "Control the customize buffers."
+  :prefix "custom-"
+  :group 'customize)
+
+(defgroup custom-menu nil
+  "Control how the customize menus."
+  :prefix "custom-"
+  :group 'customize)
+
 (defgroup abbrev-mode nil
   "Word abbreviations mode."
   :group 'abbrev)
@@ -401,7 +411,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
 
 (defcustom custom-unlispify-menu-entries t
   "Display menu entries as words instead of symbols if non nil."
-  :group 'customize
+  :group 'custom-menu
   :type 'boolean)
 
 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
@@ -440,7 +450,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
 
 (defcustom custom-unlispify-tag-names t
   "Display tag names as words instead of symbols if non nil."
-  :group 'customize
+  :group 'custom-buffer
   :type 'boolean)
 
 (defun custom-unlispify-tag-name (symbol)
@@ -518,49 +528,59 @@ if that fails, the doc string with `custom-guess-doc-alist'."
 
 ;;; Sorting.
 
-(defcustom custom-buffer-sort-predicate 'custom-buffer-sort-alphabetically
+(defcustom custom-buffer-sort-predicate 'ignore
   "Function used for sorting group members in buffers.
 The value should be useful as a predicate for `sort'.  
 The list to be sorted is the value of the groups `custom-group' property."
-  :type '(radio (function-item custom-buffer-sort-alphabetically)
+  :type '(radio (const :tag "Unsorted" ignore)
+                (const :tag "Alphabetic" custom-sort-items-alphabetically)
                 (function :tag "Other"))
-  :group 'customize)
+  :group 'custom-buffer)
 
-(defun custom-buffer-sort-alphabetically (a b)
-  "Return t iff is A should be before B.
-A and B should be members of a `custom-group' property. 
-The members are sorted alphabetically, except that all groups are
-sorted after all non-groups."
-  (cond ((and (eq (nth 1 a) 'custom-group) 
-              (not (eq (nth 1 b) 'custom-group)))
-         nil)
-        ((and (eq (nth 1 b) 'custom-group) 
-              (not (eq (nth 1 a) 'custom-group)))
-         t)
-        (t
-         (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
+(defcustom custom-buffer-order-predicate 'custom-sort-groups-last
+  "Function used for sorting group members in buffers.
+The value should be useful as a predicate for `sort'.  
+The list to be sorted is the value of the groups `custom-group' property."
+  :type '(radio (const :tag "Groups first" custom-sort-groups-first)
+                (const :tag "Groups last" custom-sort-groups-last)
+                (function :tag "Other"))
+  :group 'custom-buffer)
 
-(defcustom custom-menu-sort-predicate 'custom-menu-sort-alphabetically
+(defcustom custom-menu-sort-predicate 'ignore
   "Function used for sorting group members in menus.
 The value should be useful as a predicate for `sort'.  
 The list to be sorted is the value of the groups `custom-group' property."
-  :type '(radio (function-item custom-menu-sort-alphabetically)
+  :type '(radio (const :tag "Unsorted" ignore)
+                (const :tag "Alphabetic" custom-sort-items-alphabetically)
                 (function :tag "Other"))
-  :group 'customize)
+  :group 'custom-menu)
 
-(defun custom-menu-sort-alphabetically (a b)
-  "Return t iff is A should be before B.
-A and B should be members of a `custom-group' property. 
-The members are sorted alphabetically, except that all groups are
-sorted before all non-groups."
-  (cond ((and (eq (nth 1 a) 'custom-group) 
-              (not (eq (nth 1 b) 'custom-group)))
-         t)
-        ((and (eq (nth 1 b) 'custom-group) 
-              (not (eq (nth 1 a) 'custom-group)))
-         nil)
-        (t
-         (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
+(defcustom custom-menu-order-predicate 'custom-sort-groups-first
+  "Function used for sorting group members in menus.
+The value should be useful as a predicate for `sort'.  
+The list to be sorted is the value of the groups `custom-group' property."
+  :type '(radio (const :tag "Groups first" custom-sort-groups-first)
+                (const :tag "Groups last" custom-sort-groups-last)
+                (function :tag "Other"))
+  :group 'custom-menu)
+
+(defun custom-sort-items-alphabetically (a b)
+  "Return t iff A is alphabetically before B and the same custom type.
+A and B should be members of a `custom-group' property."
+  (and (eq (nth 1 a) (nth 1 b))
+       (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))))
+
+(defun custom-sort-groups-first (a b)
+  "Return t iff A a custom group and B is a not.
+A and B should be members of a `custom-group' property."
+  (and (eq (nth 1 a) 'custom-group)
+       (not (eq (nth 1 b) 'custom-group))))
+
+(defun custom-sort-groups-last (a b)
+  "Return t iff B a custom group and A is a not.
+A and B should be members of a `custom-group' property."
+  (and (eq (nth 1 b) 'custom-group)
+       (not (eq (nth 1 a) 'custom-group))))
 
 ;;; Custom Mode Commands.
 
@@ -897,7 +917,7 @@ that option."
   "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 'customize)
+  :group 'custom-buffer)
 
 (defun custom-buffer-create-internal (options)
   (message "Creating customization buffer...")
@@ -1017,38 +1037,49 @@ Reset all visible items in this buffer to their standard settings."
 
 ;;; The `custom-magic' Widget.
 
+(defgroup custom-magic-faces nil
+  "Faces used by the magic button."
+  :group 'custom-faces
+  :group 'custom-buffer)
+
 (defface custom-invalid-face '((((class color))
                                 (:foreground "yellow" :background "red"))
                                (t
                                 (:bold t :italic t :underline t)))
-  "Face used when the customize item is invalid.")
+  "Face used when the customize item is invalid."
+  :group 'custom-magic-faces)
 
 (defface custom-rogue-face '((((class color))
                               (:foreground "pink" :background "black"))
                              (t
                               (:underline t)))
-  "Face used when the customize item is not defined for customization.")
+  "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.")
+  "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.")
+  "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.")
+  "Face used when the customize item has been changed."
+  :group 'custom-magic-faces)
 
 (defface custom-saved-face '((t (:underline t)))
-  "Face used when the customize item has been saved.")
+  "Face used when the customize item has been saved."
+  :group 'custom-magic-faces)
 
 (defconst custom-magic-alist '((nil "#" underline "\
 uninitialized, you should not see this.")
@@ -1123,7 +1154,7 @@ If non-nil and not the symbol `long', only show first word."
   :type '(choice (const :tag "no" nil)
                  (const short)
                  (const long))
-  :group 'customize)
+  :group 'custom-buffer)
 
 (defcustom custom-magic-show-hidden '(option face)
   "Control whether the state button is shown for hidden items.
@@ -1131,12 +1162,12 @@ The value should be a list with the custom categories where the state
 button should be visible.  Possible categories are `group', `option',
 and `face'."
   :type '(set (const group) (const option) (const face))
-  :group 'customize)
+  :group 'custom-buffer)
 
 (defcustom custom-magic-show-button nil
   "Show a magic button indicating the state of each customization option."
   :type 'boolean
-  :group 'customize)
+  :group 'custom-buffer)
 
 (define-widget 'custom-magic 'default
   "Show and manipulate state for a customization option."
@@ -2176,8 +2207,9 @@ and so forth.  The remaining group tags are shown with
       (custom-load-widget widget)
       (let* ((level (widget-get widget :custom-level))
              (symbol (widget-value widget))
-             (members (sort (get symbol 'custom-group) 
-                            custom-buffer-sort-predicate))
+             (members (sort (sort (copy-sequence (get symbol 'custom-group))
+                                  custom-buffer-sort-predicate)
+                            custom-buffer-order-predicate))
              (prefixes (widget-get widget :custom-prefixes))
              (custom-prefix-list (custom-prefix-add symbol prefixes))
              (length (length members))
@@ -2199,7 +2231,6 @@ and so forth.  The remaining group tags are shown with
                                    (unless (eq (preceding-char) ?\n)
                                      (widget-insert "\n"))))
                                members)))
-        (put symbol 'custom-group members)
         (message "Creating group magic...")
         (mapcar 'custom-magic-reset children)
         (message "Creating group state...")
@@ -2465,7 +2496,7 @@ Leave point at the location of the call, or after the last expression."
 (defcustom custom-menu-nesting 2
   "Maximum nesting in custom menus."
   :type 'integer
-  :group 'customize)
+  :group 'custom-menu)
 
 (defun custom-face-menu-create (widget symbol)
   "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
@@ -2518,9 +2549,9 @@ The menu is in a format applicable to `easy-menu-define'."
              (< (length (get symbol 'custom-group)) widget-menu-max-size))
         (let ((custom-prefix-list (custom-prefix-add symbol
                                                      custom-prefix-list))
-              (members (sort (get symbol 'custom-group)
-                             custom-menu-sort-predicate)))
-          (put symbol 'custom-group members)
+              (members (sort (sort (copy-sequence (get symbol 'custom-group))
+                                   custom-menu-sort-predicate)
+                             custom-menu-order-predicate)))
           (custom-load-symbol symbol)
           `(,(custom-unlispify-menu-entry symbol t)
             ,item
@@ -2579,7 +2610,7 @@ The format is suitable for use with `easy-menu-define'."
 (defcustom custom-mode-hook nil
   "Hook called when entering custom-mode."
   :type 'hook
-  :group 'customize)
+  :group 'custom-buffer )
 
 (defun custom-mode ()
   "Major mode for editing customization buffers.
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 09a5a6617bd..cf98e2b3764 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9905
+;; Version: 1.9914
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -282,7 +282,7 @@ With arg, turn widget mode on if and only if arg is positive."
   (interactive "P")
   (cond ((null arg)
          (setq widget-minor-mode (not widget-minor-mode)))
-        ((<= 0 arg)
+        ((<= arg 0)
          (setq widget-minor-mode nil))
         (t
          (setq widget-minor-mode t)))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 35c0ffd0e13..af6c5e7d2be 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9908
+;; Version: 1.9914
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -123,17 +123,21 @@ is the string or buffer containing the text."
                    "http://www.dina.kvl.dk/~abraham/custom/")
   :prefix "widget-"
   :group 'extensions
-  :group 'faces
   :group 'hypermedia)
 
+(defgroup widget-faces nil
+  "Faces used by the widget library."
+  :group 'widgets
+  :group 'faces)
+
 (defface widget-button-face '((t (:bold t)))
   "Face used for widget buttons."
-  :group 'widgets)
+  :group 'widget-faces)
 
 (defcustom widget-mouse-face 'highlight
   "Face used for widget buttons when the mouse is above them."
   :type 'face
-  :group 'widgets)
+  :group 'widget-faces)
 
 (defface widget-field-face '((((class grayscale color)
                                (background light))
@@ -144,7 +148,7 @@ is the string or buffer containing the text."
                              (t 
                               (:italic t)))
   "Face used for editable fields."
-  :group 'widgets)
+  :group 'widget-faces)
 
 ;;; Utility functions.
 ;;
@@ -347,14 +351,15 @@ minibuffer."
                                 (t 
                                  (:italic t)))
   "Face used for inactive widgets."
-  :group 'widgets)
+  :group 'widget-faces)
 
 (defun widget-specify-inactive (widget from to)
   "Make WIDGET inactive for user modifications."
   (unless (widget-get widget :inactive)
     (let ((overlay (make-overlay from to nil t nil)))
       (overlay-put overlay 'face 'widget-inactive-face)
-      (overlay-put overlay 'mouse-face 'widget-inactive-face)
+      ;; This is disabled, as it makes the mouse cursor change shape.
+      ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
       (overlay-put overlay 'evaporate t)
       (overlay-put overlay 'priority 100)
       (overlay-put overlay (if (string-match "XEmacs" emacs-version)
@@ -474,6 +479,26 @@ This is only meaningful for radio buttons or checkboxes in a list."
           (throw 'child child)))
       nil)))
 
+(defun widget-map-buttons (function &optional buffer maparg)
+  "Map FUNCTION over the buttons in BUFFER.
+FUNCTION is called with the arguments WIDGET and MAPARG.
+
+If FUNCTION returns non-nil, the walk is cancelled.
+
+The arguments MAPARG, and BUFFER default to nil and (current-buffer),
+respectively."
+  (let ((cur (point-min))
+        (widget nil)
+        (parent nil)
+        (overlays (if buffer
+                      (save-excursion (set-buffer buffer) (overlay-lists))
+                    (overlay-lists))))
+    (setq overlays (append (car overlays) (cdr overlays)))
+    (while (setq cur (pop overlays))
+      (setq widget (overlay-get cur 'button))
+      (if (and widget (funcall function widget maparg))
+          (setq overlays nil)))))
+
 ;;; Glyphs.
 
 (defcustom widget-glyph-directory (concat data-directory "custom/")
@@ -720,6 +745,31 @@ The optional ARGS are additional keyword arguments."
     (apply 'insert args)
     (widget-specify-text from (point))))
 
+(defun widget-convert-text (type from to &optional button-from button-to)
+  "Return a widget of type TYPE with endpoint FROM TO.
+No text will be inserted to the buffer, instead the text between FROM
+and TO will be used as the widgets end points. If optional arguments
+BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
+button end points."
+  (let ((widget (widget-convert type))
+        (from (copy-marker from))
+        (to (copy-marker to)))
+    (widget-specify-text from to)
+    (set-marker-insertion-type from t)
+    (set-marker-insertion-type to nil)
+    (widget-put widget :from from)
+    (widget-put widget :to to)
+    (when button-from
+      (widget-specify-button widget button-from button-to))
+    widget))
+
+(defun widget-convert-button (type from to)
+  "Return a widget of type TYPE with endpoint FROM TO.
+No text will be inserted to the buffer, instead the text between FROM
+and TO will be used as the widgets end points, as well as the widgets
+button end points."
+  (widget-convert-text type from to from to))
+
 ;;; Keymap and Commands.
 
 (defvar widget-keymap nil
@@ -783,7 +833,7 @@ Recommended as a parent keymap for modes using widgets.")
     (t
      (:bold t :underline t)))
   "Face used for pressed buttons."
-  :group 'widgets)
+  :group 'widget-faces)
 
 (defun widget-button-click (event)
   "Invoke button below mouse pointer."
@@ -1017,7 +1067,8 @@ When not inside a field, move to the previous button or field."
             widget-field-list (cons field widget-field-list))
       (let ((from (car (widget-get field :field-overlay)))
             (to (cdr (widget-get field :field-overlay))))
-        (widget-specify-field field from to)
+        (widget-specify-field field 
+                              (marker-position from) (marker-position to))
         (set-marker from nil)
         (set-marker to nil))))
   (widget-clear-undo)
@@ -1037,16 +1088,19 @@ When not inside a field, move to the previous button or field."
 
 (defun widget-field-buffer (widget)
   "Return the start of WIDGET's editing field."
-  (overlay-buffer (widget-get widget :field-overlay)))
+  (let ((overlay (widget-get widget :field-overlay)))
+    (and overlay (overlay-buffer overlay))))
 
 (defun widget-field-start (widget)
   "Return the start of WIDGET's editing field."
-  (overlay-start (widget-get widget :field-overlay)))
+  (let ((overlay (widget-get widget :field-overlay)))
+    (and overlay (overlay-start overlay))))
 
 (defun widget-field-end (widget)
   "Return the end of WIDGET's editing field."
-  ;; Don't subtract one if local-map works at the end of the overlay.
-  (1- (overlay-end (widget-get widget :field-overlay))))
+  (let ((overlay (widget-get widget :field-overlay)))
+    ;; Don't subtract one if local-map works at the end of the overlay.
+    (and overlay (1- (overlay-end overlay)))))
 
 (defun widget-field-find (pos)
   "Return the field at POS.
@@ -1253,32 +1307,34 @@ If that does not exists, call the value of `widget-complete-field'."
 
 (defun widget-default-format-handler (widget escape)
   ;; We recognize the %h escape by default.
-  (let* ((buttons (widget-get widget :buttons))
-         (doc-property (widget-get widget :documentation-property))
-         (doc-try (cond ((widget-get widget :doc))
-                        ((symbolp doc-property)
-                         (documentation-property (widget-get widget :value)
-                                                 doc-property))
-                        (t
-                         (funcall doc-property (widget-get widget :value)))))
-         (doc-text (and (stringp doc-try)
-                        (> (length doc-try) 1)
-                        doc-try)))
+  (let* ((buttons (widget-get widget :buttons)))
     (cond ((eq escape ?h)
-           (when doc-text
-             (and (eq (preceding-char) ?\n)
-                  (widget-get widget :indent)
-                  (insert-char ?  (widget-get widget :indent)))
-             ;; The `*' in the beginning is redundant.
-             (when (eq (aref doc-text  0) ?*)
-               (setq doc-text (substring doc-text 1)))
-             ;; Get rid of trailing newlines.
-             (when (string-match "\n+\\'" doc-text)
-               (setq doc-text (substring doc-text 0 (match-beginning 0))))
-             (push (widget-create-child-and-convert
-                    widget 'documentation-string
-                    doc-text)
-                   buttons)))
+           (let* ((doc-property (widget-get widget :documentation-property))
+                  (doc-try (cond ((widget-get widget :doc))
+                                 ((symbolp doc-property)
+                                  (documentation-property 
+                                   (widget-get widget :value)
+                                   doc-property))
+                                 (t
+                                  (funcall doc-property
+                                           (widget-get widget :value)))))
+                  (doc-text (and (stringp doc-try)
+                                 (> (length doc-try) 1)
+                                 doc-try)))
+             (when doc-text
+               (and (eq (preceding-char) ?\n)
+                    (widget-get widget :indent)
+                    (insert-char ?  (widget-get widget :indent)))
+               ;; The `*' in the beginning is redundant.
+               (when (eq (aref doc-text  0) ?*)
+                 (setq doc-text (substring doc-text 1)))
+               ;; Get rid of trailing newlines.
+               (when (string-match "\n+\\'" doc-text)
+                 (setq doc-text (substring doc-text 0 (match-beginning 0))))
+               (push (widget-create-child-and-convert
+                      widget 'documentation-string
+                      doc-text)
+                     buttons))))
           (t 
            (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
@@ -2476,7 +2532,7 @@ when he invoked the menu."
                                       (:foreground "dark green"))
                                      (t nil))
   "Face used for documentation text."
-  :group 'widgets)
+  :group 'widget-faces)
 
 (define-widget 'documentation-string 'item
   "A documentation string."
@@ -2488,11 +2544,11 @@ when he invoked the menu."
 (defun widget-documentation-string-value-create (widget)
   ;; Insert documentation string.
   (let ((doc (widget-value widget))
-        (shown (widget-get (widget-get widget :parent) :documentation-shown)))
+        (shown (widget-get (widget-get widget :parent) :documentation-shown))
+        (start (point)))
     (if (string-match "\n" doc)
         (let ((before (substring doc 0 (match-beginning 0)))
               (after (substring doc (match-beginning 0)))
-              (start (point))
               buttons)
           (insert before " ")
           (widget-specify-doc widget start (point))
@@ -2507,7 +2563,8 @@ when he invoked the menu."
             (insert after)
             (widget-specify-doc widget start (point)))
           (widget-put widget :buttons buttons))
-      (insert doc)))
+      (insert doc)
+      (widget-specify-doc widget start (point))))
   (insert "\n"))
 
 (defun widget-documentation-string-action (widget &rest ignore)
@@ -2666,6 +2723,41 @@ It will read a directory name from the minibuffer when invoked."
   :prompt-history 'widget-variable-prompt-value-history
   :tag "Variable")
 
+(when (featurep 'mule)
+  (defvar widget-coding-system-prompt-value-history nil
+    "History of input to `widget-coding-system-prompt-value'.")
+  
+  (define-widget 'coding-system 'symbol
+    "A MULE coding-system."
+    :format "%{%t%}: %v"
+    :tag "Coding system"
+    :prompt-history 'widget-coding-system-prompt-value-history
+    :prompt-value 'widget-coding-system-prompt-value
+    :action 'widget-coding-system-action)
+  
+  (defun widget-coding-system-prompt-value (widget prompt value unbound)
+    ;; Read coding-system from minibuffer.
+    (intern
+     (completing-read (format "%s (default %s) " prompt value)
+                      (mapcar (function
+                               (lambda (sym)
+                                 (list (symbol-name sym))
+                                 ))
+                              (coding-system-list)))))
+
+  (defun widget-coding-system-action (widget &optional event)
+    ;; Read a file name from the minibuffer.
+    (let ((answer
+           (widget-coding-system-prompt-value
+            widget
+            (widget-apply widget :menu-tag-get)
+            (widget-value widget)
+            t)))
+      (widget-value-set widget answer)
+      (widget-apply widget :notify widget event)
+      (widget-setup)))
+  )
+
 (define-widget 'sexp 'editable-field
   "An arbitrary lisp expression."
   :tag "Lisp expression"