mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-27 15:52:00 -08:00
Code Issues Projects Releases Wiki Activity

Fix encoding of multibyte ToolTalk filenames

Browse source 
* lisp/select.el (xselect-convert-to-dt-netfile): Encode file
name before computing its tooltalk name, since the indices work
on bytes.

* test/lisp/dnd-tests.el (dnd-tests-begin-file-drag): Add test.
This commit is contained in:
Po Lu 2022-06-12 22:04:47 +08:00
parent 6263f586b8
commit 1dd92bb7b8
2 changed files with 26 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lisp/select.el
View file

@ -783,11 +783,14 @@ VALUE should be SELECTION's local value."
(stringp value) (stringp value)
(file-exists-p value) (file-exists-p value)
(not (file-remote-p value))) (not (file-remote-p value)))
(cons 'STRING (let ((name (encode-coding-string value
(encode-coding-string (xselect-tt-net-file value) (or file-name-coding-system
(or file-name-coding-system default-file-name-coding-system))))
default-file-name-coding-system) (cons 'STRING
t)))) (encode-coding-string (xselect-tt-net-file name)
(or file-name-coding-system
default-file-name-coding-system)
t)))))
(setq selection-converter-alist (setq selection-converter-alist
'((TEXT . xselect-convert-to-string) '((TEXT . xselect-convert-to-string)

19
test/lisp/dnd-tests.el
View file

@ -184,10 +184,15 @@ This function only tries to handle strings."
(not (eq window-system 'x)))) (not (eq window-system 'x))))
(let ((normal-temp-file (expand-file-name (make-temp-name "dnd-test") (let ((normal-temp-file (expand-file-name (make-temp-name "dnd-test")
temporary-file-directory)) temporary-file-directory))
(normal-multibyte-file (expand-file-name
(make-temp-name "тест-на-перетаскивание")
temporary-file-directory))
(remote-temp-file (dnd-tests-make-temp-name))) (remote-temp-file (dnd-tests-make-temp-name)))
;; Touch those files if they don't exist. ;; Touch those files if they don't exist.
(unless (file-exists-p normal-temp-file) (unless (file-exists-p normal-temp-file)
(write-region "" 0 normal-temp-file)) (write-region "" 0 normal-temp-file))
(unless (file-exists-p normal-multibyte-file)
(write-region "" 0 normal-multibyte-file))
(unless (file-exists-p remote-temp-file) (unless (file-exists-p remote-temp-file)
(write-region "" 0 remote-temp-file)) (write-region "" 0 remote-temp-file))
(unwind-protect (unwind-protect
@ -239,8 +244,20 @@ This function only tries to handle strings."
(dnd-begin-file-drag normal-temp-file) (dnd-begin-file-drag normal-temp-file)
(not dnd-last-dragged-remote-file))) (not dnd-last-dragged-remote-file)))
;; Test that links to remote files can't be created. ;; Test that links to remote files can't be created.
(should-error (dnd-begin-file-drag remote-temp-file nil 'link))) (should-error (dnd-begin-file-drag remote-temp-file nil 'link))
;; Test dragging a file with a multibyte filename.
(should (eq (dnd-begin-file-drag normal-multibyte-file) 'copy))
;; Test that the ToolTalk filename is encodes and decodes correctly.
(let* ((netfile-data (cdr (dnd-tests-verify-selection-data '_DT_NETFILE)))
(parsed (dnd-tests-parse-tt-netfile netfile-data))
(filename (encode-coding-string normal-multibyte-file
(or file-name-coding-system
default-file-name-coding-system))))
(should (equal (nth 0 parsed) (system-name)))
(should (equal (nth 1 parsed) filename))
(should (equal (nth 2 parsed) filename))))
(delete-file normal-temp-file) (delete-file normal-temp-file)
(delete-file normal-multibyte-file)
(delete-file remote-temp-file)))) (delete-file remote-temp-file))))
(ert-deftest dnd-tests-begin-drag-files () (ert-deftest dnd-tests-begin-drag-files ()