]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/map-ynp.el
Update copyright year to 2015
[gnu-emacs] / lisp / emacs-lisp / map-ynp.el
index cc4e642daf89f9e8f7b57118e7302ccfc16a593a..08b34fbe2fef6896b99f936abcb4a2bd5f35491f 100644 (file)
@@ -1,10 +1,11 @@
-;;; map-ynp.el --- general-purpose boolean question-asker
+;;; map-ynp.el --- general-purpose boolean question-asker  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1991-1995, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2015 Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: lisp, extensions
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -33,7 +34,7 @@
 
 ;;; Code:
 
-(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
 (defun map-y-or-n-p (prompter actor list &optional help action-alist
                              no-cursor-in-echo-area)
@@ -78,7 +79,7 @@ are meaningful here.
 
 Returns the number of actions taken."
   (let* ((actions 0)
-        user-keys mouse-event map prompt char elt tail def
+        user-keys mouse-event map prompt char elt def
         ;; Non-nil means we should use mouse menus to ask.
         use-menus
         delayed-switch-frame
@@ -88,13 +89,15 @@ Returns the number of actions taken."
         (next (if (functionp list)
                    (lambda () (setq elt (funcall list)))
                  (lambda () (when list
-                         (setq elt (pop list))
-                         t)))))
+                             (setq elt (pop list))
+                             t))))
+        (try-again (lambda ()
+                     (let ((x next))
+                       (setq next (lambda () (setq next x) elt))))))
     (if (and (listp last-nonmenu-event)
             use-dialog-box)
        ;; Make a list describing a dialog box.
-       (let ((object (if help (capitalize (nth 0 help))))
-             (objects (if help (capitalize (nth 1 help))))
+       (let ((objects (if help (capitalize (nth 1 help))))
              (action (if help (capitalize (nth 2 help)))))
          (setq map `(("Yes" . act) ("No" . skip)
                      ,@(mapcar (lambda (elt)
@@ -122,24 +125,15 @@ Returns the number of actions taken."
            map
             (let ((map (make-sparse-keymap)))
               (set-keymap-parent map query-replace-map)
-              (define-key map [?\C-\M-v] 'scroll-other-window)
-              (define-key map [M-next] 'scroll-other-window)
-              (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
-              (define-key map [M-prior] 'scroll-other-window-down)
-              ;; The above are rather inconvenient, so maybe we should
-              ;; provide the non-other keys for the other-scroll as well.
-              ;; (define-key map [?\C-v] 'scroll-other-window)
-              ;; (define-key map [next] 'scroll-other-window)
-              ;; (define-key map [?\M-v] 'scroll-other-window-down)
-              ;; (define-key map [prior] 'scroll-other-window-down)
               (dolist (elt action-alist)
                 (define-key map (vector (car elt)) (vector (nth 1 elt))))
               map)))
     (unwind-protect
        (progn
          (if (stringp prompter)
-             (setq prompter `(lambda (object)
-                               (format ,prompter object))))
+             (setq prompter (let ((prompter prompter))
+                              (lambda (object)
+                                (format prompter object)))))
          (while (funcall next)
            (setq prompt (funcall prompter elt))
            (cond ((stringp prompt)
@@ -185,9 +179,7 @@ Returns the number of actions taken."
                                next (lambda () nil)))
                         ((eq def 'quit)
                          (setq quit-flag t)
-                         (setq next `(lambda ()
-                                       (setq next ',next)
-                                       ',elt)))
+                         (funcall try-again))
                         ((eq def 'automatic)
                          ;; Act on this and all following objects.
                          (if (funcall prompter elt)
@@ -228,40 +220,30 @@ the current %s and exit."
                            (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)))
+                         (funcall try-again))
+                        ((and (symbolp def) (commandp def))
+                         (call-interactively def)
+                         ;; Regurgitated; try again.
+                         (funcall try-again))
                         ((vectorp def)
                          ;; A user-defined key.
                          (if (funcall (aref def 0) elt) ;Call its function.
                              ;; The function has eaten this object.
                              (setq actions (1+ actions))
                            ;; Regurgitated; try again.
-                           (setq next `(lambda ()
-                                        (setq next ',next)
-                                        ',elt))))
+                           (funcall try-again)))
                         ((and (consp char)
                               (eq (car char) 'switch-frame))
                          ;; switch-frame event.  Put it off until we're done.
                          (setq delayed-switch-frame char)
-                         (setq next `(lambda ()
-                                      (setq next ',next)
-                                      ',elt)))
+                         (funcall try-again))
                         (t
                          ;; Random char.
                          (message "Type %s for help."
                                   (key-description (vector help-char)))
                          (beep)
                          (sit-for 1)
-                         (setq next `(lambda ()
-                                      (setq next ',next)
-                                      ',elt)))))
+                         (funcall try-again))))
                  (prompt
                   (funcall actor elt)
                   (setq actions (1+ actions))))))