]> code.delx.au - gnu-emacs/blobdiff - src/w32fns.c
* cl-generic.el (cl-defmethod): Make docstring dynamic
[gnu-emacs] / src / w32fns.c
index fa45b4781c138552997a4eb811eeaf579587f7ff..f5e5b33556c77133bb5732bac9007995f4b68647 100644 (file)
@@ -186,11 +186,7 @@ MonitorFromWindow_Proc monitor_from_window_fn = NULL;
 EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL;
 GetTitleBarInfo_Proc get_title_bar_info_fn = NULL;
 
-#ifdef NTGUI_UNICODE
-#define unicode_append_menu AppendMenuW
-#else /* !NTGUI_UNICODE */
 extern AppendMenuW_Proc unicode_append_menu;
-#endif /* NTGUI_UNICODE */
 
 /* Flag to selectively ignore WM_IME_CHAR messages.  */
 static int ignore_ime_char = 0;
@@ -280,6 +276,8 @@ static struct
 } kbdhook;
 typedef HWND (WINAPI *GetConsoleWindow_Proc) (void);
 
+typedef BOOL (WINAPI *IsDebuggerPresent_Proc) (void);
+
 /* stdin, from w32console.c */
 extern HANDLE keyboard_handle;
 
@@ -345,7 +343,6 @@ x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
 
 \f
 static Lisp_Object unwind_create_frame (Lisp_Object);
-static void unwind_create_tip_frame (Lisp_Object);
 static void my_create_window (struct frame *);
 static void my_create_tip_window (struct frame *);
 
@@ -1662,7 +1659,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
 
   if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
     {
-      FRAME_INTERNAL_BORDER_WIDTH (f) = border;
+      f->internal_border_width = border;
 
       if (FRAME_X_WINDOW (f) != 0)
        {
@@ -2182,7 +2179,7 @@ funhook (int code, WPARAM w, LPARAM l)
                     can prevent this by setting the
                     w32-pass-[lr]window-to-system variable to
                     NIL.  */
-                 if (hs->vkCode == (VK_LWIN && !NILP (Vw32_pass_lwindow_to_system)) ||
+                 if ((hs->vkCode == VK_LWIN && !NILP (Vw32_pass_lwindow_to_system)) ||
                      (hs->vkCode == VK_RWIN && !NILP (Vw32_pass_rwindow_to_system)))
                    {
                      /* Not prevented - Simulate the keypress to the system.  */
@@ -2308,6 +2305,19 @@ setup_w32_kbdhook (void)
 {
   kbdhook.hook_count++;
 
+  /* This hook gets in the way of debugging, since when Emacs stops,
+     its input thread stops, and there's nothing to process keyboard
+     events, whereas this hook is global, and is invoked in the
+     context of the thread that installed it.  So we don't install the
+     hook if the process is being debugged. */
+  if (w32_kbdhook_active)
+    {
+      IsDebuggerPresent_Proc is_debugger_present = (IsDebuggerPresent_Proc)
+       GetProcAddress (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent");
+      if (is_debugger_present && is_debugger_present ())
+       return;
+    }
+
   /* Hooking is only available on NT architecture systems, as
      indicated by the w32_kbdhook_active variable.  */
   if (kbdhook.hook_count == 1 && w32_kbdhook_active)
@@ -2406,6 +2416,7 @@ hook_w32_key (int hook, int modifier, int vkey)
     }
 }
 
+#ifdef WINDOWSNT
 /* Check the current Win key pressed state.  */
 int
 check_w32_winkey_state (int vkey)
@@ -2433,6 +2444,7 @@ check_w32_winkey_state (int vkey)
     }
   return 0;
 }
+#endif /* WINDOWSNT */
 
 /* Reset the keyboard hook state.  Locking the workstation with Win-L
    leaves the Win key(s) "down" from the hook's point of view - the
@@ -2623,8 +2635,10 @@ modifier_set (int vkey)
       else
        return (GetKeyState (vkey) & 0x1);
     }
+#ifdef WINDOWSNT
   if (w32_kbdhook_active && (vkey == VK_LWIN || vkey == VK_RWIN))
     return check_w32_winkey_state (vkey);
+#endif
 
   if (!modifiers_recorded)
     return (GetKeyState (vkey) & 0x8000);
@@ -3382,7 +3396,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
       W32Msg wmsg;
       DWORD console_modifiers = construct_console_modifiers ();
       int *b = buf, strip_ExtraMods = 1, hairy = 0;
-      char *type_CtrlAlt = NULL;
+      const char *type_CtrlAlt = NULL;
 
       /*  XXXX In fact, there may be another case when we need to do the same:
               What happens if the string defined in the LIGATURES has length
@@ -5053,6 +5067,7 @@ static void
 my_create_tip_window (struct frame *f)
 {
   RECT rect;
+  Window tip_window;
 
   rect.left = rect.top = 0;
   rect.right = FRAME_PIXEL_WIDTH (f);
@@ -5200,9 +5215,8 @@ x_make_gc (struct frame *f)
 }
 
 
-/* Handler for signals raised during x_create_frame and
-   x_create_tip_frame.  FRAME is the frame which is partially
-   constructed.  */
+/* Handler for signals raised during x_create_frame.
+   FRAME is the frame which is partially constructed.  */
 
 static Lisp_Object
 unwind_create_frame (Lisp_Object frame)
@@ -5976,7 +5990,7 @@ w32_display_monitor_attributes_list (void)
     {
       struct frame *f = XFRAME (frame);
 
-      if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
+      if (FRAME_W32_P (f) && !FRAME_TOOLTIP_P (f))
        {
          HMONITOR monitor =
            monitor_from_window_fn (FRAME_W32_WINDOW (f),
@@ -6063,7 +6077,7 @@ w32_display_monitor_attributes_list_fallback (struct w32_display_info *dpyinfo)
     {
       struct frame *f = XFRAME (frame);
 
-      if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
+      if (FRAME_W32_P (f) && FRAME_TOOLTIP_P (f))
        frames = Fcons (frame, frames);
     }
   attributes = Fcons (Fcons (Qframes, frames), attributes);
@@ -6466,39 +6480,6 @@ no value of TYPE (always string in the MS Windows case).  */)
                                Tool tips
  ***********************************************************************/
 
-static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
-                           Lisp_Object, int, int, int *, int *);
-
-/* The frame of a currently visible tooltip.  */
-
-Lisp_Object tip_frame;
-
-/* If non-nil, a timer started that hides the last tooltip when it
-   fires.  */
-
-Lisp_Object tip_timer;
-Window tip_window;
-
-/* If non-nil, a vector of 3 elements containing the last args
-   with which x-show-tip was called.  See there.  */
-
-Lisp_Object last_show_tip_args;
-
-
-static void
-unwind_create_tip_frame (Lisp_Object frame)
-{
-  Lisp_Object deleted;
-
-  deleted = unwind_create_frame (frame);
-  if (EQ (deleted, Qt))
-    {
-      tip_window = NULL;
-      tip_frame = Qnil;
-    }
-}
-
-
 /* Create a frame for a tooltip on the display described by DPYINFO.
    PARMS is a list of frame parameters.  Value is the frame.
 
@@ -6543,7 +6524,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
   f->wants_modeline = false;
   XSETFRAME (frame, f);
 
-  record_unwind_protect (unwind_create_tip_frame, frame);
+  record_unwind_protect (do_unwind_create_frame, frame);
 
   /* By setting the output method, we're essentially saying that
      the frame is live, as per FRAME_LIVE_P.  If we get a signal
@@ -6555,6 +6536,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
 
   FRAME_FONTSET (f)  = -1;
   fset_icon_name (f, Qnil);
+  f->tooltip = true;
 
 #ifdef GLYPH_DEBUG
   image_cache_refcount =
@@ -6663,11 +6645,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
   height = FRAME_LINES (f);
   SET_FRAME_COLS (f, 0);
   SET_FRAME_LINES (f, 0);
-  adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
-                    height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
-  /* Add `tooltip' frame parameter's default value. */
-  if (NILP (Fframe_parameter (frame, Qtooltip)))
-    Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
+  change_frame_size (f, width, height, true, false, false, false);
 
   /* Set up faces after all frame parameters are known.  This call
      also merges in face attributes specified for new frames.
@@ -6695,6 +6673,9 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
 
   f->no_split = true;
 
+  /* Now this is an official tooltip frame on this display.  */
+  dpyinfo->w32_tooltip_frame = f;
+
   /* Now that the frame is official, it counts as a reference to
      its display.  */
   FRAME_DISPLAY_INFO (f)->reference_count++;
@@ -6813,46 +6794,39 @@ compute_tip_xy (struct frame *f,
     *root_x = min_x;
 }
 
-/* Hide tooltip.  Delete its frame if DELETE is true.  */
+/* Hide tooltip frame F and delete it if DELETE is true.  */
+
 static Lisp_Object
-x_hide_tip (bool delete)
+x_hide_tip (struct frame *f, bool delete)
 {
-  if (!NILP (tip_timer))
+  if (f)
     {
-      call1 (Qcancel_timer, tip_timer);
-      tip_timer = Qnil;
-    }
+      Lisp_Object frame, timer;
 
-  if (NILP (tip_frame)
-      || (!delete && FRAMEP (tip_frame)
-         && !FRAME_VISIBLE_P (XFRAME (tip_frame))))
-    return Qnil;
-  else
-    {
-      ptrdiff_t count;
-      Lisp_Object was_open = Qnil;
+      XSETFRAME (frame, f);
+      timer = Fframe_parameter (frame, Qtooltip_timer);
 
-      count = SPECPDL_INDEX ();
-      specbind (Qinhibit_redisplay, Qt);
-      specbind (Qinhibit_quit, Qt);
+      if (!NILP (timer))
+       call1 (Qcancel_timer, timer);
 
-      if (FRAMEP (tip_frame))
+      if (!delete && !FRAME_VISIBLE_P (f))
+       return Qnil;
+      else
        {
+         ptrdiff_t count = SPECPDL_INDEX ();
+
+         specbind (Qinhibit_redisplay, Qt);
+         specbind (Qinhibit_quit, Qt);
+
          if (delete)
-           {
-             delete_frame (tip_frame, Qnil);
-             tip_frame = Qnil;
-           }
+           delete_frame (frame, Qnil);
          else
-           x_make_frame_invisible (XFRAME (tip_frame));
+           x_make_frame_invisible (f);
 
-         was_open = Qt;
+         return unbind_to (count, Qt);
        }
-      else
-       tip_frame = Qnil;
-
-      return unbind_to (count, was_open);
     }
+  return Qnil;
 }
 
 
@@ -6886,7 +6860,8 @@ with offset DY added (default is -10).
 
 A tooltip's maximum size is specified by `x-max-tooltip-size'.
 Text larger than the specified size is clipped.  */)
-  (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
+  (Lisp_Object string, Lisp_Object frame, Lisp_Object parms,
+   Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
 {
   struct frame *tip_f;
   struct window *w;
@@ -6897,7 +6872,8 @@ Text larger than the specified size is clipped.  */)
   int old_windows_or_buffers_changed = windows_or_buffers_changed;
   ptrdiff_t count = SPECPDL_INDEX ();
   ptrdiff_t count_1;
-  Lisp_Object window, size;
+  Lisp_Object window, size, tip_frame, parameters;
+  AUTO_STRING (tip, " *tip*");
 
   specbind (Qinhibit_redisplay, Qt);
 
@@ -6918,14 +6894,22 @@ Text larger than the specified size is clipped.  */)
   else
     CHECK_NUMBER (dy);
 
-  if (NILP (last_show_tip_args))
-    last_show_tip_args = Fmake_vector (make_number (3), Qnil);
+  parameters = Fframe_parameter (frame, Qtooltip_parameters);
+  if (NILP (parameters))
+    parameters = Fmake_vector (make_number (3), Qnil);
+
+  /* Look at current tooltip frame, if any.  */
+  tip_f = FRAME_DISPLAY_INFO (XFRAME (frame))->w32_tooltip_frame;
+  if (tip_f)
+    XSETFRAME (tip_frame, tip_f);
+  else
+    tip_frame = Qnil;
 
-  if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
+  if (tip_f && FRAME_LIVE_P (tip_f))
     {
-      Lisp_Object last_string = AREF (last_show_tip_args, 0);
-      Lisp_Object last_frame = AREF (last_show_tip_args, 1);
-      Lisp_Object last_parms = AREF (last_show_tip_args, 2);
+      Lisp_Object last_string = AREF (parameters, 0);
+      Lisp_Object last_frame = AREF (parameters, 1);
+      Lisp_Object last_parms = AREF (parameters, 2);
 
       if (FRAME_VISIBLE_P (XFRAME (tip_frame))
          && EQ (frame, last_frame)
@@ -6933,14 +6917,10 @@ Text larger than the specified size is clipped.  */)
          && !NILP (Fequal (last_parms, parms)))
        {
          /* Only DX and DY have changed.  */
-         tip_f = XFRAME (tip_frame);
-         if (!NILP (tip_timer))
-           {
-             Lisp_Object timer = tip_timer;
+         Lisp_Object timer = Fframe_parameter (tip_frame, Qtooltip_timer);
 
-             tip_timer = Qnil;
-             call1 (Qcancel_timer, timer);
-           }
+         if (!NILP (timer))
+           call1 (Qcancel_timer, timer);
 
          block_input ();
          compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
@@ -7010,17 +6990,22 @@ Text larger than the specified size is clipped.  */)
                }
            }
 
-         x_hide_tip (delete);
+         x_hide_tip (tip_f, delete);
        }
       else
-       x_hide_tip (true);
+       x_hide_tip (tip_f, true);
     }
   else
-    x_hide_tip (true);
+    x_hide_tip (tip_f, true);
 
-  ASET (last_show_tip_args, 0, string);
-  ASET (last_show_tip_args, 1, frame);
-  ASET (last_show_tip_args, 2, parms);
+  /* Update tooltip parameters.  */
+  {
+    AUTO_FRAME_ARG (arg, Qtooltip_parameters, parameters);
+    ASET (parameters, 0, string);
+    ASET (parameters, 1, frame);
+    ASET (parameters, 2, parms);
+    Fmodify_frame_parameters (frame, arg);
+  }
 
   /* Block input until the tip has been fully drawn, to avoid crashes
      when drawing tips in menus.  */
@@ -7040,10 +7025,8 @@ Text larger than the specified size is clipped.  */)
       if (NILP (Fassq (Qbackground_color, parms)))
        parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
                       parms);
-
-      /* Create a frame for the tooltip, and record it in the global
-        variable tip_frame.  */
-      if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms)))
+      if (NILP (tip_frame
+               = x_create_tip_frame (FRAME_DISPLAY_INFO (XFRAME (frame)), parms)))
        {
          /* Creating the tip frame failed.  */
          unblock_input ();
@@ -7053,7 +7036,6 @@ Text larger than the specified size is clipped.  */)
 
   tip_f = XFRAME (tip_frame);
   window = FRAME_ROOT_WINDOW (tip_f);
-  AUTO_STRING (tip, " *tip*");
   set_window_buffer (window, Fget_buffer_create (tip), false, false);
   w = XWINDOW (window);
   w->pseudo_window_p = true;
@@ -7148,20 +7130,47 @@ Text larger than the specified size is clipped.  */)
   windows_or_buffers_changed = old_windows_or_buffers_changed;
 
  start_timer:
-  /* Let the tip disappear after timeout seconds.  */
-  tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
-                    intern ("x-hide-tip"));
-
+  {
+    /* Let the tip disappear after timeout seconds.  */
+    AUTO_FRAME_ARG (arg, Qtooltip_timer,
+                   call3 (intern ("run-at-time"), timeout,
+                          Qnil, intern ("x-hide-tip")));
+    Fmodify_frame_parameters (tip_frame, arg);
+  }
   return unbind_to (count, Qnil);
 }
 
 
-DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
+DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 1, 0,
        doc: /* Hide the current tooltip window, if there is any.
+Optional FRAME is the frame to hide tooltip on.
 Value is t if tooltip was open, nil otherwise.  */)
-  (void)
+  (Lisp_Object frame)
 {
-  return x_hide_tip (!tooltip_reuse_hidden_frame);
+  Lisp_Object obj = Qnil;
+
+  if (NILP (frame))
+    {
+      struct w32_display_info *dpyinfo;
+
+      for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+       if (dpyinfo->w32_tooltip_frame)
+         if (!NILP (x_hide_tip (dpyinfo->w32_tooltip_frame,
+                                !tooltip_reuse_hidden_frame)))
+           obj = Qt;
+    }
+  else
+    {
+      struct frame *f;
+
+      CHECK_FRAME (frame);
+      f = XFRAME (frame);
+      if (FRAME_DISPLAY_INFO (f)
+         && FRAME_DISPLAY_INFO (f)->w32_tooltip_frame)
+       obj = x_hide_tip (FRAME_DISPLAY_INFO (f)->w32_tooltip_frame,
+                         !tooltip_reuse_hidden_frame);
+    }
+  return obj;
 }
 \f
 /***********************************************************************
@@ -7288,7 +7297,9 @@ value of DIR as in previous invocations; this is standard Windows behavior.  */)
 {
   /* Filter index: 1: All Files, 2: Directories only  */
   static const wchar_t filter_w[] = L"All Files (*.*)\0*.*\0Directories\0*|*\0";
+#ifndef NTGUI_UNICODE
   static const char filter_a[] = "All Files (*.*)\0*.*\0Directories\0*|*\0";
+#endif
 
   Lisp_Object filename = default_filename;
   struct frame *f = SELECTED_FRAME ();
@@ -8962,7 +8973,7 @@ w32_strerror (int error_no)
       --ret;
   buf[ret] = '\0';
   if (!ret)
-    sprintf (buf, "w32 error %u", error_no);
+    sprintf (buf, "w32 error %d", error_no);
 
   return buf;
 }
@@ -9762,7 +9773,6 @@ syms_of_w32fns (void)
   DEFSYM (Qworkarea, "workarea");
   DEFSYM (Qmm_size, "mm-size");
   DEFSYM (Qframes, "frames");
-  DEFSYM (Qtip_frame, "tip-frame");
   DEFSYM (Qassq_delete_all, "assq-delete-all");
   DEFSYM (Qunicode_sip, "unicode-sip");
 #if defined WINDOWSNT && !defined HAVE_DBUS
@@ -10148,13 +10158,6 @@ tip frame.  */);
   defsubr (&Sset_message_beep);
   defsubr (&Sx_show_tip);
   defsubr (&Sx_hide_tip);
-  tip_timer = Qnil;
-  staticpro (&tip_timer);
-  tip_frame = Qnil;
-  staticpro (&tip_frame);
-
-  last_show_tip_args = Qnil;
-  staticpro (&last_show_tip_args);
 
   defsubr (&Sx_file_dialog);
 #ifdef WINDOWSNT
@@ -10331,8 +10334,8 @@ emacs_abort (void)
               but not on Windows 7.  addr2line doesn't mind a missing
               "0x", but will be confused by an extra one.  */
            if (except_addr)
-             sprintf (buf, "\r\nException 0x%lx at this address:\r\n%p\r\n",
-                      except_code, except_addr);
+             sprintf (buf, "\r\nException 0x%x at this address:\r\n%p\r\n",
+                      (unsigned int) except_code, except_addr);
            if (stderr_fd >= 0)
              {
                if (except_addr)