]> code.delx.au - gnu-emacs/blobdiff - src/w32fns.c
(print_error_message): Print data of `end-of-file'
[gnu-emacs] / src / w32fns.c
index 21d80af05726a727e2ba51703cd8bb640bf6b58e..ad914f44a4ce299f07f529be97dc040fe9137dfe 100644 (file)
@@ -30,12 +30,12 @@ Boston, MA 02111-1307, USA.  */
 
 #include "lisp.h"
 #include "charset.h"
-#include "fontset.h"
 #include "w32term.h"
 #include "frame.h"
 #include "window.h"
 #include "buffer.h"
 #include "dispextern.h"
+#include "fontset.h"
 #include "intervals.h"
 #include "keyboard.h"
 #include "blockinput.h"
@@ -124,7 +124,7 @@ Lisp_Object Vw32_enable_caps_lock;
 /* Modifier associated with Scroll Lock, or nil to act as a normal key.  */
 Lisp_Object Vw32_scroll_lock_modifier;
 
-/* Switch to control whether we inhibit requests for synthesyzed bold
+/* Switch to control whether we inhibit requests for synthesized bold
    and italic versions of fonts.  */
 Lisp_Object Vw32_enable_synthesized_fonts;
 
@@ -378,6 +378,10 @@ x_window_to_frame (dpyinfo, wdesc)
       f = XFRAME (frame);
       if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
        continue;
+      if (f->output_data.w32->busy_window == wdesc)
+        return f;
+
+      /* NTEMACS_TODO: Check tooltips when supported.  */
       if (FRAME_W32_WINDOW (f) == wdesc)
         return f;
     }
@@ -1781,18 +1785,21 @@ w32_defined_color (f, color, color_def, alloc)
 
   if (!NILP (tem)) 
     {
-      /* Apply gamma correction.  */
-      w32_color_ref = XUINT (tem);
-      gamma_correct (f, &w32_color_ref);
-      XSETINT (tem, w32_color_ref);
+      if (f)
+        {
+          /* Apply gamma correction.  */
+          w32_color_ref = XUINT (tem);
+          gamma_correct (f, &w32_color_ref);
+          XSETINT (tem, w32_color_ref);
+        }
 
       /* Map this color to the palette if it is enabled. */
       if (!NILP (Vw32_enable_palette))
        {
          struct w32_palette_entry * entry =
-           FRAME_W32_DISPLAY_INFO (f)->color_list;
+           one_w32_display_info.color_list;
          struct w32_palette_entry ** prev =
-           &FRAME_W32_DISPLAY_INFO (f)->color_list;
+           &one_w32_display_info.color_list;
       
          /* check if color is already mapped */
          while (entry)
@@ -1811,10 +1818,10 @@ w32_defined_color (f, color, color_def, alloc)
              SET_W32_COLOR (entry->entry, XUINT (tem));
              entry->next = NULL;
              *prev = entry;
-             FRAME_W32_DISPLAY_INFO (f)->num_colors++;
+             one_w32_display_info.num_colors++;
 
              /* set flag that palette must be regenerated */
-             FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
+             one_w32_display_info.regen_palette = TRUE;
            }
        }
       /* Ensure COLORREF value is snapped to nearest color in (default)
@@ -4209,7 +4216,7 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
         are used together, but only if user has two button mouse. */
     case WM_LBUTTONDOWN:
     case WM_RBUTTONDOWN:
-      if (XINT (Vw32_num_mouse_buttons) == 3)
+      if (XINT (Vw32_num_mouse_buttons) > 2)
        goto handle_plain_button;
 
       {
@@ -4272,7 +4279,7 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
 
     case WM_LBUTTONUP:
     case WM_RBUTTONUP:
-      if (XINT (Vw32_num_mouse_buttons) == 3)
+      if (XINT (Vw32_num_mouse_buttons) > 2)
        goto handle_plain_button;
 
       {
@@ -4464,6 +4471,11 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
        f->output_data.w32->menubar_active = 0;
       goto dflt;
 
+    case WM_MENUSELECT:
+      wmsg.dwModifiers = w32_get_modifiers ();
+      my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+      return 0;
+
     case WM_MEASUREITEM:
       f = x_window_to_frame (dpyinfo, hwnd);
       if (f)
@@ -5031,10 +5043,6 @@ This function is an internal primitive--use `make-frame' instead.")
       specbind (Qx_resource_name, name);
     }
 
-  /* Create fontsets from `global_fontset_alist' before handling fonts.  */
-  for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
-    fs_register_fontset (f, XCAR (tem));
-
   /* Extract the window parameters from the supplied values
      that are needed to determine window geometry.  */
   {
@@ -5343,7 +5351,7 @@ w32_load_system_font (f,fontname,size)
         lf.lfItalic = font->tm.tmItalic;
         lf.lfCharSet = font->tm.tmCharSet;
         lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
-                               ? FIXED_PITCH : VARIABLE_PITCH);
+                               ? VARIABLE_PITCH : FIXED_PITCH);
         lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
                              ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
       }
@@ -5399,9 +5407,9 @@ w32_load_system_font (f,fontname,size)
 
     /* The slot `encoding' specifies how to map a character
        code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
-       the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
-       the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
-       0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
+       the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
+       (0:0x20..0x7F, 1:0xA0..0xFF,
+       (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
        2:0xA020..0xFF7F).  For the moment, we don't know which charset
        uses this font.  So, we set information in fontp->encoding[1]
        which is never used by any charset.  If mapping can't be
@@ -5709,8 +5717,8 @@ w32_to_x_font (lplogfont, lpxstr, len)
   char height_dpi[8];
   char width_pixels[8];
   char *fontname_dash;
-  int display_resy = one_w32_display_info.height_in;
-  int display_resx = one_w32_display_info.width_in;
+  int display_resy = one_w32_display_info.resy;
+  int display_resx = one_w32_display_info.resx;
   int bufsz;
   struct coding_system coding;
 
@@ -5894,7 +5902,7 @@ x_to_w32_font (lpxstr, lplogfont)
       fields--;
 
       /* Strip the trailing '-' if present. (it shouldn't be, as it
-         fails the test against xlfn-tight-regexp in fontset.el).  */
+         fails the test against xlfd-tight-regexp in fontset.el).  */
       {
        int len = strlen (remainder);
        if (len > 0 && remainder[len-1] == '-')
@@ -5947,6 +5955,125 @@ x_to_w32_font (lpxstr, lplogfont)
   return (TRUE);
 }
 
+/* Strip the pixel height and point height from the given xlfd, and
+   return the pixel height. If no pixel height is specified, calculate
+   one from the point height, or if that isn't defined either, return
+   0 (which usually signifies a scalable font).
+*/
+int xlfd_strip_height (char *fontname)
+{
+  int pixel_height, point_height, dpi, field_number;
+  char *read_from, *write_to;
+
+  xassert (fontname);
+
+  pixel_height = field_number = 0;
+  write_to = NULL;
+
+  /* Look for height fields.  */
+  for (read_from = fontname; *read_from; read_from++)
+    {
+      if (*read_from == '-')
+        {
+          field_number++;
+          if (field_number == 7) /* Pixel height.  */
+            {
+              read_from++;
+              write_to = read_from;
+
+              /* Find end of field.  */
+              for (;*read_from && *read_from != '-'; read_from++)
+                ;
+
+              /* Split the fontname at end of field.  */
+              if (*read_from)
+                {
+                  *read_from = '\0';
+                  read_from++;
+                }
+              pixel_height = atoi (write_to);
+              /* Blank out field. */
+              if (read_from > write_to)
+                {
+                  *write_to = '-';
+                  write_to++;
+                }
+              /* If the pixel height field is at the end (partial xfld),
+                 return now.  */
+              else
+                return pixel_height;
+
+              /* If we got a pixel height, the point height can be
+                 ignored. Just blank it out and break now.  */
+              if (pixel_height)
+                {
+                  /* Find end of point size field.  */
+                  for (; *read_from && *read_from != '-'; read_from++)
+                    ;
+
+                  if (*read_from)
+                    read_from++;
+
+                  /* Blank out the point size field.  */
+                  if (read_from > write_to)
+                    {
+                      *write_to = '-';
+                      write_to++;
+                    }
+                  else
+                    return pixel_height;
+
+                  break;
+                }
+              /* If the point height is already blank, break now.  */
+              if (*read_from == '-')
+                {
+                  read_from++;
+                  break;
+                }
+            }
+          else if (field_number == 8)
+            {
+              /* If we didn't get a pixel height, try to get the point
+                 height and convert that.  */
+              int point_size;
+              char *point_size_start = read_from++;
+
+              /* Find end of field.  */
+              for (; *read_from && *read_from != '-'; read_from++)
+                ;
+
+              if (*read_from)
+                {
+                  *read_from = '\0';
+                  read_from++;
+                }
+
+              point_size = atoi (point_size_start);
+
+              /* Convert to pixel height. */
+              pixel_height = point_size
+                           * one_w32_display_info.height_in / 720;
+
+              /* Blank out this field and break.  */
+              *write_to = '-';
+              write_to++;
+              break;
+            }
+        }
+    }
+
+  /* Shift the rest of the font spec into place.  */
+  if (write_to && read_from > write_to)
+    {
+      for (; *read_from; read_from++, write_to++)
+        *write_to = *read_from;
+      *write_to = '\0';
+    }
+
+  return pixel_height;
+}
+
 /* Assume parameter 1 is fully qualified, no wildcards. */
 BOOL 
 w32_font_match (fontname, pattern)
@@ -5954,8 +6081,12 @@ w32_font_match (fontname, pattern)
     char * pattern;
 {
   char *regex = alloca (strlen (pattern) * 2);
+  char *font_name_copy = alloca (strlen (fontname) + 1);
   char *ptr;
 
+  /* Copy fontname so we can modify it during comparison.  */
+  strcpy (font_name_copy, fontname);
+
   ptr = regex;
   *ptr++ = '^';
 
@@ -5975,8 +6106,25 @@ w32_font_match (fontname, pattern)
   *ptr = '$';
   *(ptr + 1) = '\0';
 
+  /* Strip out font heights and compare them seperately, since
+     rounding error can cause mismatches. This also allows a
+     comparison between a font that declares only a pixel height and a
+     pattern that declares the point height.
+  */
+  {
+    int font_height, pattern_height;
+
+    font_height = xlfd_strip_height (font_name_copy);
+    pattern_height = xlfd_strip_height (regex);
+
+    /* Compare now, and don't bother doing expensive regexp matching
+       if the heights differ.  */
+    if (font_height && pattern_height && (font_height != pattern_height))
+      return FALSE;
+  }
+
   return (fast_c_string_match_ignore_case (build_string (regex),
-                                           fontname) >= 0);
+                                           font_name_copy) >= 0);
 }
 
 /* Callback functions, and a structure holding info they need, for
@@ -6982,9 +7130,9 @@ If DISPLAY is nil, that stands for the selected frame's display.")
   for (i = 0; i < dpyinfo->n_fonts; i++)
     if (dpyinfo->font_table[i].name)
       {
+        if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
+          xfree (dpyinfo->font_table[i].full_name);
         xfree (dpyinfo->font_table[i].name);
-        /* Don't free the full_name string;
-           it is always shared with something else.  */
         w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
       }
   x_destroy_all_bitmaps (dpyinfo);
@@ -7053,7 +7201,7 @@ Lisp_Object Qxbm;
 
 /* Keywords.  */
 
-Lisp_Object QCtype, QCdata, QCascent, QCmargin, QCrelief;
+Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
 Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
 extern Lisp_Object QCindex;
@@ -11454,109 +11602,156 @@ value.")
                                Busy cursor
  ***********************************************************************/
 
-/* The implementation partly follows a patch from
-   F.Pierresteguy@frcl.bull.fr dated 1994.  */
+/* If non-null, an asynchronous timer that, when it expires, displays
+   a busy cursor on all frames.  */
 
-/* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
-   the next X event is read and we enter XTread_socket again.  Setting
-   it to 1 inhibits busy-cursor display for direct commands.  */
+static struct atimer *busy_cursor_atimer;
 
-int inhibit_busy_cursor;
+/* Non-zero means a busy cursor is currently shown.  */
 
-/* Incremented with each call to x-display-busy-cursor.
-   Decremented in x-undisplay-busy-cursor.  */
+static int busy_cursor_shown_p;
 
-static int busy_count;
+/* Number of seconds to wait before displaying a busy cursor.  */
 
+static Lisp_Object Vbusy_cursor_delay;
 
-DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor,
-       Sx_show_busy_cursor, 0, 0, 0,
-  "Show a busy cursor, if not already shown.\n\
-Each call to this function must be matched by a call to\n\
-x-undisplay-busy-cursor to make the busy pointer disappear again.")
-  ()
+/* Default number of seconds to wait before displaying a busy
+   cursor.  */
+
+#define DEFAULT_BUSY_CURSOR_DELAY 1
+
+/* Function prototypes.  */
+
+static void show_busy_cursor P_ ((struct atimer *));
+static void hide_busy_cursor P_ ((void));
+
+
+/* Cancel a currently active busy-cursor timer, and start a new one.  */
+
+void
+start_busy_cursor ()
+{
+#if 0 /* NTEMACS_TODO: cursor shape changes.  */
+  EMACS_TIME delay;
+  int secs;
+  
+  cancel_busy_cursor ();
+
+  if (INTEGERP (Vbusy_cursor_delay)
+      && XINT (Vbusy_cursor_delay) > 0)
+    secs = XFASTINT (Vbusy_cursor_delay);
+  else
+    secs = DEFAULT_BUSY_CURSOR_DELAY;
+  
+  EMACS_SET_SECS_USECS (delay, secs, 0);
+  busy_cursor_atimer = start_atimer (ATIMER_RELATIVE, delay,
+                                    show_busy_cursor, NULL);
+#endif
+}
+
+
+/* Cancel the busy cursor timer if active, hide a busy cursor if
+   shown.  */
+
+void
+cancel_busy_cursor ()
+{
+  if (busy_cursor_atimer)
+    cancel_atimer (busy_cursor_atimer);
+  if (busy_cursor_shown_p)
+    hide_busy_cursor ();
+}
+
+
+/* Timer function of busy_cursor_atimer.  TIMER is equal to
+   busy_cursor_atimer.
+
+   Display a busy cursor on all frames by mapping the frames'
+   busy_window.  Set the busy_p flag in the frames' output_data.x
+   structure to indicate that a busy cursor is shown on the
+   frames.  */
+
+static void
+show_busy_cursor (timer)
+     struct atimer *timer;
 {
-  ++busy_count;
-  if (busy_count == 1)
+#if 0  /* NTEMACS_TODO: cursor shape changes.  */
+  /* The timer implementation will cancel this timer automatically
+     after this function has run.  Set busy_cursor_atimer to null
+     so that we know the timer doesn't have to be canceled.  */
+  busy_cursor_atimer = NULL;
+
+  if (!busy_cursor_shown_p)
     {
       Lisp_Object rest, frame;
-
+  
+      BLOCK_INPUT;
+  
       FOR_EACH_FRAME (rest, frame)
        if (FRAME_X_P (XFRAME (frame)))
          {
            struct frame *f = XFRAME (frame);
-#if 0 /* NTEMACS_TODO : busy cursor */
-           
-           BLOCK_INPUT;
+       
            f->output_data.w32->busy_p = 1;
-           
+       
            if (!f->output_data.w32->busy_window)
              {
                unsigned long mask = CWCursor;
                XSetWindowAttributes attrs;
-
+           
                attrs.cursor = f->output_data.w32->busy_cursor;
+           
                f->output_data.w32->busy_window
-                 = XCreateWindow (FRAME_W32_DISPLAY (f),
+                 = XCreateWindow (FRAME_X_DISPLAY (f),
                                   FRAME_OUTER_WINDOW (f),
                                   0, 0, 32000, 32000, 0, 0,
-                                  InputOnly, CopyFromParent,
+                                  InputOnly,
+                                  CopyFromParent,
                                   mask, &attrs);
              }
-
-           XMapRaised (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
-           UNBLOCK_INPUT;
-#endif
+       
+           XMapRaised (FRAME_X_DISPLAY (f), f->output_data.w32->busy_window);
+           XFlush (FRAME_X_DISPLAY (f));
          }
-    }
 
-  return Qnil;
+      busy_cursor_shown_p = 1;
+      UNBLOCK_INPUT;
+    }
+#endif
 }
 
 
-DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor,
-       Sx_hide_busy_cursor, 0, 1, 0,
-  "Hide a busy-cursor.\n\
-A busy-cursor will actually be undisplayed when a matching\n\
-`x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
-issued.  FORCE non-nil means undisplay the busy-cursor forcibly,\n\
-not counting calls.")
-  (force)
-     Lisp_Object force;
-{
-  Lisp_Object rest, frame;
-
-  if (busy_count == 0)
-    return Qnil;
-
-  if (!NILP (force) && busy_count != 0)
-    busy_count = 1;
-
-  --busy_count;
-  if (busy_count != 0)
-    return Qnil;
+/* Hide the busy cursor on all frames, if it is currently shown.  */
 
-  FOR_EACH_FRAME (rest, frame)
+static void
+hide_busy_cursor ()
+{
+#if 0 /* NTEMACS_TODO: cursor shape changes.  */
+  if (busy_cursor_shown_p)
     {
-      struct frame *f = XFRAME (frame);
-      
-      if (FRAME_X_P (f)
-         /* Watch out for newly created frames.  */
-         && f->output_data.w32->busy_window)
+      Lisp_Object rest, frame;
+
+      BLOCK_INPUT;
+      FOR_EACH_FRAME (rest, frame)
        {
-#if 0 /* NTEMACS_TODO : busy cursor */   
-         BLOCK_INPUT;
-         XUnmapWindow (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
-         /* Sync here because XTread_socket looks at the busy_p flag
-            that is reset to zero below.  */
-         XSync (FRAME_W32_DISPLAY (f), False);
-         UNBLOCK_INPUT;
-         f->output_data.w32->busy_p = 0;
-#endif
+         struct frame *f = XFRAME (frame);
+      
+         if (FRAME_X_P (f)
+             /* Watch out for newly created frames.  */
+             && f->output_data.x->busy_window)
+           {
+             XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
+             /* Sync here because XTread_socket looks at the busy_p flag
+                that is reset to zero below.  */
+             XSync (FRAME_X_DISPLAY (f), False);
+             f->output_data.x->busy_p = 0;
+           }
        }
-    }
 
-  return Qnil;
+      busy_cursor_shown_p = 0;
+      UNBLOCK_INPUT;
+    }
+#endif
 }
 
 
@@ -11622,7 +11817,7 @@ x_create_tip_frame (dpyinfo, parms)
   XSETFRAME (frame, f);
   FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
 
-  f->output_method = output_x_window;
+  f->output_method = output_w32;
   f->output_data.w32 =
     (struct w32_output *) xmalloc (sizeof (struct w32_output));
   bzero (f->output_data.w32, sizeof (struct w32_output));
@@ -11653,10 +11848,6 @@ x_create_tip_frame (dpyinfo, parms)
       specbind (Qx_resource_name, name);
     }
 
-  /* Create fontsets from `global_fontset_alist' before handling fonts.  */
-  for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
-    fs_register_fontset (f, XCAR (tem));
-
   /* Extract the window parameters from the supplied values
      that are needed to determine window geometry.  */
   {
@@ -12721,6 +12912,11 @@ or when you set the mouse color.");
     "Non-zero means Emacs displays a busy cursor on window systems.");
   display_busy_cursor_p = 1;
   
+  DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay,
+     "*Seconds to wait before displaying a busy-cursor.\n\
+Value must be an integer.");
+  Vbusy_cursor_delay = make_number (DEFAULT_BUSY_CURSOR_DELAY);
+
   DEFVAR_LISP ("x-sensitive-text-pointer-shape",
              &Vx_sensitive_text_pointer_shape,
              "The shape of the pointer when over mouse-sensitive text.\n\
@@ -12861,8 +13057,6 @@ only be necessary if the default setting causes problems.");
   staticpro (&QCheuristic_mask);
   QCcolor_symbols = intern (":color-symbols");
   staticpro (&QCcolor_symbols);
-  QCdata = intern (":data");
-  staticpro (&QCdata);
   QCascent = intern (":ascent");
   staticpro (&QCascent);
   QCmargin = intern (":margin");
@@ -12917,12 +13111,6 @@ only be necessary if the default setting causes problems.");
 #endif
 #endif /* NTEMACS_TODO */
 
-  /* Busy-cursor.  */
-  defsubr (&Sx_show_busy_cursor);
-  defsubr (&Sx_hide_busy_cursor);
-  busy_count = 0;
-  inhibit_busy_cursor = 0;
-
   defsubr (&Sx_show_tip);
   defsubr (&Sx_hide_tip);
   staticpro (&tip_timer);