From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 7 Mar 2022 02:27:55 +0000 (+0100)
Subject: Fix `W' in Dired with non-ASCII file names
X-Git-Tag: emacs-29.0.90~1985
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e06319b39d548571f19964b392be779aae7d298a;p=emacs.git

Fix `W' in Dired with non-ASCII file names

* lisp/net/browse-url.el (browse-url--file-name-coding-system):
Factor out into own function.
(browse-url-file-url): Property encode non-ASCII characters so
that external browsers can understand them.
(browse-url-emacs): Make `W' in Dired work with non-ASCII file
names (bug#54271).
---

diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index e4c485eccde..ccb4e12a9f1 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -708,16 +708,29 @@ interactively.  Turn the filename into a URL with function
   (browse-url (browse-url-file-url file))
   (run-hooks 'browse-url-of-file-hook))
 
+(defun browse-url--file-name-coding-system ()
+  (if (equal system-type 'windows-nt)
+      ;; W32 pretends that file names are UTF-8 encoded.
+      'utf-8
+    (or file-name-coding-system default-file-name-coding-system)))
+
 (defun browse-url-file-url (file)
   "Return the URL corresponding to FILE.
 Use variable `browse-url-filename-alist' to map filenames to URLs."
-  (let ((coding (if (equal system-type 'windows-nt)
-		    ;; W32 pretends that file names are UTF-8 encoded.
-		    'utf-8
-		  (and (or file-name-coding-system
-			   default-file-name-coding-system)))))
-    (if coding (setq file (encode-coding-string file coding))))
-  (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
+  (when-let ((coding (browse-url--file-name-coding-system)))
+    (setq file (encode-coding-string file coding)))
+  (if (and (file-remote-p file)
+           ;; We're applying special rules for FTP URLs for historical
+           ;; reasons.
+           (seq-find (lambda (match)
+                       (and (string-match-p (car match) file)
+                            (not (string-match "\\`file:" (cadr match)))))
+                     browse-url-filename-alist))
+      (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
+    ;; Encode all other file names properly.
+    (setq file (mapconcat #'url-hexify-string
+                          (file-name-split file)
+                          "/")))
   (dolist (map browse-url-filename-alist)
     (when (and map (string-match (car map) file))
       (setq file (replace-match (cdr map) t nil file))))
@@ -1213,10 +1226,12 @@ currently selected window instead."
   (require 'url-handlers)
   (let ((parsed (url-generic-parse-url url))
         (func (if same-window 'find-file 'find-file-other-window)))
-    (if (and (equal (url-type parsed) "file")
-             (file-directory-p (url-filename parsed)))
-        ;; It's a directory; just open it.
-        (funcall func (url-filename parsed))
+    (if (equal (url-type parsed) "file")
+        ;; It's a file; just open it.
+        (let ((file (url-unhex-string (url-filename parsed))))
+          (when-let ((coding (browse-url--file-name-coding-system)))
+            (setq file (decode-coding-string file 'utf-8)))
+          (funcall func file))
       (let ((file-name-handler-alist
              (cons (cons url-handler-regexp 'url-file-handler)
                    file-name-handler-alist)))
diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el
index 8f180f3d6bb..c94719c97af 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -82,10 +82,13 @@
 
 (ert-deftest browse-url-tests-file-url ()
   (should (equal (browse-url-file-url "/foo") "file:///foo"))
-  (should (equal (browse-url-file-url "/foo:") "ftp://foo/"))
-  (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/"))
-  (should (equal (browse-url-file-url "/anonymous@foo:")
-                 "ftp://foo/")))
+  (when (file-remote-p "/foo:")
+    (should (equal (browse-url-file-url "/foo:") "ftp://foo/")))
+  (when (file-remote-p "/ftp@foo:")
+    (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/")))
+  (when (file-remote-p "/anonymous@foo:")
+    (should (equal (browse-url-file-url "/anonymous@foo:")
+                   "ftp://foo/"))))
 
 (ert-deftest browse-url-tests-delete-temp-file ()
   (ert-with-temp-file browse-url-temp-file-name