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).
This commit is contained in:
Lars Ingebrigtsen 2022-03-07 03:27:55 +01:00
parent 36b31d38cd
commit e06319b39d
2 changed files with 33 additions and 15 deletions

View file

@ -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)))

View file

@ -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