bug#8948: 24.0.50; y-or-n-p doesn't support scroll-o-w like yes-or-no-p

[Thierry Volpiatto]

Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:

> Hi,
> after discussion about bug#8927, i discover that 
> from a yes-or-no-p i can scroll-other-window, but not from a
> y-or-n-p.

This allow scrolling from a y-or-n-p:


#+BEGIN_SRC lisp
(defun y-or-n-p (prompt)
  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
PROMPT is the string to display to ask the question.  It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.

No confirmation of the answer is requested; a single character is enough.
Also accepts Space to mean yes, or Delete to mean no.  \(Actually, it uses
the bindings in `query-replace-map'; see the documentation of that variable
for more information.  In this case, the useful bindings are `act', `skip',
`recenter', and `quit'.\)

Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
  ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
  ;; where all the keys were unbound (i.e. it somehow got triggered
  ;; within read-key, apparently).  I had to kill it.
  (let ((answer 'recenter))
    (if (and (display-popup-menus-p)
             (listp last-nonmenu-event)
             use-dialog-box)
        (setq answer
              (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
      (setq prompt (concat prompt
                           (if (eq ?\s (aref prompt (1- (length prompt))))
                               "" " ")
                           "(y or n) "))
      (while
          (let* ((key
                  (let ((cursor-in-echo-area t))
                    (when minibuffer-auto-raise
                      (raise-frame (window-frame (minibuffer-window))))
                    (read-key (propertize (if (or (eq answer 'recenter)
                                                  (eq com 'scroll-other-window)
                                                  (eq com 
'scroll-other-window-down))
                                              prompt
                                            (concat "Please answer y or n.  "
                                                    prompt))
                                          'face 'minibuffer-prompt)))))
            (setq answer (lookup-key query-replace-map (vector key) t))
            (setq com (lookup-key global-map (vector key) t))
            (cond
              ((eq com 'scroll-other-window)
               (with-selected-window (minibuffer-window)
                 (scroll-other-window 1)) t)
              ((eq com 'scroll-other-window-down)
               (with-selected-window (minibuffer-window)
                 (scroll-other-window -1)) t)
              ((memq answer '(skip act)) nil)
              ((eq answer 'recenter) (recenter) t)
              ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
              (t t)))
        (ding)
        (discard-input)))
    (let ((ret (eq answer 'act)))
      (unless noninteractive
        (message "%s %s" prompt (if ret "y" "n")))
      ret)))

#+END_SRC

>
>
> In GNU Emacs 24.0.50.17 (i686-pc-linux-gnu, GTK+ Version 2.24.4)
>  of 2011-06-27 on thierry-MM061
> Windowing system distributor `The X.Org Foundation', version 11.0.11001000
> Important settings:
>   value of $LC_ALL: nil
>   value of $LC_COLLATE: nil
>   value of $LC_CTYPE: nil
>   value of $LC_MESSAGES: nil
>   value of $LC_MONETARY: nil
>   value of $LC_NUMERIC: nil
>   value of $LC_TIME: nil
>   value of $LANG: fr_FR.utf8
>   value of $XMODIFIERS: nil
>   locale-coding-system: utf-8-unix
>   default enable-multibyte-characters: t
>
> Major mode: Emacs-Lisp
>
> Minor modes in effect:
>   TeX-PDF-mode: t
>   eldoc-mode: t
>   minibuffer-depth-indicate-mode: t
>   auto-image-file-mode: t
>   show-paren-mode: t
>   display-time-mode: t
>   diff-auto-refine-mode: t
>   recentf-mode: t
>   savehist-mode: t
>   shell-dirtrack-mode: t
>   tooltip-mode: t
>   mouse-wheel-mode: t
>   file-name-shadow-mode: t
>   global-font-lock-mode: t
>   font-lock-mode: t
>   auto-composition-mode: t
>   auto-encryption-mode: t
>   auto-compression-mode: t
>   column-number-mode: t
>   line-number-mode: t
>   transient-mark-mode: t
>
> Recent input:
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> C-c R y e s <return> C-< q C-< C-x C-² <f7> m L <up> 
> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
> <up> <up> <up> <up> <up> <up> <up> <up> C-u <return> 
> 2 <backspace> 5 6 <return> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <down> <down> <down> <down> <down> <down> 
> <down> <down> <up> <up> <up> <up> <up> <up> <up> <up> 
> <up> <right> C-SPC C-f C-f C-f C-f C-f C-f C-f C-f 
> M-w q q y M-x r e p o <return>
>
> Recent messages:
> Fetching headers for gmane.emacs.bugs...done
> Scoring...done
> Generating summary...done
> No more unseen articles
> No more unread articles
> Mark set
> No more unread newsgroups
> Are you sure you want to quit reading news? (y or n)  y
> (No changes need to be saved)
>
>
> Load-path shadows:
> None found.
>
> Features:
> (shadow epa-mail emacsbug flow-fill help-mode xmtn-dvc dvc-status
> xmtn-conflicts xmtn-ids xmtn-match xmtn-automate xmtn-compat xmtn-run
> xmtn-basic-io xmtn-base w3m-cookie w3m-bookmark w3m-tabmenu w3m-session
> dabbrev tramp-cache tramp-sh qp align url-cache url-http url-gw url-auth
> w3m-form smiley gnus-cite gnus-async gnus-bcklg mail-extr gnus-ml
> nndraft nnmh nndoc utf-7 nnimap utf7 nnml nnfolder rot13 netrc
> network-stream starttls tls gnus-agent gnus-srvr gnus-score score-mode
> nnvirtual gnus-msg nntp gnus-cache gnus-dired gnus-registry registry
> eieio-base ert find-func debug view cal-iso preview prv-emacs tex-buf
> reftex-vcr reftex-dcr reftex-auc reftex reftex-vars font-latex latex
> tex-style tex latexenc vc-git xgit-dvc xgit xgit-annotate dvc-annotate
> xgit-log js cc-mode cc-fonts cc-menus cc-cmds cc-styles cc-align
> cc-engine cc-vars cc-defs conf-mode sh-script vc-rcs imenu xhg-dvc xhg
> xhg-annotate xhg-mq xhg-log bzr-core xdarcs-core xgit-core xhg-core
> xmtn-minimal tla smerge-mode newcomment dvc-state dvc-config dvc-diff
> dvc-fileinfo diff dvc-cmenu dvc-about dvc-version dvc-revlist uniquify
> em-unix em-script em-prompt em-ls em-hist em-pred em-glob em-dirs
> em-cmpl em-basic esh-opt em-banner em-alias esh-var esh-io esh-cmd
> esh-ext esh-proc esh-groups eshell esh-module esh-mode align-let server
> googlecl google-maps google-maps-static google-maps-geocode
> google-maps-base json simple-call-tree el-expectations el-mock csv2org
> iedit zop-to-char mule-util elscreen smallurl mm-url xml-weather
> rectangle-utils tv-utils eldoc-eval eldoc pcvs pcvs-parse pcvs-info
> pcvs-defs auto-document autodoc mb-depth ioccur moz cl-info
> slime-xref-browser slime-banner slime-tramp slime-asdf slime-fancy
> slime-fontifying-fu slime-package-fu slime-references slime-scratch
> slime-presentations slime-fuzzy slime-fancy-inspector slime-c-p-c
> slime-editing-commands slime-autodoc slime-parse slime-repl slime
> hideshow hyperspec slime-autoloads boxquote rect image-file newsticker
> newst-treeview newst-plainview newst-reader newst-ticker newst-backend
> ledger-config ledger esh-arg esh-util lpr woman man two-column em-term
> term ehelp electric esh-toggle em-xtra flymake pdbtrack no-word
> regex-tool whitespace paren time dired-tar dired-extension image-dired
> yaoddmuse skeleton sgml-mode emms-mplayer-config emms-playlist-limit
> emms-volume emms-volume-amixer emms-i18n emms-history emms-score
> emms-stream-info emms-metaplaylist-mode emms-bookmarks
> emms-lastfm-client parse-time emms-cue emms-mode-line-icon emms-browser
> sort emms-playlist-sort emms-last-played emms-player-xine
> emms-player-mpd tq emms-playing-time emms-lyrics emms-url hl-line
> emms-tag-editor emms-mark emms-mode-line emms-cache emms-info-ogginfo
> emms-info-mp3info emms-playlist-mode emms-player-vlc emms-player-mplayer
> emms-info emms-streams later-do emms-source-playlist emms-source-file
> emms-player-simple emms-setup emms emms-compat winner dvc-init bzr-gnus
> tla-gnus xgit-gnus xhg-gnus gnus-art mm-uu mml2015 mm-view mml-smime
> smime dig nnir gnus-sum nnoo gnus-group gnus-undo nnmail mail-source
> gnus-start gnus-spec gnus-int gnus-range gnus-win gnus gnus-ems nnheader
> dvc-gnus tla-core tla-autoconf tla-defs dvc-log vc vc-dispatcher
> dvc-unified dvc-tips dired-x ediff-merg ediff-diff ediff-wind ediff-help
> ediff-util ediff-mult ediff-init ediff dvc-autoloads dvc-core dvc-lisp
> dvc-buffers dvc-ui dvc-register dvc-utils dvc-emacs ewoc dvc-defs
> dvc-site psvn log-edit pcvs-util add-log diff-mode htmlize-hack htmlize
> muse-colors muse-docbook muse-texinfo texnfo-upd texinfo muse-latex
> muse-html muse-xml-common muse-wiki cus-edit cus-start cus-load
> muse-publish muse-project muse-protocols muse-regexps muse
> muse-nested-tags muse-mode muse-autoloads org-config-thierry org-crypt
> cal-china lunar solar cal-dst cal-bahai cal-islam cal-hebrew holidays
> hol-loaddefs vc-hg org-wl org-w3m org-vm org-rmail org-mhe org-mew
> org-irc org-jsinfo org-infojs org-html org-exp ob-exp org-exp-blocks
> org-info org-gnus org-docview org-bibtex org-bbdb org-agenda appt
> diary-lib diary-loaddefs org-annotation-helper org-capture org-mks
> remember org-remember org-datetree config-w3m mime-w3m w3m doc-view
> jka-compr image-mode timezone w3m-hist w3m-fb w3m-ems w3m-ccl ccl
> w3m-favicon w3m-image w3m-proc w3m-util mime eword-decode mel path-util
> mime-parse std11 luna mime-def alist mcharset mcs-20 mcs-e20 pces
> pces-e20 pces-20 broken pcustom poe pym static apel-ver product w3m-load
> addressbook-bookmark message sendmail rfc822 mml mml-sec mm-decode
> mm-bodies mm-encode mail-parse rfc2231 rfc2047 rfc2045 ietf-drums
> mailabbrev mail-utils gmm-utils mailheader firefox-protocol
> bookmark-uzbl-handler bookmark-firefox-handler url url-proxy url-privacy
> url-expand url-methods url-history url-cookie url-util url-parse
> url-vars mailcap bookmark-extensions org ob-emacs-lisp ob-tangle ob-ref
> ob-lob ob-table org-footnote org-src ob-comint ob-keys ob ob-eval
> org-complete org-list org-faces org-compat org-entities org-macs
> noutline outline cal-menu calendar cal-loaddefs bookmark pp recentf
> tree-widget wid-edit savehist init-anything-thierry descbinds-anything
> anything-ipython ipython python-mode info-look ansi-color executable
> shell pcomplete shell-history anything-complete anything-show-completion
> anything-obsolete anything-match-plugin anything-delicious xml
> anything-mercurial anything-config browse-url rx grep compile comint
> ring tramp tramp-compat format-spec tramp-loaddefs dired-aux ffap
> thingatpt anything warnings epa-file epa derived epg epg-config
> auth-source eieio byte-opt bytecomp byte-compile cconv macroexp assoc
> gnus-util time-date mm-util mail-prsvr password-cache dired regexp-opt
> usage-memo punycode idna naquadah-theme eev-thierry edmacro kmacro
> iterator eev-all eev-mini-steps eev-browse-url eev-langs eev-compose
> eev-glyphs disp-table eev-insert eev-steps eev-bounded eev easy-mmode
> advice help-fns advice-preload w3m-wget preview-latex tex-site
> auto-loads info easymenu cl tooltip ediff-hook vc-hooks lisp-float-type
> mwheel x-win x-dnd tool-bar dnd fontset image fringe lisp-mode register
> page menu-bar rfn-eshadow timer select scroll-bar mouse jit-lock
> font-lock syntax facemenu font-core frame cham georgian utf-8-lang
> misc-lang vietnamese tibetan thai tai-viet lao korean japanese hebrew
> greek romanian slovak czech european ethiopic indian cyrillic chinese
> case-table epa-hook jka-cmpr-hook help simple abbrev minibuffer loaddefs
> button faces cus-face files text-properties overlay sha1 md5 base64
> format env code-pages mule custom widget hashtable-print-readable
> backquote make-network-process dbusbind dynamic-setting
> font-render-setting move-toolbar gtk x-toolkit x multi-tty emacs)

-- 
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997