diff src/msw-proc.c @ 219:262b8bb4a523 r20-4b8

Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents d44af0c54775
children 6c0ae1f9357f
line wrap: on
line diff
--- a/src/msw-proc.c	Mon Aug 13 10:08:36 2007 +0200
+++ b/src/msw-proc.c	Mon Aug 13 10:09:35 2007 +0200
@@ -28,6 +28,8 @@
 /*
  * Comment:
  *
+ * X on UNIX may be bad, but the win32 API really really really sucks.
+ *
  * Windows user-input type events are stored in a per-thread message queue
  * and retrieved using GetMessage(). It is not possible to wait on this
  * queue and on other events (eg process input) simultaneously. Also, the
@@ -35,21 +37,31 @@
  * asynchronously when windows has certain other types of events ("nonqueued
  * messages") to deliver. The documentation doesn't appear to specify the
  * context in which the windows procedure is called, but I assume that the
- * thread that created the window is temporarily highjacked for this purpose.
+ * thread that created the window is temporarily highjacked for this purpose
+ * when it calls GetMessage (a bit like X callbacks?).
  *
- * We spawn off a single thread to deal with both kinds of messages. The
- * thread turns the windows events into emacs_events and stuffs them in a
- * queue which XEmacs reads at its leisure. This file contains the code for
- * the thread. This scheme also helps to prevent weird synchronisation and
- * deadlock problems that might occur if the windows procedure was called
- * when XEmacs was already in the middle of processing an event. 
+ * We spawn off a single thread to deal with both queued and non-queued
+ * events. The thread turns both kinds of events into emacs_events and stuffs
+ * them in a queue which XEmacs reads at its leisure. This file contains the
+ * code for that thread.
  *
- * Unfortunately, only the thread that created a window can retrieve messages
+ * Unfortunately, under win32 a seemingly-random selection of resources are
+ * owned by the thread that created/asked for them and not by the process. In
+ * particular, only the thread that created a window can retrieve messages
  * destined for that window ("GetMessage does not retrieve messages for
  * windows that belong to other threads..."). This means that our message-
- * processing thread also has to do all window creation. We handle this
- * bogosity by getting the main XEmacs thread to send special user-defined
- * messages to the message-processing thread to instruct it to create windows.
+ * processing thread also has to do all window creation, deletion and various
+ * other random stuff. We handle this bogosity by getting the main XEmacs
+ * thread to send special user-defined messages to the message-processing
+ * thread to instruct it to create windows etc.
+ *
+ * More bogosity: Windows95 doesn't offer any one-shot timers, only a
+ * periodic timer. Worse, if you don't want a periodic timer to be associated
+ * with a particular mswindows window (we don't) your periodic timers don't
+ * have unique ids associated with them. We get round this lameness by
+ * setting off a single periodic timer and we use this to schedule timeouts
+ * manually. Implementing basic stuff like one-shot timers at the application
+ * level is not particularly efficient, but Windows95 leaves us no choice.
  */
 
 
@@ -62,13 +74,37 @@
 #include "events.h"
 #include "event-msw.h"
 
+#ifdef DEBUG_XEMACS
+# include "opaque.h"	/* For the debug functions at the end of this file */
+# undef DEBUG_MESSAGES
+# undef DEBUG_TIMEOUTS
+#endif
+
 #define MSWINDOWS_FRAME_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_TILEDWINDOW
 #define MSWINDOWS_POPUP_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_CAPTION|WS_POPUP
 
-static LRESULT WINAPI mswindows_wnd_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);
+static LRESULT WINAPI mswindows_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);
 static Lisp_Object mswindows_find_console (HWND hwnd);
 static Lisp_Object mswindows_find_frame (HWND hwnd);
-static Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key);
+static Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods);
+static int mswindows_modifier_state (void);
+static int mswindows_enqueue_timeout (int milliseconds);
+static void mswindows_dequeue_timeout (int interval_id);
+
+/* Virtual keycode of the '@' key */
+static int virtual_at_key;
+
+/* Timeout queue */
+struct mswindows_timeout
+{
+  int ticks;
+  int interval_id;
+  struct mswindows_timeout *next;
+};
+typedef struct mswindows_timeout mswindows_timeout;
+static mswindows_timeout timeout_pool[MSW_TIMEOUT_MAX];
+static mswindows_timeout *timeout_head = NULL;
+static int timeout_mswindows_id;
 
 /*
  * Entry point for the "windows" message-processing thread
@@ -101,6 +137,15 @@
   /* Notify the main thread that we're ready */
   assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0));
 
+  /* Hack! Windows doesn't report Ctrl-@ characters so we have to find out
+   * which virtual key generates '@' at runtime */
+  virtual_at_key = VkKeyScan ('@');
+  if (virtual_at_key & 0x200)	/* 0x200 means the control key */
+    /* If you need Ctrl just to generate @, you can't do Ctrl-@ */
+    virtual_at_key = -1;
+  else
+    virtual_at_key &= 0xff;	/* The low byte contains the keycode */
+
   /* Main windows loop */
   while (1)
   {
@@ -115,22 +160,32 @@
     if (msg.message>=WM_XEMACS_BASE && msg.message<=WM_XEMACS_END)
       mswindows_handle_request(&msg);
 
-    /* Timeout */
+    /* Timeout(s) */
     else if (msg.message ==  WM_TIMER)
     {
-      Lisp_Object emacs_event;
-      struct Lisp_Event *event;
+      EnterCriticalSection (&mswindows_dispatch_crit);
+      if (timeout_head!=NULL)
+	--(timeout_head->ticks);
+
+      while (timeout_head!=NULL && timeout_head->ticks==0)
+	{
+	  Lisp_Object emacs_event;
+	  struct Lisp_Event *event;
+	  int id = timeout_head->interval_id;
 
-      KillTimer(NULL, msg.wParam);
-      EnterCriticalSection (&mswindows_dispatch_crit);
-      emacs_event = Fmake_event (Qnil, Qnil);
-      event = XEVENT(emacs_event);
+#ifdef DEBUG_TIMEOUTS
+	  stderr_out("--> %x\n", id);
+#endif
+	  mswindows_dequeue_timeout (id);
+	  emacs_event = Fmake_event (Qnil, Qnil);
+	  event = XEVENT(emacs_event);
 
-      event->channel = Qnil;
-      event->timestamp = msg.time;
-      event->event_type = timeout_event;
-      event->event.timeout.interval_id = msg.wParam;
-      mswindows_enqueue_dispatch_event (emacs_event);
+	  event->channel = Qnil;
+	  event->timestamp = msg.time;
+	  event->event_type = timeout_event;
+	  event->event.timeout.interval_id = id;
+	  mswindows_enqueue_dispatch_event (emacs_event);
+	}
       LeaveCriticalSection (&mswindows_dispatch_crit);
     }
     else
@@ -150,33 +205,22 @@
   Lisp_Object emacs_event;
   struct Lisp_Event *event;
 
-  static int mods = 0;
   MSG msg = { hwnd, message, wParam, lParam, 0, {0,0} };
   msg.time = GetMessageTime();
 
-#if 0 /* XXX */
+#ifdef DEBUG_MESSAGES
   stderr_out("Message %04x, wParam=%04x, lParam=%08lx\n", message, wParam, lParam);
 #endif
   switch (message)
   {
   case WM_KEYDOWN:
   case WM_SYSKEYDOWN:
-    switch(wParam)
     {
-    case VK_SHIFT:
-      mods |= MOD_SHIFT;
-      break;
-    case VK_CONTROL:
-      mods |= MOD_CONTROL;
-      break;
-    case VK_MENU:
-      mods |= MOD_META;
-      break;
-    default:
       /* Handle those keys that TranslateMessage won't generate a WM_CHAR for */
-      {
-        Lisp_Object keysym;
-        if (!NILP (keysym = mswindows_key_to_emacs_keysym(wParam)))
+      Lisp_Object keysym;
+      int mods = mswindows_modifier_state();
+
+      if (!NILP (keysym = mswindows_key_to_emacs_keysym(wParam, mods)))
 	{
           EnterCriticalSection (&mswindows_dispatch_crit);
 	  emacs_event = Fmake_event (Qnil, Qnil);
@@ -191,28 +235,10 @@
           LeaveCriticalSection (&mswindows_dispatch_crit);
 	  return (0);
 	}
-      }
     }
     TranslateMessage (&msg);  /* Maybe generates WM_[SYS]CHAR in message queue */
     goto defproc;
 
-  case WM_KEYUP:
-  case WM_SYSKEYUP:
-    switch(wParam)
-    {
-    case VK_SHIFT:
-      mods &= ~MOD_SHIFT;
-      break;
-    case VK_CONTROL:
-      mods &= ~MOD_CONTROL;
-      break;
-    case VK_MENU:
-      mods &= ~MOD_META;
-      break;
-    }
-    TranslateMessage (&msg);
-    goto defproc;
-
   case WM_CHAR:
   case WM_SYSCHAR:
     {
@@ -223,18 +249,25 @@
       event->channel = mswindows_find_console(hwnd);
       event->timestamp = msg.time;
       event->event_type = key_press_event;
-      event->event.key.modifiers = mods;
-      event->event.key.modifiers = lParam & 0x20000000 ? MOD_META : 0; /* redundant? */
-      if (wParam<' ')	/* Control char not handled under WM_KEYDOWN */
+
+      /* XEmacs doesn't seem to like Shift on non-alpha keys */
+      event->event.key.modifiers = isalpha(wParam) ? 
+				   mswindows_modifier_state() :
+				   mswindows_modifier_state() & ~MOD_SHIFT;
+
+      if (wParam<' ')	/* Control char not already handled under WM_KEYDOWN */
       {
-	event->event.key.keysym = make_char(wParam+'a'-1);
-	event->event.key.modifiers |= MOD_CONTROL;   /* redundant? */
+	/* Don't capitalise alpha control keys */
+	event->event.key.keysym = isalpha(wParam+'a'-1) ?
+				  make_char(wParam+'a'-1) :
+				  make_char(wParam+'A'-1);
       }
       else
       {
 	/* Assumes that emacs keysym == ASCII code */
 	event->event.key.keysym = make_char(wParam);
       }
+
       mswindows_enqueue_dispatch_event (emacs_event);
       LeaveCriticalSection (&mswindows_dispatch_crit);
     }
@@ -248,27 +281,35 @@
   case WM_RBUTTONUP:
     {
       /* XXX FIXME: Do middle button emulation */
+      short x, y;
+
       EnterCriticalSection (&mswindows_dispatch_crit);
       emacs_event = Fmake_event (Qnil, Qnil);
       event = XEVENT(emacs_event);
 
       event->channel = mswindows_find_frame(hwnd);
       event->timestamp = msg.time;
-      event->event_type =
-	(message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN ||
-	 message==WM_RBUTTONDOWN) ?
-	 button_press_event : button_release_event;
-#if 0
-	((wParam & MK_CONTROL) ? MOD_CONTROL : 0) |
-	 ((wParam & MK_SHIFT) ? MOD_SHIFT : 0);
-#endif
       event->event.button.button =
 	(message==WM_LBUTTONDOWN || message==WM_LBUTTONUP) ? 1 :
 	 ((message==WM_RBUTTONDOWN || message==WM_RBUTTONUP) ? 3 : 2);
-      event->event.button.x = LOWORD(lParam);
-      event->event.button.y = HIWORD(lParam);
-      event->event.button.modifiers = mods;
+      x = LOWORD (lParam);
+      y = HIWORD (lParam);
+      event->event.button.x = x;
+      event->event.button.y = y;
+      event->event.button.modifiers = mswindows_modifier_state();
       
+      if (message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN ||
+	  message==WM_RBUTTONDOWN)
+	{
+	  event->event_type = button_press_event;
+	  SetCapture (hwnd);
+	}
+      else
+	{
+	  event->event_type = button_release_event;
+	  ReleaseCapture ();
+	}
+
       mswindows_enqueue_dispatch_event (emacs_event);
       LeaveCriticalSection (&mswindows_dispatch_crit);
     }
@@ -276,6 +317,8 @@
 
   case WM_MOUSEMOVE:
     {
+      short x, y;
+
       EnterCriticalSection (&mswindows_dispatch_crit);
       emacs_event = Fmake_event (Qnil, Qnil);
       event = XEVENT(emacs_event);
@@ -283,9 +326,11 @@
       event->channel = mswindows_find_frame(hwnd);
       event->timestamp = msg.time;
       event->event_type = pointer_motion_event;
-      event->event.motion.x = LOWORD(lParam);
-      event->event.motion.y = HIWORD(lParam);
-      event->event.motion.modifiers = mods;
+      x = LOWORD (lParam);
+      y = HIWORD (lParam);
+      event->event.motion.x = x;
+      event->event.motion.y = y;
+      event->event.motion.modifiers = mswindows_modifier_state();
       
       mswindows_enqueue_dispatch_event (emacs_event);
       LeaveCriticalSection (&mswindows_dispatch_crit);
@@ -338,25 +383,66 @@
     }
     break;
 
+  /* Misc magic events which only require that the frame be identified */
   case WM_SETFOCUS:
   case WM_KILLFOCUS:
+  case WM_CLOSE:
     {
       EnterCriticalSection (&mswindows_dispatch_crit);
       emacs_event = Fmake_event (Qnil, Qnil);
-      event = XEVENT(emacs_event);
+      event = XEVENT (emacs_event);
 
-      event->channel = mswindows_find_frame(hwnd);
+      event->channel = mswindows_find_frame (hwnd);
       event->timestamp = msg.time;
       event->event_type = magic_event;
-      EVENT_MSWINDOWS_MAGIC_TYPE(event) = message;
+      EVENT_MSWINDOWS_MAGIC_TYPE (event) = message;
 
       mswindows_enqueue_dispatch_event (emacs_event);
       LeaveCriticalSection (&mswindows_dispatch_crit);
     }
     break;
 
-  case WM_QUIT:
-    /* XXX FIXME: Should do something here! */
+  case WM_WINDOWPOSCHANGING:
+    {
+      WINDOWPOS *wp = (LPWINDOWPOS) lParam;
+      WINDOWPLACEMENT wpl = { sizeof(WINDOWPLACEMENT) };
+      GetWindowPlacement(hwnd, &wpl);
+
+      /* Only interested if size is changing and we're not being iconified */
+      if ((wpl.showCmd != SW_SHOWMINIMIZED) && !(wp->flags & SWP_NOSIZE))
+      {
+	RECT ncsize = { 0, 0, 0, 0 };
+	int pixwidth, pixheight;
+	AdjustWindowRect (&ncsize, GetWindowLong (hwnd, GWL_STYLE), FALSE);
+
+	round_size_to_char (XFRAME (mswindows_find_frame (hwnd)),
+			    wp->cx - (ncsize.right - ncsize.left),
+			    wp->cy - (ncsize.bottom - ncsize.top),
+			    &pixwidth, &pixheight);
+
+	/* Convert client sizes to window sizes */
+	pixwidth += (ncsize.right - ncsize.left);
+	pixheight += (ncsize.bottom - ncsize.top);
+
+	if (wpl.showCmd != SW_SHOWMAXIMIZED)
+	  {
+	    /* Adjust so that the bottom or right doesn't move if it's
+	     * the top or left that's being changed */
+	    RECT rect;
+	    GetWindowRect (hwnd, &rect);
+
+	    if (rect.left != wp->x)
+	      wp->x += wp->cx - pixwidth;
+	    if (rect.top != wp->y)
+	      wp->y += wp->cy - pixheight;
+	  }
+
+	wp->cx = pixwidth;
+	wp->cy = pixheight;
+      }
+    }
+    break;
+
   defproc:
   default:
     return DefWindowProc (hwnd, message, wParam, lParam);
@@ -410,11 +496,11 @@
 
     style = (NILP(popup)) ? MSWINDOWS_FRAME_STYLE : MSWINDOWS_POPUP_STYLE;
 
-    /* The +1 is because there is no msw-glyph.c yet. */
-    char_to_pixel_size (f, 80+1, 24+1, &pixel_width, &pixel_height);
-    rect.left = rect.top = 0;
-    rect.right = INTP(width) ? XINT(width) : pixel_width;
-    rect.bottom = INTP(height) ? XINT(height) : pixel_height;
+    rect.left = INTP(left) ? XINT(left) : 0;
+    rect.top = INTP(top) ? XINT(top) : 0;
+    char_to_pixel_size (f, INTP(width) ? XINT(width) : 80,
+			INTP(height) ? XINT(height) : 24,
+			&rect.right, &rect.bottom);
 #ifdef HAVE_MENUBARS
     AdjustWindowRect(&rect, style, TRUE);
 #else
@@ -433,18 +519,31 @@
     }
     return;
 
+  case WM_XEMACS_DESTROYWINDOW:
+    {
+      struct frame *f = request->thing1;
+      ReleaseDC(FRAME_MSWINDOWS_HANDLE(f), FRAME_MSWINDOWS_DC(f));
+      DestroyWindow(FRAME_MSWINDOWS_HANDLE(f));
+      assert (PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0));
+    }
+    break;
+
   case WM_XEMACS_SETTIMER:
     {
-    UINT id;
-    id=SetTimer (NULL, 0, (UINT) request->thing1, NULL);
-    assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, id));
+      int id;
+      EnterCriticalSection (&mswindows_dispatch_crit);
+      id = mswindows_enqueue_timeout((int) request->thing1);
+      LeaveCriticalSection (&mswindows_dispatch_crit);
+      assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, id));
     }
     break;
 
   case WM_XEMACS_KILLTIMER:
     {
-    KillTimer (NULL, (UINT) request->thing1);
-    assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0));
+      EnterCriticalSection (&mswindows_dispatch_crit);
+      mswindows_dequeue_timeout((int) request->thing1);
+      LeaveCriticalSection (&mswindows_dispatch_crit);
+      assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0));
     }
     break;
 
@@ -454,6 +553,17 @@
 }
 
 
+/* Returns the state of the modifier keys in the format expected by the
+ * Lisp_Event key_data, button_data and motion_data modifiers member */
+int mswindows_modifier_state (void)
+{
+  /* Set high bit of GetKeyState's return value indicates the key is down */
+  return ((GetKeyState (VK_SHIFT)   & 0x8000) ? MOD_SHIFT  : 0) |
+	 ((GetKeyState (VK_CONTROL) & 0x8000) ? MOD_CONTROL: 0) |
+	 ((GetKeyState (VK_MENU)    & 0x8000) ? MOD_META   : 0);
+}
+
+
 /*
  * Translate a mswindows virtual key to a keysym.
  * Only returns non-Qnil for keys that don't generate WM_CHAR messages
@@ -461,7 +571,7 @@
  * Virtual key values are defined in winresrc.h
  * XXX I'm not sure that KEYSYM("name") is the best thing to use here.
  */
-Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key)
+Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods)
 {
   switch (mswindows_key)
   {
@@ -475,6 +585,7 @@
   case VK_DELETE:	return QKdelete;
 
   /* The rest */
+  case VK_CLEAR:	return KEYSYM ("clear");  /* Should do ^L ? */
   case VK_PRIOR:	return KEYSYM ("prior");
   case VK_NEXT:		return KEYSYM ("next");
   case VK_END:		return KEYSYM ("end");
@@ -483,8 +594,17 @@
   case VK_UP:		return KEYSYM ("up");
   case VK_RIGHT:	return KEYSYM ("right");
   case VK_DOWN:		return KEYSYM ("down");
+  case VK_SELECT:	return KEYSYM ("select");
+  case VK_PRINT:	return KEYSYM ("print");
+  case VK_EXECUTE:	return KEYSYM ("execute");
+  case VK_SNAPSHOT:	return KEYSYM ("print");
   case VK_INSERT:	return KEYSYM ("insert");
   case VK_HELP:		return KEYSYM ("help");
+#if 0	/* XXX What are these supposed to do? */
+  case VK_LWIN		return KEYSYM ("");
+  case VK_RWIN		return KEYSYM ("");
+#endif
+  case VK_APPS:		return KEYSYM ("menu");
   case VK_F1:		return KEYSYM ("F1");
   case VK_F2:		return KEYSYM ("F2");
   case VK_F3:		return KEYSYM ("F3");
@@ -509,12 +629,160 @@
   case VK_F22:		return KEYSYM ("F22");
   case VK_F23:		return KEYSYM ("F23");
   case VK_F24:		return KEYSYM ("F24");
+  default:
+    /* Special handling for Ctrl-'@' because '@' lives shifted on varying
+     * virtual keys and because Windows doesn't report Ctrl-@ as a WM_CHAR */
+    if (((mods & (MOD_SHIFT|MOD_CONTROL)) == (MOD_SHIFT|MOD_CONTROL)) &&
+	(mswindows_key == virtual_at_key))
+      return make_char('@');
   }
   return Qnil;
 }
 
 
 /*
+ * Add a timeout to the queue. Returns the id or 0 on failure
+ */
+static int mswindows_enqueue_timeout (int milliseconds)
+{
+  static int timeout_last_interval_id;
+  int target_ticks = (milliseconds + MSW_TIMEOUT_GRANULARITY-1) /
+		     MSW_TIMEOUT_GRANULARITY;
+  mswindows_timeout *target;
+  int i;
+
+  /* Find a free timeout */
+  for (i=0; i<MSW_TIMEOUT_MAX; i++)
+    {
+      target = timeout_pool + i;
+      if (target->interval_id == 0)
+	break;
+    }
+
+  /* No free timeout */
+  if (i==MSW_TIMEOUT_MAX)
+    return 0;
+
+  if (++timeout_last_interval_id == 0)
+    ++timeout_last_interval_id;
+
+  if (timeout_head == NULL || timeout_head->ticks >= target_ticks)
+    {
+      /* First or only timeout in the queue (common case) */
+      target->interval_id = timeout_last_interval_id;
+      target->ticks = target_ticks;
+      target->next = timeout_head;
+      timeout_head = target;
+
+      if (target->next == NULL)
+	{
+	  /* Queue was empty - restart the timer */
+	  timeout_mswindows_id = SetTimer (NULL, 0, MSW_TIMEOUT_GRANULARITY,
+					   NULL);
+#ifdef DEBUG_TIMEOUTS
+	  stderr_out("Start\n");
+#endif
+	}
+      else
+	target->next->ticks -= target->ticks;
+    }
+  else
+    {
+      /* Find the timeout before this new one */
+      mswindows_timeout *prev = timeout_head;
+      int tick_count = prev->ticks;	/* Number of ticks up to prev */
+
+      while (prev->next != NULL)
+	{
+	  if (tick_count + prev->next->ticks >= target_ticks)
+	    break;
+	  prev = prev->next;
+	  tick_count += prev->ticks;
+	}
+
+      /* Insert the new timeout in the queue */
+      target->interval_id = timeout_last_interval_id;
+      target->ticks = target_ticks - tick_count;
+      target->next = prev->next;
+      prev->next = target;
+      if (target->next != NULL)
+	target->next->ticks -= target->ticks;
+    }
+#ifdef DEBUG_TIMEOUTS
+  stderr_out("Set %x %d %d\n", timeout_last_interval_id, target_ticks, milliseconds);
+#endif
+  return timeout_last_interval_id;
+}
+
+
+/*
+ * Remove a timeout from the queue
+ */
+static void mswindows_dequeue_timeout (int interval_id)
+{
+  mswindows_timeout *target;
+  mswindows_timeout *prev;
+
+  target = timeout_head;
+  prev = NULL;
+  while (target != NULL)
+    {
+      if (target->interval_id == interval_id)
+	{
+#ifdef DEBUG_TIMEOUTS
+	  stderr_out("Kil %x %d\n", interval_id, target->ticks);
+#endif
+	  target->interval_id = 0;	/* Mark free */
+
+	  if (prev!=NULL)
+	    {
+	      prev->next = target->next;
+              if (target->next != NULL)
+		target->next->ticks += target->ticks;
+	    }
+	  else if ((timeout_head = target->next) == NULL)
+	    {
+	      /* Queue is now empty - stop the timer */
+	      KillTimer (NULL, timeout_mswindows_id);
+	      timeout_mswindows_id = 0;
+#ifdef DEBUG_TIMEOUTS
+	      stderr_out("Stop\n");
+#endif
+	    }
+	  return;
+	}
+      else
+	{
+	  prev = target;
+	  target = target->next;
+	}
+    }
+
+  /* Ack! the timeout wasn't in the timeout queue which means that it's
+   * probably gone off and is now sitting in the dispatch queue. XEmacs will
+   * be very unhappy if it sees the timeout so we have to fish it out of the
+   * dispatch queue. This only happens if XEmacs can't keep up with events */
+#ifdef DEBUG_TIMEOUTS
+    stderr_out("Kil %x - not found\n", interval_id);
+#endif
+  {
+    Lisp_Object match_event, emacs_event;
+    struct Lisp_Event *event;
+    match_event = Fmake_event (Qnil, Qnil);
+    event = XEVENT(match_event);
+
+    event->channel = Qnil;
+    event->event_type = timeout_event;
+    event->event.timeout.interval_id = interval_id;
+    emacs_event = mswindows_cancel_dispatch_event (match_event);
+    if (!NILP (emacs_event))
+      Fdeallocate_event(emacs_event);
+    Fdeallocate_event(match_event);
+  }
+}
+
+
+/*
  * Find the console that matches the supplied mswindows window handle
  */
 static Lisp_Object
@@ -553,6 +821,8 @@
   return Qnil;
 }
 
+
+#ifdef DEBUG_XEMACS
 /*
  * Random helper functions for debugging.
  * Intended for use in the MSVC "Watch" window which doesn't like
@@ -560,46 +830,62 @@
  */
 struct lrecord_header *DHEADER(Lisp_Object obj)
 {
-  return LRECORDP(obj) ? XRECORD_LHEADER(obj) : NULL;
-    /* (lrecord_header*)(obj & 0xfffffff) */
+  return (LRECORDP (obj)) ? XRECORD_LHEADER (obj) : NULL;
+}
+
+int DOPAQUE_DATA (Lisp_Object obj)
+{
+  return (OPAQUEP (obj)) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL;
 }
 
 struct Lisp_Event *DEVENT(Lisp_Object obj)
 {
-  return (EVENTP (obj)) ? XEVENT(obj) : NULL;
+  return (EVENTP (obj)) ? XEVENT (obj) : NULL;
 }
 
 struct Lisp_Cons *DCONS(Lisp_Object obj)
 {
-  return (CONSP (obj)) ? XCONS(obj) : NULL;
+  return (CONSP (obj)) ? XCONS (obj) : NULL;
 }
 
 Lisp_Object DCAR(Lisp_Object obj)
 {
-  return (CONSP (obj)) ? XCAR(obj) : 0;
+  return (CONSP (obj)) ? XCAR (obj) : 0;
 }
 
 Lisp_Object DCDR(Lisp_Object obj)
 {
-  return (CONSP (obj)) ? XCDR(obj) : 0;
+  return (CONSP (obj)) ? XCDR (obj) : 0;
+}
+
+Lisp_Object DCONSCDR(Lisp_Object obj)
+{
+  return ((CONSP (obj)) && (CONSP (XCDR (obj)))) ? XCONS (XCDR (obj)) : 0;
+}
+
+Lisp_Object DCARCDR(Lisp_Object obj)
+{
+  return ((CONSP (obj)) && (CONSP (XCDR (obj)))) ? XCAR (XCDR (obj)) : 0;
 }
 
 char *DSTRING(Lisp_Object obj)
 {
-  return (STRINGP (obj)) ? XSTRING_DATA(obj) : NULL;
+  return (STRINGP (obj)) ? XSTRING_DATA (obj) : NULL;
 }
 
 struct Lisp_Vector *DVECTOR(Lisp_Object obj)
 {
-  return (VECTORP (obj)) ? XVECTOR(obj) : NULL;
+  return (VECTORP (obj)) ? XVECTOR (obj) : NULL;
 }
 
 struct Lisp_Symbol *DSYMBOL(Lisp_Object obj)
 {
-  return (SYMBOLP (obj)) ? XSYMBOL(obj) : NULL;
+  return (SYMBOLP (obj)) ? XSYMBOL (obj) : NULL;
 }
 
 char *DSYMNAME(Lisp_Object obj)
 {
-  return (SYMBOLP (obj)) ? XSYMBOL(obj)->name->_data : NULL;
+  return (SYMBOLP (obj)) ? XSYMBOL (obj)->name->_data : NULL;
 }
+
+#endif