Mercurial > hg > xemacs-beta

changeset 4178:e687f1912d5b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-09-20 21:18:33 by didierv] User options interactive prompting improvements
author didierv
date Thu, 20 Sep 2007 21:18:35 +0000
parents d080fe09a356
children 8284a525f1b4
files lisp/ChangeLog lisp/cus-edit.el lisp/wid-edit.el
diffstat 3 files changed, 282 insertions(+), 163 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Sep 19 21:50:57 2007 +0000
+++ b/lisp/ChangeLog	Thu Sep 20 21:18:35 2007 +0000
@@ -1,3 +1,36 @@
+2007-09-20  Didier Verna  <didier@xemacs.org>
+
+	Improvements in user options interactive prompting. This mainly
+	involves the following: before this patch, options of type 'group
+	or 'checklist were prompted by full sexp, without taking a
+	possible default value into account. Now, the user interaction
+	features individual prompting _with completion_ for each group or
+	checklist member. For group options, an optional default value is
+	also handled on an individual group member basis.
+
+	* cus-edit.el (customize-set-value): Suppress the final ": " from
+	created prompts.
+	(customize-set-variable): Ditto.
+	(customize-save-variable): Ditto.
+	(custom-prompt-variable): Add final ": " to prompts if needed.
+
+	* wid-edit.el (widget-prompt-spaceify): New. Add trailing space to
+	string if needed.
+	(widget-prompt): New. Construct a prompt for a widget.
+	(widget-prompt-value): Use it; make prompt argument optional.
+	(widget-default-prompt-value): Add final ": " to prompt.
+	(widget-field-prompt-internal): Ditto.
+	(widget-sexp-prompt-value): Ditto.
+	(widget-file-prompt-value): Ditto.
+	(widget-symbol-prompt-internal): Ditto.
+	(widget-choice-prompt-value): Ditto.
+	(widget-boolean-prompt-value): Ditto.
+	(widget-checklist-prompt-value): New. Prompt value with completion.
+	(checklist): Make the widget aware of it.
+	(widget-group-prompt-value): New. Prompt value with completion;
+	handle default value individually for each group member.
+	* wid-edit.el (group): Make the widget aware of it.
+
 2007-09-19  Didier Verna  <didier@xemacs.org>
 
 	Update my personal info.
--- a/lisp/cus-edit.el	Wed Sep 19 21:50:57 2007 +0000
+++ b/lisp/cus-edit.el	Thu Sep 20 21:18:35 2007 +0000
@@ -1,10 +1,11 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
+;; Copyright (C) 2007 Didier Verna
+;; Copyright (C) 2003 Ben Wing
 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
-;; Copyright (C) 2003 Ben Wing.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; Keywords: help, faces
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -306,7 +307,7 @@
 			  (and (boundp symbol)
 			       (or (get symbol 'custom-type)
 				   (user-variable-p symbol))))
-                t nil nil (and v (symbol-name v))))
+		t nil nil (and v (symbol-name v))))
      (list (if (equal val "")
 	       (if (symbolp v) v nil)
 	     (intern val)))))
@@ -651,8 +652,8 @@
 (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.
+prompt for the value.  A %s escape in PROMPT-VAL is replaced with
+the name of the variable. A final colon is appended to both prompts.
 
 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.
@@ -662,7 +663,7 @@
 
 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))
+  (let* ((var (read-variable (concat prompt-var ": ")))
 	 (minibuffer-help-form '(describe-variable var))
 	 (val
 	  (let ((prop (get var 'variable-interactive))
@@ -683,12 +684,11 @@
 					    (symbol-value var))
 					(not (boundp var))))
 		  (t
-		   (eval-minibuffer prompt))))))
+		   (eval-minibuffer (concat prompt ": ")))))))
     (if comment
 	(list var val
 	      (read-string "Comment: " (get var 'variable-comment)))
-      (list var val))
-    ))
+      (list var val))))
 
 ;;;###autoload
 (defun customize-set-value (var val &optional comment)
@@ -701,8 +701,8 @@
 `: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: "
+  (interactive (custom-prompt-variable "Set variable"
+				       "Set value of %s"
 				       current-prefix-arg))
 
   (set var val)
@@ -728,8 +728,8 @@
 `: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: "
+  (interactive (custom-prompt-variable "Set variable"
+				       "Set customized value of %s"
 				       current-prefix-arg))
   (funcall (or (get variable 'custom-set) 'set-default) variable value)
   (put variable 'customized-value (list (custom-quote value)))
@@ -757,8 +757,8 @@
 `: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 save variable: "
-				       "Set and save value for %s as: "
+  (interactive (custom-prompt-variable "Set and save variable"
+				       "Set and save value of %s"
 				       current-prefix-arg))
   (funcall (or (get variable 'custom-set) 'set-default) variable value)
   (put variable 'saved-value (list (custom-quote value)))
@@ -1770,7 +1770,7 @@
 		     (return-from custom-load nil)))
 	       #'(lambda ()
 		   (load (expand-file-name "custom-defines" dir))))))
-      ;; we get here only from the `return-from'; see above 
+      ;; we get here only from the `return-from'; see above
       (load source))))
 
 (defun custom-load-widget (widget)
@@ -2545,7 +2545,7 @@
   :sample-face 'custom-face-tag-face
   :help-echo "Set or reset this face"
   :documentation-property #'(lambda (face)
-                              (face-doc-string face))
+			      (face-doc-string face))
   :value-create 'custom-face-value-create
   :action 'custom-face-action
   :custom-category 'face
@@ -3496,40 +3496,40 @@
   (goto-char (point-min))
   (condition-case nil
       (while (not (eobp))
-        (let ((sexp (read (current-buffer))))
-          (when (and (listp sexp)
-                     (memq (car sexp) symbols))
-            (delete-region (save-excursion
-                             (backward-sexp)
-                             (point))
-                           (point))
-            (while (and (eolp) (not (eobp)))
-              (delete-region (point) (prog2 (forward-line 1) (point))))
-            )))
+	(let ((sexp (read (current-buffer))))
+	  (when (and (listp sexp)
+		     (memq (car sexp) symbols))
+	    (delete-region (save-excursion
+			     (backward-sexp)
+			     (point))
+			   (point))
+	    (while (and (eolp) (not (eobp)))
+	      (delete-region (point) (prog2 (forward-line 1) (point))))
+	    )))
     (end-of-file nil)))
 
 (defsubst custom-save-variable-p (symbol)
   "Return non-nil if symbol SYMBOL is a customized variable."
   (and (symbolp symbol)
        (let ((spec (car-safe (get symbol 'theme-value))))
-         (or (and spec (eq (car spec) 'user)
-                  (eq (second spec) 'set))
-             (get symbol 'saved-variable-comment)
-             ;; support non-themed vars
-             (and (null spec) (get symbol 'saved-value))))))
+	 (or (and spec (eq (car spec) 'user)
+		  (eq (second spec) 'set))
+	     (get symbol 'saved-variable-comment)
+	     ;; support non-themed vars
+	     (and (null spec) (get symbol 'saved-value))))))
 
 (defun custom-save-variable-internal (symbol)
   "Print variable SYMBOL to the standard output.
 SYMBOL must be a customized variable."
   (let ((requests (get symbol 'custom-requests))
-        (now (not (or (get symbol 'standard-value)
-                      (and (not (boundp symbol))
-                           (not (eq (get symbol 'force-value)
-                                    'rogue))))))
-        (comment (get symbol 'saved-variable-comment))
-        ;; Print everything, no placeholders `...'
-        (print-level nil)
-        (print-length nil))
+	(now (not (or (get symbol 'standard-value)
+		      (and (not (boundp symbol))
+			   (not (eq (get symbol 'force-value)
+				    'rogue))))))
+	(comment (get symbol 'saved-variable-comment))
+	;; Print everything, no placeholders `...'
+	(print-level nil)
+	(print-length nil))
     (unless (custom-save-variable-p symbol)
       (error 'wrong-type-argument "Not a customized variable" symbol))
     (princ "\n '(")
@@ -3540,10 +3540,10 @@
     ;; (prin1 (third spec))
     ;; XEmacs -- pretty-print value if available
     (if (and custom-save-pretty-print
-             (fboundp 'pp))
-        ;; To suppress bytecompiler warning
-        (with-fboundp 'pp
-          (pp (car (get symbol 'saved-value))))
+	     (fboundp 'pp))
+	;; To suppress bytecompiler warning
+	(with-fboundp 'pp
+	  (pp (car (get symbol 'saved-value))))
       (prin1 (car (get symbol 'saved-value))))
     (when (or now requests comment)
       (princ (if now " t" " nil")))
@@ -3570,21 +3570,21 @@
      (custom-save-loaded-themes)
      (custom-save-resets 'theme-value 'custom-reset-variables nil)
      (let ((standard-output (current-buffer))
-           (sorted-list ()))
+	   (sorted-list ()))
        ;; First create a sorted list of saved variables.
        (mapatoms
-        (lambda (symbol)
-          (when (custom-save-variable-p symbol)
-            (push symbol sorted-list))))
+	(lambda (symbol)
+	  (when (custom-save-variable-p symbol)
+	    (push symbol sorted-list))))
        (setq sorted-list (sort sorted-list 'string<))
        (unless (bolp)
-         (princ "\n"))
+	 (princ "\n"))
        (princ "(custom-set-variables")
        (mapc 'custom-save-variable-internal
-             sorted-list)
+	     sorted-list)
        (princ ")")
        (unless (looking-at "\n")
-         (princ "\n")))))
+	 (princ "\n")))))
 
 (defvar custom-save-face-ignoring nil)
 
@@ -3593,14 +3593,14 @@
   (let ((theme-spec (car-safe (get symbol 'theme-face)))
 	(comment (get symbol 'saved-face-comment)))
     (or (and (not (memq symbol custom-save-face-ignoring))
-             ;; Don't print default face here.
-             (or (and theme-spec
-                      (eq (car theme-spec) 'user)
-                      (eq (second theme-spec) 'set))
-                 ;; cope with non-themed faces
-                 (and (null theme-spec)
-                      (get symbol 'saved-face))))
-        comment)))
+	     ;; Don't print default face here.
+	     (or (and theme-spec
+		      (eq (car theme-spec) 'user)
+		      (eq (second theme-spec) 'set))
+		 ;; cope with non-themed faces
+		 (and (null theme-spec)
+		      (get symbol 'saved-face))))
+	comment)))
 
 (defun custom-save-face-internal (symbol)
   "Print face SYMBOL to the standard output.
@@ -3609,24 +3609,24 @@
 	(now (not (or (get symbol 'face-defface-spec)
 	      (and (not (find-face symbol))
 		   (not (eq (get symbol 'force-face) 'rogue))))))
-        ;; Print everything, no placeholders `...'
-        (print-level nil)
-        (print-length nil))
+	;; Print everything, no placeholders `...'
+	(print-level nil)
+	(print-length nil))
     (if (memq symbol custom-save-face-ignoring)
-        ;; Do nothing
-        nil
+	;; Do nothing
+	nil
       ;; Print face
       (unless (custom-save-face-p symbol)
-        (error 'wrong-type-argument "Not a customized face" symbol))
+	(error 'wrong-type-argument "Not a customized face" symbol))
       (princ "\n '(")
       (prin1 symbol)
       (princ " ")
       (prin1 (get symbol 'saved-face))
       (if (or comment now)
-          (princ (if now " t" " nil")))
+	  (princ (if now " t" " nil")))
       (when comment
-        (princ " ")
-        (prin1 comment))
+	(princ " ")
+	(prin1 comment))
       (princ ")"))))
 
 (defun custom-save-faces ()
@@ -3641,22 +3641,22 @@
     ;;                        'custom-set-faces)
     (custom-save-resets 'theme-face 'custom-reset-faces '(default))
     (let ((standard-output (current-buffer))
-          (sorted-list ()))
+	  (sorted-list ()))
       ;; Create a sorted list of faces
       (mapatoms
        (lambda (symbol)
-         (when (custom-save-face-p symbol)
-           (push symbol sorted-list))))
+	 (when (custom-save-face-p symbol)
+	   (push symbol sorted-list))))
       (setq sorted-list (sort sorted-list 'string<))
       (unless (bolp)
 	(princ "\n"))
       (princ "(custom-set-faces")
 	;; The default face must be first, since it affects the others.
       (when (custom-save-face-p 'default)
-        (custom-save-face-internal 'default))
+	(custom-save-face-internal 'default))
       (let ((custom-save-face-ignoring '(default)))
 	(mapc 'custom-save-face-internal
-              sorted-list))
+	      sorted-list))
       (princ ")")
       (unless (looking-at "\n")
 	(princ "\n")))))
@@ -3665,35 +3665,35 @@
   "Create a mapper for `custom-save-resets'."
   `(lambda (object)
      (let ((spec (car-safe (get object (quote ,property))))
-           (print-level nil)
-           (print-length nil))
+	   (print-level nil)
+	   (print-length nil))
        (with-boundp '(ignored-special started-writing)
-         (when (and (not (memq object ignored-special))
-                    (eq (car spec) 'user)
-                    (eq (second spec) 'reset))
-           ;; Do not write reset statements unless necessary.
-           (unless started-writing
-             (setq started-writing t)
-             (unless (bolp)
-               (princ "\n"))
-             (princ "(")
-             (princ (quote ,setter))
-             (princ "\n '(")
-             (prin1 object)
-             (princ " ")
-             (prin1 (third spec))
-             (princ ")")))))))
+	 (when (and (not (memq object ignored-special))
+		    (eq (car spec) 'user)
+		    (eq (second spec) 'reset))
+	   ;; Do not write reset statements unless necessary.
+	   (unless started-writing
+	     (setq started-writing t)
+	     (unless (bolp)
+	       (princ "\n"))
+	     (princ "(")
+	     (princ (quote ,setter))
+	     (princ "\n '(")
+	     (prin1 object)
+	     (princ " ")
+	     (prin1 (third spec))
+	     (princ ")")))))))
 
 (defconst custom-save-resets-mapper-alist
   (eval-when-compile
     (list (list 'theme-value 'custom-reset-variables
-                (byte-compile
-                 (make-custom-save-resets-mapper
-                  'theme-value 'custom-reset-variables)))
-          (list 'theme-face 'custom-reset-faces
-                (byte-compile
-                 (make-custom-save-resets-mapper
-                  'theme-face 'custom-reset-faces)))))
+		(byte-compile
+		 (make-custom-save-resets-mapper
+		  'theme-value 'custom-reset-variables)))
+	  (list 'theme-face 'custom-reset-faces
+		(byte-compile
+		 (make-custom-save-resets-mapper
+		  'theme-face 'custom-reset-faces)))))
   "Never use it.
 Hashes several heavily used functions for `custom-save-resets'")
 
@@ -3703,9 +3703,9 @@
     ;; (custom-save-delete setter) Done by caller
     (let ((standard-output (current-buffer))
 	  (mapper (let ((triple (assq property custom-save-resets-mapper-alist)))
-                    (if (and triple (eq (second triple) setter))
-                        (third triple)
-                      (make-custom-save-resets-mapper property setter)))))
+		    (if (and triple (eq (second triple) setter))
+			(third triple)
+		      (make-custom-save-resets-mapper property setter)))))
       (mapc mapper special)
       (setq ignored-special special)
       (mapatoms mapper)
@@ -3716,8 +3716,8 @@
 (defun custom-save-loaded-themes ()
   (let ((themes (reverse (get 'user 'theme-loads-themes)))
 	(standard-output (current-buffer))
-        (print-level nil)
-        (print-length nil))
+	(print-level nil)
+	(print-length nil))
     (when themes
       (unless (bolp) (princ "\n"))
       (princ "(custom-load-themes")
@@ -3910,7 +3910,7 @@
 Invoke 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 options.		   \\[Custom-reset-current]
 Reset all modified or set options.	   \\[Custom-reset-saved]
 Reset all options.			   \\[Custom-reset-standard]
 
--- a/lisp/wid-edit.el	Wed Sep 19 21:50:57 2007 +0000
+++ b/lisp/wid-edit.el	Thu Sep 20 21:18:35 2007 +0000
@@ -1,9 +1,10 @@
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;
+;; Copyright (C) 2007 Didier Verna
 ;; Copyright (C) 1996-1997, 1999-2002 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; Keywords: extensions
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -330,7 +331,7 @@
   (mouse-set-point event)
   (let ((pos (event-point event)))
     (if (and pos (get-char-property pos 'button))
-        (widget-button-click event))))
+	(widget-button-click event))))
 
 ;;; Widget text specifications.
 ;;
@@ -591,15 +592,15 @@
 (defun widget-specify-active (widget)
   "Make WIDGET active for user modifications."
   (let ((inactive (widget-get widget :inactive))
-        (from (widget-get widget :from))
-        (to (widget-get widget :to)))
+	(from (widget-get widget :from))
+	(to (widget-get widget :to)))
     (when (and inactive (not (extent-detached-p inactive)))
       ;; Reactivate the buttons and fields covered by the extent.
       (map-extents 'widget-activation-widget-mapper
-                   nil from to :activate nil 'button-or-field)
+		   nil from to :activate nil 'button-or-field)
       ;; Reactivate the glyphs.
       (map-extents 'widget-activation-glyph-mapper
-                   nil from to :activate nil 'end-glyph)
+		   nil from to :activate nil 'end-glyph)
       (delete-extent inactive)
       (widget-put widget :inactive nil))))
 
@@ -706,15 +707,44 @@
 ;;
 ;; These are widget specific.
 
+;; #### Note: this should probably be a more general utility -- dvl
+(defsubst widget-prompt-spaceify (prompt)
+  ;; Add a space at the end of PROMPT if needed
+  (if (or (string= prompt "") (eq ?  (aref prompt (1- (length prompt)))))
+      prompt
+    (concat prompt " ")))
+
+(defsubst widget-prompt (widget &optional prompt default-prompt)
+  ;; Construct a prompt for WIDGET.
+  ;; - If PROMPT is given, use it.
+  ;; - Otherwise, use the :tag property, if any.
+  ;; - Otherwise, use DEFAULT-PROMPT, if given.
+  ;; - Otherise, use "Value".
+  ;; - If the result is not the empty string, add a space for later addition
+  ;; of the widget type by `widget-prompt-value'.
+  (unless prompt
+    (setq prompt (or (and (widget-get widget :tag)
+			  (replace-in-string (widget-get widget :tag)
+					     "^[ \t]+" "" t))
+		     default-prompt
+		     "Value")))
+  (widget-prompt-spaceify prompt))
+
+
 ;;;###autoload
-(defun widget-prompt-value (widget prompt &optional value unbound)
-  "Prompt for a value matching WIDGET, using PROMPT.
+(defun widget-prompt-value (widget &optional prompt value unbound)
+  "Prompt for a value matching WIDGET.
+Prompt with PROMPT, or WIDGET's :tag otherwise.
 The current value is assumed to be VALUE, unless UNBOUND is non-nil."
   (unless (listp widget)
     (setq widget (list widget)))
-  (setq prompt (format "[%s] %s" (widget-type widget) prompt))
   (setq widget (widget-convert widget))
-  (let ((answer (widget-apply widget :prompt-value prompt value unbound)))
+  (let ((answer (widget-apply widget
+			      :prompt-value
+			      (format "%s[%s]"
+				      (widget-prompt widget prompt)
+				      (widget-type widget))
+			      value unbound)))
     (while (not (widget-apply widget :match answer))
       (setq answer (signal 'error (list "Answer does not match type"
 					answer (widget-type widget)))))
@@ -1783,11 +1813,11 @@
 	    (lambda ()			;?\]
 	      (setq button-end (point-marker))
 	      (set-marker-insertion-type button-end nil))
-	    (lambda ()			;?\{ 
+	    (lambda ()			;?\{
 	      (setq sample-begin (point)))
 	    (lambda ()			;?\}
 	      (setq sample-end (point)))
-	    (lambda ()			;?n 
+	    (lambda ()			;?n
 	      (when (widget-get widget :indent)
 		(insert ?\n)
 		(insert-char ?\  (widget-get widget :indent))))
@@ -2001,7 +2031,7 @@
 ;; It would be nice if we could do a `(cons val 1)' here.
 ;; (prin1-to-string (custom-quote value))))))
   ;; XEmacs: make this use default VALUE.  Need to check callers.
-  (eval-minibuffer prompt))
+  (eval-minibuffer (concat prompt ": ")))
 
 ;;; The `item' Widget.
 
@@ -2224,7 +2254,7 @@
   "Read string for WIDGET prompting with PROMPT.
 INITIAL is the initial input and HISTORY is a symbol containing
 the earlier input."
-  (read-string prompt initial history))
+  (read-string (concat prompt ": ") initial history))
 
 (defun widget-field-prompt-value (widget prompt value unbound)
   "Prompt for a string."
@@ -2577,6 +2607,7 @@
   :value-create 'widget-checklist-value-create
   :value-delete 'widget-children-value-delete
   :value-get 'widget-checklist-value-get
+  :prompt-value 'widget-checklist-prompt-value
   :validate 'widget-checklist-validate
   :match 'widget-checklist-match
   :match-inline 'widget-checklist-match-inline)
@@ -2701,6 +2732,27 @@
 	  (setq result (append result (widget-apply child :value-inline)))))
     result))
 
+;; #### FIXME: should handle default value some day -- dvl
+(defun widget-checklist-prompt-value (widget prompt value unbound)
+  ;; Prompt for items to be selected, and the prompt for their value
+  (let* ((args (widget-get widget :args))
+	 (choices (mapcar (lambda (elt)
+			    (cons (widget-get elt :tag) elt))
+			  args))
+	 (continue t)
+	 value)
+    (while continue
+      (setq continue (completing-read
+		      (concat (widget-prompt-spaceify prompt)
+			      "select [ret. when done]: ")
+		      choices nil t))
+      (if (string= continue "")
+	  (setq continue nil)
+	(push (widget-prompt-value (cdr (assoc continue choices))
+				   prompt nil t)
+	      value)))
+    (nreverse value)))
+
 (defun widget-checklist-validate (widget)
   ;; Ticked children must be valid.
   (let ((children (widget-get widget :children))
@@ -3116,6 +3168,7 @@
   :value-delete 'widget-children-value-delete
   :value-get 'widget-editable-list-value-get
   :default-get 'widget-group-default-get
+  :prompt-value 'widget-group-prompt-value
   :validate 'widget-children-validate
   :match 'widget-group-match
   :match-inline 'widget-group-match-inline)
@@ -3146,6 +3199,36 @@
   ;; Get the default of the components.
   (mapcar 'widget-default-get (widget-get widget :args)))
 
+(defun widget-group-prompt-value (widget prompt value unbound)
+  ;; Prompt in turn for every component of the group.
+  (let ((args (widget-get widget :args)))
+    (widget-apply
+     widget :value-to-external
+     (if unbound
+	 (mapcar #'(lambda (arg)
+		     (widget-prompt-value
+		      arg
+		      (concat (widget-prompt-spaceify prompt)
+			      (widget-prompt arg nil ""))
+		      nil t))
+		 args)
+       ;; If VALUE is bound, the situation is a bit more complex because we
+       ;; have to split it into a list of default values for every child. Oh,
+       ;; boy, do I miss 'cl here... -- dvl
+       (let ((children args)
+	     (defaults (widget-apply widget
+				     :value-to-internal value))
+	     child default result)
+	 (while (setq child (pop children))
+	   (setq default (pop defaults))
+	   (push
+	    (widget-prompt-value
+	     child
+	     (concat (widget-prompt-spaceify prompt)
+		     (widget-prompt child nil ""))
+	     default) result))
+	 (nreverse result))))))
+
 (defun widget-group-match (widget values)
   ;; Match if the components match.
   (and (listp values)
@@ -3378,7 +3461,7 @@
 
 (defun widget-sexp-prompt-value (widget prompt value unbound)
   ;; Read an arbitrary sexp.
-  (let ((found (read-string prompt
+  (let ((found (read-string (concat prompt ": ")
 			    (if unbound nil (cons (prin1-to-string value) 0))
 			    (widget-get widget :prompt-history))))
     (save-excursion
@@ -3502,8 +3585,8 @@
   ;; Read file from minibuffer.
   (abbreviate-file-name
    (if unbound
-       (read-file-name prompt)
-     (let ((prompt2 (format "%s (default %s) " prompt value))
+       (read-file-name (concat prompt ": "))
+     (let ((prompt2 (format "%s: (default %s) " prompt value))
 	   (dir (file-name-directory value))
 	   (file (file-name-nondirectory value))
 	   (must-match (widget-get widget :must-match)))
@@ -3552,7 +3635,7 @@
 
 (defun widget-symbol-prompt-internal (widget prompt initial history)
   ;; Read file from minibuffer.
-  (let ((answer (completing-read prompt obarray
+  (let ((answer (completing-read (concat prompt ": ") obarray
 				 (widget-get widget :prompt-match)
 				 nil initial history)))
     (if (and (stringp answer)
@@ -3824,42 +3907,45 @@
   (let ((args (widget-get widget :args))
 	(completion-ignore-case (widget-get widget :case-fold))
 	current choices old)
-    ;; Find the first arg that matches VALUE.
-    (let ((look args))
-      (while look
-	(if (widget-apply (car look) :match value)
-	    (setq old (car look)
-		  look nil)
-	  (setq look (cdr look)))))
-    ;; Find new choice.
+    ;; Find the first choice matching VALUE (if given):
+    (unless unbound
+      (let ((look args))
+	(while look
+	  (if (widget-apply (car look) :match value)
+	      (setq old (car look)
+		    look nil)
+	    (setq look (cdr look)))))
+      ;; If VALUE is invalid (it doesn't match any choice), discard it by
+      ;; considering it unbound:
+      (unless old
+	(setq unbound t)))
+    ;; Now offer the choice, providing the given default value when/where
+    ;; appropriate:
+    (while args
+      (setq current (car args)
+	    args (cdr args))
+      (setq choices
+	    (cons (cons (widget-apply current :menu-tag-get)
+			current)
+		  choices)))
     (setq current
-	  (cond ((= (length args) 0)
-		 nil)
-		((= (length args) 1)
-		 (nth 0 args))
-		((and (= (length args) 2)
-		      (memq old args))
-		 (if (eq old (nth 0 args))
-		     (nth 1 args)
-		   (nth 0 args)))
-		(t
-		 (while args
-		   (setq current (car args)
-			 args (cdr args))
-		   (setq choices
-			 (cons (cons (widget-apply current :menu-tag-get)
-				     current)
-			       choices)))
-		 (let ((val (completing-read prompt choices nil t)))
-		   (if (stringp val)
-		       (let ((try (try-completion val choices)))
-			 (when (stringp try)
-			   (setq val try))
-			 (cdr (assoc val choices)))
-		     nil)))))
+	  (let ((val (completing-read (concat prompt ": ") choices nil t
+				      (when old
+					(widget-apply old :menu-tag-get)))))
+	    (if (stringp val) ;; #### is this really needed ? --dvl
+		(let ((try (try-completion val choices)))
+		  (when (stringp try) ;; #### and this ? --dvl
+		    (setq val try))
+		  (cdr (assoc val choices)))
+	      nil)))
     (if current
-	(widget-prompt-value current prompt nil t)
-      value)))
+	(widget-prompt-value current
+			     (concat (widget-prompt-spaceify prompt)
+				     (widget-get current :tag))
+			     (unless unbound
+			       (when (eq current old) value))
+			     (or unbound (not (eq current old))))
+      (and (not unbound) value))))
 
 (define-widget 'radio 'radio-button-choice
   "A set widget, selecting exactly one from many.
@@ -3891,7 +3977,7 @@
 
 (defun widget-boolean-prompt-value (widget prompt value unbound)
   ;; Toggle a boolean.
-  (y-or-n-p prompt))
+  (y-or-n-p (concat prompt ": ")))
 
 ;;; The `color' Widget.
 
@@ -4002,8 +4088,8 @@
 nil, or a cons-cell containing a sexp and my-lisp.  This will not work
 because the `choice' widget does not allow recursion.
 
-Using the `lazy' widget you can overcome this problem, as in this 
-example: 
+Using the `lazy' widget you can overcome this problem, as in this
+example:
 
   (define-widget 'sexp-list 'lazy
     \"A list of sexps.\"
@@ -4012,7 +4098,7 @@
   :format "%{%t%}: %v"
   ;; We don't convert :type because we want to allow recursive
   ;; datastructures.  This is slow, so we should not create speed
-  ;; critical widgets by deriving from this. 
+  ;; critical widgets by deriving from this.
   :convert-widget 'widget-value-convert-widget
   :value-create 'widget-type-value-create
   :value-delete 'widget-children-value-delete
@@ -4041,10 +4127,10 @@
 The value of the :type attribute should be an unconverted widget type."
   (let ((value (widget-get widget :value))
 	(type (widget-get widget :type)))
-    (widget-put widget :children 
-                (list (widget-create-child-value widget 
-                                                 (widget-convert type)
-                                                 value)))))
+    (widget-put widget :children
+		(list (widget-create-child-value widget
+						 (widget-convert type)
+						 value)))))
 
 (defun widget-type-default-get (widget)
   "Get default value from the :type attribute of WIDGET.