master 7fa5d6c87d: Improvements to Haiku selection handling

[Po Lu]

branch: master
commit 7fa5d6c87d43926008c15a7f7ddc924bbf8d2e76
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    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.
---
 lisp/term/haiku-win.el |   7 ++-
 src/haiku_select.cc    |  48 +++++++++++++++++++
 src/haiku_support.cc   |   2 +-
 src/haikuselect.c      | 127 ++++++++++++++++++++++++++++++++-----------------
 src/haikuselect.h      |   6 +++
 5 files changed, 145 insertions(+), 45 deletions(-)

diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index 632177f843..8ec959a758 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -79,7 +79,6 @@ VALUE as a unibyte string, or nil if VALUE was not a string."
 (declare-function x-handle-args "common-win")
 (declare-function haiku-selection-data "haikuselect.c")
 (declare-function haiku-selection-put "haikuselect.c")
-(declare-function haiku-selection-targets "haikuselect.c")
 (declare-function haiku-selection-owner-p "haikuselect.c")
 (declare-function haiku-put-resource "haikufns.c")
 (declare-function haiku-drag-message "haikuselect.c")
@@ -123,6 +122,12 @@ If TYPE is nil, return \"text/plain\"."
    ((symbolp type) (symbol-name type))
    (t "text/plain")))
 
+(defun haiku-selection-targets (clipboard)
+  "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."
+  (mapcar #'car (haiku-selection-data clipboard nil)))
+
 (cl-defmethod gui-backend-get-selection (type data-type
                                               &context (window-system haiku))
   (if (eq data-type 'TARGETS)
diff --git a/src/haiku_select.cc b/src/haiku_select.cc
index bccc79da01..373ad321c4 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)
 {
@@ -363,6 +398,19 @@ be_add_refs_data (void *message, const char *name,
   return msg->AddRef (name, &ref) != B_OK;
 }
 
+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 3ded7a80f4..24009c0ef6 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 d59b4512a4..5540f467c0 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 4278994918..01e4ca327d 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);