mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 12:21:25 -08:00
Improve drag-and-drop tests
* lisp/dnd.el (dnd-begin-file-drag, dnd-begin-drag-files): Fix type of `x-xdnd-username'. * lisp/select.el (selection-converter-alist): Fix declaration of _DT_NETFILE converter. * test/lisp/dnd-tests.el (dnd-tests-verify-selection-data): Handle "compound" selection converters. (dnd-tests-parse-tt-netfile): New function. (dnd-tests-begin-file-drag, dnd-tests-begin-drag-files): Verify validity of file selection data.
This commit is contained in:
Po Lu
parent
f3162b8240
commit
3237d1d6b6
3 changed files with 96 additions and 6 deletions
|
|
@ -423,7 +423,7 @@ currently being held down. It should only be called upon a
|
|||
(x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
|
||||
;; modern programs that expect filenames to
|
||||
;; be supplied as URIs.
|
||||
"text/uri-list" "text/x-dnd-username"
|
||||
"text/uri-list" "text/x-xdnd-username"
|
||||
;; Traditional X selection targets used by
|
||||
;; programs supporting the Motif
|
||||
;; drag-and-drop protocols. Also used by NS
|
||||
|
|
@ -493,7 +493,7 @@ FILES will be dragged."
|
|||
(x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
|
||||
;; modern programs that expect filenames to
|
||||
;; be supplied as URIs.
|
||||
"text/uri-list" "text/x-dnd-username"
|
||||
"text/uri-list" "text/x-xdnd-username"
|
||||
;; Traditional X selection targets used by
|
||||
;; programs supporting the Motif
|
||||
;; drag-and-drop protocols. Also used by NS
|
||||
|
|
|
|||
|
|
@ -819,8 +819,8 @@ VALUE should be SELECTION's local value."
|
|||
(_EMACS_INTERNAL . xselect-convert-to-identity)
|
||||
(XmTRANSFER_SUCCESS . xselect-convert-xm-special)
|
||||
(XmTRANSFER_FAILURE . xselect-convert-xm-special)
|
||||
(_DT_NETFILE . (xselect-convert-to-dt-netfile
|
||||
. xselect-dt-netfile-available-p))))
|
||||
(_DT_NETFILE . (xselect-dt-netfile-available-p
|
||||
. xselect-convert-to-dt-netfile))))
|
||||
|
||||
(provide 'select)
|
||||
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@
|
|||
(or (get-text-property 0 type basic-value)
|
||||
basic-value)
|
||||
basic-value))
|
||||
(converter-list (assq type selection-converter-alist))
|
||||
(converter-list (cdr (assq type selection-converter-alist)))
|
||||
(converter (if (consp converter-list)
|
||||
(cdr converter-list)
|
||||
converter-list)))
|
||||
|
|
@ -118,6 +118,30 @@ The temporary file is not created."
|
|||
(expand-file-name (make-temp-name "dnd-test-remote")
|
||||
dnd-tests-temporary-file-directory))
|
||||
|
||||
(defun dnd-tests-parse-tt-netfile (netfile)
|
||||
"Parse NETFILE and return its components.
|
||||
NETFILE should be a canonicalized ToolTalk file name.
|
||||
Return a list of its hostname, real path, and local path."
|
||||
(save-match-data
|
||||
(when (string-match (concat "HOST=0-\\([[:digit:]]+\\),RPATH=\\([[:digit:]]+\\)-"
|
||||
"\\([[:digit:]]+\\),LPATH=\\([[:digit:]]+\\)-"
|
||||
"\\([[:digit:]]+\\)\\(:\\)")
|
||||
netfile)
|
||||
(let ((beg (match-end 6)))
|
||||
(list (substring netfile beg
|
||||
(+ beg 1
|
||||
(string-to-number (match-string 1 netfile))))
|
||||
(substring netfile
|
||||
(+ beg
|
||||
(string-to-number (match-string 2 netfile)))
|
||||
(+ beg 1
|
||||
(string-to-number (match-string 3 netfile))))
|
||||
(substring netfile
|
||||
(+ beg
|
||||
(string-to-number (match-string 4 netfile)))
|
||||
(+ beg 1
|
||||
(string-to-number (match-string 5 netfile)))))))))
|
||||
|
||||
(ert-deftest dnd-tests-begin-text-drag ()
|
||||
;; ASCII Latin-1 UTF-8
|
||||
(let ((test-text "hello, everyone! sæl öllsömul! всем привет"))
|
||||
|
|
@ -159,6 +183,41 @@ The temporary file is not created."
|
|||
(progn
|
||||
;; Now test dragging a normal file.
|
||||
(should (eq (dnd-begin-file-drag normal-temp-file) 'copy))
|
||||
;; Test that the selection data is correct.
|
||||
(let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
|
||||
(username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
|
||||
(file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
|
||||
(host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME)))
|
||||
(netfile-data (cdr (dnd-tests-verify-selection-data '_DT_NETFILE))))
|
||||
;; Check if the URI list is formatted correctly.
|
||||
(let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
|
||||
(decoded (dnd-get-local-file-name (car split-uri-list))))
|
||||
(should (equal decoded normal-temp-file)))
|
||||
;; Test that the username reported is correct.
|
||||
(should (equal username-data (user-real-login-name)))
|
||||
;; Test that the file name data is correct.
|
||||
(let* ((split-file-names (split-string file-name-data "\0"))
|
||||
(file-name (car split-file-names)))
|
||||
;; Make sure there are no extra leading or trailing NULL bytes.
|
||||
(should (and split-file-names (null (cdr split-file-names))))
|
||||
;; Make sure the file name is encoded correctly;
|
||||
(should-not (multibyte-string-p file-name))
|
||||
;; Make sure decoding the file name results in the
|
||||
;; originals.
|
||||
(should (equal (decode-coding-string file-name
|
||||
(or file-name-coding-system
|
||||
default-file-name-coding-system))
|
||||
normal-temp-file))
|
||||
;; Also make sure the hostname is correct.
|
||||
(should (equal host-name-data (system-name))))
|
||||
;; Check that the netfile hostname, rpath and lpath are correct.
|
||||
(let ((parsed (dnd-tests-parse-tt-netfile netfile-data))
|
||||
(filename (encode-coding-string normal-temp-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))))
|
||||
;; And the remote file.
|
||||
(should (eq (dnd-begin-file-drag remote-temp-file) 'copy))
|
||||
;; Test that the remote file was added to the list of files
|
||||
|
|
@ -205,12 +264,43 @@ The temporary file is not created."
|
|||
;; Test that the remote file produced was added to the list
|
||||
;; of files to remove upon the next call.
|
||||
(should dnd-last-dragged-remote-file)
|
||||
;; Two remote files at the same time.
|
||||
;; Two local files at the same time.
|
||||
(should (eq (dnd-begin-drag-files (list normal-temp-file
|
||||
normal-temp-file-1))
|
||||
'copy))
|
||||
;; Test that the remote files were removed.
|
||||
(should-not dnd-last-dragged-remote-file)
|
||||
;; Test the selection data is correct.
|
||||
(let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
|
||||
(username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
|
||||
(file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
|
||||
(host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME))))
|
||||
;; Check if the URI list is formatted correctly.
|
||||
(let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
|
||||
(decoded (mapcar #'dnd-get-local-file-name split-uri-list)))
|
||||
(should (equal (car decoded) normal-temp-file))
|
||||
(should (equal (cadr decoded) normal-temp-file-1)))
|
||||
;; Test that the username reported is correct.
|
||||
(should (equal username-data (user-real-login-name)))
|
||||
;; Test that the file name data is correct.
|
||||
(let ((split-file-names (split-string file-name-data "\0")))
|
||||
;; Make sure there are no extra leading or trailing NULL bytes.
|
||||
(should (equal (length split-file-names) 2))
|
||||
;; Make sure all file names are encoded correctly;
|
||||
(dolist (name split-file-names)
|
||||
(should-not (multibyte-string-p name)))
|
||||
;; Make sure decoding the file names result in the
|
||||
;; originals.
|
||||
(should (equal (decode-coding-string (car split-file-names)
|
||||
(or file-name-coding-system
|
||||
default-file-name-coding-system))
|
||||
normal-temp-file))
|
||||
(should (equal (decode-coding-string (cadr split-file-names)
|
||||
(or file-name-coding-system
|
||||
default-file-name-coding-system))
|
||||
normal-temp-file-1))
|
||||
;; Also make sure the hostname is correct.
|
||||
(should (equal host-name-data (system-name)))))
|
||||
;; Multiple local files with some remote files that will
|
||||
;; fail, and some that won't.
|
||||
(should (and (eq (dnd-begin-drag-files (list normal-temp-file
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue