Merge from origin/emacs-26

9226cf3254 Fix bug in recent styled_format change
fa92f0c447 Cleanup emacs-lisp-mode's use of Flymake
0d0265bf50 Fix @include directive in Flymake doc
295457ae52 Move read-multiple-choice to its own library
560dd9b573 * src/process.c (syms_of_process): Remove duplicated call ...

5 files changed, 255 insertions, 238 deletions

diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
new file mode 100644
index 00000000000..417301cde06
--- /dev/null
+++ b/lisp/emacs-lisp/rmc.el
@@ -0,0 +1,199 @@
+;;; rmc.el --- read from a multiple choice question -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###autoload
+(defun read-multiple-choice (prompt choices)
+  "Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+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.
+
+When `use-dialog-box' is t (the default), this function can pop
+up a dialog window to collect the user input. That functionality
+requires `display-popup-menus-p' to return t. Otherwise, a text
+dialog will be used.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+                      \\='((?a \"always\")
+                        (?s \"session only\")
+                        (?n \"no\")))"
+  (let* ((altered-names nil)
+         (full-prompt
+          (format
+           "%s (%s): "
+           prompt
+           (mapconcat
+            (lambda (elem)
+              (let* ((name (cadr elem))
+                     (pos (seq-position name (car elem)))
+                     (altered-name
+                      (cond
+                       ;; Not in the name string.
+                       ((not pos)
+                        (format "[%c] %s" (car elem) name))
+                       ;; The prompt character is in the name, so highlight
+                       ;; it on graphical terminals...
+                       ((display-supports-face-attributes-p
+                         '(:underline t) (window-frame))
+                        (setq name (copy-sequence name))
+                        (put-text-property pos (1+ pos)
+                                           'face 'read-multiple-choice-face
+                                           name)
+                        name)
+                       ;; And put it in [bracket] on non-graphical terminals.
+                       (t
+                        (concat
+                         (substring name 0 pos)
+                         "["
+                         (upcase (substring name pos (1+ pos)))
+                         "]"
+                         (substring name (1+ pos)))))))
+                (push (cons (car elem) altered-name)
+                      altered-names)
+                altered-name))
+            (append choices '((?? "?")))
+            ", ")))
+         tchar buf wrong-char answer)
+    (save-window-excursion
+      (save-excursion
+        (while (not tchar)
+          (message "%s%s"
+                   (if wrong-char
+                       "Invalid choice.  "
+                     "")
+                   full-prompt)
+          (setq tchar
+                (if (and (display-popup-menus-p)
+                         last-input-event ; not during startup
+                         (listp last-nonmenu-event)
+                         use-dialog-box)
+                    (x-popup-dialog
+                     t
+                     (cons prompt
+                           (mapcar
+                            (lambda (elem)
+                              (cons (capitalize (cadr elem))
+                                    (car elem)))
+                            choices)))
+                  (condition-case nil
+                      (let ((cursor-in-echo-area t))
+                        (read-char))
+                    (error nil))))
+          (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)
+                 (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 '(?? ?\C-h)))
+                  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))))
+                      (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)))
+
+(provide 'rmc)
+
+;;; rmc.el ends here
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 5189cc4a6e8..8ed29d8659d 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -245,176 +245,6 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
       (substring string 0 (- (length string) (length suffix)))
     string))
 
-(defun read-multiple-choice (prompt choices)
-  "Ask user a multiple choice question.
-PROMPT should be a string that will be displayed as the prompt.
-
-CHOICES is an alist where the first element in each entry is a
-character to be entered, the second element is a short name for
-the entry to be displayed while prompting (if there's room, it
-might be shortened), and the third, optional entry is a longer
-explanation that will be displayed in a help buffer if the user
-requests more help.
-
-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.
-
-When `use-dialog-box' is t (the default), this function can pop
-up a dialog window to collect the user input. That functionality
-requires `display-popup-menus-p' to return t. Otherwise, a text
-dialog will be used.
-
-The return value is the matching entry from the CHOICES list.
-
-Usage example:
-
-\(read-multiple-choice \"Continue connecting?\"
-                      \\='((?a \"always\")
-                        (?s \"session only\")
-                        (?n \"no\")))"
-  (let* ((altered-names nil)
-         (full-prompt
-          (format
-           "%s (%s): "
-           prompt
-           (mapconcat
-            (lambda (elem)
-              (let* ((name (cadr elem))
-                     (pos (seq-position name (car elem)))
-                     (altered-name
-                      (cond
-                       ;; Not in the name string.
-                       ((not pos)
-                        (format "[%c] %s" (car elem) name))
-                       ;; The prompt character is in the name, so highlight
-                       ;; it on graphical terminals...
-                       ((display-supports-face-attributes-p
-                         '(:underline t) (window-frame))
-                        (setq name (copy-sequence name))
-                        (put-text-property pos (1+ pos)
-                                           'face 'read-multiple-choice-face
-                                           name)
-                        name)
-                       ;; And put it in [bracket] on non-graphical terminals.
-                       (t
-                        (concat
-                         (substring name 0 pos)
-                         "["
-                         (upcase (substring name pos (1+ pos)))
-                         "]"
-                         (substring name (1+ pos)))))))
-                (push (cons (car elem) altered-name)
-                      altered-names)
-                altered-name))
-            (append choices '((?? "?")))
-            ", ")))
-         tchar buf wrong-char answer)
-    (save-window-excursion
-      (save-excursion
-        (while (not tchar)
-          (message "%s%s"
-                   (if wrong-char
-                       "Invalid choice.  "
-                     "")
-                   full-prompt)
-          (setq tchar
-                (if (and (display-popup-menus-p)
-                         last-input-event ; not during startup
-                         (listp last-nonmenu-event)
-                         use-dialog-box)
-                    (x-popup-dialog
-                     t
-                     (cons prompt
-                           (mapcar
-                            (lambda (elem)
-                              (cons (capitalize (cadr elem))
-                                    (car elem)))
-                            choices)))
-                  (condition-case nil
-                      (let ((cursor-in-echo-area t))
-                        (read-char))
-                    (error nil))))
-          (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)
-                 (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 '(?? ?\C-h)))
-                  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))))
-                      (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)))
-
 (provide 'subr-x)
 
 ;;; subr-x.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index ed0b3cb44fc..7dc9dd7b13c 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -49,7 +49,7 @@
 (require 'mm-util)
 (require 'rfc2047)
 (require 'puny)
-(require 'subr-x)                       ; read-multiple-choice
+(require 'rmc)                  ; read-multiple-choice
 
 (autoload 'mailclient-send-it "mailclient")
 
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index e2053a09355..87fa9778b6d 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (require 'cl-lib)
-(require 'subr-x)                       ; read-multiple-choice
+(require 'rmc)                       ; read-multiple-choice
 
 (defvar nsm-permanent-host-settings nil)
 (defvar nsm-temporary-host-settings nil)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 3690f673832..99a4841e318 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1599,8 +1599,11 @@ ARGLIST is either a string, or a list of strings or symbols."
 (defvar checkdoc-autofix-flag)
 (defvar checkdoc-generate-compile-warnings-flag)
 (defvar checkdoc-diagnostic-buffer)
-(defun elisp-flymake--checkdoc-1 ()
-  "Do actual work for `elisp-flymake-checkdoc'."
+
+;;;###autoload
+(defun elisp-flymake-checkdoc (report-fn &rest _args)
+  "A Flymake backend for `checkdoc'.
+Calls REPORT-FN directly."
   (let (collected)
     (let* ((checkdoc-create-error-function
             (lambda (text start end &optional unfixable)
@@ -1608,63 +1611,52 @@ ARGLIST is either a string, or a list of strings or symbols."
               nil))
            (checkdoc-autofix-flag nil)
            (checkdoc-generate-compile-warnings-flag nil)
-           (buf (generate-new-buffer " *checkdoc-temp*"))
-           (checkdoc-diagnostic-buffer buf))
+           (checkdoc-diagnostic-buffer
+            (generate-new-buffer " *checkdoc-temp*")))
       (unwind-protect
           (save-excursion
             (checkdoc-current-buffer t))
-        (kill-buffer buf)))
+        (kill-buffer checkdoc-diagnostic-buffer)))
+    (funcall report-fn
+             (cl-loop for (text start end _unfixable) in
+                      collected
+                      collect
+                      (flymake-make-diagnostic
+                       (current-buffer)
+                       start end :note text)))
     collected))
 
-;;;###autoload
-(defun elisp-flymake-checkdoc (report-fn &rest _args)
-  "A Flymake backend for `checkdoc'.
-Calls REPORT-FN directly."
-  (unless (derived-mode-p 'emacs-lisp-mode)
-    (error "Can only work on `emacs-lisp-mode' buffers"))
-  (funcall report-fn
-           (cl-loop for (text start end _unfixable) in
-                    (elisp-flymake--checkdoc-1)
-                    collect
-                    (flymake-make-diagnostic
-                     (current-buffer)
-                     start end :note text))))
-
 (defun elisp-flymake--byte-compile-done (report-fn
-                                         origin-buffer
-                                         output-buffer
-                                         temp-file)
-  (unwind-protect
-      (with-current-buffer
-          origin-buffer
-        (save-excursion
-          (save-restriction
-            (widen)
-            (funcall
-             report-fn
-             (cl-loop with data =
-                      (with-current-buffer output-buffer
-                        (goto-char (point-min))
-                        (search-forward ":elisp-flymake-output-start")
-                        (read (point-marker)))
-                      for (string pos _fill level) in data
-                      do (goto-char pos)
-                      for beg = (if (< (point) (point-max))
-                                    (point)
-                                  (line-beginning-position))
-                      for end = (min
-                                 (line-end-position)
-                                 (or (cdr
-                                      (bounds-of-thing-at-point 'sexp))
-                                     (point-max)))
-                      collect (flymake-make-diagnostic
-                               (current-buffer)
-                               (if (= beg end) (1- beg) beg)
-                               end
-                               level
-                               string))))))
-    (kill-buffer output-buffer)
-    (ignore-errors (delete-file temp-file))))
+                                         source-buffer
+                                         output-buffer)
+  (with-current-buffer
+      source-buffer
+    (save-excursion
+      (save-restriction
+        (widen)
+        (funcall
+         report-fn
+         (cl-loop with data =
+                  (with-current-buffer output-buffer
+                    (goto-char (point-min))
+                    (search-forward ":elisp-flymake-output-start")
+                    (read (point-marker)))
+                  for (string pos _fill level) in data
+                  do (goto-char pos)
+                  for beg = (if (< (point) (point-max))
+                                (point)
+                              (line-beginning-position))
+                  for end = (min
+                             (line-end-position)
+                             (or (cdr
+                                  (bounds-of-thing-at-point 'sexp))
+                                 (point-max)))
+                  collect (flymake-make-diagnostic
+                           (current-buffer)
+                           (if (= beg end) (1- beg) beg)
+                           end
+                           level
+                           string)))))))
 
 (defvar-local elisp-flymake--byte-compile-process nil
   "Buffer-local process started for byte-compiling the buffer.")
@@ -1674,16 +1666,11 @@ Calls REPORT-FN directly."
   "A Flymake backend for elisp byte compilation.
 Spawn an Emacs process that byte-compiles a file representing the
 current buffer state and calls REPORT-FN when done."
-  (interactive (list (lambda (stuff)
-                       (message "aha %s" stuff))))
-  (unless (derived-mode-p 'emacs-lisp-mode)
-    (error "Can only work on `emacs-lisp-mode' buffers"))
   (when elisp-flymake--byte-compile-process
-    (process-put elisp-flymake--byte-compile-process 'elisp-flymake--obsolete t)
     (when (process-live-p elisp-flymake--byte-compile-process)
       (kill-process elisp-flymake--byte-compile-process)))
   (let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
-        (origin-buffer (current-buffer)))
+        (source-buffer (current-buffer)))
     (save-restriction
       (widen)
       (write-region (point-min) (point-max) temp-file nil 'nomessage))
@@ -1703,21 +1690,22 @@ current buffer state and calls REPORT-FN when done."
         :connection-type 'pipe
         :sentinel
         (lambda (proc _event)
-          (unless (process-live-p proc)
+          (when (eq (process-status proc) 'exit)
             (unwind-protect
                 (cond
+                 ((not (eq proc elisp-flymake--byte-compile-process))
+                  (flymake-log :warning "byte-compile process %s obsolete" proc))
                  ((zerop (process-exit-status proc))
                   (elisp-flymake--byte-compile-done report-fn
-                                                    origin-buffer
-                                                    output-buffer
-                                                    temp-file))
-                 ((process-get proc 'elisp-flymake--obsolete)
-                  (flymake-log :warning "byte-compile process %s obsolete" proc))
+                                                    source-buffer
+                                                    output-buffer))
                  (t
                   (funcall report-fn
                            :panic
                            :explanation
-                           (format "byte-compile process %s died" proc)))))))))
+                           (format "byte-compile process %s died" proc))))
+              (ignore-errors (delete-file temp-file))
+              (kill-buffer output-buffer))))))
       :stderr null-device
       :noquery t)))