Merge from emacs--devo--0
[bpt/emacs.git] / src / w32fns.c
index 96fa937..5a93862 100644 (file)
@@ -1,6 +1,6 @@
 /* Graphical user interface functions for the Microsoft W32 API.
    Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-                 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+                 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -29,22 +29,23 @@ Boston, MA 02110-1301, USA.  */
 #include <errno.h>
 
 #include "lisp.h"
-#include "charset.h"
-#include "dispextern.h"
 #include "w32term.h"
-#include "keyboard.h"
 #include "frame.h"
 #include "window.h"
 #include "buffer.h"
-#include "fontset.h"
 #include "intervals.h"
+#include "dispextern.h"
+#include "keyboard.h"
 #include "blockinput.h"
 #include "epaths.h"
-#include "w32heap.h"
-#include "termhooks.h"
+#include "character.h"
+#include "charset.h"
 #include "coding.h"
 #include "ccl.h"
+#include "fontset.h"
 #include "systime.h"
+#include "termhooks.h"
+#include "w32heap.h"
 
 #include "bitmaps/gray.xbm"
 
@@ -297,6 +298,10 @@ extern int w32_use_visible_system_caret;
 
 static HWND w32_visible_system_caret_hwnd;
 
+/* From w32menu.c  */
+extern HMENU current_popup_menu;
+static int menubar_in_use = 0;
+
 \f
 /* Error if we are not connected to MS-Windows.  */
 void
@@ -3411,11 +3416,14 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
          KillTimer (hwnd, menu_free_timer);
          menu_free_timer = 0;
          f = x_window_to_frame (dpyinfo, hwnd);
-         if (!f->output_data.w32->menu_command_in_progress)
+          /* If a popup menu is active, don't wipe its strings.  */
+         if (menubar_in_use
+              && current_popup_menu == NULL)
            {
              /* Free memory used by owner-drawn and help-echo strings.  */
              w32_free_menu_strings (hwnd);
              f->output_data.w32->menubar_active = 0;
+              menubar_in_use = 0;
            }
        }
       return 0;
@@ -3467,16 +3475,21 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
        if (find_deferred_msg (hwnd, msg) != NULL)
          abort ();
 
+        menubar_in_use = 1;
+
        return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
       }
 
     case WM_EXITMENULOOP:
       f = x_window_to_frame (dpyinfo, hwnd);
 
-      /* If a menu command is not already in progress, check again
-        after a short delay, since Windows often (always?) sends the
-        WM_EXITMENULOOP before the corresponding WM_COMMAND message.  */
-      if (f && !f->output_data.w32->menu_command_in_progress)
+      /* If a menu is still active, check again after a short delay,
+        since Windows often (always?) sends the WM_EXITMENULOOP
+        before the corresponding WM_COMMAND message.
+         Don't do this if a popup menu is active, since it is only
+         menubar menus that require cleaning up in this way.
+      */
+      if (f && menubar_in_use && current_popup_menu == NULL)
        menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
       goto dflt;
 
@@ -3631,10 +3644,10 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
        }
       goto command;
     case WM_COMMAND:
+      menubar_in_use = 0;
       f = x_window_to_frame (dpyinfo, hwnd);
       if (f && HIWORD (wParam) == 0)
        {
-         f->output_data.w32->menu_command_in_progress = 1;
          if (menu_free_timer)
            {
              KillTimer (hwnd, menu_free_timer);
@@ -4261,7 +4274,7 @@ This function is an internal primitive--use `make-frame' instead.  */)
       {
         tem = Fquery_fontset (font, Qnil);
         if (STRINGP (tem))
-          font = x_new_fontset (f, SDATA (tem));
+          font = x_new_fontset (f, tem);
         else
           font = x_new_font (f, SDATA (font));
       }
@@ -4659,6 +4672,8 @@ w32_load_system_font (f,fontname,size)
        fontp->average_width = font->tm.tmAveCharWidth;
       }
 
+
+    fontp->charset = -1;
     charset = xlfd_charset_of_font (fontname);
 
   /* Cache the W32 codepage for a font.  This makes w32_encode_char
@@ -4685,7 +4700,7 @@ w32_load_system_font (f,fontname,size)
        (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]
+       uses this font.  So, we set information in fontp->encoding_type
        which is never used by any charset.  If mapping can't be
        decided, set FONT_ENCODING_NOT_DECIDED.  */
 
@@ -4693,9 +4708,9 @@ w32_load_system_font (f,fontname,size)
        type FONT_ENCODING_NOT_DECIDED.  */
     encoding = strrchr (fontp->name, '-');
     if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
-      fontp->encoding[1] = 4;
+      fontp->encoding_type = 4;
     else
-      fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
+      fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
 
     /* The following three values are set to 0 under W32, which is
        what they get set to if XGetFontProperty fails under X.  */
@@ -4849,12 +4864,16 @@ x_to_w32_charset (lpcs)
   if (strncmp (lpcs, "*-#", 3) == 0)
     return atoi (lpcs + 3);
 
+  /* All Windows fonts qualify as unicode.  */
+  if (!strncmp (lpcs, "iso10646", 8))
+    return DEFAULT_CHARSET;
+
   /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5".  */
   charset = alloca (len + 1);
   strcpy (charset, lpcs);
   lpcs = strchr (charset, '*');
   if (lpcs)
-    *lpcs = 0;
+    *lpcs = '\0';
 
   /* Look through w32-charset-info-alist for the character set.
      Format of each entry is
@@ -4922,11 +4941,26 @@ x_to_w32_charset (lpcs)
 
 
 static char *
-w32_to_x_charset (fncharset)
+w32_to_x_charset (fncharset, matching)
     int fncharset;
+    char *matching;
 {
   static char buf[32];
   Lisp_Object charset_type;
+  int match_len = 0;
+
+  if (matching)
+    {
+      /* If fully specified, accept it as it is.  Otherwise use a
+        substring match. */
+      char *wildcard = strchr (matching, '*');
+      if (wildcard)
+       *wildcard = '\0';
+      else if (strchr (matching, '-'))
+       return matching;
+
+      match_len = strlen (matching);
+    }
 
   switch (fncharset)
     {
@@ -5011,6 +5045,7 @@ w32_to_x_charset (fncharset)
   {
     Lisp_Object rest;
     char * best_match = NULL;
+    int matching_found = 0;
 
     /* Look through w32-charset-info-alist for the character set.
        Prefer ISO codepages, and prefer lower numbers in the ISO
@@ -5046,12 +5081,34 @@ w32_to_x_charset (fncharset)
             /* If we don't have a match already, then this is the
                best.  */
             if (!best_match)
-              best_match = x_charset;
-            /* If this is an ISO codepage, and the best so far isn't,
-               then this is better.  */
-            else if (strnicmp (best_match, "iso", 3) != 0
-                     && strnicmp (x_charset, "iso", 3) == 0)
-              best_match = x_charset;
+             {
+               best_match = x_charset;
+               if (matching && !strnicmp (x_charset, matching, match_len))
+                 matching_found = 1;
+             }
+           /* If we already found a match for MATCHING, then
+              only consider other matches.  */
+           else if (matching_found
+                    && strnicmp (x_charset, matching, match_len))
+             continue;
+           /* If this matches what we want, and the best so far doesn't,
+              then this is better.  */
+           else if (!matching_found && matching
+                    && !strnicmp (x_charset, matching, match_len))
+             {
+               best_match = x_charset;
+               matching_found = 1;
+             }
+           /* If this is fully specified, and the best so far isn't,
+              then this is better.  */
+           else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
+           /* If this is an ISO codepage, and the best so far isn't,
+              then this is better, but only if it fully specifies the
+              encoding.  */
+               || (strnicmp (best_match, "iso", 3) != 0
+                   && strnicmp (x_charset, "iso", 3) == 0
+                   && strchr (x_charset, '-')))
+               best_match = x_charset;
             /* If both are ISO8859 codepages, choose the one with the
                lowest number in the encoding field.  */
             else if (strnicmp (best_match, "iso8859-", 8) == 0
@@ -5072,7 +5129,18 @@ w32_to_x_charset (fncharset)
         return buf;
       }
 
-    strncpy(buf, best_match, 31);
+    strncpy (buf, best_match, 31);
+    /* If the charset is not fully specified, put -0 on the end.  */
+    if (!strchr (best_match, '-'))
+      {
+       int pos = strlen (best_match);
+       /* Charset specifiers shouldn't be very long.  If it is a made
+          up one, truncating it should not do any harm since it isn't
+          recognized anyway.  */
+       if (pos > 29)
+         pos = 29;
+       strcpy (buf + pos, "-0");
+      }
     buf[31] = '\0';
     return buf;
   }
@@ -5172,7 +5240,8 @@ w32_to_all_x_charsets (fncharset)
   {
     Lisp_Object rest;
     /* Look through w32-charset-info-alist for the character set.
-       Only return charsets for codepages which are installed.
+       Only return fully specified charsets for codepages which are
+       installed.
 
        Format of each entry in Vw32_charset_info_alist is
          (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
@@ -5195,6 +5264,9 @@ w32_to_all_x_charsets (fncharset)
         w32_charset = XCAR (XCDR (this_entry));
         codepage = XCDR (XCDR (this_entry));
 
+       if (!strchr (SDATA (x_charset), '-'))
+         continue;
+
         /* Look for Same charset and a valid codepage (or non-int
            which means ignore).  */
         if (EQ (w32_charset, charset_type)
@@ -5225,9 +5297,6 @@ w32_codepage_for_font (char *fontname)
   Lisp_Object codepage, entry;
   char *charset_str, *charset, *end;
 
-  if (NILP (Vw32_charset_info_alist))
-    return CP_DEFAULT;
-
   /* Extract charset part of font string.  */
   charset = xlfd_charset_of_font (fontname);
 
@@ -5253,6 +5322,12 @@ w32_codepage_for_font (char *fontname)
         *end = '\0';
       }
 
+  if (!strcmp (charset, "iso10646"))
+    return CP_UNICODE;
+
+  if (NILP (Vw32_charset_info_alist))
+    return CP_DEFAULT;
+
   entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
   if (NILP (entry))
     return CP_UNKNOWN;
@@ -5285,7 +5360,6 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
   char *fontname_dash;
   int display_resy = (int) one_w32_display_info.resy;
   int display_resx = (int) one_w32_display_info.resx;
-  int bufsz;
   struct coding_system coding;
 
   if (!lpxstr) abort ();
@@ -5307,12 +5381,14 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
   coding.mode |= CODING_MODE_LAST_BLOCK;
   /* We explicitely disable composition handling because selection
      data should not contain any composition sequence.  */
-  coding.composing = COMPOSITION_DISABLED;
-  bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
+  coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+  coding.dst_bytes = LF_FACESIZE * 2;
+  coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
+  decode_coding_c_string (&coding, lplogfont->lfFaceName,
+                         strlen(lplogfont->lfFaceName), Qnil);
+  fontname = coding.destination;
 
-  fontname = alloca(sizeof(*fontname) * bufsz);
-  decode_coding (&coding, lplogfont->lfFaceName, fontname,
-                 strlen(lplogfont->lfFaceName), bufsz - 1);
   *(fontname + coding.produced) = '\0';
 
   /* Replace dashes with underscores so the dashes are not
@@ -5356,8 +5432,7 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
             ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
              ? 'p' : 'c',                            /* spacing */
             width_pixels,                           /* avg width */
-            specific_charset ? specific_charset
-             : w32_to_x_charset (lplogfont->lfCharSet)
+             w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
              /* charset registry and encoding */
             );
 
@@ -5435,26 +5510,24 @@ x_to_w32_font (lpxstr, lplogfont)
 
       if (fields > 0 && name[0] != '*')
         {
-         int bufsize;
-         unsigned char *buf;
-
+         Lisp_Object string = build_string (name);
           setup_coding_system
             (Fcheck_coding_system (Vlocale_coding_system), &coding);
-         coding.src_multibyte = 1;
-         coding.dst_multibyte = 0;
-         /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
-            encode_coding_iso2022 trying to dereference a null pointer.  */
-         coding.composing = COMPOSITION_DISABLED;
-         if (coding.type == coding_type_iso2022)
-           coding.flags |= CODING_FLAG_ISO_SAFE;
-         bufsize = encoding_buffer_size (&coding, strlen (name));
-         buf = (unsigned char *) alloca (bufsize);
-          coding.mode |= CODING_MODE_LAST_BLOCK;
-          encode_coding (&coding, name, buf, strlen (name), bufsize);
+          coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
+         /* Disable composition/charset annotation.   */
+         coding.common_flags &= ~CODING_ANNOTATION_MASK;
+         coding.dst_bytes = SCHARS (string) * 2;
+
+         coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+          encode_coding_object (&coding, string, 0, 0,
+                               SCHARS (string), SBYTES (string), Qnil);
          if (coding.produced >= LF_FACESIZE)
            coding.produced = LF_FACESIZE - 1;
-         buf[coding.produced] = 0;
-         strcpy (lplogfont->lfFaceName, buf);
+
+         coding.destination[coding.produced] = '\0';
+
+         strcpy (lplogfont->lfFaceName, coding.destination);
+         xfree (coding.destination);
        }
       else
         {
@@ -5832,14 +5905,17 @@ enum_font_cb2 (lplf, lptm, FontType, lpef)
        if (charset
            && strncmp (charset, "*-*", 3) != 0
            && lpef->logfont.lfCharSet == DEFAULT_CHARSET
-           && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0)
+           && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
          return 1;
       }
 
     if (charset)
       charset_list = Fcons (build_string (charset), Qnil);
     else
-      charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
+      /* Always prefer unicode.  */
+      charset_list
+       = Fcons (build_string ("iso10646-1"),
+                w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
 
     /* Loop through the charsets.  */
     for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
@@ -5847,14 +5923,15 @@ enum_font_cb2 (lplf, lptm, FontType, lpef)
        Lisp_Object this_charset = Fcar (charset_list);
        charset = SDATA (this_charset);
 
+       enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
+                                    charset, width);
+
        /* List bold and italic variations if w32-enable-synthesized-fonts
           is non-nil and this is a plain font.  */
        if (w32_enable_synthesized_fonts
            && lplf->elfLogFont.lfWeight == FW_NORMAL
            && lplf->elfLogFont.lfItalic == FALSE)
          {
-           enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
-                                        charset, width);
            /* bold.  */
            lplf->elfLogFont.lfWeight = FW_BOLD;
            enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
@@ -5868,9 +5945,6 @@ enum_font_cb2 (lplf, lptm, FontType, lpef)
            enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
                                         charset, width);
          }
-       else
-         enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
-                                      charset, width);
       }
   }
 
@@ -7278,7 +7352,7 @@ x_create_tip_frame (dpyinfo, parms, text)
       {
        tem = Fquery_fontset (font, Qnil);
        if (STRINGP (tem))
-         font = x_new_fontset (f, SDATA (tem));
+         font = x_new_fontset (f, tem);
        else
          font = x_new_font (f, SDATA (font));
       }
@@ -8349,6 +8423,30 @@ is set to off if the low bit of NEW-STATE is zero, otherwise on.  */)
     }
   return Qnil;
 }
+
+DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
+       2, 2, 0,
+       doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
+
+This is a direct interface to the Windows API FindWindow function.  */)
+  (class, name)
+Lisp_Object class, name;
+{
+  HWND hnd;
+
+  if (!NILP (class))
+    CHECK_STRING (class);
+  if (!NILP (name))
+    CHECK_STRING (name);
+
+  hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
+                   STRINGP (name)  ? ((LPCTSTR) SDATA (name))  : NULL);
+  if (!hnd)
+    return Qnil;
+  return Qt;
+}
+
+
 \f
 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
        doc: /* Return storage information about the file system FILENAME is on.
@@ -8915,6 +9013,7 @@ versions of Windows) characters.  */);
 
     staticpro (&Qw32_charset_unicode);
     Qw32_charset_unicode = intern ("w32-charset-unicode");
+  }
 #endif
 
 #if 0 /* TODO: Port to W32 */
@@ -8959,6 +9058,7 @@ versions of Windows) characters.  */);
   defsubr (&Sw32_registered_hot_keys);
   defsubr (&Sw32_reconstruct_hot_key);
   defsubr (&Sw32_toggle_lock_key);
+  defsubr (&Sw32_window_exists_p);
   defsubr (&Sw32_find_bdf_fonts);
 
   defsubr (&Sfile_system_info);
@@ -8976,6 +9076,7 @@ versions of Windows) characters.  */);
   find_ccl_program_func = w32_find_ccl_program;
   query_font_func = w32_query_font;
   set_frame_fontset_func = x_set_font;
+  get_font_repertory_func = x_get_font_repertory;
   check_window_system_func = check_w32;