(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).

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c08414554680ee853e494070e7b9214adae09812..4209b0f645f26e14a9dd65ad0443722e397230fc 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2008-06-13  Kenichi Handa  <handa@m17n.org>
+
+       * cus-face.el (custom-face-attributes): Add :foundry.
+
+       * faces.el (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
+       (face-x-resources): Add :foundry.
+       (face-valid-attribute-values): Likewise.
+       (face-attribute-name-alist): Likewise.
+       (describe-face): Likewise.
+
 2008-06-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * emacs-lisp/map-ynp.el (map-y-or-n-p): Accept non-char events.

diff --git a/src/xfaces.c b/src/xfaces.c
index 7f64618b53ebe834ae2f0fa3d955e87f926e068a..51da48be48f378c3d7d5055115fffd9dab92e30b 100644 (file)
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -27,34 +27,36 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
    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).
 
@@ -513,7 +515,6 @@ 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 *));
@@ -1961,6 +1962,7 @@ the WIDTH times as wide as FACE on FRAME.  */)
 /* 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)
@@ -1997,6 +1999,9 @@ check_lface_attrs (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]));
@@ -2366,25 +2371,16 @@ set_lface_from_font (f, lface, font_object, force_p)
 
   if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
     {
-      Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
       Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
 
-      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;
+      LFACE_FAMILY (lface) = SYMBOL_NAME (family);
+    }
+
+  if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
+    {
+      Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
+
+      LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry);
     }
 
   if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
@@ -2517,6 +2513,7 @@ merge_face_vectors (f, from, to, named_merge_points)
            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
@@ -2652,6 +2649,16 @@ merge_face_ref (f, face_ref, to, err_msgs, named_merge_points)
                  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))
                {
                  Lisp_Object new_height =
@@ -3052,6 +3059,18 @@ FRAME 0 means change the face on all frames, and change the default
       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))
@@ -3730,6 +3749,7 @@ x_update_menu_appearance (f)
 
       if (face->font
          && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
+             || !UNSPECIFIEDP (LFACE_FOUNDRY (lface))
              || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
              || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
              || !UNSPECIFIEDP (LFACE_SLANT (lface))
@@ -3846,6 +3866,8 @@ frames).  If FRAME is omitted or nil, use the selected frame.  */)
 
   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))
@@ -4156,6 +4178,7 @@ 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])
@@ -4178,6 +4201,8 @@ lface_same_font_attributes_p (lface1, lface2)
           && 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])
@@ -5016,6 +5041,7 @@ x_supports_face_attributes_p (f, attrs, def_face)
   /* 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])
@@ -5103,6 +5129,7 @@ tty_supports_face_attributes_p (f, attrs, def_face)
      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])
@@ -5402,7 +5429,13 @@ 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;
@@ -5419,7 +5452,13 @@ 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;
@@ -5542,6 +5581,7 @@ realize_default_face (f)
   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)))