feature/native-comp 92dc81f 2/2: Merge remote-tracking branch 'savannah/master' into HEAD

[Andrea Corallo]

branch: feature/native-comp
commit 92dc81f85e1b91db04487ccf1b52c0cd3328dfee
Merge: cf105f6 de5f592
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Merge remote-tracking branch 'savannah/master' into HEAD
---
 lisp/dnd.el                  | 19 ++++---------
 lisp/net/browse-url.el       | 64 ++++++++++++++++++++++++++------------------
 lisp/net/tramp-adb.el        |  4 +++
 lisp/net/tramp-sh.el         |  4 +++
 test/lisp/net/tramp-tests.el |  2 ++
 5 files changed, 53 insertions(+), 40 deletions(-)

diff --git a/lisp/dnd.el b/lisp/dnd.el
index 2f7b16c..c185794 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -92,7 +92,6 @@ If no match is found here, `browse-url-handlers' and
 If no match is found, just call `dnd-insert-text'.  WINDOW is
 where the drop happened, ACTION is the action for the drop, URL
 is what has been dropped.  Returns ACTION."
-  (require 'browse-url)
   (let (ret)
     (or
      (catch 'done
@@ -102,19 +101,11 @@ is what has been dropped.  Returns ACTION."
           (throw 'done t)))
        nil)
      (catch 'done
-       (require 'browse-url) ;; browse-url-handlers is not autoloaded.
-       (dolist (bf (append
-                    ;; The alist choice of browse-url-browser-function
-                    ;; is deprecated since 28.1, so the (unless ...)
-                    ;; can be removed at some point in time.
-                    (unless (functionp browse-url-browser-function)
-                      browse-url-browser-function)
-                    browse-url-handlers
-                    browse-url-default-handlers))
-        (when (string-match (car bf) url)
-          (setq ret 'private)
-          (funcall (cdr bf) url action)
-          (throw 'done t)))
+       (let ((browser (browse-url-select-handler url)))
+         (when browser
+           (setq ret 'private)
+           (funcall browser url action)
+           (throw 'done t)))
        nil)
      (progn
        (dnd-insert-text window action url)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 1275c15..b346653 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -601,10 +601,17 @@ down (this *won't* always work)."
   "Calls `browse-url-man-function' with URL and ARGS."
   (funcall browse-url-man-function url args))
 
+(defun browse-url--browser (url &rest args)
+  "Calls `browse-url-browser-function' with URL and ARGS."
+  (funcall browse-url-browser-function url args))
+
 ;;;###autoload
 (defvar browse-url-default-handlers
   '(("\\`mailto:"; . browse-url--mailto)
     ("\\`man:" . browse-url--man)
+    ;; Render file:// URLs if they are HTML pages, otherwise just find
+    ;; the file.
+    ("\\`file://.*\\.html?\\b" . browse-url--browser)
     ("\\`file://" . browse-url-emacs))
   "Like `browse-url-handlers' but populated by Emacs and packages.
 
@@ -628,6 +635,32 @@ match, the URL is opened using the value of
                 :value-type (function :tag "Handler"))
   :version "28.1")
 
+;;;###autoload
+(defun browse-url-select-handler (url)
+  "Return a handler suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler.  Return nil
+if no handler is found.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+Emacs 28.1 and will be removed in a future release."
+  (catch 'custom-url-handler
+    (dolist (regex-handler
+             (append
+              ;; The alist choice of browse-url-browser-function
+              ;; is deprecated since 28.1, so the (unless ...)
+              ;; can be removed at some point in time.
+              (when (and (consp browse-url-browser-function)
+                        (not (functionp browse-url-browser-function)))
+                (warn "Having `browse-url-browser-function' set to an
+alist is deprecated.  Use `browse-url-handlers' instead.")
+                browse-url-browser-function)
+              browse-url-handlers
+              browse-url-default-handlers))
+      (when (string-match-p (car regex-handler) url)
+        (throw 'custom-url-handler (cdr regex-handler))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; URL encoding
 
@@ -821,14 +854,8 @@ If ARGS are omitted, the default is to pass
              (not (string-match "\\`[a-z]+:" url)))
     (setq url (expand-file-name url)))
   (let ((process-environment (copy-sequence process-environment))
-       (function
-         (catch 'custom-url-handler
-           (dolist (regex-handler (append browse-url-handlers
-                                          browse-url-default-handlers))
-             (when (string-match-p (car regex-handler) url)
-               (throw 'custom-url-handler (cdr regex-handler))))
-           ;; No special handler found.
-           browse-url-browser-function))
+       (function (or (browse-url-select-handler url)
+                      browse-url-browser-function))
        ;; Ensure that `default-directory' exists and is readable (bug#6077).
        (default-directory (or (unhandled-file-name-directory default-directory)
                               (expand-file-name "~/"))))
@@ -837,24 +864,9 @@ If ARGS are omitted, the default is to pass
     ;; which may not even exist any more.
     (if (stringp (frame-parameter nil 'display))
         (setenv "DISPLAY" (frame-parameter nil 'display)))
-    (if (and (consp function)
-            (not (functionp function)))
-       ;; The `function' can be an alist; look down it for first
-       ;; match and apply the function (which might be a lambda).
-       ;; However, this usage is deprecated as of Emacs 28.1.
-        (progn
-          (warn "Having `browse-url-browser-function' set to an
-alist is deprecated.  Use `browse-url-handlers' instead.")
-          (catch 'done
-           (dolist (bf function)
-             (when (string-match (car bf) url)
-               (apply (cdr bf) url args)
-               (throw 'done t)))
-           (error "No browse-url-browser-function matching URL %s"
-                  url)))
-      ;; Unbound symbols go down this leg, since void-function from
-      ;; apply is clearer than wrong-type-argument from dolist.
-      (apply function url args))))
+    (if (functionp nil)
+        (apply function url args)
+      (error "No suitable browser for URL %s" url))))
 
 ;;;###autoload
 (defun browse-url-at-point (&optional arg)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 7f829f1..7ef07af 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -918,6 +918,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
         (kill-buffer (tramp-get-connection-buffer v))
         (setq ret 1)))
 
+      ;; Handle signals.
+      (when (and (natnump ret) (> ret 128))
+       (setq ret (format "Signal %d" (- ret 128))))
+
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
 
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index c6eb7a8..c609f58 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3159,6 +3159,10 @@ STDERR can also be a file name."
         (kill-buffer (tramp-get-connection-buffer v))
         (setq ret 1)))
 
+      ;; Handle signals.
+      (when (and (natnump ret) (> ret 128))
+       (setq ret (format "Signal %d" (- ret 128))))
+
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
 
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 462539a..4cacfa2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4209,6 +4209,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (should-not (zerop (process-file "false")))
            (should-not (zerop (process-file "binary-does-not-exist")))
            (should (= 42 (process-file "sh" nil nil nil "-c" "exit 42")))
+           ;; Return string in case the process is interrupted.
+           (should (stringp (process-file "sh" nil nil nil "-c" "kill -2 $$")))
            (with-temp-buffer
              (write-region "foo" nil tmp-name)
              (should (file-exists-p tmp-name))