Provide text directionality and language to HarfBuzz shaper

* lisp/language/tv-util.el (tai-viet-composition-function):
* lisp/language/ethio-util.el (ethio-composition-function):
* lisp/language/japanese.el (compose-gstring-for-variation-glyph):
* lisp/language/thai-util.el (thai-composition-function):
* lisp/language/misc-lang.el (arabic-shape-gstring):
* lisp/language/lao-util.el (lao-composition-function):
* lisp/language/hebrew.el (hebrew-shape-gstring):
* lisp/composite.el (compose-gstring-for-graphic)
(compose-gstring-for-dotted-circle, auto-compose-chars)
(compose-gstring-for-terminal): Accept 2nd argument DIRECTION; all
callers changed.

* src/composite.c (composition_reseat_it): Call
auto-composition-function with one more argument DIRECTION.
(syms_of_composite) <auto-composition-function>: Update the doc
string.
* src/ftfont.c (ftfont_shape_by_hb): Compute language and
direction, and set buffer properties accordingly.
* src/composite.c (autocmp_chars):
* src/w32uniscribe.c (uniscribe_shape):
* src/xftfont.c (xftfont_shape):
* src/ftfont.c (ftfont_shape, ftfont_shape_by_hb):
* src/font.c (Ffont_shape_gstring): Accept an additional argument
DIRECTION.
* src/macfont.m (lgstring_direction): New enum.
(mac_font_shape_1, mac_screen_font_shape, mac_font_shape):
Accept an additional argument specifying text direction.  All
callers changed.
* src/font.c (syms_of_font): New symbols QL2R and QR2L.
* src/font.h (shape): Accept new argument DIRECTION.  All
implementations changed.  (Bug#33729)
(ftfont_shape): Update prototype.

7 files changed, 104 insertions, 36 deletions

diff --git a/src/composite.c b/src/composite.c
index 9819805c399..48824946e64 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -873,7 +873,7 @@ fill_gstring_body (Lisp_Object gstring)
 static Lisp_Object
 autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
 	       ptrdiff_t limit, struct window *win, struct face *face,
-	       Lisp_Object string)
+	       Lisp_Object string, Lisp_Object direction)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
   Lisp_Object pos = make_fixnum (charpos);
@@ -920,8 +920,9 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
       if (NILP (string))
 	record_unwind_protect (restore_point_unwind,
 			       build_marker (current_buffer, pt, pt_byte));
-      lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
-			    pos, make_fixnum (to), font_object, string);
+      lgstring = safe_call (7, Vauto_composition_function, AREF (rule, 2),
+			    pos, make_fixnum (to), font_object, string,
+			    direction);
     }
   return unbind_to (count, lgstring);
 }
@@ -1221,7 +1222,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
 	      if (XFIXNAT (AREF (elt, 1)) != cmp_it->lookback)
 		goto no_composition;
 	      lgstring = autocmp_chars (elt, charpos, bytepos, endpos,
-					w, face, string);
+					w, face, string, QL2R);
 	      if (composition_gstring_p (lgstring))
 		break;
 	      lgstring = Qnil;
@@ -1246,7 +1247,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
 		bpos = CHAR_TO_BYTE (cpos);
 	    }
 	  lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
-				    string);
+				    string, QR2L);
 	  if (! composition_gstring_p (lgstring)
 	      || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
 	    /* Composition failed or didn't cover the current
@@ -1566,7 +1567,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
 		  for (check = cur; check_pos < check.pos; )
 		    BACKWARD_CHAR (check, stop);
 		  *gstring = autocmp_chars (elt, check.pos, check.pos_byte,
-					    tail, w, NULL, string);
+					    tail, w, NULL, string, Qnil);
 		  need_adjustment = 1;
 		  if (NILP (*gstring))
 		    {
@@ -1943,15 +1944,24 @@ Use the command `auto-composition-mode' to change this variable. */);
 
   DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
 	       doc: /* Function to call to compose characters automatically.
-This function is called from the display routine with four arguments:
-FROM, TO, WINDOW, and STRING.
+This function is called from the display engine with 6 arguments:
+FUNC, FROM, TO, FONT-OBJECT, STRING, and DIRECTION.
+
+FUNC is the function to compose characters.  On text-mode display,
+FUNC is ignored and `compose-gstring-for-terminal' is used instead.
 
 If STRING is nil, the function must compose characters in the region
 between FROM and TO in the current buffer.
 
 Otherwise, STRING is a string, and FROM and TO are indices into the
 string.  In this case, the function must compose characters in the
-string.  */);
+string.
+
+FONT-OBJECT is the font to use, or nil if characters are to be
+composed on a text-mode display.
+
+DIRECTION is the bidi directionality of the text to shape.  It could
+be L2R or R2L, or nil if unknown.  */);
   Vauto_composition_function = Qnil;
 
   DEFVAR_LISP ("composition-function-table", Vcomposition_function_table,
diff --git a/src/font.c b/src/font.c
index e81c267de41..fc8efa7f235 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4397,18 +4397,22 @@ font_fill_lglyph_metrics (Lisp_Object glyph, Lisp_Object font_object)
 }
 
 
-DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
-       doc: /* Shape the glyph-string GSTRING.
+DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 2, 2, 0,
+       doc: /* Shape the glyph-string GSTRING subject to bidi DIRECTION.
 Shaping means substituting glyphs and/or adjusting positions of glyphs
 to get the correct visual image of character sequences set in the
 header of the glyph-string.
 
+DIRECTION should be produced by the UBA, the Unicode Bidirectional
+Algorithm, and should be a symbol, either L2R or R2L.  It can also
+be nil if the bidi context is unknown.
+
 If the shaping was successful, the value is GSTRING itself or a newly
 created glyph-string.  Otherwise, the value is nil.
 
 See the documentation of `composition-get-gstring' for the format of
 GSTRING.  */)
-  (Lisp_Object gstring)
+  (Lisp_Object gstring, Lisp_Object direction)
 {
   struct font *font;
   Lisp_Object font_object, n, glyph;
@@ -4427,7 +4431,7 @@ GSTRING.  */)
   /* Try at most three times with larger gstring each time.  */
   for (i = 0; i < 3; i++)
     {
-      n = font->driver->shape (gstring);
+      n = font->driver->shape (gstring, direction);
       if (FIXNUMP (n))
 	break;
       gstring = larger_vector (gstring,
@@ -5350,6 +5354,10 @@ syms_of_font (void)
 
   DEFSYM (QCuser_spec, ":user-spec");
 
+  /* For shapers that need to know text directionality.  */
+  DEFSYM (QL2R, "L2R");
+  DEFSYM (QR2L, "R2L");
+
   staticpro (&scratch_font_spec);
   scratch_font_spec = Ffont_spec (0, NULL);
   staticpro (&scratch_font_prefer);
diff --git a/src/font.h b/src/font.h
index 1741b3f3964..52bdaa38899 100644
--- a/src/font.h
+++ b/src/font.h
@@ -700,7 +700,11 @@ struct font_driver
 
      Return the number of output codes.  If none of the features are
      applicable to the input data, return 0.  If GSTRING-OUT is too
-     short, return -1.  */
+     short, return -1.
+
+     Note: This method is currently not implemented by any font
+     back-end, and is only called by 'font-drive-otf' and
+     'font-otf-alternates', which are themselves ifdef'ed away. */
   int (*otf_drive) (struct font *font, Lisp_Object features,
                     Lisp_Object gstring_in, int from, int to,
                     Lisp_Object gstring_out, int idx, bool alternate_subst);
@@ -723,6 +727,9 @@ struct font_driver
      (N+1)th element of GSTRING is nil, input of shaping is from the
      1st to (N)th elements.  In each input glyph, FROM, TO, CHAR, and
      CODE are already set.
+     DIRECTION is either L2R or R2L, or nil if unknown.  During
+     redisplay, this comes from applying the UBA, is passed from
+     composition_reseat_it, and is used by the HarfBuzz shaper.
 
      This function updates all fields of the input glyphs.  If the
      output glyphs (M) are more than the input glyphs (N), (N+1)th
@@ -730,7 +737,7 @@ struct font_driver
      a new glyph object and storing it in GSTRING.  If (M) is greater
      than the length of GSTRING, nil should be return.  In that case,
      this function is called again with the larger GSTRING.  */
-  Lisp_Object (*shape) (Lisp_Object lgstring);
+  Lisp_Object (*shape) (Lisp_Object lgstring, Lisp_Object direction);
 
   /* Optional.
 
@@ -887,7 +894,7 @@ extern Lisp_Object ftfont_list_family (struct frame *);
 extern Lisp_Object ftfont_match (struct frame *, Lisp_Object);
 extern Lisp_Object ftfont_open (struct frame *, Lisp_Object, int);
 extern Lisp_Object ftfont_otf_capability (struct font *);
-extern Lisp_Object ftfont_shape (Lisp_Object);
+extern Lisp_Object ftfont_shape (Lisp_Object, Lisp_Object);
 extern unsigned ftfont_encode_char (struct font *, int);
 extern void ftfont_close (struct font *);
 extern void ftfont_filter_properties (Lisp_Object, Lisp_Object);
diff --git a/src/ftfont.c b/src/ftfont.c
index 74d72f94abd..5a8adfdb24c 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2797,7 +2797,7 @@ get_hb_unicode_funcs (void)
 
 static Lisp_Object
 ftfont_shape_by_hb (Lisp_Object lgstring, FT_Face ft_face, hb_font_t *hb_font,
-                    FT_Matrix *matrix)
+                    FT_Matrix *matrix, Lisp_Object direction)
 {
   ptrdiff_t glyph_len = 0, text_len = LGSTRING_GLYPH_LEN (lgstring);
   ptrdiff_t i;
@@ -2836,15 +2836,38 @@ ftfont_shape_by_hb (Lisp_Object lgstring, FT_Face ft_face, hb_font_t *hb_font,
   hb_buffer_set_content_type (hb_buffer, HB_BUFFER_CONTENT_TYPE_UNICODE);
   hb_buffer_set_cluster_level (hb_buffer, HB_BUFFER_CLUSTER_LEVEL_MONOTONE_CHARACTERS);
 
-  /* FIXME: guess_segment_properties is BAD BAD BAD.
-   * we need to get these properties with the LGSTRING. */
-#if 1
+  /* Set the default properties for when they cannot be determined
+     below.  */
   hb_buffer_guess_segment_properties (hb_buffer);
-#else
-  hb_buffer_set_direction (hb_buffer, XXX);
+  hb_direction_t dir = HB_DIRECTION_INVALID;
+  if (EQ (direction, QL2R))
+    dir = HB_DIRECTION_LTR;
+  else if (EQ (direction, QR2L))
+    dir = HB_DIRECTION_RTL;
+  /* If the caller didn't provide a meaningful DIRECTION, let HarfBuzz
+     guess it.  */
+  if (dir != HB_DIRECTION_INVALID)
+    hb_buffer_set_direction (hb_buffer, dir);
+  /* Leave the script determination to HarfBuzz, until Emacs has a
+     better idea of the script of LGSTRING.  FIXME. */
+#if 0
   hb_buffer_set_script (hb_buffer, XXX);
-  hb_buffer_set_language (hb_buffer, XXX);
 #endif
+  /* FIXME: This can only handle the single global language, which
+     normally comes from the locale.  In addition, if
+     current-iso639-language is a list, we arbitrarily use the first
+     one.  We should instead have a notion of the language of the text
+     being shaped.  */
+  Lisp_Object lang = Vcurrent_iso639_language;
+  if (CONSP (Vcurrent_iso639_language))
+    lang = XCAR (Vcurrent_iso639_language);
+  if (SYMBOLP (lang))
+    {
+      Lisp_Object lang_str = SYMBOL_NAME (lang);
+      hb_buffer_set_language (hb_buffer,
+			      hb_language_from_string (SSDATA (lang_str),
+						       SBYTES (lang_str)));
+    }
 
   if (!hb_shape_full (hb_font, hb_buffer, NULL, 0, NULL))
     return Qnil;
@@ -2919,7 +2942,7 @@ ftfont_shape_by_hb (Lisp_Object lgstring, FT_Face ft_face, hb_font_t *hb_font,
 #if (defined HAVE_M17N_FLT && defined HAVE_LIBOTF) || defined HAVE_HARFBUZZ
 
 Lisp_Object
-ftfont_shape (Lisp_Object lgstring)
+ftfont_shape (Lisp_Object lgstring, Lisp_Object direction)
 {
   struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring));
   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
@@ -2929,7 +2952,7 @@ ftfont_shape (Lisp_Object lgstring)
       hb_font_t *hb_font = ftfont_get_hb_font (ftfont_info);
 
       return ftfont_shape_by_hb (lgstring, ftfont_info->ft_size->face,
-				 hb_font, &ftfont_info->matrix);
+				 hb_font, &ftfont_info->matrix, direction);
     }
   else
 #endif  /* HAVE_HARFBUZZ */
diff --git a/src/macfont.m b/src/macfont.m
index d137648937c..ee6c1737269 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -38,6 +38,12 @@ Original author: YAMAMOTO Mitsuharu
 
 #include <libkern/OSByteOrder.h>
 
+/* Values for `dir' argument to shaper functions.  */
+enum lgstring_direction
+  {
+    DIR_R2L = -1, DIR_UNKNOWN = 0, DIR_L2R = 1,
+  };
+
 static double mac_font_get_advance_width_for_glyph (CTFontRef, CGGlyph);
 static CGRect mac_font_get_bounding_rect_for_glyph (CTFontRef, CGGlyph);
 static CFArrayRef mac_font_create_available_families (void);
@@ -48,7 +54,8 @@ static Boolean mac_font_descriptor_supports_languages (CTFontDescriptorRef,
 						       CFArrayRef);
 static CFStringRef mac_font_create_preferred_family_for_attributes (CFDictionaryRef);
 static CFIndex mac_font_shape (CTFontRef, CFStringRef,
-			       struct mac_glyph_layout *, CFIndex);
+			       struct mac_glyph_layout *, CFIndex,
+			       enum lgstring_direction);
 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef);
 static CFStringRef mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef, CFArrayRef);
 #if USE_CT_GLYPH_INFO
@@ -317,7 +324,8 @@ mac_screen_font_get_metrics (ScreenFontRef font, CGFloat *ascent,
 
 static CFIndex
 mac_font_shape_1 (NSFont *font, NSString *string,
-                  struct mac_glyph_layout *glyph_layouts, CFIndex glyph_len)
+                  struct mac_glyph_layout *glyph_layouts, CFIndex glyph_len,
+		  enum lgstring_direction dir)
 {
   NSUInteger i;
   CFIndex result = 0;
@@ -581,11 +589,11 @@ mac_font_shape_1 (NSFont *font, NSString *string,
 static CFIndex
 mac_screen_font_shape (ScreenFontRef font, CFStringRef string,
                        struct mac_glyph_layout *glyph_layouts,
-                       CFIndex glyph_len)
+                       CFIndex glyph_len, enum lgstring_direction dir)
 {
   return mac_font_shape_1 ([(NSFont *)font printerFont],
                            (NSString *) string,
-                           glyph_layouts, glyph_len);
+                           glyph_layouts, glyph_len, dir);
 }
 
 static CGColorRef
@@ -2916,7 +2924,7 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
 }
 
 static Lisp_Object
-macfont_shape (Lisp_Object lgstring)
+macfont_shape (Lisp_Object lgstring, Lisp_Object direction)
 {
   struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring));
   struct macfont_info *macfont_info = (struct macfont_info *) font;
@@ -2966,12 +2974,18 @@ macfont_shape (Lisp_Object lgstring)
                                                kCFAllocatorNull);
   if (string)
     {
+      enum lgstring_direction dir = DIR_UNKNOWN;
+
+      if (EQ (direction, QL2R))
+	dir = DIR_L2R;
+      else if (EQ (direction, QR2L))
+	dir = DIR_R2L;
       glyph_layouts = alloca (sizeof (struct mac_glyph_layout) * glyph_len);
       if (macfont_info->screen_font)
         used = mac_screen_font_shape (macfont_info->screen_font, string,
-                                      glyph_layouts, glyph_len);
+                                      glyph_layouts, glyph_len, dir);
       else
-        used = mac_font_shape (macfont, string, glyph_layouts, glyph_len);
+        used = mac_font_shape (macfont, string, glyph_layouts, glyph_len, dir);
       CFRelease (string);
     }
 
@@ -3652,7 +3666,8 @@ mac_font_create_line_with_string_and_font (CFStringRef string,
 
 static CFIndex
 mac_font_shape (CTFontRef font, CFStringRef string,
-		struct mac_glyph_layout *glyph_layouts, CFIndex glyph_len)
+		struct mac_glyph_layout *glyph_layouts, CFIndex glyph_len,
+		lgstring_direction dir)
 {
   CFIndex used, result = 0;
   CTLineRef ctline = mac_font_create_line_with_string_and_font (string, font);
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index 29c9c7a0bd1..3c400f38b13 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -198,6 +198,9 @@ uniscribe_otf_capability (struct font *font)
    (N+1)th element of LGSTRING is nil, input of shaping is from the
    1st to (N)th elements.  In each input glyph, FROM, TO, CHAR, and
    CODE are already set.
+   DIRECTION is either L2R or R2L, or nil if unknown.  During
+   redisplay, this comes from applying the UBA, is passed from
+   composition_reseat_it, and is used by the HarfBuzz shaper.
 
    This function updates all fields of the input glyphs.  If the
    output glyphs (M) are more than the input glyphs (N), (N+1)th
@@ -206,7 +209,7 @@ uniscribe_otf_capability (struct font *font)
    than the length of LGSTRING, nil should be returned.  In that case,
    this function is called again with a larger LGSTRING.  */
 static Lisp_Object
-uniscribe_shape (Lisp_Object lgstring)
+uniscribe_shape (Lisp_Object lgstring, Lisp_Object direction)
 {
   struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring));
   struct uniscribe_font_info *uniscribe_font
@@ -394,6 +397,8 @@ uniscribe_shape (Lisp_Object lgstring)
 			 adjustment for the base character, which is
 			 then updated for each successive glyph in the
 			 grapheme cluster.  */
+		      /* FIXME: Should we use DIRECTION here instead
+			 of what ScriptItemize guessed?  */
 		      if (items[i].a.fRTL)
 			{
 			  int j1 = j;
diff --git a/src/xftfont.c b/src/xftfont.c
index 56d0e30e24c..6f56c053bb7 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -674,13 +674,13 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
 
 #if (defined HAVE_M17N_FLT && defined HAVE_LIBOTF) || defined HAVE_HARFBUZZ
 static Lisp_Object
-xftfont_shape (Lisp_Object lgstring)
+xftfont_shape (Lisp_Object lgstring, Lisp_Object direction)
 {
   struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring));
   struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
   FT_Face ft_face = XftLockFace (xftfont_info->xftfont);
   xftfont_info->ft_size = ft_face->size;
-  Lisp_Object val = ftfont_shape (lgstring);
+  Lisp_Object val = ftfont_shape (lgstring, direction);
   XftUnlockFace (xftfont_info->xftfont);
   return val;
 }