From: Po Lu Date: Thu, 30 Jun 2022 06:13:30 +0000 (+0800) Subject: Improve compliance with the XDS and XDND protocols X-Git-Tag: emacs-29.0.90~1447^2~1367 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=25887d634f624369559ab072beea0d1e2d6886cd;p=emacs.git 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. --- diff --git a/lisp/select.el b/lisp/select.el index 127a6a5c61f..8ffe16e7b33 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 d92009f85cf..762d42175e7 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)))))