| 1 | ;;; map-ynp.el --- General-purpose boolean question-asker. |
| 2 | |
| 3 | ;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Roland McGrath <roland@gnu.ai.mit.edu> |
| 6 | ;; Maintainer: FSF |
| 7 | ;; Keywords: lisp, extensions |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 24 | ;; Boston, MA 02111-1307, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; map-y-or-n-p is a general-purpose question-asking function. |
| 29 | ;; It asks a series of y/n questions (a la y-or-n-p), and decides to |
| 30 | ;; apply an action to each element of a list based on the answer. |
| 31 | ;; The nice thing is that you also get some other possible answers |
| 32 | ;; to use, reminiscent of query-replace: ! to answer y to all remaining |
| 33 | ;; questions; ESC or q to answer n to all remaining questions; . to answer |
| 34 | ;; y once and then n for the remainder; and you can get help with C-h. |
| 35 | |
| 36 | ;;; Code: |
| 37 | |
| 38 | (defun map-y-or-n-p (prompter actor list &optional help action-alist |
| 39 | no-cursor-in-echo-area) |
| 40 | "Ask a series of boolean questions. |
| 41 | Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST. |
| 42 | |
| 43 | LIST is a list of objects, or a function of no arguments to return the next |
| 44 | object or nil. |
| 45 | |
| 46 | If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not |
| 47 | a string, PROMPTER is a function of one arg (an object from LIST), which |
| 48 | returns a string to be used as the prompt for that object. If the return |
| 49 | value is not a string, it may be nil to ignore the object or non-nil to act |
| 50 | on the object without asking the user. |
| 51 | |
| 52 | ACTOR is a function of one arg (an object from LIST), |
| 53 | which gets called with each object that the user answers `yes' for. |
| 54 | |
| 55 | If HELP is given, it is a list (OBJECT OBJECTS ACTION), |
| 56 | where OBJECT is a string giving the singular noun for an elt of LIST; |
| 57 | OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive |
| 58 | verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\). |
| 59 | |
| 60 | At the prompts, the user may enter y, Y, or SPC to act on that object; |
| 61 | n, N, or DEL to skip that object; ! to act on all following objects; |
| 62 | ESC or q to exit (skip all following objects); . (period) to act on the |
| 63 | current object and then exit; or \\[help-command] to get help. |
| 64 | |
| 65 | If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys |
| 66 | that will be accepted. KEY is a character; FUNCTION is a function of one |
| 67 | arg (an object from LIST); HELP is a string. When the user hits KEY, |
| 68 | FUNCTION is called. If it returns non-nil, the object is considered |
| 69 | \"acted upon\", and the next object from LIST is processed. If it returns |
| 70 | nil, the prompt is repeated for the same object. |
| 71 | |
| 72 | Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set |
| 73 | `cursor-in-echo-area' while prompting. |
| 74 | |
| 75 | This function uses `query-replace-map' to define the standard responses, |
| 76 | but not all of the responses which `query-replace' understands |
| 77 | are meaningful here. |
| 78 | |
| 79 | Returns the number of actions taken." |
| 80 | (let* ((actions 0) |
| 81 | user-keys mouse-event map prompt char elt tail def |
| 82 | ;; Non-nil means we should use mouse menus to ask. |
| 83 | use-menus |
| 84 | delayed-switch-frame |
| 85 | (next (if (or (and list (symbolp list)) |
| 86 | (subrp list) |
| 87 | (byte-code-function-p list) |
| 88 | (and (consp list) |
| 89 | (eq (car list) 'lambda))) |
| 90 | (function (lambda () |
| 91 | (setq elt (funcall list)))) |
| 92 | (function (lambda () |
| 93 | (if list |
| 94 | (progn |
| 95 | (setq elt (car list) |
| 96 | list (cdr list)) |
| 97 | t) |
| 98 | nil)))))) |
| 99 | (if (listp last-nonmenu-event) |
| 100 | ;; Make a list describing a dialog box. |
| 101 | (let ((object (capitalize (nth 0 help))) |
| 102 | (objects (capitalize (nth 1 help))) |
| 103 | (action (capitalize (nth 2 help)))) |
| 104 | (setq map (` (("Yes" . act) ("No" . skip) ("Quit" . exit) |
| 105 | ((, (if help (concat action " " object " And Quit") |
| 106 | "Do it and Quit")) . act-and-exit) |
| 107 | ((, (if help (concat action " All " objects) |
| 108 | "Do All")) . automatic) |
| 109 | (,@ (mapcar (lambda (elt) |
| 110 | (cons (capitalize (nth 2 elt)) |
| 111 | (vector (nth 1 elt)))) |
| 112 | action-alist)))) |
| 113 | use-menus t |
| 114 | mouse-event last-nonmenu-event)) |
| 115 | (setq user-keys (if action-alist |
| 116 | (concat (mapconcat (function |
| 117 | (lambda (elt) |
| 118 | (key-description |
| 119 | (char-to-string (car elt))))) |
| 120 | action-alist ", ") |
| 121 | " ") |
| 122 | "") |
| 123 | ;; Make a map that defines each user key as a vector containing |
| 124 | ;; its definition. |
| 125 | map (cons 'keymap |
| 126 | (append (mapcar (lambda (elt) |
| 127 | (cons (car elt) (vector (nth 1 elt)))) |
| 128 | action-alist) |
| 129 | query-replace-map)))) |
| 130 | (unwind-protect |
| 131 | (progn |
| 132 | (if (stringp prompter) |
| 133 | (setq prompter (` (lambda (object) |
| 134 | (format (, prompter) object))))) |
| 135 | (while (funcall next) |
| 136 | (setq prompt (funcall prompter elt)) |
| 137 | (cond ((stringp prompt) |
| 138 | ;; Prompt the user about this object. |
| 139 | (setq quit-flag nil) |
| 140 | (if use-menus |
| 141 | (setq def (or (x-popup-dialog (or mouse-event use-menus) |
| 142 | (cons prompt map)) |
| 143 | 'quit)) |
| 144 | ;; Prompt in the echo area. |
| 145 | (let ((cursor-in-echo-area (not no-cursor-in-echo-area)) |
| 146 | (message-log-max nil)) |
| 147 | (message "%s(y, n, !, ., q, %sor %s) " |
| 148 | prompt user-keys |
| 149 | (key-description (vector help-char))) |
| 150 | (if minibuffer-auto-raise |
| 151 | (raise-frame (window-frame (minibuffer-window)))) |
| 152 | (setq char (read-event)) |
| 153 | ;; Show the answer to the question. |
| 154 | (message "%s(y, n, !, ., q, %sor %s) %s" |
| 155 | prompt user-keys |
| 156 | (key-description (vector help-char)) |
| 157 | (single-key-description char))) |
| 158 | (setq def (lookup-key map (vector char)))) |
| 159 | (cond ((eq def 'exit) |
| 160 | (setq next (function (lambda () nil)))) |
| 161 | ((eq def 'act) |
| 162 | ;; Act on the object. |
| 163 | (funcall actor elt) |
| 164 | (setq actions (1+ actions))) |
| 165 | ((eq def 'skip) |
| 166 | ;; Skip the object. |
| 167 | ) |
| 168 | ((eq def 'act-and-exit) |
| 169 | ;; Act on the object and then exit. |
| 170 | (funcall actor elt) |
| 171 | (setq actions (1+ actions) |
| 172 | next (function (lambda () nil)))) |
| 173 | ((or (eq def 'quit) (eq def 'exit-prefix)) |
| 174 | (setq quit-flag t) |
| 175 | (setq next (` (lambda () |
| 176 | (setq next '(, next)) |
| 177 | '(, elt))))) |
| 178 | ((eq def 'automatic) |
| 179 | ;; Act on this and all following objects. |
| 180 | (if (funcall prompter elt) |
| 181 | (progn |
| 182 | (funcall actor elt) |
| 183 | (setq actions (1+ actions)))) |
| 184 | (while (funcall next) |
| 185 | (if (funcall prompter elt) |
| 186 | (progn |
| 187 | (funcall actor elt) |
| 188 | (setq actions (1+ actions)))))) |
| 189 | ((eq def 'help) |
| 190 | (with-output-to-temp-buffer "*Help*" |
| 191 | (princ |
| 192 | (let ((object (if help (nth 0 help) "object")) |
| 193 | (objects (if help (nth 1 help) "objects")) |
| 194 | (action (if help (nth 2 help) "act on"))) |
| 195 | (concat |
| 196 | (format "Type SPC or `y' to %s the current %s; |
| 197 | DEL or `n' to skip the current %s; |
| 198 | ! to %s all remaining %s; |
| 199 | ESC or `q' to exit;\n" |
| 200 | action object object action objects) |
| 201 | (mapconcat (function |
| 202 | (lambda (elt) |
| 203 | (format "%c to %s" |
| 204 | (nth 0 elt) |
| 205 | (nth 2 elt)))) |
| 206 | action-alist |
| 207 | ";\n") |
| 208 | (if action-alist ";\n") |
| 209 | (format "or . (period) to %s \ |
| 210 | the current %s and exit." |
| 211 | action object)))) |
| 212 | (save-excursion |
| 213 | (set-buffer standard-output) |
| 214 | (help-mode))) |
| 215 | |
| 216 | (setq next (` (lambda () |
| 217 | (setq next '(, next)) |
| 218 | '(, elt))))) |
| 219 | ((vectorp def) |
| 220 | ;; A user-defined key. |
| 221 | (if (funcall (aref def 0) elt) ;Call its function. |
| 222 | ;; The function has eaten this object. |
| 223 | (setq actions (1+ actions)) |
| 224 | ;; Regurgitated; try again. |
| 225 | (setq next (` (lambda () |
| 226 | (setq next '(, next)) |
| 227 | '(, elt)))))) |
| 228 | ((and (consp char) |
| 229 | (eq (car char) 'switch-frame)) |
| 230 | ;; switch-frame event. Put it off until we're done. |
| 231 | (setq delayed-switch-frame char) |
| 232 | (setq next (` (lambda () |
| 233 | (setq next '(, next)) |
| 234 | '(, elt))))) |
| 235 | (t |
| 236 | ;; Random char. |
| 237 | (message "Type %s for help." |
| 238 | (key-description (vector help-char))) |
| 239 | (beep) |
| 240 | (sit-for 1) |
| 241 | (setq next (` (lambda () |
| 242 | (setq next '(, next)) |
| 243 | '(, elt))))))) |
| 244 | (prompt |
| 245 | (funcall actor elt) |
| 246 | (setq actions (1+ actions)))))) |
| 247 | (if delayed-switch-frame |
| 248 | (setq unread-command-events |
| 249 | (cons delayed-switch-frame unread-command-events)))) |
| 250 | ;; Clear the last prompt from the minibuffer. |
| 251 | (let ((message-log-max nil)) |
| 252 | (message "")) |
| 253 | ;; Return the number of actions that were taken. |
| 254 | actions)) |
| 255 | |
| 256 | ;;; map-ynp.el ends here |