aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/dnd.el4
-rw-r--r--lisp/select.el4
-rw-r--r--test/lisp/dnd-tests.el94
3 files changed, 96 insertions, 6 deletions
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 0f65b5228d6..7eb43f5baab 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -423,7 +423,7 @@ currently being held down. It should only be called upon a
423 (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other 423 (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
424 ;; modern programs that expect filenames to 424 ;; modern programs that expect filenames to
425 ;; be supplied as URIs. 425 ;; be supplied as URIs.
426 "text/uri-list" "text/x-dnd-username" 426 "text/uri-list" "text/x-xdnd-username"
427 ;; Traditional X selection targets used by 427 ;; Traditional X selection targets used by
428 ;; programs supporting the Motif 428 ;; programs supporting the Motif
429 ;; drag-and-drop protocols. Also used by NS 429 ;; drag-and-drop protocols. Also used by NS
@@ -493,7 +493,7 @@ FILES will be dragged."
493 (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other 493 (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
494 ;; modern programs that expect filenames to 494 ;; modern programs that expect filenames to
495 ;; be supplied as URIs. 495 ;; be supplied as URIs.
496 "text/uri-list" "text/x-dnd-username" 496 "text/uri-list" "text/x-xdnd-username"
497 ;; Traditional X selection targets used by 497 ;; Traditional X selection targets used by
498 ;; programs supporting the Motif 498 ;; programs supporting the Motif
499 ;; drag-and-drop protocols. Also used by NS 499 ;; drag-and-drop protocols. Also used by NS
diff --git a/lisp/select.el b/lisp/select.el
index 706197e027e..417968b25cb 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -819,8 +819,8 @@ VALUE should be SELECTION's local value."
819 (_EMACS_INTERNAL . xselect-convert-to-identity) 819 (_EMACS_INTERNAL . xselect-convert-to-identity)
820 (XmTRANSFER_SUCCESS . xselect-convert-xm-special) 820 (XmTRANSFER_SUCCESS . xselect-convert-xm-special)
821 (XmTRANSFER_FAILURE . xselect-convert-xm-special) 821 (XmTRANSFER_FAILURE . xselect-convert-xm-special)
822 (_DT_NETFILE . (xselect-convert-to-dt-netfile 822 (_DT_NETFILE . (xselect-dt-netfile-available-p
823 . xselect-dt-netfile-available-p)))) 823 . xselect-convert-to-dt-netfile))))
824 824
825(provide 'select) 825(provide 'select)
826 826
diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el
index a714c4a4e55..7a12cb8347c 100644
--- a/test/lisp/dnd-tests.el
+++ b/test/lisp/dnd-tests.el
@@ -96,7 +96,7 @@
96 (or (get-text-property 0 type basic-value) 96 (or (get-text-property 0 type basic-value)
97 basic-value) 97 basic-value)
98 basic-value)) 98 basic-value))
99 (converter-list (assq type selection-converter-alist)) 99 (converter-list (cdr (assq type selection-converter-alist)))
100 (converter (if (consp converter-list) 100 (converter (if (consp converter-list)
101 (cdr converter-list) 101 (cdr converter-list)
102 converter-list))) 102 converter-list)))
@@ -118,6 +118,30 @@ The temporary file is not created."
118 (expand-file-name (make-temp-name "dnd-test-remote") 118 (expand-file-name (make-temp-name "dnd-test-remote")
119 dnd-tests-temporary-file-directory)) 119 dnd-tests-temporary-file-directory))
120 120
121(defun dnd-tests-parse-tt-netfile (netfile)
122 "Parse NETFILE and return its components.
123NETFILE should be a canonicalized ToolTalk file name.
124Return a list of its hostname, real path, and local path."
125 (save-match-data
126 (when (string-match (concat "HOST=0-\\([[:digit:]]+\\),RPATH=\\([[:digit:]]+\\)-"
127 "\\([[:digit:]]+\\),LPATH=\\([[:digit:]]+\\)-"
128 "\\([[:digit:]]+\\)\\(:\\)")
129 netfile)
130 (let ((beg (match-end 6)))
131 (list (substring netfile beg
132 (+ beg 1
133 (string-to-number (match-string 1 netfile))))
134 (substring netfile
135 (+ beg
136 (string-to-number (match-string 2 netfile)))
137 (+ beg 1
138 (string-to-number (match-string 3 netfile))))
139 (substring netfile
140 (+ beg
141 (string-to-number (match-string 4 netfile)))
142 (+ beg 1
143 (string-to-number (match-string 5 netfile)))))))))
144
121(ert-deftest dnd-tests-begin-text-drag () 145(ert-deftest dnd-tests-begin-text-drag ()
122 ;; ASCII Latin-1 UTF-8 146 ;; ASCII Latin-1 UTF-8
123 (let ((test-text "hello, everyone! sæl öllsömul! всем привет")) 147 (let ((test-text "hello, everyone! sæl öllsömul! всем привет"))
@@ -159,6 +183,41 @@ The temporary file is not created."
159 (progn 183 (progn
160 ;; Now test dragging a normal file. 184 ;; Now test dragging a normal file.
161 (should (eq (dnd-begin-file-drag normal-temp-file) 'copy)) 185 (should (eq (dnd-begin-file-drag normal-temp-file) 'copy))
186 ;; Test that the selection data is correct.
187 (let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
188 (username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
189 (file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
190 (host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME)))
191 (netfile-data (cdr (dnd-tests-verify-selection-data '_DT_NETFILE))))
192 ;; Check if the URI list is formatted correctly.
193 (let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
194 (decoded (dnd-get-local-file-name (car split-uri-list))))
195 (should (equal decoded normal-temp-file)))
196 ;; Test that the username reported is correct.
197 (should (equal username-data (user-real-login-name)))
198 ;; Test that the file name data is correct.
199 (let* ((split-file-names (split-string file-name-data "\0"))
200 (file-name (car split-file-names)))
201 ;; Make sure there are no extra leading or trailing NULL bytes.
202 (should (and split-file-names (null (cdr split-file-names))))
203 ;; Make sure the file name is encoded correctly;
204 (should-not (multibyte-string-p file-name))
205 ;; Make sure decoding the file name results in the
206 ;; originals.
207 (should (equal (decode-coding-string file-name
208 (or file-name-coding-system
209 default-file-name-coding-system))
210 normal-temp-file))
211 ;; Also make sure the hostname is correct.
212 (should (equal host-name-data (system-name))))
213 ;; Check that the netfile hostname, rpath and lpath are correct.
214 (let ((parsed (dnd-tests-parse-tt-netfile netfile-data))
215 (filename (encode-coding-string normal-temp-file
216 (or file-name-coding-system
217 default-file-name-coding-system))))
218 (should (equal (nth 0 parsed) (system-name)))
219 (should (equal (nth 1 parsed) filename))
220 (should (equal (nth 2 parsed) filename))))
162 ;; And the remote file. 221 ;; And the remote file.
163 (should (eq (dnd-begin-file-drag remote-temp-file) 'copy)) 222 (should (eq (dnd-begin-file-drag remote-temp-file) 'copy))
164 ;; Test that the remote file was added to the list of files 223 ;; Test that the remote file was added to the list of files
@@ -205,12 +264,43 @@ The temporary file is not created."
205 ;; Test that the remote file produced was added to the list 264 ;; Test that the remote file produced was added to the list
206 ;; of files to remove upon the next call. 265 ;; of files to remove upon the next call.
207 (should dnd-last-dragged-remote-file) 266 (should dnd-last-dragged-remote-file)
208 ;; Two remote files at the same time. 267 ;; Two local files at the same time.
209 (should (eq (dnd-begin-drag-files (list normal-temp-file 268 (should (eq (dnd-begin-drag-files (list normal-temp-file
210 normal-temp-file-1)) 269 normal-temp-file-1))
211 'copy)) 270 'copy))
212 ;; Test that the remote files were removed. 271 ;; Test that the remote files were removed.
213 (should-not dnd-last-dragged-remote-file) 272 (should-not dnd-last-dragged-remote-file)
273 ;; Test the selection data is correct.
274 (let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
275 (username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
276 (file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
277 (host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME))))
278 ;; Check if the URI list is formatted correctly.
279 (let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
280 (decoded (mapcar #'dnd-get-local-file-name split-uri-list)))
281 (should (equal (car decoded) normal-temp-file))
282 (should (equal (cadr decoded) normal-temp-file-1)))
283 ;; Test that the username reported is correct.
284 (should (equal username-data (user-real-login-name)))
285 ;; Test that the file name data is correct.
286 (let ((split-file-names (split-string file-name-data "\0")))
287 ;; Make sure there are no extra leading or trailing NULL bytes.
288 (should (equal (length split-file-names) 2))
289 ;; Make sure all file names are encoded correctly;
290 (dolist (name split-file-names)
291 (should-not (multibyte-string-p name)))
292 ;; Make sure decoding the file names result in the
293 ;; originals.
294 (should (equal (decode-coding-string (car split-file-names)
295 (or file-name-coding-system
296 default-file-name-coding-system))
297 normal-temp-file))
298 (should (equal (decode-coding-string (cadr split-file-names)
299 (or file-name-coding-system
300 default-file-name-coding-system))
301 normal-temp-file-1))
302 ;; Also make sure the hostname is correct.
303 (should (equal host-name-data (system-name)))))
214 ;; Multiple local files with some remote files that will 304 ;; Multiple local files with some remote files that will
215 ;; fail, and some that won't. 305 ;; fail, and some that won't.
216 (should (and (eq (dnd-begin-drag-files (list normal-temp-file 306 (should (and (eq (dnd-begin-drag-files (list normal-temp-file