Function: read-multiple-choice--short-answers

read-multiple-choice--short-answers is a byte-compiled function defined in rmc.el.gz.

Signature

(read-multiple-choice--short-answers PROMPT CHOICES HELP-STRING SHOW-HELP)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/rmc.el.gz
(defun read-multiple-choice--short-answers (prompt choices help-string show-help)
  (let* ((dialog-p (use-dialog-box-p))
         (prompt-choices
          (if (or show-help dialog-p) choices (append choices '((?? "?")))))
         (altered-names (mapcar #'rmc--add-key-description prompt-choices))
         (full-prompt
          (format
           "%s (%s): "
           prompt
           (mapconcat (lambda (e) (cdr e)) altered-names ", ")))
         tchar buf wrong-char answer command)
    (save-window-excursion
      (save-excursion
        (if show-help
            (setq buf (rmc--show-help prompt help-string show-help
                                      choices altered-names)))
	(while (not tchar)
          (unless dialog-p
	    (message "%s%s"
                     (if wrong-char
                         "Invalid choice.  "
                       "")
                     full-prompt))
          (setq tchar
                (if dialog-p
                    (x-popup-dialog
                     t
                     (cons prompt
                           (mapcar
                            (lambda (elem)
                              (cons (capitalize (cadr elem))
                                    (car elem)))
                            prompt-choices)))
                  (condition-case nil
                      (let ((cursor-in-echo-area t))
                        (read-event))
                    (error nil))))
          (if (memq (car-safe tchar) '(touchscreen-begin
                                       touchscreen-end
                                       touchscreen-update))
              ;; Execute commands generally bound to certain touchscreen
              ;; events.
              (progn
                (when (setq command
                            (let ((current-key-remap-sequence
                                   (vector tchar)))
                              ;; Provide an empty prompt so that it may
                              ;; not repeatedly display and/or disable
                              ;; the on-screen keyboard, or move point.
                              (touch-screen-translate-touch "")))
                  (setq command (if (> (length command) 0)
                                    (aref command 0)
                                  nil))
                  (setq tchar nil)
                  (cond
                   ((null command)) ; Read another event.
                   ((memq (car-safe command) '(mouse-1 mouse-2))
                    ;; Display the on-screen keyboard if a tap should be
                    ;; registered.
                    (frame-toggle-on-screen-keyboard (selected-frame)
                                                     nil))
                   ;; Respond to scroll and pinch events as if RMC were
                   ;; not in progress.
                   ((eq (car-safe command) 'touchscreen-scroll)
                    (touch-screen-scroll command))
                   ((eq (car-safe command) 'touchscreen-pinch)
                    (touch-screen-pinch command))
                   ;; Prevent other touchscreen-generated events from
                   ;; reaching the default conditional.
                   ((memq (or (and (symbolp command) command)
                              (car-safe command))
                          '(touchscreen-hold touchscreen-drag
                                             touchscreen-restart-drag))
                    nil)
                   (t (setq tchar command)))))
            (setq answer (lookup-key query-replace-map (vector tchar) t))
            (setq tchar
                  (cond
                   ((eq answer 'recenter)
                    (recenter) t)
                   ((eq answer 'scroll-up)
                    (ignore-errors (scroll-up-command)) t)
                   ((eq answer 'scroll-down)
                    (ignore-errors (scroll-down-command)) t)
                   ((eq answer 'scroll-other-window)
                    (ignore-errors (scroll-other-window)) t)
                   ((eq answer 'scroll-other-window-down)
                    (ignore-errors (scroll-other-window-down)) t)
                   ((eq answer 'edit)
                    (save-match-data
                      (save-excursion
                        (message
                         "%s"
                         (substitute-command-keys
                          "Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
                        (recursive-edit))))
                   (t tchar)))
            (when (eq tchar t)
              (setq wrong-char nil
                    tchar nil))
            ;; The user has entered an invalid choice, so display the
            ;; help messages.
            (when (and (not (eq tchar nil))
                       (not (assq tchar choices)))
	      (setq wrong-char (not (memq tchar `(?? ,help-char)))
                    tchar nil)
              (when wrong-char
                (ding))
              (setq buf (rmc--show-help prompt help-string show-help
                                        choices altered-names)))))))
    (when (buffer-live-p buf)
      (kill-buffer buf))
    (assq tchar choices)))