LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - map-ynp.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 137 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 11 0.0 %

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

Generated by: LCOV version 1.12