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.

2 files changed, 56 insertions, 23 deletions

diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index 83f70edd2c3..632177f843e 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -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))))))))
diff --git a/src/haikuselect.c b/src/haikuselect.c
index 807cbc24939..8192a1ad5b9 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -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);