Implement drag-and-drop of files on Haiku

* lisp/term/haiku-win.el (haiku-dnd-selection-converters): Add
new selection converter.
(haiku-dnd-convert-uri-list): New function.
(x-begin-drag): Allow selection converters to change message
field type.

* src/haikuselect.c (haiku_lisp_to_message): Perform more error
checking.
This commit is contained in:
Po Lu 2022-03-18 09:21:39 +00:00
parent ff89d27c07
commit 2b05a06786
2 changed files with 56 additions and 23 deletions

View file

@ -48,13 +48,18 @@
(defvar haiku-dnd-selection-value nil
"The local value of the special `XdndSelection' selection.")
(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string))
(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string)
(text/uri-list . haiku-dnd-convert-uri-list))
"Alist of X selection types to functions that act as selection converters.
The functions should accept a single argument VALUE, describing
the value of the drag-and-drop selection, and return a list of
two elements TYPE and DATA, where TYPE is a string containing the
MIME type of DATA, and DATA is a unibyte string, or nil if the
data could not be converted.")
data could not be converted.
DATA can optionally have a text property `type', which specifies
the type of DATA inside the system message (see the doc string of
`haiku-drag-message' for more details).")
(defun haiku-dnd-convert-string (value)
"Convert VALUE to a UTF-8 string and appropriate MIME type.
@ -64,6 +69,12 @@ VALUE as a unibyte string, or nil if VALUE was not a string."
(list "text/plain" (string-to-unibyte
(encode-coding-string value 'utf-8)))))
(defun haiku-dnd-convert-uri-list (value)
"Convert VALUE to a file system reference if it is a file name."
(when (and (stringp value)
(file-exists-p value))
(list "refs" (propertize (expand-file-name value) 'type 'ref))))
(declare-function x-open-connection "haikufns.c")
(declare-function x-handle-args "common-win")
(declare-function haiku-selection-data "haikuselect.c")
@ -199,9 +210,12 @@ take effect on menu items until the menu bar is updated again."
(let ((field (cdr (assoc (car selection-result) message))))
(unless (cadr field)
;; Add B_MIME_TYPE to the message if the type was not
;; previously defined.
(push 1296649541 (alist-get (car selection-result) message
nil nil #'equal))))
;; previously specified, or the type if it was.
(push (or (get-text-property 0 'type
(cadr selection-result))
1296649541)
(alist-get (car selection-result) message
nil nil #'equal))))
(push (cadr selection-result)
(cdr (alist-get (car selection-result) message
nil nil #'equal))))))))

View file

@ -351,6 +351,7 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
int8 char_data;
bool bool_data;
intmax_t t4;
int rc;
CHECK_LIST (obj);
for (tem = obj; CONSP (tem); tem = XCDR (tem))
@ -390,10 +391,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
short_data = XFIXNUM (data);
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, &short_data,
sizeof short_data);
rc = be_add_message_data (message, SSDATA (name),
type_code, &short_data,
sizeof short_data);
unblock_input ();
if (rc)
signal_error ("Failed to add short", data);
break;
case 'LONG':
@ -417,10 +421,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
}
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, &long_data,
sizeof long_data);
rc = be_add_message_data (message, SSDATA (name),
type_code, &long_data,
sizeof long_data);
unblock_input ();
if (rc)
signal_error ("Failed to add long", data);
break;
case 'LLNG':
@ -443,10 +450,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
}
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, &llong_data,
sizeof llong_data);
rc = be_add_message_data (message, SSDATA (name),
type_code, &llong_data,
sizeof llong_data);
unblock_input ();
if (rc)
signal_error ("Failed to add llong", data);
break;
case 'CHAR':
@ -456,30 +466,39 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
char_data = XFIXNUM (data);
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, &char_data,
sizeof char_data);
rc = be_add_message_data (message, SSDATA (name),
type_code, &char_data,
sizeof char_data);
unblock_input ();
if (rc)
signal_error ("Failed to add char", data);
break;
case 'BOOL':
bool_data = !NILP (data);
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, &bool_data,
sizeof bool_data);
rc = be_add_message_data (message, SSDATA (name),
type_code, &bool_data,
sizeof bool_data);
unblock_input ();
if (rc)
signal_error ("Failed to add bool", data);
break;
default:
CHECK_STRING (data);
block_input ();
be_add_message_data (message, SSDATA (name),
type_code, SDATA (data),
SBYTES (data));
rc = be_add_message_data (message, SSDATA (name),
type_code, SDATA (data),
SBYTES (data));
unblock_input ();
if (rc)
signal_error ("Failed to add", data);
}
}
CHECK_LIST_END (t2, t1);