diff options
| -rw-r--r-- | lisp/dnd.el | 4 | ||||
| -rw-r--r-- | lisp/select.el | 4 | ||||
| -rw-r--r-- | test/lisp/dnd-tests.el | 94 |
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. | ||
| 123 | NETFILE should be a canonicalized ToolTalk file name. | ||
| 124 | Return 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 |