Improvements to Haiku selection handling

* lisp/term/haiku-win.el (haiku-selection-targets): Implement in Lisp.
* src/haiku_select.cc (be_get_message_type):
(be_set_message_type):
(be_get_message_message):
(be_add_message_message): New functions.

* src/haiku_support.cc (MessageReceived): Fix typo.
* src/haikuselect.c (haiku_selection_data_1)
(Fhaiku_selection_targets): Delete functions.
(haiku_message_to_lisp, lisp_to_type_code)
(haiku_lisp_to_message): Correctly decode and encode nested
messages, and fix encoding specially decoded types via numeric
names.  Also store and decode message types inside Lisp
messages.
(Fhaiku_drag_message): Update doc string.
(syms_of_haikuselect): Update subrs.
* src/haikuselect.h: Update prototypes.

4 files changed, 139 insertions, 44 deletions

diff --git a/src/haiku_select.cc b/src/haiku_select.cc
index bccc79da018..373ad321c4b 100644
--- a/src/haiku_select.cc
+++ b/src/haiku_select.cc
@@ -330,6 +330,41 @@ be_get_message_data (void *message, const char *name,
                         index, buf_return, size_return) != B_OK;
 }
 
+uint32
+be_get_message_type (void *message)
+{
+  BMessage *msg = (BMessage *) message;
+
+  return msg->what;
+}
+
+void
+be_set_message_type (void *message, uint32 what)
+{
+  BMessage *msg = (BMessage *) message;
+
+  msg->what = what;
+}
+
+void *
+be_get_message_message (void *message, const char *name,
+                        int32 index)
+{
+  BMessage *msg = (BMessage *) message;
+  BMessage *out = new (std::nothrow) BMessage;
+
+  if (!out)
+    return NULL;
+
+  if (msg->FindMessage (name, index, out) != B_OK)
+    {
+      delete out;
+      return NULL;
+    }
+
+  return out;
+}
+
 void *
 be_create_simple_message (void)
 {
@@ -364,6 +399,19 @@ be_add_refs_data (void *message, const char *name,
 }
 
 int
+be_add_message_message (void *message, const char *name,
+                        void *data)
+{
+  BMessage *msg = (BMessage *) message;
+  BMessage *data_message = (BMessage *) data;
+
+  if (msg->AddMessage (name, data_message) != B_OK)
+    return 1;
+
+  return 0;
+}
+
+int
 be_lock_clipboard_message (enum haiku_clipboard clipboard,
                            void **message_return)
 {
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 3ded7a80f4d..24009c0ef6a 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -726,7 +726,7 @@ public:
             this->ConvertFromScreen (&whereto);
 
             rq.window = this;
-            rq.message = DetachCurrentMessage ();;
+            rq.message = DetachCurrentMessage ();
             rq.x = whereto.x;
             rq.y = whereto.y;
 
diff --git a/src/haikuselect.c b/src/haikuselect.c
index d59b4512a46..5540f467c0d 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -27,46 +27,6 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <stdlib.h>
 
-static Lisp_Object
-haiku_selection_data_1 (Lisp_Object clipboard)
-{
-  Lisp_Object result = Qnil;
-  char *targets[256];
-
-  block_input ();
-  if (EQ (clipboard, QPRIMARY))
-    BClipboard_primary_targets ((char **) &targets, 256);
-  else if (EQ (clipboard, QSECONDARY))
-    BClipboard_secondary_targets ((char **) &targets, 256);
-  else if (EQ (clipboard, QCLIPBOARD))
-    BClipboard_system_targets ((char **) &targets, 256);
-  else
-    {
-      unblock_input ();
-      signal_error ("Bad clipboard", clipboard);
-    }
-
-  for (int i = 0; targets[i]; ++i)
-    {
-      result = Fcons (build_unibyte_string (targets[i]),
-                      result);
-      free (targets[i]);
-    }
-  unblock_input ();
-
-  return result;
-}
-
-DEFUN ("haiku-selection-targets", Fhaiku_selection_targets,
-       Shaiku_selection_targets, 1, 1, 0,
-       doc: /* Find the types of data available from CLIPBOARD.
-CLIPBOARD should be the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'.
-Return the available types as a list of strings.  */)
-  (Lisp_Object clipboard)
-{
-  return haiku_selection_data_1 (clipboard);
-}
-
 DEFUN ("haiku-selection-data", Fhaiku_selection_data, Shaiku_selection_data,
        2, 2, 0,
        doc: /* Retrieve content typed as NAME from the clipboard
@@ -225,7 +185,11 @@ same as `SECONDARY'.  */)
    DATA is a 16-bit signed integer.  If TYPE is `long', then DATA is a
    32-bit signed integer.  If TYPE is `llong', then DATA is a 64-bit
    signed integer. If TYPE is `byte' or `char', then DATA is an 8-bit
-   signed integer.  If TYPE is `bool', then DATA is a boolean.  */
+   signed integer.  If TYPE is `bool', then DATA is a boolean.
+
+   If the field name is not a string but the symbol `type', then it
+   associates to a 32-bit unsigned integer describing the type of the
+   system message.  */
 Lisp_Object
 haiku_message_to_lisp (void *message)
 {
@@ -236,6 +200,7 @@ haiku_message_to_lisp (void *message)
   ssize_t buf_size;
   int32 i, j, count, type_code;
   int rc;
+  void *msg;
 
   for (i = 0; !be_enum_message (message, &type_code, i,
                                 &count, &name); ++i)
@@ -252,6 +217,15 @@ haiku_message_to_lisp (void *message)
 
           switch (type_code)
             {
+            case 'MSGG':
+              msg = be_get_message_message (message, name, j);
+              if (!msg)
+                memory_full (SIZE_MAX);
+              t1 = haiku_message_to_lisp (msg);
+              BMessage_delete (msg);
+
+              break;
+
             case 'BOOL':
               t1 = (*(bool *) buf) ? Qt : Qnil;
               break;
@@ -335,6 +309,10 @@ haiku_message_to_lisp (void *message)
           t2 = Qbool;
           break;
 
+        case 'MSGG':
+          t2 = Qmessage;
+          break;
+
         default:
           t2 = make_int (type_code);
         }
@@ -343,7 +321,8 @@ haiku_message_to_lisp (void *message)
       list = Fcons (Fcons (build_string_from_utf8 (name), tem), list);
     }
 
-  return list;
+  tem = Fcons (Qtype, make_uint (be_get_message_type (message)));
+  return Fcons (tem, list);
 }
 
 static int32
@@ -371,6 +350,8 @@ lisp_to_type_code (Lisp_Object obj)
     return 'CHAR';
   else if (EQ (obj, Qbool))
     return 'BOOL';
+  else if (EQ (obj, Qmessage))
+    return 'MSGG';
   else
     return -1;
 }
@@ -384,8 +365,11 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
   int64 llong_data;
   int8 char_data;
   bool bool_data;
+  void *msg_data;
   intmax_t t4;
+  uintmax_t t5;
   int rc;
+  specpdl_ref ref;
 
   CHECK_LIST (obj);
   for (tem = obj; CONSP (tem); tem = XCDR (tem))
@@ -395,6 +379,35 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
       CHECK_CONS (t1);
 
       name = XCAR (t1);
+
+      if (EQ (name, Qtype))
+        {
+          t2 = XCDR (t1);
+
+          if (BIGNUMP (t2))
+            {
+              t5 = bignum_to_uintmax (t2);
+
+              if (!t5 || t5 > TYPE_MAXIMUM (uint32))
+                signal_error ("Value too large", t2);
+
+              block_input ();
+              be_set_message_type (message, t5);
+              unblock_input ();
+            }
+          else
+            {
+              if (!TYPE_RANGED_FIXNUMP (uint32, t2))
+                signal_error ("Invalid data type", t2);
+
+              block_input ();
+              be_set_message_type (message, XFIXNAT (t2));
+              unblock_input ();
+            }
+
+          continue;
+        }
+
       CHECK_STRING (name);
 
       t1 = XCDR (t1);
@@ -412,8 +425,30 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
           maybe_quit ();
           data = XCAR (t2);
 
+          if (FIXNUMP (type_sym) || BIGNUMP (type_sym))
+            goto decode_normally;
+
           switch (type_code)
             {
+            case 'MSGG':
+              ref = SPECPDL_INDEX ();
+
+              block_input ();
+              msg_data = be_create_simple_message ();
+              unblock_input ();
+
+              record_unwind_protect_ptr (BMessage_delete, msg_data);
+              haiku_lisp_to_message (data, msg_data);
+
+              block_input ();
+              rc = be_add_message_message (message, SSDATA (name), msg_data);
+              unblock_input ();
+
+              if (rc)
+                signal_error ("Invalid message", msg_data);
+              unbind_to (ref, Qnil);
+              break;
+
             case 'RREF':
               CHECK_STRING (data);
 
@@ -525,6 +560,7 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
               break;
 
             default:
+            decode_normally:
               CHECK_STRING (data);
 
               block_input ();
@@ -565,6 +601,10 @@ signed integer.  If TYPE is `llong', then DATA is a 64-bit signed
 integer. If TYPE is `byte' or `char', then DATA is an 8-bit signed
 integer.  If TYPE is `bool', then DATA is a boolean.
 
+If the field name is not a string but the symbol `type', then it
+associates to a 32-bit unsigned integer describing the type of the
+system message.
+
 FRAME is a window system frame that must be visible, from which the
 drag will originate.  */)
   (Lisp_Object frame, Lisp_Object message)
@@ -605,6 +645,7 @@ syms_of_haikuselect (void)
   DEFSYM (QUTF8_STRING, "UTF8_STRING");
   DEFSYM (Qforeign_selection, "foreign-selection");
   DEFSYM (QTARGETS, "TARGETS");
+  DEFSYM (Qmessage, "message");
   DEFSYM (Qstring, "string");
   DEFSYM (Qref, "ref");
   DEFSYM (Qshort, "short");
@@ -613,10 +654,10 @@ syms_of_haikuselect (void)
   DEFSYM (Qbyte, "byte");
   DEFSYM (Qchar, "char");
   DEFSYM (Qbool, "bool");
+  DEFSYM (Qtype, "type");
 
   defsubr (&Shaiku_selection_data);
   defsubr (&Shaiku_selection_put);
-  defsubr (&Shaiku_selection_targets);
   defsubr (&Shaiku_selection_owner_p);
   defsubr (&Shaiku_drag_message);
 }
diff --git a/src/haikuselect.h b/src/haikuselect.h
index 42789949182..01e4ca327da 100644
--- a/src/haikuselect.h
+++ b/src/haikuselect.h
@@ -94,12 +94,18 @@ extern "C"
                                   ssize_t *size_return);
   extern int be_get_refs_data (void *message, const char *name,
                                int32 index, char **path_buffer);
+  extern uint32 be_get_message_type (void *message);
+  extern void be_set_message_type (void *message, uint32 what);
+  extern void *be_get_message_message (void *message, const char *name,
+                                       int32 index);
   extern void *be_create_simple_message (void);
   extern int be_add_message_data (void *message, const char *name,
                                   int32 type_code, const void *buf,
                                   ssize_t buf_size);
   extern int be_add_refs_data (void *message, const char *name,
                                const char *filename);
+  extern int be_add_message_message (void *message, const char *name,
+                                     void *data);
   extern int be_lock_clipboard_message (enum haiku_clipboard clipboard,
                                         void **message_return);
   extern void be_unlock_clipboard (enum haiku_clipboard clipboard);