RFC: let's make term.el possible

[Daniel Colascione]

Let's make term.el possible to implement.

"But wait. We have it already. What do you _mean_ make it possible?"

term.el exists and sort-of works, but because we have (and have had for
a few decades now, I think?) a problem in which we silently substitute
missing glyphs in one font with glyphs we find in some other font ---
possibly one with different metrics --- we can't reason about character
grids of the sort term.el wants to maintain.  Various workarounds for
this problem exist, but how about solving the root problem once and
for all?

The patch below adds a new face attribute :conform-to-main-font that
tells Emacs to substitute the metrics of any substituted glyph with the
metrics of the font for which we've found a substitute.  The result
might be that the glyph gets clipped when drawing, but that's a better
outcome than wobbly columns and inconsistent line heights.

This way, term.el can set :conform-to-main-font on its faces and its
coordinate calculations begin to Just Work.

diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index ccaf43d772a..8c82ab473b1 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -291,7 +291,12 @@ custom-face-attributes
      ,(lambda (cus-value)
        (if (and (consp cus-value) (null (cdr cus-value)))
            (car cus-value)
-         cus-value))))
+         cus-value)))
+    (:conform-to-main-font
+     (choice :tag "Conform to Main Font"
+            :help-echo "Whether to force substituted glyphs to main font"
+            (const :tag "Off" nil)
+            (const :tag "On" t))))
 
   "Alist of face attributes.
 
diff --git a/lisp/faces.el b/lisp/faces.el
index dbc0a2e04f6..11d6d22960f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -848,6 +848,14 @@ set-face-attribute
 into the face like an underlying face would be, with higher
 priority than underlying faces.
 
+`:conform-to-main-font'
+
+VALUE specifies whether substituted glyphs should conform to the metrics
+of the primary font.  If VALUE is non-nil, we use the main font's
+metrics instead of the substituted font's (perhaps causing clipping when
+drawing) to ensure that code can reason about grid-based
+character layout.
+
 For backward compatibility, the keywords `:bold' and `:italic'
 can be used to specify weight and slant respectively.  This usage
 is considered obsolete.  For these two keywords, the VALUE must
@@ -1256,7 +1264,8 @@ face-attribute-name-alist
     (:foreground . "foreground color")
     (:background . "background color")
     (:stipple . "background stipple")
-    (:inherit . "inheritance"))
+    (:inherit . "inheritance")
+    (:conform-to-main-font . "conform to main font"))
   "An alist of descriptive names for face attributes.
 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
diff --git a/src/composite.c b/src/composite.c
index 2ef72a33d2e..485400ed416 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -897,7 +897,7 @@ fill_gstring_body (Lisp_Object gstring)
         code = FONT_INVALID_CODE;
       if (code != FONT_INVALID_CODE)
         {
-         font_fill_lglyph_metrics (g, font, code);
+         font_fill_lglyph_metrics (g, font, code, NULL);
         }
       else
        {
diff --git a/src/dispextern.h b/src/dispextern.h
index bd48005b83f..fd73ba676ad 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1705,6 +1705,7 @@ #define FONT_TOO_HIGH(ft)                                 
        \
   LFACE_FONTSET_INDEX,
   LFACE_DISTANT_FOREGROUND_INDEX,
   LFACE_EXTEND_INDEX,
+  LFACE_CONFORM_TO_MAIN_FONT_INDEX,
   LFACE_VECTOR_SIZE
 };
 
@@ -1872,6 +1873,12 @@ #define FONT_TOO_HIGH(ft)                                
                \
   bool_bf synth_ital : 1;
 #endif
 
+  /* True means this face was created for font fallback.  */
+  bool_bf is_fallback_face : 1;
+
+  /* True means fallback glyphs should conform to main font metrics.  */
+  bool_bf conform_to_main_font_p : 1;
+
   /* The hash value of this face.  */
   uintptr_t hash;
 
diff --git a/src/font.c b/src/font.c
index dfe479f9355..d590fd979dd 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4578,12 +4578,42 @@ DEFUN ("clear-font-cache", Fclear_font_cache, 
Sclear_font_cache, 0, 0, 0,
 
 
 void
-font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font, unsigned int 
code)
+font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font,
+                         unsigned int code, struct face *face)
 {
   struct font_metrics metrics;
 
   LGLYPH_SET_CODE (glyph, code);
   font->driver->text_extents (font, &code, 1, &metrics);
+
+  if (face && face->is_fallback_face
+      && face->conform_to_main_font_p
+      && face->ascii_face)
+    {
+      struct font *primary_font = face->ascii_face->font;
+      if (primary_font)
+        {
+          unsigned int space_code = ' ';
+          struct font_metrics primary_metrics;
+          primary_font->driver->text_extents (
+           primary_font, &space_code, 1, &primary_metrics);
+
+          if (font_is_monospace (primary_font))
+            metrics.width = primary_metrics.width;
+
+          metrics.ascent = primary_metrics.ascent;
+          metrics.descent = primary_metrics.descent;
+
+          if (font_is_monospace (primary_font))
+            {
+              int center_offset =
+               (metrics.width - (metrics.rbearing - metrics.lbearing)) / 2;
+              metrics.lbearing = -center_offset;
+              metrics.rbearing = metrics.width - center_offset;
+            }
+        }
+    }
+
   LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
   LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
   LGLYPH_SET_WIDTH (glyph, metrics.width);
diff --git a/src/font.h b/src/font.h
index 402980ea9f0..215f7e9e053 100644
--- a/src/font.h
+++ b/src/font.h
@@ -908,7 +908,8 @@ valid_font_driver (struct font_driver const *d)
 extern Lisp_Object font_range (ptrdiff_t, ptrdiff_t, ptrdiff_t *,
                               struct window *, struct face *,
                               Lisp_Object, int);
-extern void font_fill_lglyph_metrics (Lisp_Object, struct font *, unsigned 
int);
+extern void font_fill_lglyph_metrics (Lisp_Object, struct font *,
+                                      unsigned int, struct face *);
 
 extern Lisp_Object font_put_extra (Lisp_Object font, Lisp_Object prop,
                                    Lisp_Object val);
@@ -1029,6 +1030,15 @@ font_data_structures_may_be_ill_formed (void)
 #endif
 }
 
+/* Check if FONT is monospace (fixed-pitch).  */
+INLINE bool
+font_is_monospace (struct font *font)
+{
+  return (FIXNUMP (font->props[FONT_SPACING_INDEX])
+         && XFIXNUM (font->props[FONT_SPACING_INDEX])
+          == FONT_SPACING_MONO);
+}
+
 INLINE_HEADER_END
 
 #endif /* not EMACS_FONT_H */
diff --git a/src/xdisp.c b/src/xdisp.c
index f2b158f00e3..6b8a5e9f05c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -32901,9 +32901,95 @@ produce_glyphless_glyph (struct it *it, bool 
for_no_font, Lisp_Object acronym)
                            lower_xoff, lower_yoff);
   it->nglyphs = 1;
   take_vertical_position_into_account (it);
+
+  struct face *merged_face = FACE_FROM_ID (it->f, face_id);
+  if (merged_face->conform_to_main_font_p && merged_face->ascii_face)
+    {
+      struct font *primary_font = merged_face->ascii_face->font;
+      int primary_ascent = FONT_BASE (primary_font);
+      int primary_descent = FONT_DESCENT (primary_font);
+      int primary_height = primary_ascent + primary_descent;
+
+      if (it->ascent + it->descent > primary_height)
+        {
+          int total_height = it->ascent + it->descent;
+          it->ascent = (it->ascent * primary_height + total_height / 2)
+           / total_height;
+          it->descent = (it->descent * primary_height + total_height / 2)
+           / total_height;
+        }
+
+      if (it->ascent > primary_ascent)
+        {
+          it->descent = min (
+           primary_descent,
+           it->descent + it->ascent - primary_ascent);
+          it->ascent = primary_ascent;
+        }
+      if (it->descent > primary_descent)
+        {
+          it->ascent = min (
+           primary_ascent,
+           it->ascent + it->descent - primary_descent);
+          it->descent = primary_descent;
+        }
+
+      it->phys_ascent = min (it->phys_ascent, it->ascent);
+      it->phys_descent = min (it->phys_descent, it->descent);
+    }
 }
 
 
+static void
+adjust_glyph_metrics_for_fallback (struct it *it, struct face *face,
+                                   int *width, int *ascent, int *descent,
+                                   int *lbearing, int *rbearing, int boff)
+{
+  struct font *primary_font = face->ascii_face->font;
+  if (!primary_font)
+    return;
+
+  if (font_is_monospace (primary_font))
+    {
+      int new_width = primary_font->space_width;
+
+      if (it && it->char_to_display >= 0)
+        {
+          Lisp_Object width_val = char_table_ref (
+           Vchar_width_table, it->char_to_display);
+
+          if (FIXNUMP (width_val) && XFIXNUM (width_val) == 2)
+            new_width *= 2;
+        }
+
+      if (width)
+       *width = new_width;
+
+      if (lbearing && rbearing)
+        {
+          int center_offset = (new_width - (*rbearing - *lbearing)) / 2;
+          *lbearing = -center_offset;
+          *rbearing = new_width - center_offset;
+        }
+    }
+
+  if (ascent)
+    *ascent = FONT_BASE (primary_font) + boff;
+
+  if (descent)
+    *descent = FONT_DESCENT (primary_font) - boff;
+
+  if (it)
+    {
+      it->phys_ascent = min (it->phys_ascent,
+                            FONT_BASE (primary_font) + boff);
+      it->phys_descent = min (it->phys_descent,
+                             FONT_DESCENT (primary_font) - boff);
+      it->ascent = it->phys_ascent;
+      it->descent = it->phys_descent;
+    }
+}
+
 /* If face has a box, add the box thickness to the character
    height.  If character has a box line to the left and/or
    right, add the box line width to the character's width.  */
@@ -33003,9 +33089,16 @@ gui_produce_glyphs (struct it *it)
              it->phys_ascent = pcm->ascent + boff;
              it->phys_descent = pcm->descent - boff;
              it->pixel_width = pcm->width;
+
+             if (face->is_fallback_face
+                 && face->conform_to_main_font_p
+                 && face->ascii_face)
+               adjust_glyph_metrics_for_fallback (
+                 it, face, &it->pixel_width,
+                 NULL, NULL, NULL, NULL, boff);
              /* Don't use font-global values for ascent and descent
                 if they result in an exceedingly large line height.  */
-             if (it->override_ascent < 0)
+             else if (it->override_ascent < 0)
                {
                  if (FONT_TOO_HIGH (font))
                    {
@@ -33477,6 +33570,13 @@ gui_produce_glyphs (struct it *it)
                  descent = pcm->descent;
                  lbearing = pcm->lbearing;
                  rbearing = pcm->rbearing;
+
+                 if (this_face->is_fallback_face
+                     && this_face->conform_to_main_font_p
+                     && this_face->ascii_face)
+                   adjust_glyph_metrics_for_fallback (
+                     it, this_face, &width, &ascent, &descent,
+                     &lbearing, &rbearing, 0);
                  if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
                    {
                      /* Relative composition with or without
diff --git a/src/xfaces.c b/src/xfaces.c
index 7a4571c00c4..ff02a6f8fe6 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1804,6 +1804,8 @@ #define LFACE_FONT(LFACE)     AREF (LFACE, 
LFACE_FONT_INDEX)
 #define LFACE_INHERIT(LFACE)       AREF (LFACE, LFACE_INHERIT_INDEX)
 #define LFACE_FONTSET(LFACE)       AREF (LFACE, LFACE_FONTSET_INDEX)
 #define LFACE_EXTEND(LFACE)        AREF (LFACE, LFACE_EXTEND_INDEX)
+#define LFACE_CONFORM_TO_MAIN_FONT(LFACE) \
+  AREF (LFACE, LFACE_CONFORM_TO_MAIN_FONT_INDEX)
 #define LFACE_DISTANT_FOREGROUND(LFACE) \
   AREF (LFACE, LFACE_DISTANT_FOREGROUND_INDEX)
 
@@ -1862,6 +1864,10 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE])
           || RESET_P (attrs[LFACE_EXTEND_INDEX])
           || SYMBOLP (attrs[LFACE_EXTEND_INDEX])
           || STRINGP (attrs[LFACE_EXTEND_INDEX]));
+  eassert (UNSPECIFIEDP (attrs[LFACE_CONFORM_TO_MAIN_FONT_INDEX])
+          || IGNORE_DEFFACE_P (attrs[LFACE_CONFORM_TO_MAIN_FONT_INDEX])
+          || RESET_P (attrs[LFACE_CONFORM_TO_MAIN_FONT_INDEX])
+          || SYMBOLP (attrs[LFACE_CONFORM_TO_MAIN_FONT_INDEX]));
   eassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
           || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
           || RESET_P (attrs[LFACE_OVERLINE_INDEX])
@@ -2162,7 +2168,8 @@ lface_fully_specified_p (Lisp_Object 
attrs[LFACE_VECTOR_SIZE])
 
   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
     if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
-        && i != LFACE_DISTANT_FOREGROUND_INDEX)
+        && i != LFACE_DISTANT_FOREGROUND_INDEX
+        && i != LFACE_CONFORM_TO_MAIN_FONT_INDEX)
       if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
        break;
 
@@ -3490,6 +3497,21 @@ DEFUN ("internal-set-lisp-face-attribute", 
Finternal_set_lisp_face_attribute,
       old_value = LFACE_EXTEND (lface);
       ASET (lface, LFACE_EXTEND_INDEX, value);
     }
+  else if (EQ (attr, QCconform_to_main_font))
+    {
+      if (!UNSPECIFIEDP (value)
+         && !IGNORE_DEFFACE_P (value)
+         && !RESET_P (value))
+       {
+         CHECK_SYMBOL (value);
+         if (!EQ (value, Qt) && !NILP (value))
+           signal_error (
+             "Invalid conform-to-main-font face attribute value",
+             value);
+       }
+      old_value = LFACE_CONFORM_TO_MAIN_FONT (lface);
+      ASET (lface, LFACE_CONFORM_TO_MAIN_FONT_INDEX, value);
+    }
   else if (EQ (attr, QCforeground))
     {
       HANDLE_INVALID_NIL_VALUE (QCforeground, face);
@@ -4209,6 +4231,8 @@ DEFUN ("internal-get-lisp-face-attribute", 
Finternal_get_lisp_face_attribute,
     value = LFACE_INHERIT (lface);
   else if (EQ (keyword, QCextend))
     value = LFACE_EXTEND (lface);
+  else if (EQ (keyword, QCconform_to_main_font))
+    value = LFACE_CONFORM_TO_MAIN_FONT (lface);
   else if (EQ (keyword, QCfont))
     value = LFACE_FONT (lface);
   else if (EQ (keyword, QCfontset))
@@ -4237,7 +4261,8 @@ DEFUN ("internal-lisp-face-attribute-values",
   if (EQ (attr, QCunderline) || EQ (attr, QCoverline)
       || EQ (attr, QCstrike_through)
       || EQ (attr, QCinverse_video)
-      || EQ (attr, QCextend))
+      || EQ (attr, QCextend)
+      || EQ (attr, QCconform_to_main_font))
     result = list2 (Qt, Qnil);
 
   return result;
@@ -5976,6 +6001,9 @@ realize_default_face (struct frame *f)
   if (UNSPECIFIEDP (LFACE_EXTEND (lface)))
     ASET (lface, LFACE_EXTEND_INDEX, Qnil);
 
+  if (UNSPECIFIEDP (LFACE_CONFORM_TO_MAIN_FONT (lface)))
+    ASET (lface, LFACE_CONFORM_TO_MAIN_FONT_INDEX, Qnil);
+
   if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
     ASET (lface, LFACE_UNDERLINE_INDEX, Qnil);
 
@@ -6164,6 +6192,9 @@ realize_non_ascii_face (struct frame *f, Lisp_Object 
font_object,
        && FONT_WEIGHT_NAME_NUMERIC (face->lface[LFACE_WEIGHT_INDEX]) > 100
        && FONT_WEIGHT_NUMERIC (font_object) <= 100);
 
+  face->is_fallback_face = true;
+  face->conform_to_main_font_p = base_face->conform_to_main_font_p;
+
   /* Don't try to free the colors copied bitwise from BASE_FACE.  */
   face->colors_copied_bitwise_p = true;
   face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object);
@@ -6215,6 +6246,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object 
attrs[LFACE_VECTOR_SIZE]
   face = make_realized_face (attrs);
   face->ascii_face = face;
 
+  face->conform_to_main_font_p = !NILP 
(attrs[LFACE_CONFORM_TO_MAIN_FONT_INDEX]);
+
   f = cache->f;
 
   /* Determine the font to use.  Most of the time, the font will be
@@ -7365,6 +7398,7 @@ init_xfaces (void)
   face_attr_sym[LFACE_FONTSET_INDEX] = QCfontset;
   face_attr_sym[LFACE_DISTANT_FOREGROUND_INDEX] = QCdistant_foreground;
   face_attr_sym[LFACE_EXTEND_INDEX] = QCextend;
+  face_attr_sym[LFACE_CONFORM_TO_MAIN_FONT_INDEX] = QCconform_to_main_font;
 }
 
 void
@@ -7404,6 +7438,7 @@ syms_of_xfaces (void)
   DEFSYM (QCbox, ":box");
   DEFSYM (QCinherit, ":inherit");
   DEFSYM (QCextend, ":extend");
+  DEFSYM (QCconform_to_main_font, ":conform-to-main-font");
 
   /* Symbols used for Lisp face attribute values.  */
   DEFSYM (QCcolor, ":color");