diff src/event-msw.c @ 903:4a27df428c73

[xemacs-hg @ 2002-07-06 05:48:14 by andyp] sync with 21.4
author andyp
date Sat, 06 Jul 2002 05:48:22 +0000
parents 79c6ff3eef26
children 3b122a8e1d51
line wrap: on
line diff
--- a/src/event-msw.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/event-msw.c	Sat Jul 06 05:48:22 2002 +0000
@@ -1733,6 +1733,191 @@
 #ifdef HAVE_DRAGNDROP
 extern int mswindows_dde_enable;
 
+EXFUN(Fread_from_string, 3);
+
+/* The following variables are used to maintain consistency of result and
+ * error reporting to the client.
+ * The basic protocol is to Execute a lisp form, and then Request one or
+ * more of the following items: Status (1 = OK, 0 = Error), Result, or Error.
+ * When the lisp form is queued, the dde_eval_pending flag is set to 1,
+ * to indicate that the items are not yet available. The dde_eval_pending
+ * flag is set to 0 when the evaluation is complete. Requests for the result
+ * items will block while the dde_eval_pending flag is 1, to avoid clients
+ * getting inconsistent results.
+ */
+static int dde_eval_pending;
+static Lisp_Object dde_eval_result;
+static Lisp_Object dde_eval_error;
+
+static Lisp_Object
+dde_error (Lisp_Object err, Lisp_Object obj)
+{
+  dde_eval_error = err;
+  return Qnil;
+}
+
+/* Read lisp forms from a string. Evaluate the forms as if they were
+ * wrapped in a progn form. Return the result of the form.
+ */
+static Lisp_Object
+dde_eval_string (Lisp_Object str)
+{
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object args[3];
+  Lisp_Object obj;
+
+  /* Heavy handed GCPROing, on the principle of it's better to be safe than
+   * sorry...
+   */
+  args[0] = Qnil;
+  args[1] = Qnil;
+  args[2] = Qnil;
+  GCPRO2 (args[0], str);
+  gcpro1.nvars = 3;
+
+  /* Wrap the user supplied string in string "(progn ...)".
+   * We can now just read-from-string a single form. If we
+   * get an error, or finish before the end of the string,
+   * we know the original string had syntax errors.
+   */
+  args[0] = build_string ("(progn ");
+  args[1] = str;
+  args[2] = build_string (")");
+  str = Fconcat (3, args);
+
+  obj = Fread_from_string (str, Qnil, Qnil);
+  UNGCPRO;
+
+  /* The following doesn't check that the length fits in an EMACS_INT.
+   * This won't be a problem in reality...?
+   *
+   * If the read didn't get to the end of the string, we have a syntax
+   * error in the string supplied by the user.
+   */
+  if (XINT (XCDR (obj)) != XSTRING_LENGTH (str))
+    return Qnil;
+
+  GCPRO1 (obj);
+  obj = Feval (XCAR (obj));
+
+  RETURN_UNGCPRO(obj);
+}
+
+/* Evaluate the supplied string as a sequence of Lisp forms, wrapped in
+ * a progn. Catch any evaluation errors. Set the evaluation status and
+ * result variables.
+ */
+static void
+dde_eval (Lisp_Object str)
+{
+  dde_eval_error = Qnil;
+  dde_eval_result = condition_case_1 (Qt, dde_eval_string, str,
+				      dde_error, Qnil);
+  dde_eval_pending = 0;
+
+  /* Re-enable callbacks in case the client is waiting on a request */
+  DdeEnableCallback (mswindows_dde_mlid, NULL, EC_ENABLEALL);
+
+  /* Post advise notifications on the result item */
+  DdePostAdvise (mswindows_dde_mlid, mswindows_dde_topic_eval,
+		 mswindows_dde_item_result);
+}
+
+/* A list of DDE advise tokens. Each token is an uninterned symbol,
+ * whose value is the DDE string handle for its name (stored as a float,
+ * as a Lisp int cannot hold a full C int).
+ * The token's 'dde-data property is used to store data for a dde-advise.
+ */
+Lisp_Object Vdde_advise_items;
+
+/* The symbol 'HSZ */
+Lisp_Object QHSZ;
+
+DEFUN("dde-alloc-advise-item", Fdde_alloc_advise_item, 0, 1, 0, /*
+Allocate an advise item, and return its token.
+*/
+      (name))
+{
+  Lisp_Object token;
+  Extbyte *str;
+  HSZ hsz;
+  struct gcpro gcpro1, gcpro2;
+
+  if (!NILP (name))
+    CHECK_STRING (name);
+  else
+    {
+      static int num = 0;
+      char buf[20];
+      sprintf (buf, "Tok%d", num);
+      ++num;
+      name = build_string (buf);
+    }
+
+  token = Qnil;
+  GCPRO2 (name, token);
+  token = Fmake_symbol (name);
+  TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, str,
+		      Qmswindows_tstr);
+  hsz = qxeDdeCreateStringHandle (mswindows_dde_mlid, str,
+				  XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
+
+  Fput(token, QHSZ, make_float ((int)hsz));
+  Vdde_advise_items = Fcons (token, Vdde_advise_items);
+
+  RETURN_UNGCPRO(token);
+}
+
+DEFUN("dde-free-advise-item", Fdde_free_advise_item, 1, 1, 0, /*
+Free the resources associated with advise item ITEM.
+
+Frees all resources allocated to allow clients to set up advise loops
+on ITEM. It is assumed that no active advise loops remain. However, no
+problems should arise if they do - it's just that we won't ever send any
+notifications again.
+
+If the user does not free an advise item, resources will be leaked.
+*/
+      (item))
+{
+  HSZ hsz;
+  Lisp_Object val;
+
+  CHECK_SYMBOL (item);
+  val = Fget (item, QHSZ, Qnil);
+  if (!FLOATP (val))
+    return Qnil;
+  hsz = (HSZ)(int)XFLOAT_DATA (val);
+  DdeFreeStringHandle (mswindows_dde_mlid, hsz);
+  Vdde_advise_items = delq_no_quit (item, Vdde_advise_items);
+  return Qnil;
+}
+
+DEFUN("dde-advise", Fdde_advise, 2, 2, 0, /*
+Post a DDE advise for ITEM with associated data DATA.
+
+Records the value DATA for sending back to clients waiting for
+notifications on DDE item ITEM in the system topic, and posts
+the advise transaction.
+
+ITEM must be an advise token allocated using dde-alloc-advise-item.
+*/
+      (item, data))
+{
+  HSZ hsz;
+  Lisp_Object val;
+
+  CHECK_SYMBOL (item);
+  val = Fget (item, QHSZ, Qnil);
+  if (!FLOATP (val))
+    return Qnil;
+  hsz = (HSZ)(int)XFLOAT_DATA (val);
+
+  Fset (item, data);
+  DdePostAdvise (mswindows_dde_mlid, mswindows_dde_topic_eval, hsz);
+  return Qnil;
+}
+
 HDDEDATA CALLBACK
 mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv,
 			HSZ hszTopic, HSZ hszItem, HDDEDATA hdata,
@@ -1741,31 +1926,172 @@
   switch (uType)
     {
     case XTYP_CONNECT:
-      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)
+          || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval))
 	return (HDDEDATA) TRUE;
       return (HDDEDATA) FALSE;
 
     case XTYP_WILDCONNECT:
       {
-	/* We only support one {service,topic} pair */
-	HSZPAIR pairs[2] =
+	/* We support two {service,topic} pairs */
+	HSZPAIR pairs[3] =
 	{
-	  { mswindows_dde_service, mswindows_dde_topic_system }, { 0, 0 } };
-
-	if (!(hszItem 
-	      || DdeCmpStringHandles (hszItem, mswindows_dde_service)) &&
-	    !(hszTopic
-	      || DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)))
+	  { mswindows_dde_service, mswindows_dde_topic_system },
+	  { mswindows_dde_service, mswindows_dde_topic_eval },
+	  { 0, 0 }
+	};
+
+	if ((!hszItem
+	     || !DdeCmpStringHandles (hszItem, mswindows_dde_service)) &&
+	    (!hszTopic
+	     || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)
+	     || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval)))
 	  return (DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE) pairs,
 				       sizeof (pairs), 0L, 0, uFmt, 0));
       }
       return (HDDEDATA) NULL;
 
+    case XTYP_ADVSTART:
+      if (!mswindows_dde_enable)
+	return (HDDEDATA) FALSE;
+
+      /* We only support advise loops on the eval topic for text data */
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval)
+	  && (uFmt == CF_TEXT || uFmt == CF_UNICODETEXT))
+	{
+	  /* Only allocated items or Result, are allowed */
+	  if (!DdeCmpStringHandles (hszItem, mswindows_dde_item_result))
+	    return (HDDEDATA) TRUE;
+
+	  {
+	    EXTERNAL_LIST_LOOP_2 (elt, Vdde_advise_items)
+	      {
+		Lisp_Object val;
+		HSZ hsz;
+		if (!SYMBOLP (elt))
+		  continue;
+		val = Fget (elt, QHSZ, Qnil);
+		if (!FLOATP (val))
+		  continue;
+		hsz = (HSZ) (int) XFLOAT_DATA (val);
+		if (!DdeCmpStringHandles (hszItem, hsz))
+		  return (HDDEDATA) TRUE;
+	      }
+	  }
+	}
+      return (HDDEDATA) FALSE;
+
+      /* Both advise requests and normal requests work the same */
+    case XTYP_ADVREQ:
+    case XTYP_REQUEST:
+      if (!mswindows_dde_enable)
+	return (HDDEDATA) NULL;
+
+      if (DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval) != 0)
+	return (HDDEDATA) NULL;
+
+      /* If this is a normal request and we're in the middle of
+       * an Execute, block until the Execute completes.
+       */
+      if (dde_eval_pending && uType == XTYP_REQUEST)
+	return (HDDEDATA) CBR_BLOCK;
+
+      /* We can only support requests for ANSI or Unicode text */
+      if (uFmt != CF_TEXT && uFmt != CF_UNICODETEXT)
+	return (HDDEDATA) NULL;
+
+      {
+	Lisp_Object args[2];
+	struct gcpro gcpro1;
+	Lisp_Object res;
+	Extbyte *result;
+	DWORD bytes;
+
+	args[0] = Qnil;
+	args[1] = Qnil;
+	GCPRO1 (args[0]);
+	gcpro1.nvars = 2;
+
+
+	if (!DdeCmpStringHandles (hszItem, mswindows_dde_item_result))
+	  {
+	    if (NILP (dde_eval_error))
+	      {
+		args[0] = build_string ("OK: %s");
+		args[1] = dde_eval_result;
+	      }
+	    else
+	      {
+		args[0] = build_string ("ERR: %s");
+		args[1] = dde_eval_error;
+	      }
+	  }
+	else
+	  {
+	    EXTERNAL_LIST_LOOP_2 (elt, Vdde_advise_items)
+	      {
+		Lisp_Object val;
+		HSZ hsz;
+		if (!SYMBOLP (elt))
+		  continue;
+		val = Fget (elt, QHSZ, Qnil);
+		if (!FLOATP (val))
+		  continue;
+		hsz = (HSZ) (int) XFLOAT_DATA (val);
+		if (!DdeCmpStringHandles (hszItem, hsz))
+		  args[1] = Fsymbol_value (elt);
+	      }
+	    args[0] = build_string ("%s");
+	  }
+
+	res = Fformat (2, args);
+	UNGCPRO;
+
+	bytes = (uFmt == CF_TEXT ? 1 : 2) * (XSTRING_LENGTH (res) + 1);
+	TO_EXTERNAL_FORMAT (LISP_STRING, res,
+			    C_STRING_ALLOCA, result,
+			    uFmt == CF_TEXT ? Qmswindows_multibyte
+			    : Qmswindows_unicode);
+
+	/* If we cannot create the data handle, this passes the null
+	 * return back to the client, which signals an error as we wish.
+	 */
+	return DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE)result,
+				    bytes, 0L, hszItem, uFmt, 0);
+      }
+
     case XTYP_EXECUTE:
       if (!mswindows_dde_enable)
 	return (HDDEDATA) DDE_FBUSY;
 
-      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval))
+	{
+	  DWORD len;
+	  LPBYTE extcmd;
+	  Lisp_Object tmp;
+
+	  /* Grab a pointer to the raw data supplied */
+	  extcmd = DdeAccessData (hdata, &len);
+
+	  TO_INTERNAL_FORMAT (DATA, (extcmd, len),
+			      LISP_STRING, tmp,
+			      Qmswindows_tstr);
+
+	  /* Release and free the data handle */
+	  DdeUnaccessData (hdata);
+	  DdeFreeDataHandle (hdata);
+
+	  /* Set a flag to say that the evaluation isn't yet complete,
+	   * enqueue the evaluation, send a dummy event to trigger the
+	   * event loop (I've no idea why this is needed, but it works...)
+	   * and return success to the client.
+	   */
+	  dde_eval_pending = 1;
+	  enqueue_magic_eval_event (dde_eval, tmp);
+	  mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE);
+	  return (HDDEDATA) DDE_FACK;
+	}
+      else if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
 	{
 	  DWORD len = DdeGetData (hdata, NULL, 0, 0);
 	  LPBYTE extcmd = (LPBYTE) ALLOCA (len + 1);
@@ -1786,7 +2112,6 @@
 
 	  /* Check syntax & that it's an [Open("foo")] command, which we
 	   * treat like a file drop */
-	  /* #### Ought to be generalised and accept some other commands */
 	  if (*cmd == '[')
 	    cmd++;
 	  if (qxestrncasecmp_c (cmd, MSWINDOWS_DDE_ITEM_OPEN,
@@ -2966,6 +3291,70 @@
       mswindows_handle_paint (XFRAME (mswindows_find_frame (hwnd)));
       break;
 
+    case WM_ACTIVATE:
+      {
+        /*
+         * If we receive a WM_ACTIVATE message that indicates that our frame
+         * is being activated, make sure that the frame is marked visible
+         * if the window itself is visible. This seems to fix the problem
+         * where XEmacs appears to lock-up after switching desktops with
+         * some virtual window managers.
+         */
+        int state = (int)(short) LOWORD(wParam);
+#ifdef DEBUG_XEMACS
+        if (debug_mswindows_events)
+          stderr_out("state = %d\n", state);
+#endif /* DEBUG_XEMACS */
+        if (state == WA_ACTIVE || state == WA_CLICKACTIVE)
+          {
+#ifdef DEBUG_XEMACS
+            if (debug_mswindows_events)
+              stderr_out("  activating\n");
+#endif /* DEBUG_XEMACS */
+            
+            fobj = mswindows_find_frame (hwnd);
+            frame = XFRAME (fobj);
+            if (IsWindowVisible (hwnd))
+              {
+#ifdef DEBUG_XEMACS
+                if (debug_mswindows_events)
+                  stderr_out("  window is visible\n");
+#endif /* DEBUG_XEMACS */
+                if (!FRAME_VISIBLE_P (frame))
+                  {
+#ifdef DEBUG_XEMACS
+                    if (debug_mswindows_events)
+                      stderr_out("  frame is not visible\n");
+#endif /* DEBUG_XEMACS */
+                    /*
+                     * It seems that we have to enqueue the XM_MAPFRAME event
+                     * prior to setting the frame visible so that
+                     * suspend-or-iconify-emacs works properly.
+                     */
+                    mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
+                    FRAME_VISIBLE_P (frame) = 1;
+                    FRAME_ICONIFIED_P (frame) = 0;
+                  }
+#ifdef DEBUG_XEMACS
+                else
+                  {
+                    if (debug_mswindows_events)
+                      stderr_out("  frame is visible\n");
+                  }
+#endif /* DEBUG_XEMACS */
+              }
+#ifdef DEBUG_XEMACS
+            else
+              {     
+                if (debug_mswindows_events)
+                  stderr_out("  window is not visible\n");
+              }
+#endif /* DEBUG_XEMACS */
+          }
+	return qxeDefWindowProc (hwnd, message_, wParam, lParam);
+      }
+      break;
+      
     case WM_WINDOWPOSCHANGED:
       /* This is sent before WM_SIZE; in fact, the processing of this
 	 by DefWindowProc() sends WM_SIZE.  But WM_SIZE is not sent when
@@ -3075,13 +3464,14 @@
 		}
 	      else
 		{
-		  if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) {
-		    mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
-		    /* APA: Now that the magic XM_MAPFRAME event has
-		     * been sent we can mark the frame as visible (just
-		     * like 21.1 did). */
-		    FRAME_VISIBLE_P (frame) = 1;
-		  }
+		  if (!msframe->sizing && !FRAME_VISIBLE_P (frame))
+                    {
+                      mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
+                      /* APA: Now that the magic XM_MAPFRAME event has
+                       * been sent we can mark the frame as visible (just
+                       * like 21.1 did). */
+                      FRAME_VISIBLE_P (frame) = 1;
+                    }
 
 		  if (!msframe->sizing || mswindows_dynamic_frame_resize)
 		    redisplay ();
@@ -4725,6 +5115,25 @@
       stderr_out (" wparam=%d lparam=%d hwnd=%x frame: ",
 		  wParam, (int) lParam, (unsigned int) hwnd);
       debug_print (frame);
+      if (message_ == WM_WINDOWPOSCHANGED ||
+          message_ == WM_WINDOWPOSCHANGING)
+        {
+          WINDOWPOS *wp = (WINDOWPOS *) lParam;
+          stderr_out("  WINDOWPOS: x=%d, y=%d, h=%d, w=%d\n",
+                     wp->x, wp->y, wp->cx, wp->cy);
+        }
+      else if (message_ == WM_MOVE)
+        {
+          int x = (int)(short) LOWORD(lParam);   /* horizontal position */
+          int y = (int)(short) HIWORD(lParam);   /* vertical position */
+          stderr_out("  MOVE: x=%d, y=%d\n", x, y);
+        }
+      else if (message_ == WM_SIZE)
+        {
+          int w = (int)(short) LOWORD(lParam);   /* width */
+          int h = (int)(short) HIWORD(lParam);   /* height */
+          stderr_out("  SIZE: w=%d, h=%d\n", w, h);
+        }
     }
   else
     stderr_out ("\n");
@@ -4762,6 +5171,8 @@
   mswindows_event_stream->delete_io_streams_cb = emacs_mswindows_delete_io_streams;
   mswindows_event_stream->current_event_timestamp_cb =
     emacs_mswindows_current_event_timestamp;
+
+  dde_eval_pending = 0;
 }
 
 void
@@ -4781,6 +5192,28 @@
 
   mswindows_error_caught_in_modal_loop = 0;
 
+#ifdef HAVE_DRAGNDROP
+  Fprovide (Qdde);
+
+  DEFVAR_LISP ("dde-advise-items", &Vdde_advise_items /*
+A list of allocated DDE advise items.
+Each item is an uninterned symbol, created using dde-alloc-advise-item.
+
+The symbol's value is the data which is returned to the DDE client when
+a request for the item is made (or a dde-advise call is made).
+
+The symbol also has a 'HSZ property, which holds the DDE string handle
+for the item, as a float. This is for internal use only, and should not
+be modified.
+*/ );
+  Vdde_advise_items = Qnil;
+  
+  dde_eval_result = Qnil;
+  staticpro (&dde_eval_result);
+  dde_eval_error = Qnil;
+  staticpro (&dde_eval_error);
+#endif
+
 #ifdef DEBUG_XEMACS
   DEFVAR_INT ("debug-mswindows-events", &debug_mswindows_events /*
 If non-zero, display debug information about Windows messages that XEmacs sees.
@@ -4853,6 +5286,12 @@
 void
 syms_of_event_mswindows (void)
 {
+#ifdef HAVE_DRAGNDROP
+  DEFSYMBOL(QHSZ);
+  DEFSUBR(Fdde_alloc_advise_item);
+  DEFSUBR(Fdde_free_advise_item);
+  DEFSUBR(Fdde_advise);
+#endif
 }
 
 void