[Emacs-diffs] master 73a3677 2/2: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

[Michael Albinus]

branch: master
commit 73a367795f6dfc947a91798c6a62de822e199053
Merge: c595d5d bb97552
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
 lisp/progmodes/python.el            | 10 ++++---
 lisp/simple.el                      | 58 ++++++++++++++++++------------------
 test/lisp/progmodes/python-tests.el |  9 ++++++
 test/lisp/simple-tests.el           | 59 +++++++++++++++++++++++++------------
 4 files changed, 83 insertions(+), 53 deletions(-)

diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 32d645c..a09ca2f 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2842,10 +2842,12 @@ process buffer for a list of commands.)"
         (y-or-n-p "Make dedicated process? ")
         (= (prefix-numeric-value current-prefix-arg) 4))
      (list (python-shell-calculate-command) nil t)))
-  (get-buffer-process
-   (python-shell-make-comint
-    (or cmd (python-shell-calculate-command))
-    (python-shell-get-process-name dedicated) show)))
+  (let ((buffer
+         (python-shell-make-comint
+          (or cmd (python-shell-calculate-command))
+          (python-shell-get-process-name dedicated) show)))
+    (pop-to-buffer buffer)
+    (get-buffer-process buffer)))
 
 (defun run-python-internal ()
   "Run an inferior Internal Python process.
diff --git a/lisp/simple.el b/lisp/simple.el
index a0a6898..57e70a8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3400,6 +3400,8 @@ a shell (with its need to quote arguments)."
     (setq command (concat command " &")))
   (shell-command command output-buffer error-buffer))
 
+(declare-function comint-output-filter "comint" (process string))
+
 (defun shell-command (command &optional output-buffer error-buffer)
   "Execute string COMMAND in inferior shell; display output, if any.
 With prefix argument, insert the COMMAND's output at point.
@@ -3477,12 +3479,11 @@ impose the use of a shell (with its need to quote 
arguments)."
               (not (or (bufferp output-buffer)  (stringp output-buffer))))
          ;; Output goes in current buffer.
          (let ((error-file
-                (if error-buffer
-                    (make-temp-file
-                     (expand-file-name "scor"
-                                       (or small-temporary-file-directory
-                                           temporary-file-directory)))
-                  nil)))
+                 (and error-buffer
+                      (make-temp-file
+                       (expand-file-name "scor"
+                                         (or small-temporary-file-directory
+                                             temporary-file-directory))))))
            (barf-if-buffer-read-only)
            (push-mark nil t)
            ;; We do not use -f for csh; we will not support broken use of
@@ -3490,24 +3491,22 @@ impose the use of a shell (with its need to quote 
arguments)."
            ;; "if ($?prompt) exit" before things which are not useful
            ;; non-interactively.  Besides, if someone wants their other
            ;; aliases for shell commands then they can still have them.
-           (call-process shell-file-name nil
-                         (if error-file
-                             (list t error-file)
-                           t)
-                         nil shell-command-switch command)
+            (call-process-shell-command command nil (if error-file
+                                                        (list t error-file)
+                                                      t))
            (when (and error-file (file-exists-p error-file))
-             (if (< 0 (nth 7 (file-attributes error-file)))
-                 (with-current-buffer (get-buffer-create error-buffer)
-                   (let ((pos-from-end (- (point-max) (point))))
-                     (or (bobp)
-                         (insert "\f\n"))
-                     ;; Do no formatting while reading error file,
-                     ;; because that can run a shell command, and we
-                     ;; don't want that to cause an infinite recursion.
-                     (format-insert-file error-file nil)
-                     ;; Put point after the inserted errors.
-                     (goto-char (- (point-max) pos-from-end)))
-                   (display-buffer (current-buffer))))
+              (when (< 0 (file-attribute-size (file-attributes error-file)))
+                (with-current-buffer (get-buffer-create error-buffer)
+                  (let ((pos-from-end (- (point-max) (point))))
+                    (or (bobp)
+                        (insert "\f\n"))
+                    ;; Do no formatting while reading error file,
+                    ;; because that can run a shell command, and we
+                    ;; don't want that to cause an infinite recursion.
+                    (format-insert-file error-file nil)
+                    ;; Put point after the inserted errors.
+                    (goto-char (- (point-max) pos-from-end)))
+                  (display-buffer (current-buffer))))
              (delete-file error-file))
            ;; This is like exchange-point-and-mark, but doesn't
            ;; activate the mark.  It is cleaner to avoid activation,
@@ -3526,12 +3525,11 @@ impose the use of a shell (with its need to quote 
arguments)."
               (let* ((buffer (get-buffer-create
                               (or output-buffer "*Async Shell Command*")))
                      (bname (buffer-name buffer))
-                     (directory default-directory)
-                     proc)
+                     (proc (get-buffer-process buffer))
+                     (directory default-directory))
                ;; Remove the ampersand.
                (setq command (substring command 0 (match-beginning 0)))
                ;; Ask the user what to do with already running process.
-               (setq proc (get-buffer-process buffer))
                (when proc
                  (cond
                   ((eq async-shell-command-buffer 'confirm-kill-process)
@@ -3563,14 +3561,14 @@ impose the use of a shell (with its need to quote 
arguments)."
                (with-current-buffer buffer
                   (shell-command--save-pos-or-erase)
                  (setq default-directory directory)
-                 (setq proc (start-process "Shell" buffer shell-file-name
-                                           shell-command-switch command))
+                  (setq proc
+                        (start-process-shell-command "Shell" buffer command))
                  (setq mode-line-process '(":%s"))
                  (require 'shell) (shell-mode)
-                 (set-process-sentinel proc 'shell-command-sentinel)
+                  (set-process-sentinel proc #'shell-command-sentinel)
                  ;; Use the comint filter for proper handling of
                  ;; carriage motion (see comint-inhibit-carriage-motion).
-                 (set-process-filter proc 'comint-output-filter)
+                  (set-process-filter proc #'comint-output-filter)
                   (if async-shell-command-display-buffer
                       ;; Display buffer immediately.
                       (display-buffer buffer '(nil (allow-no-window . t)))
diff --git a/test/lisp/progmodes/python-tests.el 
b/test/lisp/progmodes/python-tests.el
index 4955da0..1c4d22d 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -5352,6 +5352,15 @@ buffer with overlapping strings."
                     (python-nav-end-of-statement)))
     (should (eolp))))
 
+;; After call `run-python' the buffer running the python process is current.
+(ert-deftest python-tests--bug31398 ()
+  "Test for https://debbugs.gnu.org/31398 ."
+  (skip-unless (executable-find python-tests-shell-interpreter))
+  (let ((buffer (process-buffer (run-python nil nil 'show))))
+    (should (eq buffer (current-buffer)))
+    (pop-to-buffer (other-buffer))
+    (run-python nil nil 'show)
+    (should (eq buffer (current-buffer)))))
 
 (provide 'python-tests)
 
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 7a10df2..678d9b9 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -521,30 +521,51 @@ See Bug#21722."
     (do-auto-fill)
     (should (string-equal (buffer-string) "foo bar"))))
 
+
+;;; Shell command.
+
 (ert-deftest simple-tests-async-shell-command-30280 ()
   "Test for https://debbugs.gnu.org/30280 ."
-  :expected-result :failed
   (let* ((async-shell-command-buffer 'new-buffer)
          (async-shell-command-display-buffer nil)
-         (str "*Async Shell Command*")
-         (buffers-name
-          (cl-loop repeat 2
-                   collect (buffer-name
-                            (generate-new-buffer str))))
+         (base "name")
+         (first (buffer-name (generate-new-buffer base)))
+         (second (generate-new-buffer-name base))
+         ;; `save-window-excursion' doesn't restore frame configurations.
+         (pop-up-frames nil)
          (inhibit-message t))
-    (mapc #'kill-buffer buffers-name)
-    (async-shell-command
-     (format "%s -Q -batch -eval '(progn (sleep-for 3600) (message \"foo\"))'"
-             invocation-name))
-    (async-shell-command
-     (format "%s -Q -batch -eval '(progn (sleep-for 1) (message \"bar\"))'"
-             invocation-name))
-    (let ((buffers (mapcar #'get-buffer buffers-name))
-          (processes (mapcar #'get-buffer-process buffers-name)))
-      (unwind-protect
-          (should (memq (cadr buffers) (mapcar #'window-buffer (window-list))))
-        (mapc #'delete-process processes)
-        (mapc #'kill-buffer buffers)))))
+    ;; Let `shell-command' create the buffer as needed.
+    (kill-buffer first)
+    (unwind-protect
+        (save-window-excursion
+          ;; One command has no output, the other does.
+          ;; Removing the -eval argument also yields no output, but
+          ;; then both commands exit simultaneously when
+          ;; `accept-process-output' is called on the second command.
+          (dolist (form '("(sleep-for 8)" "(message \"\")"))
+            (async-shell-command (format "%s -Q -batch -eval '%s'"
+                                         invocation-name form)
+                                 first))
+          ;; First command should neither have nor display output.
+          (let* ((buffer (get-buffer first))
+                 (process (get-buffer-process buffer)))
+            (should (buffer-live-p buffer))
+            (should process)
+            (should (zerop (buffer-size buffer)))
+            (should (not (get-buffer-window buffer))))
+          ;; Second command should both have and display output.
+          (let* ((buffer (get-buffer second))
+                 (process (get-buffer-process buffer)))
+            (should (buffer-live-p buffer))
+            (should process)
+            (should (accept-process-output process 4 nil t))
+            (should (> (buffer-size buffer) 0))
+            (should (get-buffer-window buffer))))
+      (dolist (name (list first second))
+        (let* ((buffer (get-buffer name))
+               (process (and buffer (get-buffer-process buffer))))
+          (when process (delete-process process))
+          (when buffer (kill-buffer buffer)))))))
 
 (provide 'simple-test)
 ;;; simple-test.el ends here