changeset 102521:855091f2ad89

(Ffontset_info, check_fontset_name): New arg frame. Hanlde NAME nil and t correctly. Callers changed. (font_def_arg, add_arg, from_arg, to_arg): Delete them. (set_fontset_font): Change ARG to a vector. Handle range_list in ARG correctly. (Fset_fontset_font): Fix the case that TARGET is both a script name and charset name. Adjusted the arg to set_fontset_font for the above change. (fontset_from_font): Fix previous change. (Ffontset_info): Adjusted for the 2008-07-09 change of fontset entry. If FONTSET is the default fontset, don't set the extra slot of the returning char-table.
author Kenichi Handa <handa@m17n.org>
date Fri, 13 Mar 2009 05:08:39 +0000
parents 66b0cc830a26
children fdf969fedba2
files src/fontset.c
diffstat 1 files changed, 126 insertions(+), 87 deletions(-) [+]
line wrap: on
line diff
--- a/src/fontset.c	Fri Mar 13 05:08:19 2009 +0000
+++ b/src/fontset.c	Fri Mar 13 05:08:39 2009 +0000
@@ -1291,25 +1291,39 @@
 
 /* Check validity of NAME as a fontset name and return the
    corresponding fontset.  If not valid, signal an error.
-   If NAME is t, return Vdefault_fontset.  */
+
+   If NAME is t, return Vdefault_fontset.  If NAME is nil, return the
+   fontset of *FRAME.
+
+   Set *FRAME to the actual frame.  */
 
 static Lisp_Object
-check_fontset_name (name)
-     Lisp_Object name;
+check_fontset_name (name, frame)
+     Lisp_Object name, *frame;
 {
   int id;
 
+  if (NILP (*frame))
+    *frame = selected_frame;
+  CHECK_LIVE_FRAME (*frame);
+
   if (EQ (name, Qt))
     return Vdefault_fontset;
-
-  CHECK_STRING (name);
-  /* 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));
+  if (NILP (name))
+    {
+      id = FRAME_FONTSET (XFRAME (*frame));
+    }
+  else
+    {
+      CHECK_STRING (name);
+      /* 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);
 }
 
@@ -1349,46 +1363,57 @@
   return make_unibyte_string (xlfd, i);
 }
 
-/* Variables referred in set_fontset_font.  They are set before
-   map_charset_chars is called in Fset_fontset_font.  */
-static Lisp_Object font_def_arg, add_arg;
-static int from_arg, to_arg;
+/* Callback function for map_charset_chars in Fset_fontset_font.
+   ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
 
-/* Callback function for map_charset_chars in Fset_fontset_font.  In
-   FONTSET, set font_def_arg in a fashion specified by add_arg for
-   characters in RANGE while ignoring the range between from_arg and
-   to_arg.  */
+   In FONTSET, set FONT_DEF in a fashion specified by ADD for
+   characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
+   The consumed ranges are poped up from SCRIPT_RANGE_LIST, and the
+   new SCRIPT_RANGE_LIST is stored in ARG.
+
+   If ASCII is nil, don't set FONT_DEF for ASCII characters.  It is
+   assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
+   case.  */
 
 static void
-set_fontset_font (fontset, range)
-     Lisp_Object fontset, range;
+set_fontset_font (arg, range)
+     Lisp_Object arg, range;
 {
-  if (from_arg < to_arg)
-    {
-      int from = XINT (XCAR (range)), to = XINT (XCDR (range));
+  Lisp_Object fontset, font_def, add, ascii, script_range_list;
+  int from = XINT (XCAR (range)), to = XINT (XCDR (range));
 
-      if (from < from_arg)
-	{
-	  if (to > to_arg)
-	    {
-	      Lisp_Object range2;
+  fontset = AREF (arg, 0);
+  font_def = AREF (arg, 1);
+  add = AREF (arg, 2);
+  ascii = AREF (arg, 3);
+  script_range_list = AREF (arg, 4);
 
-	      range2 = Fcons (make_number (to_arg), XCDR (range));
-	      FONTSET_ADD (fontset, range, font_def_arg, add_arg);
-	      to = to_arg;
-	    }
-	  if (to > from_arg)
-	    range = Fcons (XCAR (range), make_number (from_arg));
-	}
-      else if (to <= to_arg)
+  if (NILP (ascii) && from < 0x80)
+    {
+      if (to < 0x80)
 	return;
-      else
-	{
-	  if (from < to_arg)
-	    range = Fcons (make_number (to_arg), XCDR (range));
-	}
+      from = 0x80;
+      range = Fcons (make_number (0x80), XCDR (range));
     }
-  FONTSET_ADD (fontset, range, font_def_arg, add_arg);
+
+#define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
+#define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
+#define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
+
+  for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
+    FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
+  if (CONSP (script_range_list))
+    {
+      if (SCRIPT_FROM < from)
+	range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
+      while (CONSP (script_range_list) && SCRIPT_TO <= to)
+	POP_SCRIPT_RANGE ();
+      if (CONSP (script_range_list) && SCRIPT_FROM <= to)
+	XSETCAR (XCAR (script_range_list), make_number (to + 1));
+    }
+
+  FONTSET_ADD (fontset, range, font_def, add);
+  ASET (arg, 4, script_range_list);
 }
 
 extern Lisp_Object QCfamily, QCregistry;
@@ -1399,6 +1424,9 @@
        doc: /*
 Modify fontset NAME to use FONT-SPEC for TARGET characters.
 
+NAME is a fontset name string, nil for the fontset of FRAME, or t for
+the default fontset.
+
 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
 In that case, use FONT-SPEC for all characters in the range FROM and
 TO (inclusive).
@@ -1420,8 +1448,8 @@
  * A font name string.
  * nil, which explicitly specifies that there's no font for TARGET.
 
-Optional 4th argument FRAME, if non-nil, is a frame.  This argument is
-kept for backward compatibility and has no meaning.
+Optional 4th argument FRAME is a frame or nil for the selected frame
+that is concerned in the case that NAME is nil.
 
 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
 to the font specifications for TARGET previously set.  If it is
@@ -1437,12 +1465,7 @@
   Lisp_Object fontname;
   int ascii_changed = 0;
 
-  fontset = check_fontset_name (name);
-
-  /* The arg FRAME is kept for backward compatibility.  We only check
-     the validity.  */
-  if (!NILP (frame))
-    CHECK_LIVE_FRAME (frame);
+  fontset = check_fontset_name (name, &frame);
 
   fontname = Qnil;
   if (CONSP (font_spec))
@@ -1541,7 +1564,7 @@
 	  val = Fcons (target, Qnil);
 	  map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
 			  val);
-	  range_list = XCDR (val);
+	  range_list = Fnreverse (XCDR (val));
 	}
       if (CHARSETP (target))
 	{
@@ -1558,22 +1581,33 @@
   else
     error ("Invalid target for setting a font");
 
-  if (NILP (font_spec) && ascii_changed)
-    error ("Can't set ASCII font to nil");
+  if (ascii_changed)
+    {
+      Lisp_Object val;
+
+      if (NILP (font_spec))
+	error ("Can't set ASCII font to nil");
+      val = CHAR_TABLE_REF (fontset, 0);
+      if (! NILP (val) && EQ (add, Qappend))
+	/* We are going to change just an additional font for ASCII.  */
+	ascii_changed = 0;
+    }
 
   if (charset)
     {
-      font_def_arg = font_def;
-      add_arg = add;
-      if (NILP (range_list))
-	from_arg = to_arg = 0;
-      else
-	from_arg = XINT (XCAR (XCAR (range_list))),
-	  to_arg = XINT (XCDR (XCAR (range_list)));
+      Lisp_Object arg;
 
-      map_charset_chars (set_fontset_font, Qnil, fontset, charset,
+      arg = Fmake_vector (make_number (5), Qnil);
+      ASET (arg, 0, fontset);
+      ASET (arg, 1, font_def);
+      ASET (arg, 2, add);
+      ASET (arg, 3, ascii_changed ? Qt : Qnil);
+      ASET (arg, 4, range_list);
+
+      map_charset_chars (set_fontset_font, Qnil, arg, charset,
 			 CHARSET_MIN_CODE (charset),
 			 CHARSET_MAX_CODE (charset));
+      range_list = AREF (arg, 4);
     }
   for (; CONSP (range_list); range_list = XCDR (range_list))
     FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
@@ -1729,15 +1763,15 @@
   Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
   auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
   font_spec = Fcopy_font_spec (font_spec);
-  ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1);
   for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
     ASET (font_spec, i, Qnil);
   Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil);
   Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
   if (registry != Qiso10646_1)
     {
-      ASET (font_spec, FONT_REGISTRY_INDEX, registry);
-      Fset_fontset_font (name, Qascii, font_spec, Qnil, Qnil);
+      font_spec = Fcopy_font_spec (font_spec);
+      ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1);
+      Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qappend);
     }
   FONTSET_ASCII (fontset) = font_name;
 
@@ -1876,21 +1910,22 @@
 
 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
        doc: /* Return information about a fontset FONTSET on frame FRAME.
+
+FONTSET is a fontset name string, nil for the fontset of FRAME, or t
+for the default fontset.  FRAME nil means the selected frame.
+
 The value is a char-table whose elements have this form:
 
-    ((FONT-PATTERN OPENED-FONT ...) ...)
-
-FONT-PATTERN is a vector:
+    ((FONT OPENED-FONT ...) ...)
 
-	[ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
-
-or a string of font name pattern.
+FONT is a name of font specified for a range of characters.
 
 OPENED-FONT is a name of a font actually opened.
 
-The char-table has one extra slot.  The value is a char-table
-containing the information about the derived fonts from the default
-fontset.  The format is the same as above.  */)
+The char-table has one extra slot.  If FONTSET is not the default
+fontset, the value the extra slot is a char-table containing the
+information about the derived fonts from the default fontset.  The
+format is the same as above.  */)
      (fontset, frame)
      Lisp_Object fontset, frame;
 {
@@ -1901,11 +1936,7 @@
 
   (*check_window_system_func) ();
 
-  fontset = check_fontset_name (fontset);
-
-  if (NILP (frame))
-    frame = selected_frame;
-  CHECK_LIVE_FRAME (frame);
+  fontset = check_fontset_name (fontset, &frame);
   f = XFRAME (frame);
 
   /* Recode fontsets realized on FRAME from the base fontset FONTSET
@@ -1933,10 +1964,13 @@
   realized[1][j] = Qnil;
 
   tables[0] = Fmake_char_table (Qfontset_info, Qnil);
-  tables[1] = Fmake_char_table (Qnil, Qnil);
-  XCHAR_TABLE (tables[0])->extras[0] = tables[1];
   fontsets[0] = fontset;
-  fontsets[1] = Vdefault_fontset;
+  if (fontset != Vdefault_fontset)
+    {
+      tables[1] = Fmake_char_table (Qnil, Qnil);
+      XCHAR_TABLE (tables[0])->extras[0] = tables[1];
+      fontsets[1] = Vdefault_fontset;
+    }
 
   /* Accumulate information of the fontset in TABLE.  The format of
      each element is ((FONT-SPEC OPENED-FONT ...) ...).  */
@@ -1973,10 +2007,11 @@
 		    val = FONTSET_REF (realized[k][i], c);
 		  else
 		    val = FONTSET_FALLBACK (realized[k][i]);
-		  if (! VECTORP (val))
+		  if (! CONSP (val) || ! VECTORP (XCDR (val)))
 		    continue;
-		  /* VAL: [int ? [FACE-ID FONT-DEF FONT-OBJECT int] ... ]  */
-		  for (j = 2; j < ASIZE (val); j++)
+		  /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ])  */
+		  val = XCDR (val);
+		  for (j = 0; j < ASIZE (val); j++)
 		    {
 		      elt = AREF (val, j);
 		      if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
@@ -2007,6 +2042,8 @@
 	    }
 	  c = to + 1;
 	}
+      if (fontset == Vdefault_fontset)
+	break;
     }
 
   return tables[0];
@@ -2030,8 +2067,10 @@
   int c;
   Lisp_Object fontset, elt, list, repertory, val;
   int i, j;
+  Lisp_Object frame;
 
-  fontset = check_fontset_name (name);
+  frame = Qnil;
+  fontset = check_fontset_name (name, &frame);
 
   CHECK_CHARACTER (ch);
   c = XINT (ch);