]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/map-ynp.el
* mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for
[gnu-emacs] / lisp / emacs-lisp / map-ynp.el
index 3c28113414e59ae61278a6a41c99df5d61fc0b34..13202a9ce4d11deebf53b5c526a597b9a2740488 100644 (file)
@@ -1,11 +1,11 @@
 ;;; map-ynp.el --- general-purpose boolean question-asker
 
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2013 Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 ;; Maintainer: FSF
 ;; Keywords: lisp, extensions
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -34,6 +34,8 @@
 
 ;;; Code:
 
+(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+
 (defun map-y-or-n-p (prompter actor list &optional help action-alist
                              no-cursor-in-echo-area)
   "Ask a series of boolean questions.
@@ -81,20 +83,14 @@ Returns the number of actions taken."
         ;; Non-nil means we should use mouse menus to ask.
         use-menus
         delayed-switch-frame
-        (next (if (or (and list (symbolp list))
-                      (subrp list)
-                      (byte-code-function-p list)
-                      (and (consp list)
-                           (eq (car list) 'lambda)))
-                  (function (lambda ()
-                              (setq elt (funcall list))))
-                (function (lambda ()
-                            (if list
-                                (progn
-                                  (setq elt (car list)
-                                        list (cdr list))
-                                  t)
-                              nil))))))
+         ;; Rebind other-window-scroll-buffer so that subfunctions can set
+         ;; it temporarily, without risking affecting the caller.
+         (other-window-scroll-buffer other-window-scroll-buffer)
+        (next (if (functionp list)
+                   (lambda () (setq elt (funcall list)))
+                 (lambda () (when list
+                         (setq elt (pop list))
+                         t)))))
     (if (and (listp last-nonmenu-event)
             use-dialog-box)
        ;; Make a list describing a dialog box.
@@ -116,20 +112,20 @@ Returns the number of actions taken."
                use-menus t
                mouse-event last-nonmenu-event))
       (setq user-keys (if action-alist
-                         (concat (mapconcat (function
-                                             (lambda (elt)
-                                               (key-description
-                                                (char-to-string (car elt)))))
+                         (concat (mapconcat (lambda (elt)
+                                               (key-description
+                                                (vector (car elt))))
                                             action-alist ", ")
                                  " ")
                        "")
            ;; Make a map that defines each user key as a vector containing
            ;; its definition.
-           map (cons 'keymap
-                     (append (mapcar (lambda (elt)
-                                       (cons (car elt) (vector (nth 1 elt))))
-                                     action-alist)
-                             query-replace-map))))
+           map
+            (let ((map (make-sparse-keymap)))
+              (set-keymap-parent map query-replace-map)
+              (dolist (elt action-alist)
+                (define-key map (vector (car elt)) (vector (nth 1 elt))))
+              map)))
     (unwind-protect
        (progn
          (if (stringp prompter)
@@ -165,7 +161,7 @@ Returns the number of actions taken."
                                (single-key-description char)))
                     (setq def (lookup-key map (vector char))))
                   (cond ((eq def 'exit)
-                         (setq next (function (lambda () nil))))
+                         (setq next (lambda () nil)))
                         ((eq def 'act)
                          ;; Act on the object.
                          (funcall actor elt)
@@ -177,7 +173,7 @@ Returns the number of actions taken."
                          ;; Act on the object and then exit.
                          (funcall actor elt)
                          (setq actions (1+ actions)
-                               next (function (lambda () nil))))
+                               next (lambda () nil)))
                         ((eq def 'quit)
                          (setq quit-flag t)
                          (setq next `(lambda ()
@@ -220,13 +216,18 @@ C-g to quit (cancel the whole command);
                                (format "or . (period) to %s \
 the current %s and exit."
                                        action object))))
-                           (save-excursion
-                             (set-buffer standard-output)
+                           (with-current-buffer standard-output
                              (help-mode)))
 
                          (setq next `(lambda ()
                                       (setq next ',next)
                                       ',elt)))
+                         ((and (symbolp def) (commandp def))
+                          (call-interactively def)
+                          ;; Regurgitated; try again.
+                          (setq next `(lambda ()
+                                        (setq next ',next)
+                                        ',elt)))
                         ((vectorp def)
                          ;; A user-defined key.
                          (if (funcall (aref def 0) elt) ;Call its function.
@@ -264,5 +265,4 @@ the current %s and exit."
     ;; Return the number of actions that were taken.
     actions))
 
-;; arch-tag: 1d0a3201-a151-4c10-b231-4da47c9e6dc3
 ;;; map-ynp.el ends here