From 7fa37d7a1439bf8cd76b336ea95d3a1982b3ae03 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 29 Jun 2022 06:05:25 +0000 Subject: [PATCH] Handle be:actions field in Haiku DND messages * lisp/term/haiku-win.el (haiku-get-numeric-enum): New function. (haiku-numeric-enum): New macro. (haiku-select-encode-xstring, haiku-select-encode-utf-8-string): Replace hard-coded numeric enumerators. (haiku-parse-drag-actions): New function. (haiku-drag-and-drop): Use action returned by that function. (x-begin-drag): Replace hard-coded enumerator. --- lisp/term/haiku-win.el | 102 ++++++++++++++++++++++++++++------------- 1 file changed, 71 insertions(+), 31 deletions(-) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 024459e6475..f73c8b71252 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -174,6 +174,30 @@ VALUE as a unibyte string, or nil if VALUE was not a string." (insert "\n"))) (buffer-string)))))) +(defun haiku-get-numeric-enum (name) + "Return the numeric value of the system enumerator NAME." + (or (get name 'haiku-numeric-enum) + (let ((value 0) + (offset 0) + (string (symbol-name name))) + (cl-loop for octet across string + do (progn + (when (or (< octet 0) + (> octet 255)) + (error "Out of range octet: %d" octet)) + (setq value + (logior value + (lsh octet + (- (* (1- (length string)) 8) + offset)))) + (setq offset (+ offset 8)))) + (prog1 value + (put name 'haiku-enumerator-id value))))) + +(defmacro haiku-numeric-enum (name) + "Expand to the numeric value NAME as a system identifier." + (haiku-get-numeric-enum name)) + (declare-function x-open-connection "haikufns.c") (declare-function x-handle-args "common-win") (declare-function haiku-selection-data "haikuselect.c") @@ -237,7 +261,7 @@ under the type `text/plain;charset=iso-8859-1'." (buffer-substring (nth 0 bounds) (nth 1 bounds))))))) (when (and (stringp value) (not (string-empty-p value))) - (list "text/plain;charset=iso-8859-1" 1296649541 + (list "text/plain;charset=iso-8859-1" (haiku-numeric-enum MIME) (encode-coding-string value 'iso-latin-1)))) (defun haiku-select-encode-utf-8-string (_selection value) @@ -251,7 +275,7 @@ VALUE will be encoded as UTF-8 and stored under the type (buffer-substring (nth 0 bounds) (nth 1 bounds))))))) (when (and (stringp value) (not (string-empty-p value))) - (list "text/plain" 1296649541 + (list "text/plain" (haiku-numeric-enum MIME) (encode-coding-string value 'utf-8-unix)))) (defun haiku-select-encode-file-name (_selection value) @@ -304,6 +328,21 @@ or a pair of markers) and turns it into a file system reference." (file-name-nondirectory default-filename))) (error "x-file-dialog on a tty frame"))) +(defun haiku-parse-drag-actions (message) + "Given the drag-and-drop message MESSAGE, retrieve the desired action." + (let ((actions (cddr (assoc "be:actions" message))) + (sorted nil)) + (dolist (action (list (haiku-numeric-enum DDCP) + (haiku-numeric-enum DDMV) + (haiku-numeric-enum DDLN))) + (when (member action actions) + (push sorted action))) + (cond + ((eql (car sorted) (haiku-numeric-enum DDCP)) 'copy) + ((eql (car sorted) (haiku-numeric-enum DDMV)) 'move) + ((eql (car sorted) (haiku-numeric-enum DDLN)) 'link) + (t 'private)))) + (defun haiku-drag-and-drop (event) "Handle specified drag-n-drop EVENT." (interactive "e") @@ -311,34 +350,35 @@ or a pair of markers) and turns it into a file system reference." (window (posn-window (event-start event)))) (if (eq string 'lambda) ; This means the mouse moved. (dnd-handle-movement (event-start event)) - (cond - ;; Don't allow dropping on something other than the text area. - ;; It does nothing and doesn't work with text anyway. - ((posn-area (event-start event))) - ((assoc "refs" string) - (with-selected-window window - (dolist (filename (cddr (assoc "refs" string))) - (dnd-handle-one-url window 'private - (concat "file:" filename))))) - ((assoc "text/uri-list" string) - (dolist (text (cddr (assoc "text/uri-list" string))) - (let ((uri-list (split-string text "[\0\r\n]" t))) - (dolist (bf uri-list) - (dnd-handle-one-url window 'private bf))))) - ((assoc "text/plain" string) - (with-selected-window window - (dolist (text (cddr (assoc "text/plain" string))) - (unless mouse-yank-at-point - (goto-char (posn-point (event-start event)))) - (dnd-insert-text window 'private - (if (multibyte-string-p text) - text - (decode-coding-string text 'undecided)))))) - ((not (eq (cdr (assq 'type string)) - 3003)) ; Type of the placeholder message Emacs uses - ; to cancel a drop on C-g. - (message "Don't know how to drop any of: %s" - (mapcar #'car string))))))) + (let ((action (haiku-parse-drag-actions string))) + (cond + ;; Don't allow dropping on something other than the text area. + ;; It does nothing and doesn't work with text anyway. + ((posn-area (event-start event))) + ((assoc "refs" string) + (with-selected-window window + (dolist (filename (cddr (assoc "refs" string))) + (dnd-handle-one-url window action + (concat "file:" filename))))) + ((assoc "text/uri-list" string) + (dolist (text (cddr (assoc "text/uri-list" string))) + (let ((uri-list (split-string text "[\0\r\n]" t))) + (dolist (bf uri-list) + (dnd-handle-one-url window action bf))))) + ((assoc "text/plain" string) + (with-selected-window window + (dolist (text (cddr (assoc "text/plain" string))) + (unless mouse-yank-at-point + (goto-char (posn-point (event-start event)))) + (dnd-insert-text window action + (if (multibyte-string-p text) + text + (decode-coding-string text 'undecided)))))) + ((not (eq (cdr (assq 'type string)) + 3003)) ; Type of the placeholder message Emacs uses + ; to cancel a drop on C-g. + (message "Don't know how to drop any of: %s" + (mapcar #'car string)))))))) (define-key special-event-map [drag-n-drop] 'haiku-drag-and-drop) @@ -393,7 +433,7 @@ take effect on menu items until the menu bar is updated again." ;; Add B_MIME_TYPE to the message if the type was not ;; previously specified, or the type if it was. (push (or (get-text-property 0 'type maybe-string) - 1296649541) + (haiku-numeric-enum MIME)) (alist-get (car selection-result) message nil nil #'equal)))) (if (not (consp (cadr selection-result))) -- 2.39.2