X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4531b03ec98b50fc61baad2b75f6faf439894583..374c21d59a3e2b8a49c7e4ecc466edb5313dbb98:/lisp/subr.el?ds=sidebyside

diff --git a/lisp/subr.el b/lisp/subr.el
index db1baf09c4..447c3eb1a4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2255,7 +2255,7 @@ Usage example:
   (let* ((altered-names nil)
          (full-prompt
           (format
-           "%s (%s, ?): "
+           "%s (%s): "
            prompt
            (mapconcat
             (lambda (elem)
@@ -2268,7 +2268,8 @@ Usage example:
                         (format "[%c] %s" (car elem) name))
                        ;; The prompt character is in the name, so highlight
                        ;; it on graphical terminals...
-                       ((display-graphic-p)
+                       ((display-supports-face-attributes-p
+                         '(:underline t) (window-frame))
                         (setq name (copy-sequence name))
                         (put-text-property pos (1+ pos)
                                            'face 'read-multiple-choice-face
@@ -2285,19 +2286,41 @@ Usage example:
                 (push (cons (car elem) altered-name)
                       altered-names)
                 altered-name))
-            choices ", ")))
-         tchar buf)
+            (append choices '((?? "?")))
+            ", ")))
+         tchar buf wrong-char)
     (save-window-excursion
       (save-excursion
 	(while (not tchar)
-	  (message "%s" full-prompt)
-	  (setq tchar (condition-case nil
-                          (read-char)
-                        (error nil)))
+	  (message "%s%s"
+                   (if wrong-char
+                       "Invalid choice.  "
+                     "")
+                   full-prompt)
+          (setq tchar
+                (if (and (display-popup-menus-p)
+                         last-input-event ; not during startup
+                         (listp last-nonmenu-event)
+                         use-dialog-box)
+                    (x-popup-dialog
+                     t
+                     (cons prompt
+                           (mapcar
+                            (lambda (elem)
+                              (cons (capitalize (cadr elem))
+                                    (car elem)))
+                            choices)))
+                  (condition-case nil
+                      (let ((cursor-in-echo-area t))
+                        (read-char))
+                    (error nil))))
           ;; The user has entered an invalid choice, so display the
           ;; help messages.
 	  (when (not (assq tchar choices))
-	    (setq tchar nil)
+	    (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+                  tchar nil)
+            (when wrong-char
+              (ding))
             (with-help-window (setq buf (get-buffer-create
                                          "*Multiple Choice Help*"))
               (with-current-buffer buf
@@ -2317,9 +2340,10 @@ Usage example:
                         ;; Add padding.
                         (while (not (eobp))
                           (end-of-line)
-                          (insert (make-string (- (* (mod times columns)
-                                                     (+ fill-column 4))
-                                                  (current-column))
+                          (insert (make-string (max (- (* (mod times columns)
+                                                          (+ fill-column 4))
+                                                       (current-column))
+                                                    0)
                                                ?\s))
                           (forward-line 1))))
                     (setq times (1+ times))
@@ -2331,10 +2355,11 @@ Usage example:
                                       (cdr (assq (car elem) altered-names))))
                              (fill-region (point-min) (point-max))
                              (when (nth 2 elem)
-                               (insert (nth 2 elem))
-                               (unless (bolp)
-                                 (insert "\n"))
-                               (fill-region start (point-max)))
+                               (let ((start (point)))
+                                 (insert (nth 2 elem))
+                                 (unless (bolp)
+                                   (insert "\n"))
+                                 (fill-region start (point-max))))
                              (buffer-string))))
                       (goto-char start)
                       (dolist (line (split-string text "\n"))