[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 25887d634f: Improve compliance with the XDS and XDND protocols
From: |
Po Lu |
Subject: |
master 25887d634f: Improve compliance with the XDS and XDND protocols |
Date: |
Thu, 30 Jun 2022 02:15:59 -0400 (EDT) |
branch: master
commit 25887d634f624369559ab072beea0d1e2d6886cd
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Improve compliance with the XDS and XDND protocols
* lisp/select.el (xselect-convert-to-text-uri-list): Return a
type of `text/uri-list' instead of STRING or C_STRING.
* lisp/x-dnd.el (x-dnd-xds-performed): New defvar.
(x-dnd-handle-direct-save): Set it to t and handle URIs with
hostnames correctly. Also return errors correctly.
(x-dnd-handle-octet-stream): New function.
(x-dnd-do-direct-save): Handle application/octet-stream, check
results.
---
lisp/select.el | 22 ++++++++++++----------
lisp/x-dnd.el | 58 ++++++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 58 insertions(+), 22 deletions(-)
diff --git a/lisp/select.el b/lisp/select.el
index 127a6a5c61..8ffe16e7b3 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -721,16 +721,18 @@ This function returns the string \"emacs\"."
(user-real-login-name))
(defun xselect-convert-to-text-uri-list (_selection _type value)
- (if (stringp value)
- (xselect--encode-string 'TEXT
- (concat (url-encode-url value) "\n"))
- (when (vectorp value)
- (with-temp-buffer
- (cl-loop for tem across value
- do (progn
- (insert (url-encode-url tem))
- (insert "\n")))
- (xselect--encode-string 'TEXT (buffer-string))))))
+ (let ((string
+ (if (stringp value)
+ (xselect--encode-string 'TEXT
+ (concat (url-encode-url value) "\n"))
+ (when (vectorp value)
+ (with-temp-buffer
+ (cl-loop for tem across value
+ do (progn
+ (insert (url-encode-url tem))
+ (insert "\n")))
+ (xselect--encode-string 'TEXT (buffer-string)))))))
+ (cons 'text/uri-list (cdr string))))
(defun xselect-convert-to-xm-file (selection _type value)
(when (and (stringp value)
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index d92009f85c..762d42175e 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1140,23 +1140,43 @@ ACTION is the action given to `x-begin-drag'."
(defvar x-dnd-xds-source-frame nil
"The frame from which a direct save is currently being performed.")
+(defvar x-dnd-xds-performed nil
+ "Whether or not the drop target made a request for `XdndDirectSave0'.")
+
(defun x-dnd-handle-direct-save (_selection _type _value)
"Handle a selection request for `XdndDirectSave'."
+ (setq x-dnd-xds-performed t)
(let* ((uri (x-window-property "XdndDirectSave0"
x-dnd-xds-source-frame
"AnyPropertyType" nil t))
- (local-name (dnd-get-local-file-name uri nil)))
+ (local-file-uri (if (and (string-match "^file://\\([^/]*\\)" uri)
+ (not (equal (match-string 1 uri) "")))
+ (dnd-get-local-file-uri uri)
+ uri))
+ (local-name (dnd-get-local-file-name local-file-uri)))
(if (not local-name)
'(STRING . "F")
(condition-case nil
(progn
- (rename-file x-dnd-xds-current-file
- local-name t)
+ (copy-file x-dnd-xds-current-file
+ local-name t)
(when (equal x-dnd-xds-current-file
dnd-last-dragged-remote-file)
(dnd-remove-last-dragged-remote-file)))
(:success '(STRING . "S"))
- (error '(STRING . "F"))))))
+ (error '(STRING . "E"))))))
+
+(defun x-dnd-handle-octet-stream (_selection _type _value)
+ "Handle a selecton request for `application/octet-stream'.
+Return the contents of the XDS file."
+ (cons 'application/octet-stream
+ (ignore-errors
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (setq buffer-file-coding-system 'binary)
+ (insert-file-contents-literally x-dnd-xds-current-file)
+ (buffer-substring-no-properties (point-min)
+ (point-max))))))
(defun x-dnd-do-direct-save (file name frame allow-same-frame)
"Perform a direct save operation on FILE, from FRAME.
@@ -1166,16 +1186,19 @@ FRAME is the frame from which the drop will originate.
ALLOW-SAME-FRAME means whether or not dropping will be allowed
on FRAME.
-Return the action taken by the drop target, or nil."
+Return the action taken by the drop target, or nil if no action
+was taken, or the direct save failed."
(dnd-remove-last-dragged-remote-file)
(let ((file-name file)
(original-file-name file)
(selection-converter-alist
- (cons (cons 'XdndDirectSave0
- #'x-dnd-handle-direct-save)
- selection-converter-alist))
+ (append '((XdndDirectSave0 . x-dnd-handle-direct-save)
+ (application/octet-stream . x-dnd-handle-octet-stream))
+ selection-converter-alist))
(x-dnd-xds-current-file nil)
(x-dnd-xds-source-frame frame)
+ (x-dnd-xds-performed nil)
+ (prop-deleted nil)
encoded-name)
(unwind-protect
(progn
@@ -1195,12 +1218,23 @@ Return the action taken by the drop target, or nil."
;; FIXME: this does not work with GTK file managers, since
;; they always reach for `text/uri-list' first, contrary to
;; the spec.
- (x-begin-drag '("XdndDirectSave0" "text/uri-list")
- 'XdndActionDirectSave
- frame nil allow-same-frame))
+ (let ((action (x-begin-drag '("XdndDirectSave0" "text/uri-list")
+ 'XdndActionDirectSave
+ frame nil allow-same-frame)))
+ (if (not x-dnd-xds-performed)
+ action
+ (let ((property (x-window-property "XdndDirectSave0" frame
+ "AnyPropertyType" nil t)))
+ (setq prop-deleted t)
+ ;; "System-G" deletes the property upon success.
+ (and (or (null property)
+ (and (stringp property)
+ (not (equal property ""))))
+ action)))))
;; TODO: check for failure and implement selection-based file
;; transfer.
- (x-delete-window-property "XdndDirectSave0" frame)
+ (unless prop-deleted
+ (x-delete-window-property "XdndDirectSave0" frame))
;; Delete any remote copy that was made.
(when (not (equal file-name original-file-name))
(delete-file file-name)))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 25887d634f: Improve compliance with the XDS and XDND protocols,
Po Lu <=