emacs: src/xfaces.c comparison

comparison src/xfaces.c @ 95865:99530dd346d3

(LFACE_FOUNDRY): New macro. (check_lface_attrs): Check foundry. (set_lface_from_font): Don't parse "FOUNDRY-FAMILY" from. (merge_face_vectors): Check foundry. (merge_face_ref): Likewise. (Finternal_set_lisp_face_attribute): Likewise. (x_update_menu_appearance): Likewise. (Finternal_get_lisp_face_attribute): Likewise. (lface_hash): Likewise. (lface_same_font_attributes_p): Likewise. (x_supports_face_attributes_p): Likewise. (tty_supports_face_attributes_p): Likewise. (Finternal_set_alternative_font_family_alist): Intern strings. (Finternal_set_alternative_font_registry_alist): Downcase strings. (realize_default_face): Set LFACE_FOUNDRY (lface).

author	Kenichi Handa <handa@m17n.org>
date	Fri, 13 Jun 2008 02:08:32 +0000
parents	fa7d768bdd0b
children	6cece6cbe017

comparison

equal deleted inserted replaced

-:1388820636da
+:99530dd346d3
 changed by defining `faces'.  Each face can specify the following
 display attributes:
 1. Font family name.
-2. Relative proportionate width, aka character set width or set
+2. Font foundary name.
+3. Relative proportionate width, aka character set width or set
 width (swidth), e.g. `semi-compressed'.
-3. Font height in 1/10pt.
+4. Font height in 1/10pt.
-4. Font weight, e.g. `bold'.
+5. Font weight, e.g. `bold'.
-5. Font slant, e.g. `italic'.
+6. Font slant, e.g. `italic'.
-6. Foreground color.
+7. Foreground color.
-7. Background color.
+8. Background color.
-8. Whether or not characters should be underlined, and in what color.
+9. Whether or not characters should be underlined, and in what color.
-9. Whether or not characters should be displayed in inverse video.
+10. Whether or not characters should be displayed in inverse video.
-10. A background stipple, a bitmap.
+11. A background stipple, a bitmap.
-11. Whether or not characters should be overlined, and in what color.
+12. Whether or not characters should be overlined, and in what color.
-12. Whether or not characters should be strike-through, and in what
+13. Whether or not characters should be strike-through, and in what
 color.
-13. Whether or not a box should be drawn around characters, the box
+14. Whether or not a box should be drawn around characters, the box
 type, and, for simple boxes, in what color.
-14. Font-spec, or nil.  This is a special attribute.
+15. Font-spec, or nil.  This is a special attribute.
 A font-spec is a collection of font attributes (specs).
 When this attribute is specified, the face uses a font matching
 with the specs as is except for what overwritten by the specs in
 static int may_use_scalable_font_p P_ ((const char *));
 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
 static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *,
 				     int, struct named_merge_point *));
 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
-static unsigned char *xstrlwr P_ ((unsigned char *));
 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
 static void free_face_colors P_ ((struct frame *, struct face *));
 static int face_color_gray_p P_ ((struct frame *, char *));
 static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *,
 ***********************************************************************/
 /* Access face attributes of face LFACE, a Lisp vector.  */
 #define LFACE_FAMILY(LFACE)	    AREF ((LFACE), LFACE_FAMILY_INDEX)
+#define LFACE_FOUNDRY(LFACE)	    AREF ((LFACE), LFACE_FOUNDRY_INDEX)
 #define LFACE_HEIGHT(LFACE)	    AREF ((LFACE), LFACE_HEIGHT_INDEX)
 #define LFACE_WEIGHT(LFACE)	    AREF ((LFACE), LFACE_WEIGHT_INDEX)
 #define LFACE_SLANT(LFACE)	    AREF ((LFACE), LFACE_SLANT_INDEX)
 #define LFACE_UNDERLINE(LFACE)      AREF ((LFACE), LFACE_UNDERLINE_INDEX)
 #define LFACE_INVERSE(LFACE)	    AREF ((LFACE), LFACE_INVERSE_INDEX)
 Lisp_Object *attrs;
 {
 xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
 	   || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
 	   || STRINGP (attrs[LFACE_FAMILY_INDEX]));
+xassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
+	   || IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
+	   || STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
 xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
 	   || IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
 	   || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
 xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
 	   || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
 new frames would never take effect.  If the font doesn't have a
 specific property, set a normal value for that.  */
 if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
 {
+Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
+LFACE_FAMILY (lface) = SYMBOL_NAME (family);
+}
+if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
+{
 Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
-Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
+LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry);
-if (! NILP (foundry))
-	{
-	  if (! NILP (family))
-	    val = concat3 (SYMBOL_NAME (foundry), build_string ("-"),
-			   SYMBOL_NAME (family));
-	  else
-	    val = concat2 (SYMBOL_NAME (foundry), build_string ("-*"));
-	}
-else
-	{
-	  if (! NILP (family))
-	    val = SYMBOL_NAME (family);
-	  else
-	    val = build_string ("*");
-	}
-LFACE_FAMILY (lface) = val;
 }
 if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
 {
 int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy);
 	  {
 	    to[i] = from[i];
 	    if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
 	      font_clear_prop (to,
 			       (i == LFACE_FAMILY_INDEX ? FONT_FAMILY_INDEX
+				: i == LFACE_FOUNDRY_INDEX ? FONT_FOUNDRY_INDEX
 				: i == LFACE_SWIDTH_INDEX ? FONT_WIDTH_INDEX
 				: i == LFACE_HEIGHT_INDEX ? FONT_SIZE_INDEX
 				: i == LFACE_WEIGHT_INDEX ? FONT_WEIGHT_INDEX
 				: FONT_SLANT_INDEX));
 	  }
 		{
 		  if (STRINGP (value))
 		    {
 		      to[LFACE_FAMILY_INDEX] = value;
 		      font_clear_prop (to, FONT_FAMILY_INDEX);
+		    }
+		  else
+		    err = 1;
+		}
+	      else if (EQ (keyword, QCfoundry))
+		{
+		  if (STRINGP (value))
+		    {
+		      to[LFACE_FOUNDRY_INDEX] = value;
+		      font_clear_prop (to, FONT_FOUNDRY_INDEX);
 		    }
 		  else
 		    err = 1;
 		}
 	      else if (EQ (keyword, QCheight))
 	}
 old_value = LFACE_FAMILY (lface);
 LFACE_FAMILY (lface) = value;
 prop_index = FONT_FAMILY_INDEX;
 }
+else if (EQ (attr, QCfoundry))
+{
+if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+	{
+	  CHECK_STRING (value);
+	  if (SCHARS (value) == 0)
+	    signal_error ("Invalid face foundry", value);
+	}
+old_value = LFACE_FOUNDRY (lface);
+LFACE_FOUNDRY (lface) = value;
+prop_index = FONT_FOUNDRY_INDEX;
+}
 else if (EQ (attr, QCheight))
 {
 if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
 	{
 	  Lisp_Object test;
 	  changed_p = 1;
 	}
 if (face->font
 	  && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
+	      || !UNSPECIFIEDP (LFACE_FOUNDRY (lface))
 	      || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
 	      || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
 	      || !UNSPECIFIEDP (LFACE_SLANT (lface))
 	      || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
 	{
 lface = lface_from_face_name (XFRAME (frame), symbol, 1);
 }
 if (EQ (keyword, QCfamily))
 value = LFACE_FAMILY (lface);
+else if (EQ (keyword, QCfoundry))
+value = LFACE_FOUNDRY (lface);
 else if (EQ (keyword, QCheight))
 value = LFACE_HEIGHT (lface);
 else if (EQ (keyword, QCweight))
 value = LFACE_WEIGHT (lface);
 else if (EQ (keyword, QCslant))
 static INLINE unsigned
 lface_hash (v)
 Lisp_Object *v;
 {
 return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
+	  ^ hash_string_case_insensitive (v[LFACE_FOUNDRY_INDEX])
 	  ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
 	  ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
 	  ^ XHASH (v[LFACE_WEIGHT_INDEX])
 	  ^ XHASH (v[LFACE_SLANT_INDEX])
 	  ^ XHASH (v[LFACE_SWIDTH_INDEX])
 {
 xassert (lface_fully_specified_p (lface1)
 	   && lface_fully_specified_p (lface2));
 return (xstrcasecmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
 SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
+	  && xstrcasecmp (SDATA (lface1[LFACE_FOUNDRY_INDEX]),
+			  SDATA (lface2[LFACE_FOUNDRY_INDEX])) == 0
 	  && EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
 	  && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
 	  && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
 	  && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
 	  && EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
 return 0;
 /* Check font-related attributes, as those are the most commonly
 "unsupported" on a window-system (because of missing fonts).  */
 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+|| !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]))
 {
 consider :slant unsupportable on ttys, even though the face code
 actually `fakes' them using a dim attribute if possible.  This is
 because the faked result is too different from what the face
 specifies.  */
 if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+|| !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
 || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
 be found.  Value is ALIST.  */)
 (alist)
 Lisp_Object alist;
 {
+Lisp_Object tail, tail2;
 CHECK_LIST (alist);
+alist = Fcopy_sequence (alist);
+for (tail = alist; CONSP (tail); tail = XCDR (tail))
+for (tail2 = XCAR (tail); CONSP (tail2); tail2 = XCDR (tail2))
+XSETCAR (tail2, Fintern (XCAR (tail2), Qnil));
 Vface_alternative_font_family_alist = alist;
 free_all_realized_faces (Qnil);
 return alist;
 }
 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
 be found.  Value is ALIST.  */)
 (alist)
 Lisp_Object alist;
 {
+Lisp_Object tail, tail2;
 CHECK_LIST (alist);
+alist = Fcopy_sequence (alist);
+for (tail = alist; CONSP (tail); tail = XCDR (tail))
+for (tail2 = XCAR (tail); CONSP (tail2); tail2 = XCDR (tail2))
+XSETCAR (tail2, Fdowncase (XCAR (tail2)));
 Vface_alternative_font_registry_alist = alist;
 free_all_realized_faces (Qnil);
 return alist;
 }
 #endif /* HAVE_WINDOW_SYSTEM */
 if (!FRAME_WINDOW_P (f))
 {
 LFACE_FAMILY (lface) = build_string ("default");
+LFACE_FOUNDRY (lface) = LFACE_FAMILY (lface);
 LFACE_SWIDTH (lface) = Qnormal;
 LFACE_HEIGHT (lface) = make_number (1);
 if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
 	LFACE_WEIGHT (lface) = Qnormal;
 if (UNSPECIFIEDP (LFACE_SLANT (lface)))

Mercurial > emacs

comparison src/xfaces.c @ 95865:99530dd346d3