emacs: src/fontset.c comparison

comparison src/fontset.c @ 53353:b085f18ebcf0

(Voverriding_fontspec_alist): New variable. (lookup_overriding_fontspec): New function. (fontset_ref_via_base): Call lookup_overriding_fontspec if necessary. (fontset_font_pattern): Likewise. (regulalize_fontname): New function. (Fset_fontset_font): Call regulalize_fontname. (Fset_overriding_fontspec_internal): New function. (syms_of_fontset): Initialize and staticprop Voverriding_fontspec_alist. (syms_of_fontset): Defsubr Sset_overriding_fontspec_internal.

author	Kenichi Handa <handa@m17n.org>
date	Mon, 29 Dec 2003 06:53:50 +0000
parents	8787289602d1
children	ccddf8ef9113 5de4189e659d

comparison

equal deleted inserted replaced

-:958aea5e5a05
+:b085f18ebcf0
 /* The default fontset.  This gives default FAMILY and REGISTRY of
 font for each characters.  */
 static Lisp_Object Vdefault_fontset;
+/* Alist of font specifications.  It override the font specification
+in the default fontset.  */
+static Lisp_Object Voverriding_fontspec_alist;
 Lisp_Object Vfont_encoding_alist;
 Lisp_Object Vuse_default_ascent;
 Lisp_Object Vignore_relative_composition;
 Lisp_Object Valternate_fontname_alist;
 Lisp_Object Vfontset_alias_alist;
 void (*check_window_system_func) P_ ((void));
 /* Prototype declarations for static functions.  */
 static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
+static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
 static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
 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 Lisp_Object regulalize_fontname P_ ((Lisp_Object));
 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
 /* Return the fontset with ID.  No check of ID's validness.  */
 return defalt;
 return elt;
 }
+static Lisp_Object
+lookup_overriding_fontspec (frame, c)
+Lisp_Object frame;
+int c;
+{
+Lisp_Object tail;
+for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
+{
+Lisp_Object val, target, elt;
+val = XCAR (tail);
+target = XCAR (val);
+val = XCDR (val);
+/* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME).  */
+if (NILP (Fmemq (frame, XCAR (val)))
+	  && (CHAR_TABLE_P (target)
+	      ? ! NILP (CHAR_TABLE_REF (target, c))
+	      : XINT (target) == CHAR_CHARSET (c)))
+	{
+	  val = XCDR (val);
+	  elt = XCDR (val);
+	  if (NILP (Fmemq (frame, XCAR (val))))
+	    {
+	      if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
+		{
+		  val = XCDR (XCAR (tail));
+		  XSETCAR (val, Fcons (frame, XCAR (val)));
+		  continue;
+		}
+	      XSETCAR (val, Fcons (frame, XCAR (val)));
+	    }
+	  if (NILP (XCAR (elt)))
+	    XSETCAR (elt, make_number (c));
+	  return elt;
+	}
+}
+return Qnil;
+}
 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
 static Lisp_Object
 fontset_ref_via_base (fontset, c)
 Lisp_Object fontset;
 Lisp_Object elt;
 if (SINGLE_BYTE_CHAR_P (*c))
 return FONTSET_ASCII (fontset);
-elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
+elt = Qnil;
-if (NILP (elt) && ! EQ (fontset, Vdefault_fontset))
+if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
+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))
 elt = FONTSET_REF (Vdefault_fontset, *c);
 if (NILP (elt))
 return Qnil;
 *c = XINT (XCAR (elt));
 {
 fontset = FONTSET_FROM_ID (id);
 xassert (!BASE_FONTSET_P (fontset));
 fontset = FONTSET_BASE (fontset);
 elt = FONTSET_REF (fontset, c);
+}
+if (NILP (elt))
+{
+Lisp_Object frame;
+XSETFRAME (frame, f);
+elt = lookup_overriding_fontspec (frame, c);
 }
 if (NILP (elt))
 elt = FONTSET_REF (Vdefault_fontset, c);
 if (!CONSP (elt))
 if (id < 0)
 error ("Fontset `%s' does not exist", SDATA (name));
 return FONTSET_FROM_ID (id);
 }
+/* Downcase FONTNAME or car and cdr of FONTNAME.  If FONTNAME is a
+string, maybe change FONTNAME to (FAMILY . REGISTRY).  */
+static Lisp_Object
+regulalize_fontname (Lisp_Object fontname)
+{
+Lisp_Object family, registry;
+if (STRINGP (fontname))
+return font_family_registry (Fdowncase (fontname), 0);
+CHECK_CONS (fontname);
+family = XCAR (fontname);
+registry = XCDR (fontname);
+if (!NILP (family))
+{
+CHECK_STRING (family);
+family = Fdowncase (family);
+}
+if (!NILP (registry))
+{
+CHECK_STRING (registry);
+registry = Fdowncase (registry);
+}
+return Fcons (family, registry);
+}
 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
 doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
 If NAME is nil, modify the default fontset.
 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
 	invalid_character (to);
 if (SINGLE_BYTE_CHAR_P (to))
 	error ("Can't change font for a single byte character");
 }
-if (STRINGP (fontname))
-{
-fontname = Fdowncase (fontname);
-elt = Fcons (make_number (from), font_family_registry (fontname, 0));
-}
-else
-{
-CHECK_CONS (fontname);
-family = XCAR (fontname);
-registry = XCDR (fontname);
-if (!NILP (family))
-	{
-	  CHECK_STRING (family);
-	  family = Fdowncase (family);
-	}
-if (!NILP (registry))
-	{
-	  CHECK_STRING (registry);
-	  registry = Fdowncase (registry);
-	}
-elt = Fcons (make_number (from), Fcons (family, registry));
-}
 /* The arg FRAME is kept for backward compatibility.  We only check
 the validity.  */
 if (!NILP (frame))
 CHECK_LIVE_FRAME (frame);
+elt = Fcons (make_number (from), regulalize_fontname (fontname));
 for (; from <= to; from++)
 FONTSET_SET (fontset, from, elt);
 Foptimize_char_table (fontset);
 /* If there's a realized fontset REALIZED whose parent is FONTSET,
 }
 return list;
 }
+DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
+Sset_overriding_fontspec_internal, 1, 1, 0,
+doc: /* Internal use only.
+FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
+or a char-table, FONTNAME have the same meanings as in
+`set-fontset-font'.
+It overrides the font specifications for each TARGET in the default
+fontset by the corresponding FONTNAME.
+If TARGET is a charset, targets are all characters in the charset.  If
+TARGET is a char-table, targets are characters whose value is non-nil
+in the table.
+It is intended that this function is called only from
+`set-language-environment'.  */)
+(fontlist)
+Lisp_Object fontlist;
+{
+Lisp_Object tail;
+fontlist = Fcopy_sequence (fontlist);
+/* Now FONTLIST is ((TARGET . FONTNAME) ...).  Reform it to ((TARGET
+nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
+char-table.  */
+for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
+{
+Lisp_Object elt, target;
+elt = XCAR (tail);
+target = Fcar (elt);
+elt = Fcons (Qnil, regulalize_fontname (Fcdr (elt)));
+if (! CHAR_TABLE_P (target))
+	{
+	  int charset, c;
+	  CHECK_SYMBOL (target);
+	  charset = get_charset_id (target);
+	  if (charset < 0)
+	    error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
+	  target = make_number (charset);
+	  c = MAKE_CHAR (charset, 0, 0);
+	  XSETCAR (elt, make_number (c));
+	}
+elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
+XSETCAR (tail, elt);
+}
+Voverriding_fontspec_alist = fontlist;
+clear_face_cache (0);
+++windows_or_buffers_changed;
+return Qnil;
+}
 void
 syms_of_fontset ()
 {
 if (!load_font_func)
 /* Window system initializer should have set proper functions.  */
 	     build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
 #endif
 AREF (Vfontset_table, 0) = Vdefault_fontset;
 next_fontset_id = 1;
+Voverriding_fontspec_alist = Qnil;
+staticpro (&Voverriding_fontspec_alist);
 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
 	       doc: /* Alist of fontname patterns vs corresponding encoding info.
 Each element looks like (REGEXP . ENCODING-INFO),
 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
 ENCODING is one of the following integer values:
 defsubr (&Sfont_info);
 defsubr (&Sinternal_char_font);
 defsubr (&Sfontset_info);
 defsubr (&Sfontset_font);
 defsubr (&Sfontset_list);
+defsubr (&Sset_overriding_fontspec_internal);
 }
 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
 (do not change this comment) */

Mercurial > emacs

comparison src/fontset.c @ 53353:b085f18ebcf0