Subject: bug#45412: File ... is large (... MiB), really open? (y)es or (n)o or (l)iterally

From: Daniel Martín <[email-masked]>
Date: Thu, 06 May 2021 01:10:08 +0200

Lars Ingebrigtsen <[email-masked]> writes:

> Daniel Martín <[email-masked]> writes:
>
>> Yes, if you click on a large file in Dired, you'll see a graphical
>> prompt, as always.
>
> Right.  Eli had other comments on the patch, though -- would it be
> possible for you to rework the patch, and then we can get it applied?

I think I've applied all code review suggestions (patches attached).
Thanks.

>From b5a49005af33d8fcd35ca034949920f3ff8c36d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= <[email-masked]>
Date: Wed, 21 Apr 2021 23:14:27 +0200
Subject: [PATCH 1/2] Extend read-multiple-choice to support free-form help
 descriptions

* lisp/emacs-lisp/rmc.el (read-multiple-choice): Add a new argument to
override the default help description in `read-multiple-choice'.  Use
the `help-char' variable instead of ?\C-h.  Also support the `edit'
action from `query-replace-map', so that help links can be visited by
entering a recursive edit.
---
 lisp/emacs-lisp/rmc.el | 129 +++++++++++++++++++++++------------------
 1 file changed, 74 insertions(+), 55 deletions(-)

diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index bedf598d44..6aa169c032 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -26,24 +26,32 @@
 (require 'seq)
 
 ;;;###autoload
-(defun read-multiple-choice (prompt choices)
+(defun read-multiple-choice (prompt choices &optional help-string)
   "Ask user a multiple choice question.
 PROMPT should be a string that will be displayed as the prompt.
 
 CHOICES is a list of (KEY NAME [DESCRIPTION]).  KEY is a
 character to be entered.  NAME is a short name for the entry to
 be displayed while prompting (if there's room, it might be
-shortened).  DESCRIPTION is an optional longer explanation that
-will be displayed in a help buffer if the user requests more
-help.
+shortened).  DESCRIPTION is an optional longer explanation for
+the entry that will be displayed in a help buffer if the user
+requests more help.  This help description has a fixed format in
+columns, but, for greater flexibility, instead of passing a
+DESCRIPTION, the user can use the optional argument HELP-STRING.
+This argument is a string that contains the text with the
+complete description of all choices.  `read-multiple-choice' will
+display that description in a help buffer if the user requests
+it.
 
 This function translates user input into responses by consulting
 the bindings in `query-replace-map'; see the documentation of
 that variable for more information.  In this case, the useful
-bindings are `recenter', `scroll-up', and `scroll-down'.  If the
-user enters `recenter', `scroll-up', or `scroll-down' responses,
-perform the requested window recentering or scrolling and ask
-again.
+bindings are `recenter', `scroll-up', `scroll-down', and `edit'.
+If the user enters `recenter', `scroll-up', or `scroll-down'
+responses, perform the requested window recentering or scrolling
+and ask again.  If the user enters `edit', start a recursive
+edit.  When the user exit the recursive edit, the multiple choice
+prompt gains focus again.
 
 When `use-dialog-box' is t (the default), this function can pop
 up a dialog window to collect the user input.  That functionality
@@ -133,6 +141,13 @@ read-multiple-choice
                   (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.  Resume with \\[exit-recursive-edit]"))
+                      (recursive-edit))))
                  (t tchar)))
           (when (eq tchar t)
             (setq wrong-char nil
@@ -141,57 +156,61 @@ read-multiple-choice
           ;; help messages.
           (when (and (not (eq tchar nil))
                      (not (assq tchar choices)))
-	    (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+	    (setq wrong-char (not (memq tchar `(?? ,help-char)))
                   tchar nil)
             (when wrong-char
               (ding))
-            (with-help-window (setq buf (get-buffer-create
-                                         "*Multiple Choice Help*"))
-              (with-current-buffer buf
-                (erase-buffer)
-                (pop-to-buffer buf)
-                (insert prompt "\n\n")
-                (let* ((columns (/ (window-width) 25))
-                       (fill-column 21)
-                       (times 0)
-                       (start (point)))
-                  (dolist (elem choices)
-                    (goto-char start)
-                    (unless (zerop times)
-                      (if (zerop (mod times columns))
-                          ;; Go to the next "line".
-                          (goto-char (setq start (point-max)))
-                        ;; Add padding.
-                        (while (not (eobp))
-                          (end-of-line)
-                          (insert (make-string (max (- (* (mod times columns)
-                                                          (+ fill-column 4))
-                                                       (current-column))
-                                                    0)
-                                               ?\s))
-                          (forward-line 1))))
-                    (setq times (1+ times))
-                    (let ((text
-                           (with-temp-buffer
-                             (insert (format
-                                      "%c: %s\n"
-                                      (car elem)
-                                      (cdr (assq (car elem) altered-names))))
-                             (fill-region (point-min) (point-max))
-                             (when (nth 2 elem)
-                               (let ((start (point)))
-                                 (insert (nth 2 elem))
-                                 (unless (bolp)
-                                   (insert "\n"))
-                                 (fill-region start (point-max))))
-                             (buffer-string))))
+            (setq buf (get-buffer-create "*Multiple Choice Help*"))
+            (if (stringp help-string)
+                (with-help-window buf
+                  (with-current-buffer buf
+                    (insert help-string)))
+              (with-help-window buf
+                (with-current-buffer buf
+                  (erase-buffer)
+                  (pop-to-buffer buf)
+                  (insert prompt "\n\n")
+                  (let* ((columns (/ (window-width) 25))
+                         (fill-column 21)
+                         (times 0)
+                         (start (point)))
+                    (dolist (elem choices)
                       (goto-char start)
-                      (dolist (line (split-string text "\n"))
-                        (end-of-line)
-                        (if (bolp)
-                            (insert line "\n")
-                          (insert line))
-                        (forward-line 1)))))))))))
+                      (unless (zerop times)
+                        (if (zerop (mod times columns))
+                            ;; Go to the next "line".
+                            (goto-char (setq start (point-max)))
+                          ;; Add padding.
+                          (while (not (eobp))
+                            (end-of-line)
+                            (insert (make-string (max (- (* (mod times columns)
+                                                            (+ fill-column 4))
+                                                         (current-column))
+                                                      0)
+                                                 ?\s))
+                            (forward-line 1))))
+                      (setq times (1+ times))
+                      (let ((text
+                             (with-temp-buffer
+                               (insert (format
+                                        "%c: %s\n"
+                                        (car elem)
+                                        (cdr (assq (car elem) altered-names))))
+                               (fill-region (point-min) (point-max))
+                               (when (nth 2 elem)
+                                 (let ((start (point)))
+                                   (insert (nth 2 elem))
+                                   (unless (bolp)
+                                     (insert "\n"))
+                                   (fill-region start (point-max))))
+                               (buffer-string))))
+                        (goto-char start)
+                        (dolist (line (split-string text "\n"))
+                          (end-of-line)
+                          (if (bolp)
+                              (insert line "\n")
+                            (insert line))
+                          (forward-line 1))))))))))))
     (when (buffer-live-p buf)
       (kill-buffer buf))
     (assq tchar choices)))
-- 
2.31.0

>From 406990011fe26ee681597e25155ab4dfa4f6ee42 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= <[email-masked]>
Date: Wed, 21 Apr 2021 23:27:13 +0200
Subject: [PATCH 2/2] Add a help option to the open large files prompt

* lisp/files.el (files--ask-user-about-large-file-help-text): New
function that returns information about opening large files in
Emacs.  (Bug#45412)
(files--ask-user-about-large-file): Use read-multiple-choice to
display the available actions.
* etc/NEWS: Advertise the new feature.
---
 etc/NEWS      |  8 +++++++
 lisp/files.el | 60 ++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 53 insertions(+), 15 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c2db98ae45..f99dcae536 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -276,6 +276,14 @@ commands.  The new keystrokes are 'C-x x g' ('revert-buffer'),
 ** Commands 'set-frame-width' and 'set-frame-height' can now get their
 input using the minibuffer.
 
+---
+** New help window when Emacs prompts before opening a large file.
+Commands like 'find-file' or 'visit-tags-table' ask to visit a file
+normally or literally when the file is larger than a certain size (by
+default, 9.5 MiB).  Press '?' or 'C-h' in that prompt to read more
+about the different options to visit a file, how you can disable the
+prompt, and how you can tweak the file size threshold.
+
 
 * Editing Changes in Emacs 28.1
 
diff --git a/lisp/files.el b/lisp/files.el
index 8e8fbac8dc..c1857ba032 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2129,27 +2129,57 @@ out-of-memory-warning-percentage
 
 (declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
+(defun files--ask-user-about-large-file-help-text (op-type size)
+  "Format the text that explains the options to open large files in Emacs.
+OP-TYPE contains the kind of file operation that will be
+performed.  SIZE is the size of the large file."
+  (format
+   "The file that you want to %s is large (%s), which exceeds the
+ threshold above which Emacs asks for confirmation (%s).
+
+ Large files may be slow to edit or navigate so Emacs asks you
+ before you try to %s such files.
+
+ You can press:
+ 'y' to %s the file.
+ 'n' to abort, and not %s the file.
+ 'l' (the letter ell) to %s the file literally, which means that
+ Emacs will %s the file without doing any format or character code
+ conversion and in Fundamental mode, without loading any potentially
+ expensive features.
+
+ You can customize the option `large-file-warning-threshold' to be the
+ file size, in bytes, from which Emacs will ask for confirmation.  Set
+ it to nil to never request confirmation."
+   op-type
+   size
+   (funcall byte-count-to-string-function large-file-warning-threshold)
+   op-type
+   op-type
+   op-type
+   op-type
+   op-type))
+
 (defun files--ask-user-about-large-file (size op-type filename offer-raw)
+  "If file SIZE larger than `large-file-warning-threshold', allow user to abort.
+OP-TYPE specifies the file operation being performed on FILENAME.
+If OFFER-RAW is true, give user the additional option to open the
+file literally."
   (let ((prompt (format "File %s is large (%s), really %s?"
 		        (file-name-nondirectory filename)
 		        (funcall byte-count-to-string-function size) op-type)))
     (if (not offer-raw)
         (if (y-or-n-p prompt) nil 'abort)
-      (let* ((use-dialog (and (display-popup-menus-p)
-                              last-input-event
-	                      (listp last-nonmenu-event)
-	                      use-dialog-box))
-             (choice
-              (if use-dialog
-                  (x-popup-dialog t `(,prompt
-                                      ("Yes" . ?y)
-                                      ("No" . ?n)
-                                      ("Open literally" . ?l)))
-                (read-char-choice
-                 (concat prompt " (y)es or (n)o or (l)iterally ")
-                 '(?y ?Y ?n ?N ?l ?L)))))
-        (cond ((memq choice '(?y ?Y)) nil)
-              ((memq choice '(?l ?L)) 'raw)
+      (let* ((choice
+              (car
+               (read-multiple-choice prompt '((?y "yes")
+                                              (?n "no")
+                                              (?l "literally"))
+                                     (files--ask-user-about-large-file-help-text
+                                      op-type
+                                      (funcall byte-count-to-string-function size))))))
+        (cond ((eq choice ?y) nil)
+              ((eq choice ?l) 'raw)
               (t 'abort))))))
 
 (defun abort-if-file-too-large (size op-type filename &optional offer-raw)
-- 
2.31.0