(Fload, load_unwind): Use make_save_value to unwind

[gnu-emacs] / src / fontset.c

diff --git a/src/fontset.c b/src/fontset.c
index b199f53df17e0188e32353b10fb9ca73011580ad..27295715eaf0fe312bf0431d928533bc83aeb525 100644 (file)
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1,4 +1,5 @@
 /* Fontset handler.
 /* Fontset handler.

+   Copyright (C) 2004  Free Software Foundation, Inc.

    Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
    Licensed to the Free Software Foundation.
 
    Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
    Licensed to the Free Software Foundation.
 


@@ -16,8 +17,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to

-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */

 
 /* #define FONTSET_DEBUG */
 
 
 /* #define FONTSET_DEBUG */
 


@@ -194,7 +195,7 @@ static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 static int fontset_id_valid_p P_ ((int));
 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
 static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
 static int fontset_id_valid_p P_ ((int));
 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
 static Lisp_Object font_family_registry P_ ((Lisp_Object, int));

-static Lisp_Object regulalize_fontname P_ ((Lisp_Object));
+static Lisp_Object regularize_fontname P_ ((Lisp_Object));

 
 \f
 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
 
 \f
 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/


@@ -305,7 +306,7 @@ fontset_ref_via_base (fontset, c)
     elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
   if (NILP (elt))
     elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
     elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
   if (NILP (elt))
     elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);

-  if (NILP (elt) && ! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
+  if (NILP (elt))

     elt = FONTSET_REF (Vdefault_fontset, *c);
   if (NILP (elt))
     return Qnil;
     elt = FONTSET_REF (Vdefault_fontset, *c);
   if (NILP (elt))
     return Qnil;


@@ -352,7 +353,11 @@ fontset_set (fontset, c, newelt)
   for (i = 0; code[i] > 0; i++)
     {
       if (!SUB_CHAR_TABLE_P (*elt))
   for (i = 0; code[i] > 0; i++)
     {
       if (!SUB_CHAR_TABLE_P (*elt))

-       *elt = make_sub_char_table (*elt);
+       {
+         Lisp_Object val = *elt;
+         *elt = make_sub_char_table (Qnil);
+         XCHAR_TABLE (*elt)->defalt = val;
+       }

       elt = &XCHAR_TABLE (*elt)->contents[code[i]];
     }
   if (SUB_CHAR_TABLE_P (*elt))
       elt = &XCHAR_TABLE (*elt)->contents[code[i]];
     }
   if (SUB_CHAR_TABLE_P (*elt))


@@ -598,7 +603,8 @@ fontset_font_pattern (f, id, c)
       fontset = FONTSET_FROM_ID (id);
       xassert (!BASE_FONTSET_P (fontset));
       fontset = FONTSET_BASE (fontset);
       fontset = FONTSET_FROM_ID (id);
       xassert (!BASE_FONTSET_P (fontset));
       fontset = FONTSET_BASE (fontset);

-      elt = FONTSET_REF (fontset, c);
+      if (! EQ (fontset, Vdefault_fontset))
+       elt = FONTSET_REF (fontset, c);

     }
   if (NILP (elt))
     {
     }
   if (NILP (elt))
     {


@@ -652,7 +658,7 @@ fs_load_font (f, c, fontname, id, face)
      struct face *face;
 {
   Lisp_Object fontset;
      struct face *face;
 {
   Lisp_Object fontset;

-  Lisp_Object list, elt;
+  Lisp_Object list, elt, fullname;

   int size = 0;
   struct font_info *fontp;
   int charset = CHAR_CHARSET (c);
   int size = 0;
   struct font_info *fontp;
   int charset = CHAR_CHARSET (c);


@@ -698,10 +704,11 @@ fs_load_font (f, c, fontname, id, face)
      font_info structure that are not set by (*load_font_func).  */
   fontp->charset = charset;
 
      font_info structure that are not set by (*load_font_func).  */
   fontp->charset = charset;
 

+  fullname = build_string (fontp->full_name);

   fontp->vertical_centering
     = (STRINGP (Vvertical_centering_font_regexp)
   fontp->vertical_centering
     = (STRINGP (Vvertical_centering_font_regexp)

-       && (fast_c_string_match_ignore_case
-          (Vvertical_centering_font_regexp, fontp->full_name) >= 0));
+       && (fast_string_match_ignore_case
+          (Vvertical_centering_font_regexp, fullname) >= 0));

 
   if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
     {
 
   if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
     {


@@ -718,7 +725,6 @@ fs_load_font (f, c, fontname, id, face)
       /* The font itself doesn't have information about encoding.  */
       int i;
 
       /* The font itself doesn't have information about encoding.  */
       int i;
 

-      fontname = fontp->full_name;

       /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
         others is 1 (i.e. 0x80..0xFF).  */
       fontp->encoding[0] = 0;
       /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
         others is 1 (i.e. 0x80..0xFF).  */
       fontp->encoding[0] = 0;


@@ -730,8 +736,7 @@ fs_load_font (f, c, fontname, id, face)
          elt = XCAR (list);
          if (CONSP (elt)
              && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
          elt = XCAR (list);
          if (CONSP (elt)
              && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))

-             && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
-                 >= 0))
+             && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0))

            {
              Lisp_Object tmp;
 
            {
              Lisp_Object tmp;
 


@@ -763,6 +768,23 @@ fs_load_font (f, c, fontname, id, face)
 #pragma optimize("", on)
 #endif
 
 #pragma optimize("", on)
 #endif
 

+/* Set the ASCII font of the default fontset to FONTNAME if that is
+   not yet set.  */
+void
+set_default_ascii_font (fontname)
+     Lisp_Object fontname;
+{
+  if (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
+    {
+      int id = fs_query_fontset (fontname, 2);
+
+      if (id >= 0)
+       fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
+      FONTSET_ASCII (Vdefault_fontset)
+       = Fcons (make_number (0), fontname);
+    }
+}
+

 \f
 /* Cache data used by fontset_pattern_regexp.  The car part is a
    pattern string containing at least one wild card, the cdr part is
 \f
 /* Cache data used by fontset_pattern_regexp.  The car part is a
    pattern string containing at least one wild card, the cdr part is


@@ -788,16 +810,34 @@ fontset_pattern_regexp (pattern)
       || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
     {
       /* We must at first update the cached data.  */
       || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
     {
       /* We must at first update the cached data.  */

-      char *regex = (char *) alloca (SCHARS (pattern) * 2 + 3);
-      char *p0, *p1 = regex;
+      unsigned char *regex, *p0, *p1;
+      int ndashes = 0, nstars = 0;
+
+      for (p0 = SDATA (pattern); *p0; p0++)
+       {
+         if (*p0 == '-')
+           ndashes++;
+         else if (*p0 == '*')
+           nstars++;
+       }
+
+      /* If PATTERN is not full XLFD we conert "*" to ".*".  Otherwise
+        we convert "*" to "[^-]*" which is much faster in regular
+        expression matching.  */
+      if (ndashes < 14)
+       p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1);
+      else
+       p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);

 
 

-      /* Convert "*" to ".*", "?" to ".".  */

       *p1++ = '^';
       *p1++ = '^';

-      for (p0 = (char *) SDATA (pattern); *p0; p0++)
+      for (p0 = SDATA (pattern); *p0; p0++)

        {
          if (*p0 == '*')
            {
        {
          if (*p0 == '*')
            {

-             *p1++ = '.';
+             if (ndashes < 14)
+               *p1++ = '.';
+             else
+               *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';

              *p1++ = '*';
            }
          else if (*p0 == '?')
              *p1++ = '*';
            }
          else if (*p0 == '?')


@@ -816,47 +856,50 @@ fontset_pattern_regexp (pattern)
 }
 
 /* Return ID of the base fontset named NAME.  If there's no such
 }
 
 /* Return ID of the base fontset named NAME.  If there's no such

-   fontset, return -1.  */
+   fontset, return -1.  NAME_PATTERN specifies how to treat NAME as this:
+     0: pattern containing '*' and '?' as wildcards
+     1: regular expression
+     2: literal fontset name
+*/

 
 int
 
 int

-fs_query_fontset (name, regexpp)
+fs_query_fontset (name, name_pattern)

      Lisp_Object name;
      Lisp_Object name;

-     int regexpp;
+     int name_pattern;

 {
   Lisp_Object tem;
   int i;
 
   name = Fdowncase (name);
 {
   Lisp_Object tem;
   int i;
 
   name = Fdowncase (name);

-  if (!regexpp)
+  if (name_pattern != 1)

     {
       tem = Frassoc (name, Vfontset_alias_alist);
       if (CONSP (tem) && STRINGP (XCAR (tem)))
        name = XCAR (tem);
     {
       tem = Frassoc (name, Vfontset_alias_alist);
       if (CONSP (tem) && STRINGP (XCAR (tem)))
        name = XCAR (tem);

-      else
+      else if (name_pattern == 0)

        {
          tem = fontset_pattern_regexp (name);
          if (STRINGP (tem))
            {
              name = tem;
        {
          tem = fontset_pattern_regexp (name);
          if (STRINGP (tem))
            {
              name = tem;

-             regexpp = 1;
+             name_pattern = 1;

            }
        }
     }
 
   for (i = 0; i < ASIZE (Vfontset_table); i++)
     {
            }
        }
     }
 
   for (i = 0; i < ASIZE (Vfontset_table); i++)
     {

-      Lisp_Object fontset;
-      const unsigned char *this_name;
+      Lisp_Object fontset, this_name;

 
       fontset = FONTSET_FROM_ID (i);
       if (NILP (fontset)
          || !BASE_FONTSET_P (fontset))
        continue;
 
 
       fontset = FONTSET_FROM_ID (i);
       if (NILP (fontset)
          || !BASE_FONTSET_P (fontset))
        continue;
 

-      this_name = SDATA (FONTSET_NAME (fontset));
-      if (regexpp
-         ? fast_c_string_match_ignore_case (name, this_name) >= 0
-         : !strcmp (SDATA (name), this_name))
+      this_name = FONTSET_NAME (fontset);
+      if (name_pattern == 1
+         ? fast_string_match (name, this_name) >= 0
+         : !strcmp (SDATA (name), SDATA (this_name)))

        return i;
     }
   return -1;
        return i;
     }
   return -1;


@@ -910,19 +953,18 @@ list_fontsets (f, pattern, size)
 
   for (id = 0; id < ASIZE (Vfontset_table); id++)
     {
 
   for (id = 0; id < ASIZE (Vfontset_table); id++)
     {

-      Lisp_Object fontset;
-      const unsigned char *name;
+      Lisp_Object fontset, name;

 
       fontset = FONTSET_FROM_ID (id);
       if (NILP (fontset)
          || !BASE_FONTSET_P (fontset)
          || !EQ (frame, FONTSET_FRAME (fontset)))
        continue;
 
       fontset = FONTSET_FROM_ID (id);
       if (NILP (fontset)
          || !BASE_FONTSET_P (fontset)
          || !EQ (frame, FONTSET_FRAME (fontset)))
        continue;

-      name = SDATA (FONTSET_NAME (fontset));
+      name = FONTSET_NAME (fontset);

 
       if (!NILP (regexp)
 
       if (!NILP (regexp)

-         ? (fast_c_string_match_ignore_case (regexp, name) < 0)
-         : strcmp (SDATA (pattern), name))
+         ? (fast_string_match (regexp, name) < 0)
+         : strcmp (SDATA (pattern), SDATA (name)))

        continue;
 
       if (size)
        continue;
 
       if (size)


@@ -946,6 +988,7 @@ FONTLIST is an alist of charsets vs corresponding font name patterns.  */)
 {
   Lisp_Object fontset, elements, ascii_font;
   Lisp_Object tem, tail, elt;
 {
   Lisp_Object fontset, elements, ascii_font;
   Lisp_Object tem, tail, elt;

+  int id;

 
   (*check_window_system_func) ();
 
 
   (*check_window_system_func) ();
 


@@ -953,10 +996,14 @@ FONTLIST is an alist of charsets vs corresponding font name patterns.  */)
   CHECK_LIST (fontlist);
 
   name = Fdowncase (name);
   CHECK_LIST (fontlist);
 
   name = Fdowncase (name);

-  tem = Fquery_fontset (name, Qnil);
-  if (!NILP (tem))
-    error ("Fontset `%s' matches the existing fontset `%s'",
-          SDATA (name), SDATA (tem));
+  id = fs_query_fontset (name, 2);
+  if (id >= 0)
+    {
+      fontset = FONTSET_FROM_ID (id);
+      tem = FONTSET_NAME (fontset);
+      error ("Fontset `%s' matches the existing fontset `%s'",
+            SDATA (name),  SDATA (tem));
+    }

 
   /* Check the validity of FONTLIST while creating a template for
      fontset elements.  */
 
   /* Check the validity of FONTLIST while creating a template for
      fontset elements.  */


@@ -1031,7 +1078,11 @@ check_fontset_name (name)
     return Vdefault_fontset;
 
   CHECK_STRING (name);
     return Vdefault_fontset;
 
   CHECK_STRING (name);

-  id = fs_query_fontset (name, 0);
+  /* First try NAME as literal.  */
+  id = fs_query_fontset (name, 2);
+  if (id < 0)
+    /* For backward compatibility, try again NAME as pattern.  */
+    id = fs_query_fontset (name, 0);

   if (id < 0)
     error ("Fontset `%s' does not exist", SDATA (name));
   return FONTSET_FROM_ID (id);
   if (id < 0)
     error ("Fontset `%s' does not exist", SDATA (name));
   return FONTSET_FROM_ID (id);


@@ -1041,7 +1092,7 @@ check_fontset_name (name)
    string, maybe change FONTNAME to (FAMILY . REGISTRY).  */
 
 static Lisp_Object
    string, maybe change FONTNAME to (FAMILY . REGISTRY).  */
 
 static Lisp_Object

-regulalize_fontname (Lisp_Object fontname)
+regularize_fontname (Lisp_Object fontname)

 {
   Lisp_Object family, registry;
 
 {
   Lisp_Object family, registry;
 


@@ -1083,7 +1134,6 @@ name of a font, REGISTRY is a registry name of a font.  */)
   Lisp_Object realized;
   int from, to;
   int id;
   Lisp_Object realized;
   int from, to;
   int id;

-  Lisp_Object family, registry;

 
   fontset = check_fontset_name (name);
 
 
   fontset = check_fontset_name (name);
 


@@ -1132,7 +1182,7 @@ name of a font, REGISTRY is a registry name of a font.  */)
   if (!NILP (frame))
     CHECK_LIVE_FRAME (frame);
 
   if (!NILP (frame))
     CHECK_LIVE_FRAME (frame);
 

-  elt = Fcons (make_number (from), regulalize_fontname (fontname));
+  elt = Fcons (make_number (from), regularize_fontname (fontname));

   for (; from <= to; from++)
     FONTSET_SET (fontset, from, elt);
   Foptimize_char_table (fontset);
   for (; from <= to; from++)
     FONTSET_SET (fontset, from, elt);
   Foptimize_char_table (fontset);


@@ -1211,7 +1261,10 @@ If the named font is not yet loaded, return nil.  */)
 /* Return a cons (FONT-NAME . GLYPH-CODE).
    FONT-NAME is the font name for the character at POSITION in the current
    buffer.  This is computed from all the text properties and overlays
 /* Return a cons (FONT-NAME . GLYPH-CODE).
    FONT-NAME is the font name for the character at POSITION in the current
    buffer.  This is computed from all the text properties and overlays

-   that apply to POSITION.
+   that apply to POSITION.  POSTION may be nil, in which case,
+   FONT-NAME is the font name for display the character CH with the
+   default face.
+

    GLYPH-CODE is the glyph code in the font to use for the character.
 
    If the 2nd optional arg CH is non-nil, it is a character to check
    GLYPH-CODE is the glyph code in the font to use for the character.
 
    If the 2nd optional arg CH is non-nil, it is a character to check


@@ -1224,7 +1277,8 @@ If the named font is not yet loaded, return nil.  */)
 
    (2) The character code is invalid.
 
 
    (2) The character code is invalid.
 

-   (3) The current buffer is not displayed in any window.
+   (3) If POSITION is not nil, and the current buffer is not displayed
+   in any window.

 
    In addition, the returned font name may not take into account of
    such redisplay engine hooks as what used in jit-lock-mode if
 
    In addition, the returned font name may not take into account of
    such redisplay engine hooks as what used in jit-lock-mode if


@@ -1239,31 +1293,42 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
   int pos, pos_byte, dummy;
   int face_id;
   int c, code;
   int pos, pos_byte, dummy;
   int face_id;
   int c, code;

-  Lisp_Object window;
-  struct window *w;

   struct frame *f;
   struct face *face;
 
   struct frame *f;
   struct face *face;
 

-  CHECK_NUMBER_COERCE_MARKER (position);
-  pos = XINT (position);
-  if (pos < BEGV || pos >= ZV)
-    args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
-  pos_byte = CHAR_TO_BYTE (pos);
-  if (NILP (ch))
-    c = FETCH_CHAR (pos_byte);
-  else
+  if (NILP (position))

     {
       CHECK_NATNUM (ch);
       c = XINT (ch);
     {
       CHECK_NATNUM (ch);
       c = XINT (ch);

+      f = XFRAME (selected_frame);
+      face_id = DEFAULT_FACE_ID;
+    }
+  else
+    {
+      Lisp_Object window;
+      struct window *w;
+
+      CHECK_NUMBER_COERCE_MARKER (position);
+      pos = XINT (position);
+      if (pos < BEGV || pos >= ZV)
+       args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+      pos_byte = CHAR_TO_BYTE (pos);
+      if (NILP (ch))
+       c = FETCH_CHAR (pos_byte);
+      else
+       {
+         CHECK_NATNUM (ch);
+         c = XINT (ch);
+       }
+      window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
+      if (NILP (window))
+       return Qnil;
+      w = XWINDOW (window);
+      f = XFRAME (w->frame);
+      face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);

     }
   if (! CHAR_VALID_P (c, 0))
     return Qnil;
     }
   if (! CHAR_VALID_P (c, 0))
     return Qnil;

-  window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
-  if (NILP (window))
-    return Qnil;
-  w = XWINDOW (window);
-  f = XFRAME (w->frame);
-  face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);

   face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
   face = FACE_FROM_ID (f, face_id);
   if (! face->font || ! face->font_name)
   face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
   face = FACE_FROM_ID (f, face_id);
   if (! face->font || ! face->font_name)


@@ -1539,7 +1604,7 @@ It is intended that this function is called only from
 
       elt = XCAR (tail);
       target = Fcar (elt);
 
       elt = XCAR (tail);
       target = Fcar (elt);

-      elt = Fcons (Qnil, regulalize_fontname (Fcdr (elt)));
+      elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));

       if (! CHAR_TABLE_P (target))
        {
          int charset, c;
       if (! CHAR_TABLE_P (target))
        {
          int charset, c;


@@ -1583,19 +1648,6 @@ syms_of_fontset ()
   FONTSET_ID (Vdefault_fontset) = make_number (0);
   FONTSET_NAME (Vdefault_fontset)
     = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
   FONTSET_ID (Vdefault_fontset) = make_number (0);
   FONTSET_NAME (Vdefault_fontset)
     = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");

-#if defined (MAC_OS)
-  FONTSET_ASCII (Vdefault_fontset)
-    = Fcons (make_number (0),
-            build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
-#elif defined (WINDOWSNT)
-  FONTSET_ASCII (Vdefault_fontset)
-    = Fcons (make_number (0),
-            build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
-#else
-  FONTSET_ASCII (Vdefault_fontset)
-    = Fcons (make_number (0),
-            build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
-#endif

   AREF (Vfontset_table, 0) = Vdefault_fontset;
   next_fontset_id = 1;
 
   AREF (Vfontset_table, 0) = Vdefault_fontset;
   next_fontset_id = 1;