--- a/src/specifier.c	Sat Dec 26 00:20:27 2009 -0600
+++ b/src/specifier.c	Sat Dec 26 21:18:49 2009 -0600
@@ -47,6 +47,7 @@
 Lisp_Object Qconsole_type, Qdevice_class;
 
 static Lisp_Object Vuser_defined_tags;
+static Lisp_Object Vcharset_tag_lists;
 
 typedef struct specifier_type_entry specifier_type_entry;
 struct specifier_type_entry
@@ -246,7 +247,7 @@
 	{
 	  Lisp_Specifier* sp = XSPECIFIER (rest);
 	  /* A bit of assertion that we're removing both parts of the
-             magic one altogether */
+	     magic one altogether */
 	  assert (!MAGIC_SPECIFIER_P(sp)
 		  || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback))
 		  || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent)));
@@ -295,6 +296,7 @@
   write_fmt_string (printcharfun, " 0x%x>", sp->header.uid);
 }
 
+#ifndef NEW_GC
 static void
 finalize_specifier (void *header, int for_disksave)
 {
@@ -306,6 +308,7 @@
       sp->caching = 0;
     }
 }
+#endif /* not NEW_GC */
 
 static int
 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
@@ -382,10 +385,16 @@
   { XD_END }
 };
 
+#ifdef NEW_GC
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("specifier-caching", specifier_caching,
+				      0, specifier_caching_description_1,
+				      struct specifier_caching);
+#else /* not NEW_GC */
 static const struct sized_memory_description specifier_caching_description = {
   sizeof (struct specifier_caching),
   specifier_caching_description_1
 };
+#endif /* not NEW_GC */
 
 static const struct sized_memory_description specifier_extra_description_map[]
 = {
@@ -403,8 +412,12 @@
   { XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) },
   { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) },
   { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) },
+#ifdef NEW_GC
+  { XD_LISP_OBJECT,  offsetof (Lisp_Specifier, caching) },
+#else /* not NEW_GC */
   { XD_BLOCK_PTR,  offsetof (Lisp_Specifier, caching), 1,
     { &specifier_caching_description } },
+#endif /* not NEW_GC */
   { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) },
   { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) },
   { XD_BLOCK_ARRAY, offsetof (Lisp_Specifier, data), 1,
@@ -413,21 +426,30 @@
 };
 
 static const struct memory_description specifier_empty_extra_description_1[] =
-{
-  { XD_END }
-};
+  {
+    { XD_END }
+  };
 
 const struct sized_memory_description specifier_empty_extra_description = {
   0, specifier_empty_extra_description_1
 };
 
-DEFINE_SIZABLE_LISP_OBJECT ("specifier", specifier,
-				       mark_specifier, print_specifier,
-				       finalize_specifier,
-				       specifier_equal, specifier_hash,
-				       specifier_description,
-				       sizeof_specifier,
-				       Lisp_Specifier);
+#ifdef NEW_GC
+DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier,
+				     mark_specifier, print_specifier,
+				     0, specifier_equal, specifier_hash,
+				     specifier_description,
+				     sizeof_specifier,
+				     Lisp_Specifier);
+#else /* not NEW_GC */
+DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier,
+				     mark_specifier, print_specifier,
+				     finalize_specifier,
+				     specifier_equal, specifier_hash,
+				     specifier_description,
+				     sizeof_specifier,
+				     Lisp_Specifier);
+#endif /* not NEW_GC */
 
 /************************************************************************/
 /*                       Creating specifiers                            */
@@ -445,7 +467,7 @@
     }
 
   maybe_invalid_argument ("Invalid specifier type",
-			   type, Qspecifier, errb);
+			  type, Qspecifier, errb);
 
   return 0;
 }
@@ -655,7 +677,7 @@
 instantiation will actually occur in the window the image instance itself is
 instantiated in.
 */
-     (domain))
+       (domain))
 {
   /* This cannot GC. */
   return ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) ||
@@ -666,14 +688,14 @@
     ? Qt : Qnil;
 }
 
-DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1, 1, 0,
-       /*
+DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1,
+       1, 0, /*
 Given a specifier LOCALE-TYPE, return non-nil if it is valid.
 Valid locale types are `global', `device', `frame', `window', and `buffer'.
 \(Note, however, that in functions that accept either a locale or a locale
 type, `global' is considered an individual locale.)
 */
-     (locale_type))
+       (locale_type))
 {
   /* This cannot GC. */
   return (EQ (locale_type, Qglobal) ||
@@ -703,7 +725,7 @@
   /* This cannot GC. */
   if (NILP (Fvalid_specifier_locale_p (locale)))
     invalid_argument ("Invalid specifier locale",
-		       locale);
+		      locale);
   if (DEVICEP (locale)) return Qdevice;
   if (FRAMEP  (locale)) return Qframe;
   if (WINDOWP (locale)) return Qwindow;
@@ -722,7 +744,7 @@
     return locale;
   else
     invalid_argument ("Invalid specifier locale",
-		       locale);
+		      locale);
 
   return Qnil;
 }
@@ -738,7 +760,7 @@
   if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER;
 
   invalid_argument ("Invalid specifier locale type",
-		     locale_type);
+		    locale_type);
   RETURN_NOT_REACHED (LOCALE_GLOBAL);
 }
 
@@ -775,7 +797,7 @@
 {
   if (NILP (Fvalid_specifier_domain_p (domain)))
     invalid_argument ("Invalid specifier domain",
-		       domain);
+		      domain);
 }
 
 Lisp_Object
@@ -806,10 +828,10 @@
 DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /*
 Return non-nil if TAG-SET is a valid specifier tag set.
 
-A specifier tag set is an entity that is attached to an instantiator
-and can be used to restrict the scope of that instantiator to a
-particular device class or device type and/or to mark instantiators
-added by a particular package so that they can be later removed.
+A specifier tag set is an entity that is attached to an instantiator and can
+be used to restrict the scope of that instantiator to a particular device
+class, device type, or charset.  It can also be used to mark instantiators
+added by a particular package so that they can be later removed as a group.
 
 A specifier tag set consists of a list of zero of more specifier tags,
 each of which is a symbol that is recognized by XEmacs as a tag.
@@ -818,18 +840,25 @@
 \(as opposed to a list) because the order of the tags or the number of
 times a particular tag occurs does not matter.
 
-Each tag has a predicate associated with it, which specifies whether
-that tag applies to a particular device.  The tags which are device types
-and classes match devices of that type or class.  User-defined tags can
-have any predicate, or none (meaning that all devices match).  When
-attempting to instantiate a specifier, a particular instantiator is only
-considered if the device of the domain being instantiated over matches
-all tags in the tag set attached to that instantiator.
+Each tag has two predicates associated with it, which specify, respectively,
+whether that tag applies to a particular device and whether it applies to a
+particular character set.  The predefined tags which are device types and
+classes match devices of that type or class.  User-defined tags can have any
+device predicate, or none (meaning that all devices match).  When attempting
+to instantiate a specifier, a particular instantiator is only considered if
+the device of the domain being instantiated over matches all tags in the tag
+set attached to that instantiator.
+
+If a charset is to be considered--which is only the case for face
+instantiators--this consideration may be done twice.  The first iteration
+pays attention to the character set predicates; if no instantiator can be
+found in that case, the search is repeated ignoring the character set
+predicates.
 
 Most of the time, a tag set is not specified, and the instantiator
 gets a null tag set, which matches all devices.
 */
-     (tag_set))
+       (tag_set))
 {
   Lisp_Object rest;
 
@@ -852,7 +881,7 @@
     return list1 (tag_set);
   if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
     invalid_argument ("Invalid specifier tag-set",
-		       tag_set);
+		      tag_set);
   return tag_set;
 }
 
@@ -945,6 +974,67 @@
   return 1;
 }
 
+static int
+charset_matches_specifier_tag_set_p (Lisp_Object charset,
+				     Lisp_Object tag_set,
+				     enum font_specifier_matchspec_stages
+				     stage)
+{
+  Lisp_Object rest;
+  int res = 0;
+
+  assert(stage != impossible);
+
+  LIST_LOOP (rest, tag_set)
+    {
+      Lisp_Object tag = XCAR (rest);
+      Lisp_Object assoc;
+
+      /* In the event that, during the creation of a charset, no specifier
+	 tags exist for which CHARSET-PREDICATE has been specified, then
+	 that charset's entry in Vcharset_tag_lists will be nil, and this
+	 charset shouldn't match. */
+
+      if (NILP (XVECTOR_DATA(Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
+						 - MIN_LEADING_BYTE]))
+	{
+	  return 0;
+	}
+
+      /* Now, find out what the pre-calculated value is. */
+      assoc = assq_no_quit(tag,
+			   XVECTOR_DATA(Vcharset_tag_lists)
+			   [XCHARSET_LEADING_BYTE(charset)
+			    - MIN_LEADING_BYTE]);
+
+      if (!(NILP(assoc)) && !(NILP(XCDR(assoc))))
+	{
+	  assert(VECTORP(XCDR(assoc)));
+
+	  /* In the event that a tag specifies a charset, then the specifier
+	     must match for (this stage and this charset) for all
+	     charset-specifying tags.  */
+	  if (NILP(XVECTOR_DATA(XCDR(assoc))[stage]))
+	    {
+	      /* It doesn't match for this tag, even though the tag
+		 specifies a charset. Return 0. */
+	      return 0;
+	    }
+
+	  /* This tag specifies charset limitations, and this charset and
+	     stage match those charset limitations.
+
+	     In the event that a later tag specifies charset limitations
+	     that don't match, the return 0 above prevents us giving a
+	     positive match. */
+	  res = 1;
+	}
+    }
+
+  return res;
+}
+
+
 DEFUN ("device-matches-specifier-tag-set-p",
        Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
 Return non-nil if DEVICE matches specifier tag set TAG-SET.
@@ -962,56 +1052,71 @@
   return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
 }
 
-DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /*
-Define a new specifier tag.
-If PREDICATE is specified, it should be a function of one argument
-\(a device) that specifies whether the tag matches that particular
-device.  If PREDICATE is omitted, the tag matches all devices.
-
-You can redefine an existing user-defined specifier tag.  However,
-you cannot redefine the built-in specifier tags (the device types
-and classes) or the symbols nil, t, `all', or `global'.
-*/
-       (tag, predicate))
+Lisp_Object
+define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate,
+		     Lisp_Object charset_predicate)
 {
-  Lisp_Object assoc, devcons, concons;
-  int recompute = 0;
-
-  CHECK_SYMBOL (tag);
-  if (valid_device_class_p (tag) ||
-      valid_console_type_p (tag))
-    invalid_change ("Cannot redefine built-in specifier tags", tag);
-  /* Try to prevent common instantiators and locales from being
-     redefined, to reduce ambiguity */
-  if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
-    invalid_change ("Cannot define nil, t, `all', or `global'", tag);
-  assoc = assq_no_quit (tag, Vuser_defined_tags);
+  Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags),
+    concons, devcons, charpres = Qnil;
+  int recompute_devices = 0, recompute_charsets = 0, i, max_args = -1;
+
   if (NILP (assoc))
     {
-      recompute = 1;
-      Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags);
+      recompute_devices = recompute_charsets = 1;
+      Vuser_defined_tags = Fcons (list3 (tag, device_predicate,
+					 charset_predicate),
+				  Vuser_defined_tags);
       DEVICE_LOOP_NO_BREAK (devcons, concons)
 	{
 	  struct device *d = XDEVICE (XCAR (devcons));
 	  /* Initially set the value to t in case of error
-	     in predicate */
+	     in device_predicate */
 	  DEVICE_USER_DEFINED_TAGS (d) =
 	    Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d));
 	}
+
+      if (!NILP (charset_predicate))
+	{
+	  max_args = XINT(Ffunction_max_args(charset_predicate));
+	  if (max_args < 1)
+	    {
+	      invalid_argument
+		("Charset predicate must be able to take an argument", tag);
+	    }
+	}
     }
-  else if (!NILP (predicate) && !NILP (XCDR (assoc)))
+  else if (!NILP (device_predicate) && !NILP (XCADR (assoc)))
     {
-      recompute = 1;
-      XCDR (assoc) = predicate;
+      recompute_devices = 1;
+      XCDR (assoc) = list2(device_predicate, charset_predicate);
     }
-
-  /* recompute the tag values for all devices.  However, in the special
-     case where both the old and new predicates are nil, we know that
-     we don't have to do this. (It's probably common for people to
-     call (define-specifier-tag) more than once on the same tag,
-     and the most common case is where PREDICATE is not specified.) */
-
-  if (recompute)
+  else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc)))
+    {
+      max_args = XINT(Ffunction_max_args(charset_predicate));
+      if (max_args < 1)
+	{
+	  invalid_argument
+	    ("Charset predicate must be able to take an argument", tag);
+	}
+
+      /* If there exists a charset_predicate for the tag currently (even if
+	 the new charset_predicate is nil), or if we're adding one, we need
+	 to recompute.  This contrasts with the device predicates, where we
+	 don't need to recompute if the old and new device predicates are
+	 both nil.  */
+
+      recompute_charsets = 1;
+      XCDR (assoc) = list2(device_predicate, charset_predicate);
+    }
+
+  /* Recompute the tag values for all devices and charsets, if necessary. In
+     the special case where both the old and new device_predicates are nil,
+     we know that we don't have to do it for the device. (It's probably
+     common for people to call (define-specifier-tag) more than once on the
+     same tag, and the most common case is where DEVICE_PREDICATE is not
+     specified.) */
+
+  if (recompute_devices)
     {
       DEVICE_LOOP_NO_BREAK (devcons, concons)
 	{
@@ -1019,14 +1124,158 @@
 	  assoc = assq_no_quit (tag,
 				DEVICE_USER_DEFINED_TAGS (XDEVICE (device)));
 	  assert (CONSP (assoc));
-	  if (NILP (predicate))
+	  if (NILP (device_predicate))
 	    XCDR (assoc) = Qt;
 	  else
-	    XCDR (assoc) = !NILP (call1 (predicate, device)) ? Qt : Qnil;
+	    XCDR (assoc) = !NILP (call1 (device_predicate, device)) ? Qt
+	      : Qnil;
 	}
     }
 
-  return Qnil;
+  if (recompute_charsets)
+    {
+      if (NILP(charset_predicate))
+	{
+	  charpres = Qnil;
+	}
+
+      for (i = 0; i < NUM_LEADING_BYTES; ++i)
+	{
+	  if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i)))
+	    {
+	      continue;
+	    }
+
+	  assoc = assq_no_quit (tag,
+				XVECTOR_DATA(Vcharset_tag_lists)[i]);
+
+	  if (!NILP(charset_predicate))
+	    {
+	      struct gcpro gcpro1;
+	      charpres = make_vector(impossible, Qnil);
+	      GCPRO1 (charpres);
+
+	      /* If you want to extend the number of stages available, here
+		 in setup_charset_initial_specifier_tags, and in specifier.h
+		 is where you want to go. */
+
+#define DEFINE_SPECIFIER_TAG_FROB(stage)	do {			\
+		if (max_args > 1)					\
+		  {							\
+		    XVECTOR_DATA(charpres)[stage] =			\
+		      call2_trapping_problems				\
+		      ("Error during specifier tag charset predicate,"	\
+		       " stage " #stage, charset_predicate,		\
+		       charset_by_leading_byte(MIN_LEADING_BYTE + i),	\
+		       Q##stage, 0);					\
+		  }							\
+		else							\
+		  {							\
+		    XVECTOR_DATA(charpres)[stage] =			\
+		      call1_trapping_problems				\
+		      ("Error during specifier tag charset predicate,"	\
+		       " stage " #stage, charset_predicate,		\
+		       charset_by_leading_byte(MIN_LEADING_BYTE + i),	\
+		       0);						\
+		  }							\
+									\
+		if (UNBOUNDP(XVECTOR_DATA(charpres)[stage]))		\
+		  {							\
+		    XVECTOR_DATA(charpres)[stage] = Qnil;		\
+		  }							\
+		else if (!NILP(XVECTOR_DATA(charpres)[stage]))		\
+		  {							\
+		    /* Don't want refs to random other objects.  */	\
+		    XVECTOR_DATA(charpres)[stage] = Qt;			\
+		  }							\
+	      } while (0)
+
+	      DEFINE_SPECIFIER_TAG_FROB (initial);
+	      DEFINE_SPECIFIER_TAG_FROB (final);
+
+#undef DEFINE_SPECIFIER_TAG_FROB
+
+	      UNGCPRO;
+	    }
+
+	  if (!NILP(assoc))
+	    {
+	      assert(CONSP(assoc));
+	      XCDR (assoc) = charpres;
+	    }
+	  else
+	    {
+	      XVECTOR_DATA(Vcharset_tag_lists)[i]
+		= Fcons(Fcons(tag, charpres),
+			XVECTOR_DATA (Vcharset_tag_lists)[i]);
+	    }
+	}
+    }
+  return Qt;
+}
+
+DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /*
+Define a new specifier tag.
+
+If DEVICE-PREDICATE is specified, it should be a function of one argument
+\(a device) that specifies whether the tag matches that particular device.
+If DEVICE-PREDICATE is omitted, the tag matches all devices.
+
+If CHARSET-PREDICATE is supplied, it should be a function taking a single
+Lisp character set argument.  A tag's charset predicate is primarily used to
+determine what font to use for a given \(set of) charset\(s) when that tag
+is used in a set-face-font call; a non-nil return value indicates that the
+tag matches the charset.
+
+The font matching process also has a concept of stages; the defined stages
+are currently `initial' and `final', and there exist specifier tags with
+those names that correspond to those stages.  On X11, 'initial is used when
+the font matching process is looking for fonts that match the desired
+registries of the charset--see the `charset-registries' function.  If that
+match process fails, then the 'final tag becomes relevant; this means that a
+more general lookup is desired, and that a font doesn't necessarily have to
+match the desired XLFD for the face, just the charset repertoire for this
+charset.  It also means that the charset registry and encoding used will be
+`iso10646-1', and the characters will be converted to display using that
+registry.
+
+If a tag set matches no character set; the two-stage match process will
+ignore the tag on its first pass, but if no match is found, it will respect
+it on the second pass, where character set information is ignored.
+
+You can redefine an existing user-defined specifier tag.  However, you
+cannot redefine most of the built-in specifier tags \(the device types and
+classes, `initial', and `final') or the symbols nil, t, `all', or `global'.
+Note that if a device type is not supported in this XEmacs, it will not be
+available as a built-in specifier tag; this is probably something we should
+change.
+*/
+       (tag, device_predicate, charset_predicate))
+{
+  int max_args;
+
+  CHECK_SYMBOL (tag);
+  if (valid_device_class_p (tag) ||
+      valid_console_type_p (tag) ||
+      EQ (tag, Qinitial) || EQ (tag, Qfinal))
+    invalid_change ("Cannot redefine built-in specifier tags", tag);
+  /* Try to prevent common instantiators and locales from being
+     redefined, to reduce ambiguity */
+  if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
+    invalid_change ("Cannot define nil, t, `all', or `global'", tag);
+
+  if (!NILP (charset_predicate))
+    {
+      max_args = XINT(Ffunction_max_args(charset_predicate));
+      if (max_args != 1)
+	{
+	  /* We only allow the stage argument to be specifed from C.  */
+	  invalid_change ("Charset predicate must take one argument",
+			  tag);
+	}
+    }
+
+  return define_specifier_tag(tag, device_predicate, charset_predicate);
 }
 
 /* Called at device-creation time to initialize the user-defined
@@ -1037,6 +1286,8 @@
 {
   Lisp_Object rest, rest2;
   Lisp_Object device = wrap_device (d);
+  Lisp_Object device_predicate;
+  int list_len;
 
   DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags);
 
@@ -1047,15 +1298,80 @@
   for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d);
        !NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2))
     {
-      Lisp_Object predicate = XCDR (XCAR (rest));
-      if (NILP (predicate))
-	XCDR (XCAR (rest2)) = Qt;
+      GET_LIST_LENGTH(XCAR(rest), list_len);
+
+      assert(3 == list_len);
+
+      device_predicate = XCADR(XCAR (rest));
+
+      if (NILP (device_predicate))
+	{
+	  XCDR (XCAR (rest2)) = Qt;
+	}
       else
-	XCDR (XCAR (rest2)) =
-	  !NILP (call_critical_lisp_code (d, predicate, device)) ? Qt : Qnil;
+	{
+	  device_predicate = !NILP (call_critical_lisp_code
+				    (d, device_predicate, device))
+	    ? Qt : Qnil;
+	  XCDR (XCAR (rest2)) = device_predicate;
+	}
     }
 }
 
+void
+setup_charset_initial_specifier_tags (Lisp_Object charset)
+{
+  Lisp_Object rest, charset_predicate, tag, new_value;
+  Lisp_Object charset_tag_list = Qnil;
+
+  LIST_LOOP (rest, Vuser_defined_tags)
+    {
+      tag = XCAR(XCAR(rest));
+      charset_predicate = XCADDR(XCAR (rest));
+
+      if (NILP(charset_predicate))
+	{
+	  continue;
+	}
+
+      new_value = make_vector(impossible, Qnil);
+
+#define SETUP_CHARSET_TAGS_FROB(stage)		do {			\
+									\
+	XVECTOR_DATA(new_value)[stage] = call2_trapping_problems	\
+	  ("Error during specifier tag charset predicate,"		\
+	   " stage " #stage,						\
+	   charset_predicate, charset, Q##stage, 0);			\
+									\
+	if (UNBOUNDP(XVECTOR_DATA(new_value)[stage]))			\
+	  {								\
+	    XVECTOR_DATA(new_value)[stage] = Qnil;			\
+	  }								\
+	else if (!NILP(XVECTOR_DATA(new_value)[stage]))			\
+	  {								\
+	    /* Don't want random other objects hanging around. */	\
+	    XVECTOR_DATA(new_value)[stage] = Qt;			\
+	  }								\
+									\
+      } while (0)
+
+      SETUP_CHARSET_TAGS_FROB (initial);
+      SETUP_CHARSET_TAGS_FROB (final);
+      /* More later?  */
+
+#undef SETUP_CHARSET_TAGS_FROB
+
+      charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list);
+    }
+
+  XVECTOR_DATA
+    (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE]
+    = charset_tag_list;
+}
+
+/* VM calls this, in vm-multiple-frames-possible-p, in the event that you're
+   considering taking it out. */
+
 DEFUN ("device-matching-specifier-tag-list",
        Fdevice_matching_specifier_tag_list,
        0, 1, 0, /*
@@ -1104,8 +1420,9 @@
   RETURN_UNGCPRO (list);
 }
 
-DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /*
-Return the predicate for the given specifier tag.
+DEFUN ("specifier-tag-device-predicate", Fspecifier_tag_device_predicate,
+       1, 1, 0, /*
+Return the device predicate for the given specifier tag.
 */
        (tag))
 {
@@ -1114,7 +1431,7 @@
 
   if (NILP (Fvalid_specifier_tag_p (tag)))
     invalid_argument ("Invalid specifier tag",
-		       tag);
+		      tag);
 
   /* Make up some predicates for the built-in types */
 
@@ -1128,11 +1445,27 @@
 		  list3 (Qeq, list2 (Qquote, tag),
 			 list2 (Qdevice_class, Qdevice)));
 
-  return XCDR (assq_no_quit (tag, Vuser_defined_tags));
+  return XCADR (assq_no_quit (tag, Vuser_defined_tags));
+}
+
+DEFUN ("specifier-tag-charset-predicate", Fspecifier_tag_charset_predicate,
+       1, 1, 0, /*
+Return the charset predicate for the given specifier tag.
+*/
+       (tag))
+{
+  /* The return value of this function must be GCPRO'd. */
+  CHECK_SYMBOL (tag);
+
+  if (NILP (Fvalid_specifier_tag_p (tag)))
+    invalid_argument ("Invalid specifier tag",
+		      tag);
+
+  return XCADDR (assq_no_quit (tag, Vuser_defined_tags));
 }
 
 /* Return true if A "matches" B.  If EXACT_P is 0, A must be a subset of B.
-  Otherwise, A must be `equal' to B.  The sets must be canonicalized. */
+   Otherwise, A must be `equal' to B.  The sets must be canonicalized. */
 static int
 tag_sets_match_p (Lisp_Object a, Lisp_Object b, int exact_p)
 {
@@ -1240,15 +1573,15 @@
       if (!CONSP (inst_pair))
 	{
 	  maybe_sferror (
-				   "Invalid instantiator pair", inst_pair,
-				     Qspecifier, errb);
+			 "Invalid instantiator pair", inst_pair,
+			 Qspecifier, errb);
 	  return Qnil;
 	}
       if (NILP (Fvalid_specifier_tag_set_p (tag_set = XCAR (inst_pair))))
 	{
 	  maybe_invalid_argument (
-				   "Invalid specifier tag", tag_set,
-				     Qspecifier, errb);
+				  "Invalid specifier tag", tag_set,
+				  Qspecifier, errb);
 	  return Qnil;
 	}
 
@@ -1289,15 +1622,15 @@
       if (!CONSP (spec))
 	{
 	  maybe_sferror (
-				   "Invalid specification list", spec_list,
-				     Qspecifier, errb);
+			 "Invalid specification list", spec_list,
+			 Qspecifier, errb);
 	  return Qnil;
 	}
       if (NILP (Fvalid_specifier_locale_p (locale = XCAR (spec))))
 	{
 	  maybe_invalid_argument (
-				   "Invalid specifier locale", locale,
-				     Qspecifier, errb);
+				  "Invalid specifier locale", locale,
+				  Qspecifier, errb);
 	  return Qnil;
 	}
 
@@ -1386,13 +1719,13 @@
    out the frequency with which this is called with the various types
    and reorder the check accordingly. */
 #define SPECIFIER_GET_SPEC_LIST(specifier, type)			\
-(type == LOCALE_GLOBAL ? &(XSPECIFIER (specifier)->global_specs)   :	\
- type == LOCALE_DEVICE ? &(XSPECIFIER (specifier)->device_specs)   :	\
- type == LOCALE_FRAME  ? &(XSPECIFIER (specifier)->frame_specs)    :	\
- type == LOCALE_WINDOW ? &(XWEAK_LIST_LIST				\
-			   (XSPECIFIER (specifier)->window_specs)) :	\
- type == LOCALE_BUFFER ? &(XSPECIFIER (specifier)->buffer_specs)   :	\
- 0)
+  (type == LOCALE_GLOBAL ? &(XSPECIFIER (specifier)->global_specs)   :	\
+   type == LOCALE_DEVICE ? &(XSPECIFIER (specifier)->device_specs)   :	\
+   type == LOCALE_FRAME  ? &(XSPECIFIER (specifier)->frame_specs)    :	\
+   type == LOCALE_WINDOW ? &(XWEAK_LIST_LIST				\
+			     (XSPECIFIER (specifier)->window_specs)) :	\
+   type == LOCALE_BUFFER ? &(XSPECIFIER (specifier)->buffer_specs)   :	\
+   0)
 
 static Lisp_Object *
 specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale,
@@ -1731,8 +2064,8 @@
    validating LOCALE and INST-LIST, but the tag-sets in INST-LIST
    do not need to be canonicalized. */
 
-  /* #### I really need to rethink the after-change
-     functions to make them easier to use and more efficient. */
+/* #### I really need to rethink the after-change
+   functions to make them easier to use and more efficient. */
 
 static void
 specifier_add_spec (Lisp_Object specifier, Lisp_Object locale,
@@ -1828,9 +2161,9 @@
 /* map MAPFUN over the locales in SPECIFIER that are given in LOCALE.
    CLOSURE is passed unchanged to MAPFUN.  LOCALE can be one of
 
-     -- nil (same as `all')
-     -- a single locale, locale type, or `all'
-     -- a list of locales, locale types, and/or `all'
+   -- nil (same as `all')
+   -- a single locale, locale type, or `all'
+   -- a list of locales, locale types, and/or `all'
 
    MAPFUN is called for each locale and locale type given; for `all',
    it is called for the locale `global' and for the four possible
@@ -1840,7 +2173,7 @@
    If MAPFUN ever returns non-zero, the mapping is halted and the
    value returned is returned from map_specifier().  Otherwise, the
    mapping proceeds to the end and map_specifier() returns 0.
- */
+*/
 
 static int
 map_specifier (Lisp_Object specifier, Lisp_Object locale,
@@ -1985,10 +2318,10 @@
 where
   LOCALE := a window, a buffer, a frame, a device, or `global'
   TAG-SET := an unordered list of zero or more TAGS, each of which
-             is a symbol
+	     is a symbol
   TAG := a device class (see `valid-device-class-p'), a device type
-         (see `valid-console-type-p'), or a tag defined with
-         `define-specifier-tag'
+	 (see `valid-console-type-p'), or a tag defined with
+	 `define-specifier-tag'
   INSTANTIATOR := format determined by the type of specifier
 
 The pair (TAG-SET . INSTANTIATOR) is called an `inst-pair'.
@@ -2120,7 +2453,7 @@
 TAG-SET must be equal to an instantiator's tag set for the instantiator
 to be returned.
 */
-     (specifier, locale, tag_set, exact_p))
+       (specifier, locale, tag_set, exact_p))
 {
   struct specifier_spec_list_closure cl;
   struct gcpro gcpro1, gcpro2;
@@ -2319,7 +2652,7 @@
       CHECK_SPECIFIER (dest);
       check_modifiable_specifier (dest);
       if (XSPECIFIER (dest)->methods != XSPECIFIER (specifier)->methods)
- invalid_argument ("Specifiers not of same type", Qunbound);
+	invalid_argument ("Specifiers not of same type", Qunbound);
     }
 
   cl.dest = dest;
@@ -2464,14 +2797,18 @@
 				   Lisp_Object inst_list,
 				   Error_Behavior errb, int no_quit,
 				   Lisp_Object depth,
-				   Lisp_Object *instantiator)
+				   Lisp_Object *instantiator,
+				   int no_fallback)
 {
   /* This function can GC */
   Lisp_Specifier *sp;
-  Lisp_Object device;
-  Lisp_Object rest;
-  int count = specpdl_depth ();
+  Lisp_Object device, charset = Qnil, rest;
+  int count = specpdl_depth (), respected_charsets = 0;
   struct gcpro gcpro1, gcpro2;
+  enum font_specifier_matchspec_stages stage = initial;
+#ifdef DEBUG_XEMACS
+  int non_ascii;
+#endif
 
   GCPRO2 (specifier, inst_list);
 
@@ -2479,37 +2816,125 @@
   device = DOMAIN_DEVICE (domain);
 
   if (no_quit)
-  /* The instantiate method is allowed to call eval.  Since it
-     is quite common for this function to get called from somewhere in
-     redisplay we need to make sure that quits are ignored.  Otherwise
-     Fsignal will abort. */
+    /* The instantiate method is allowed to call eval.  Since it
+       is quite common for this function to get called from somewhere in
+       redisplay we need to make sure that quits are ignored.  Otherwise
+       Fsignal will abort. */
     specbind (Qinhibit_quit, Qt);
 
+#ifdef MULE
+  if (CONSP(matchspec) && (CHARSETP(Ffind_charset(XCAR(matchspec)))))
+    {
+      charset = Ffind_charset(XCAR(matchspec));
+
+#ifdef DEBUG_XEMACS
+      /* This is mostly to have somewhere to set debug breakpoints. */
+      if (!EQ(charset, Vcharset_ascii))
+	{
+	  non_ascii = 1;
+	}
+#endif /* DEBUG_XEMACS */
+
+      if (!NILP(XCDR(matchspec)))
+	{
+
+#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec)))	\
+	    {							\
+	      stage = new_stage;				\
+	    }
+
+	  FROB(initial)
+	  else FROB(final)
+	  else assert(0);
+#undef FROB
+
+	}
+    }
+#endif /* MULE */
+
+  LIST_LOOP(rest, inst_list)
+    {
+      Lisp_Object tagged_inst = XCAR (rest);
+      Lisp_Object tag_set = XCAR (tagged_inst);
+      Lisp_Object val, the_instantiator;
+
+      if (!device_matches_specifier_tag_set_p (device, tag_set))
+	{
+	  continue;
+	}
+
+      val = XCDR (tagged_inst);
+      the_instantiator = val;
+
+      if (!NILP(charset) &&
+	  !(charset_matches_specifier_tag_set_p (charset, tag_set, stage)))
+	{
+	  ++respected_charsets;
+	  continue;
+	}
+
+      if (HAS_SPECMETH_P (sp, instantiate))
+	val = call_with_suspended_errors
+	  ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+	   Qunbound, Qspecifier, errb, 5, specifier,
+	   matchspec, domain, val, depth, no_fallback);
+
+      if (!UNBOUNDP (val))
+	{
+	  unbind_to (count);
+	  UNGCPRO;
+	  if (instantiator)
+	    *instantiator = the_instantiator;
+	  return val;
+	}
+    }
+
+  /* We've checked all the tag sets, and checking the charset part of the
+     specifier never returned 0 (preventing the attempted instantiation), so
+     there's no need to loop for the second time to avoid checking the
+     charsets. */
+  if (!respected_charsets)
+    {
+      unbind_to (count);
+      UNGCPRO;
+      return Qunbound;
+    }
+
+  /* Right, didn't instantiate a specifier last time, perhaps because we
+     paid attention to the charset-specific aspects of the specifier.  Try
+     again without checking the charset information.
+
+     We can't emulate the approach for devices, defaulting to matching all
+     character sets for a given specifier, because $random font instantiator
+     cannot usefully show all character sets, and indeed having it try is a
+     failure on our part.  */
   LIST_LOOP (rest, inst_list)
     {
       Lisp_Object tagged_inst = XCAR (rest);
       Lisp_Object tag_set = XCAR (tagged_inst);
-
-      if (device_matches_specifier_tag_set_p (device, tag_set))
+      Lisp_Object val, the_instantiator;
+
+      if (!device_matches_specifier_tag_set_p (device, tag_set))
 	{
-	  Lisp_Object val = XCDR (tagged_inst);
-	  Lisp_Object the_instantiator = val;
-
-
-	  if (HAS_SPECMETH_P (sp, instantiate))
-	    val = call_with_suspended_errors
-	      ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
-	       Qunbound, Qspecifier, errb, 5, specifier,
-	       matchspec, domain, val, depth);
-
-	  if (!UNBOUNDP (val))
-	    {
-	      unbind_to (count);
-	      UNGCPRO;
-	      if (instantiator)
-		*instantiator = the_instantiator;
-	      return val;
-	    }
+	  continue;
+	}
+
+      val = XCDR (tagged_inst);
+      the_instantiator = val;
+
+      if (HAS_SPECMETH_P (sp, instantiate))
+	val = call_with_suspended_errors
+	  ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
+	   Qunbound, Qspecifier, errb, 5, specifier,
+	   matchspec, domain, val, depth, no_fallback);
+
+      if (!UNBOUNDP (val))
+	{
+	  unbind_to (count);
+	  UNGCPRO;
+	  if (instantiator)
+	    *instantiator = the_instantiator;
+	  return val;
 	}
     }
 
@@ -2520,23 +2945,23 @@
 
 /* Given a SPECIFIER and a DOMAIN, return a specific instance for that
    specifier. Try to find one by checking the specifier types from most
-   specific (buffer) to most general (global).  If we find an instance,
+   specific (window) to most general (global).  If we find an instance,
    return it.  Otherwise return Qunbound. */
 
 #define CHECK_INSTANCE_ENTRY(key, matchspec, type) do {			\
-  Lisp_Object *CIE_inst_list =						\
-    specifier_get_inst_list (specifier, key, type);			\
-  if (CIE_inst_list)							\
-    {									\
-      Lisp_Object CIE_val =						\
-	specifier_instance_from_inst_list (specifier, matchspec,	\
-					   domain, *CIE_inst_list,	\
-					   errb, no_quit, depth,	\
-                                           instantiator);		\
-      if (!UNBOUNDP (CIE_val))						\
-	return CIE_val;							\
-    }									\
-} while (0)
+    Lisp_Object *CIE_inst_list =					\
+      specifier_get_inst_list (specifier, key, type);			\
+    if (CIE_inst_list)							\
+      {									\
+	Lisp_Object CIE_val =						\
+	  specifier_instance_from_inst_list (specifier, matchspec,	\
+					     domain, *CIE_inst_list,	\
+					     errb, no_quit, depth,	\
+					     instantiator, no_fallback); \
+	if (!UNBOUNDP (CIE_val))					\
+	  return CIE_val;						\
+      }									\
+  } while (0)
 
 /* We accept any window, frame or device domain and do our checking
    starting from as specific a locale type as we can determine from the
@@ -2644,7 +3069,8 @@
   assert (CONSP (sp->fallback));
   return specifier_instance_from_inst_list (specifier, matchspec, domain,
 					    sp->fallback, errb, no_quit,
-					    depth, instantiator);
+					    depth, instantiator,
+					    no_fallback);
 }
 #undef CHECK_INSTANCE_ENTRY
 
@@ -2814,14 +3240,21 @@
    display table is not there. (Chartable specifiers are not yet
    implemented.)
 
--- For font specifiers, MATCHSPEC should be a list (CHARSET . SECOND-STAGE-P),
-   and the specification (a font string) must have a registry that matches
-   the charset's registry.  (This only makes sense with Mule support.) This
-   makes it easy to choose a font that can display a particular
-   character. (This is what redisplay does, in fact.) SECOND-STAGE-P means
-   to ignore the font's registry and instead look at the characters in the
-   font to see if the font can support the charset.  This currently only makes
-   sense under MS Windows.
+-- For font specifiers, MATCHSPEC should be a cons (CHARSET . STAGE).
+   The defined stages are currently `initial' and `final'.  On X11, 'initial
+   is used when the font matching process is looking for fonts that match
+   the desired registries of the charset--see the `charset-registries'
+   function.  If that match process fails, then the 'final stage comes into
+   play; this means that a more general lookup is desired, and that a font
+   doesn't necessarily have to match the desired XLFD for the face, just the
+   charset repertoire for this charset.  It also means that the charset
+   registry and encoding used will be `iso10646-1', and the characters will
+   be converted to display using that registry.
+
+   See `define-specifier-tag' for details on how to create a tag that
+   specifies a given character set and stage combination.  You can supply
+   such a tag to `set-face-font' in order to set a face's font for that
+   character set and stage combination.
 */
        (specifier, matchspec, domain, default_, no_fallback))
 {
@@ -2870,7 +3303,7 @@
   if (!NILP (built_up_list))
     val = specifier_instance_from_inst_list (specifier, matchspec, domain,
 					     built_up_list, ERROR_ME,
-					     0, Qzero, &instantiator);
+					     0, Qzero, &instantiator, 0);
   UNGCPRO;
   return UNBOUNDP (val) ? default_ : want_instantiator ? instantiator : val;
 
@@ -2891,8 +3324,8 @@
 						0);
 }
 
-DEFUN ("specifier-instantiator-from-inst-list", Fspecifier_instantiator_from_inst_list,
-       3, 4, 0, /*
+DEFUN ("specifier-instantiator-from-inst-list",
+       Fspecifier_instantiator_from_inst_list, 3, 4, 0, /*
 Attempt to convert an inst-list into an instance; return instantiator.
 This is identical to `specifier-instance-from-inst-list' but returns
 the instantiator used to generate the instance, rather than the instance
@@ -2960,17 +3393,17 @@
    If you create a built-in specifier, you should do the following:
 
    - Make sure the file you create the specifier in has a
-     specifier_vars_of_foo() function.  If not, create it, declare it in
-     symsinit.h, and make sure it's called in the appropriate place in
-     emacs.c.
+   specifier_vars_of_foo() function.  If not, create it, declare it in
+   symsinit.h, and make sure it's called in the appropriate place in
+   emacs.c.
    - In specifier_vars_of_foo(), do a DEFVAR_SPECIFIER(), followed by
-     initializing the specifier using Fmake_specifier(), followed by
-     set_specifier_fallback(), followed (optionally) by
-     set_specifier_caching().
+   initializing the specifier using Fmake_specifier(), followed by
+   set_specifier_fallback(), followed (optionally) by
+   set_specifier_caching().
    - If you used set_specifier_caching(), make sure to create the
-     appropriate value-changed functions.  Also make sure to add the
-     appropriate slots where the values are cached to frameslots.h and
-     winslots.h.
+   appropriate value-changed functions.  Also make sure to add the
+   appropriate slots where the values are cached to frameslots.h and
+   winslots.h.
 
    Do a grep for menubar_visible_p for an example.
 */
@@ -2993,7 +3426,12 @@
   assert (!GHOST_SPECIFIER_P (sp));
 
   if (!sp->caching)
-    sp->caching = xnew_and_zero (struct specifier_caching);
+#ifdef NEW_GC
+    sp->caching = alloc_lrecord_type (struct specifier_caching,
+				      &lrecord_specifier_caching);
+#else /* not NEW_GC */
+  sp->caching = xnew_and_zero (struct specifier_caching);
+#endif /* not NEW_GC */
   sp->caching->offset_into_struct_window = struct_window_offset;
   sp->caching->value_changed_in_window = value_changed_in_window;
   sp->caching->offset_into_struct_frame = struct_frame_offset;
@@ -3293,10 +3731,10 @@
 
 DEFINE_SPECIFIER_TYPE (display_table);
 
-#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(instantiator)		   \
-  (VECTORP (instantiator)						   \
-   || (CHAR_TABLEP (instantiator)					   \
-       && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR	   \
+#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(instantiator)		\
+  (VECTORP (instantiator)						\
+   || (CHAR_TABLEP (instantiator)					\
+       && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR	\
 	   || XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_GENERIC)) \
    || RANGE_TABLEP (instantiator))
 
@@ -3321,7 +3759,7 @@
 	lose:
 	  dead_wrong_type_argument
 	    (display_table_specifier_methods->predicate_symbol,
-				    instantiator);
+	     instantiator);
 	}
     }
 }
@@ -3346,6 +3784,9 @@
 syms_of_specifier (void)
 {
   INIT_LISP_OBJECT (specifier);
+#ifdef NEW_GC
+  INIT_LISP_OBJECT (specifier_caching);
+#endif /* NEW_GC */
 
   DEFSYMBOL (Qspecifierp);
 
@@ -3371,8 +3812,10 @@
   DEFSUBR (Fdevice_matches_specifier_tag_set_p);
   DEFSUBR (Fdefine_specifier_tag);
   DEFSUBR (Fdevice_matching_specifier_tag_list);
+
   DEFSUBR (Fspecifier_tag_list);
-  DEFSUBR (Fspecifier_tag_predicate);
+  DEFSUBR (Fspecifier_tag_device_predicate);
+  DEFSUBR (Fspecifier_tag_charset_predicate);
 
   DEFSUBR (Fcheck_valid_instantiator);
   DEFSUBR (Fvalid_instantiator_p);
@@ -3473,4 +3916,7 @@
 
   Vunlock_ghost_specifiers = Qnil;
   staticpro (&Vunlock_ghost_specifiers);
+
+  Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil);
+  staticpro (&Vcharset_tag_lists);
 }