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.

16 files changed, 135 insertions, 62 deletions

diff --git a/lisp/composite.el b/lisp/composite.el
index 3d4805e8fa0..6d280c84d78 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -382,8 +382,8 @@ This function is the default value of `compose-chars-after-function'."
                            (looking-at pattern))
                          (<= (match-end 0) limit))
                     (setq result
-                          (funcall func pos (match-end 0) font-obj object)))
-              (setq result (funcall func pos limit font-obj  object)))
+                          (funcall func pos (match-end 0) font-obj object nil)))
+              (setq result (funcall func pos limit font-obj  object nil)))
             (if result (setq tail nil))))))
     result))
 
@@ -524,8 +524,9 @@ after a sequence of character events."
       (setq from (1+ from)))
     gstring))
 
-(defun compose-gstring-for-graphic (gstring)
-  "Compose glyph-string GSTRING for graphic display.
+(defun compose-gstring-for-graphic (gstring direction)
+  "Compose glyph-string GSTRING under bidi DIRECTION for graphic display.
+DIRECTION is either L2R or R2L, or nil if unknown.
 Combining characters are composed with the preceding base
 character.  If the preceding character is not a base character,
 each combining character is composed as a spacing character by
@@ -559,7 +560,7 @@ All non-spacing characters have this function in
 
      ;; A base character and the following non-spacing characters.
      (t
-      (let ((gstr (font-shape-gstring gstring)))
+      (let ((gstr (font-shape-gstring gstring direction)))
         (if (and gstr
                  (> (lglyph-to (lgstring-glyph gstr 0)) 0))
             gstr
@@ -686,12 +687,12 @@ All non-spacing characters have this function in
               (setq i (1+ i))))
           gstring))))))
 
-(defun compose-gstring-for-dotted-circle (gstring)
+(defun compose-gstring-for-dotted-circle (gstring direction)
   (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
          (dc-id (lglyph-code dc))
          (fc (lgstring-glyph gstring 1)) ; glyph of the following char
          (fc-id (lglyph-code fc))
-         (gstr (and nil (font-shape-gstring gstring))))
+         (gstr (and nil (font-shape-gstring gstring direction))))
     (if (and gstr
              (or (= (lgstring-glyph-len gstr) 1)
                  (and (= (lgstring-glyph-len gstr) 2)
@@ -742,7 +743,7 @@ All non-spacing characters have this function in
   (aset composition-function-table #x25CC
         `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])))
 
-(defun compose-gstring-for-terminal (gstring)
+(defun compose-gstring-for-terminal (gstring _direction)
   "Compose glyph-string GSTRING for terminal display.
 Non-spacing characters are composed with the preceding base
 character.  If the preceding character is not a base character,
@@ -799,10 +800,11 @@ prepending a space before it."
     gstring))
 
 
-(defun auto-compose-chars (func from to font-object string)
+(defun auto-compose-chars (func from to font-object string direction)
   "Compose the characters at FROM by FUNC.
-FUNC is called with one argument GSTRING which is built for characters
-in the region FROM (inclusive) and TO (exclusive).
+FUNC is called with two arguments: GSTRING, which is built for
+characters in the region FROM (inclusive) and TO (exclusive);
+and DIRECTION, which is the bidi directionality of the characters.
 
 If the character are composed on a graphic display, FONT-OBJECT
 is a font to use.  Otherwise, FONT-OBJECT is nil, and the function
@@ -819,7 +821,7 @@ This function is the default value of `auto-composition-function' (which see)."
         gstring
       (or (fontp font-object 'font-object)
           (setq func 'compose-gstring-for-terminal))
-      (funcall func gstring))))
+      (funcall func gstring direction))))
 
 (put 'auto-composition-mode 'permanent-local t)
 
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 1ea01684eaa..0729a6d3a63 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1014,7 +1014,7 @@ With ARG, insert that many delimiters."
 ;;
 
 ;;;###autoload
-(defun ethio-composition-function (pos to font-object string)
+(defun ethio-composition-function (pos to font-object string _direction)
   (setq pos (1- pos))
   (let ((pattern "\\ce\\(á�Ÿ\\|ö ‡Š\\)"))
     (if string
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index c004337c2f8..52188f44725 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -152,7 +152,7 @@ Bidirectional editing is supported.")))
 ;; (3) If the font has precomposed glyphs, use them as far as
 ;; possible.  Adjust the remaining glyphs artificially.
 
-(defun hebrew-shape-gstring (gstring)
+(defun hebrew-shape-gstring (gstring direction)
   (let* ((font (lgstring-font gstring))
          (otf (font-get font :otf))
          (nchars (lgstring-char-len gstring))
@@ -172,7 +172,7 @@ Bidirectional editing is supported.")))
 
      ((or (assq 'hebr (car otf)) (assq 'hebr (cdr otf)))
       ;; FONT has OpenType features for Hebrew.
-      (font-shape-gstring gstring))
+      (font-shape-gstring gstring direction))
 
      (t
       ;; FONT doesn't have OpenType features for Hebrew.
@@ -217,7 +217,7 @@ Bidirectional editing is supported.")))
         ;; Now IDX is an index to the first non-precomposed glyph.
         ;; Adjust positions of the remaining glyphs artificially.
         (if (font-get font :combining-capability)
-            (font-shape-gstring gstring)
+            (font-shape-gstring gstring direction)
           (setq base-width (lglyph-width (lgstring-glyph gstring 0)))
           (while (< idx nglyphs)
             (setq glyph (lgstring-glyph gstring idx))
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 85e99181b5c..e5eaf1cb4a4 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -829,6 +829,9 @@ Returns new end position."
       (let ((pos from) newpos func (max to))
         (narrow-to-region from to)
         (while (< pos max)
+          ;; FIXME: The below seems to assume
+          ;; composition-function-table holds functions?  That is no
+          ;; longer true, since long ago.
           (setq func (aref composition-function-table (char-after pos)))
           (if (fboundp func)
               (setq newpos (funcall func pos nil)
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index f6d9e1bf450..b1fb56980a4 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -248,7 +248,7 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
   (define-translation-table 'unicode-to-jisx0213
     (char-table-extra-slot table 0)))
 
-(defun compose-gstring-for-variation-glyph (gstring)
+(defun compose-gstring-for-variation-glyph (gstring _direction)
   "Compose glyph-string GSTRING for graphic display.
 GSTRING must have two glyphs; the first is a glyph for a han character,
 and the second is a glyph for a variation selector."
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 554f7cfd83a..4d58be2fc57 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -489,10 +489,10 @@ syllable.  In that case, FROM and TO are indexes to STR."
       lao-str)))
 
 ;;;###autoload
-(defun lao-composition-function (gstring)
+(defun lao-composition-function (gstring direction)
   (if (= (lgstring-char-len gstring) 1)
-      (compose-gstring-for-graphic gstring)
-    (or (font-shape-gstring gstring)
+      (compose-gstring-for-graphic gstring direction)
+    (or (font-shape-gstring gstring direction)
         (let ((glyph-len (lgstring-glyph-len gstring))
               (i 0)
               glyph)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index c1aa79cae45..e25e63b4c5c 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -101,8 +101,8 @@ thin (i.e. 1-dot width) space."
 ;; Record error in arabic-change-gstring.
 (defvar arabic-shape-log nil)
 
-(defun arabic-shape-gstring (gstring)
-  (setq gstring (font-shape-gstring gstring))
+(defun arabic-shape-gstring (gstring direction)
+  (setq gstring (font-shape-gstring gstring direction))
   (condition-case err
       (when arabic-shaper-ZWNJ-handling
         (let ((font (lgstring-font gstring))
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index d6c9732a9e8..638d4832d93 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -225,10 +225,10 @@ positions (integers or markers) specifying the region."
   (thai-compose-region (point-min) (point-max)))
 
 ;;;###autoload
-(defun thai-composition-function (gstring)
+(defun thai-composition-function (gstring direction)
   (if (= (lgstring-char-len gstring) 1)
-      (compose-gstring-for-graphic gstring)
-    (or (font-shape-gstring gstring)
+      (compose-gstring-for-graphic gstring direction)
+    (or (font-shape-gstring gstring direction)
         (let ((glyph-len (lgstring-glyph-len gstring))
               (last-char (lgstring-char gstring
                                         (1- (lgstring-char-len gstring))))
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index a667956a060..7ce8ee1e500 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -128,7 +128,7 @@
 
 
 ;;;###autoload
-(defun tai-viet-composition-function (from to font-object string)
+(defun tai-viet-composition-function (from to font-object string _direction)
   (if string
       (if (string-match tai-viet-re string from)
           (tai-viet-compose-string from (match-end 0) string))
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;
 }