(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))
(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
;; 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
(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)
(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,
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
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)
;;
;;;###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
;; (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))
((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.
;; 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))
(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)
(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."
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)
;; 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))
(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))))
;;;###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))
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);
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);
}
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;
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
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))
{
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,
}
-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;
/* 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,
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);
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);
(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
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.
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);
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;
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;
#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;
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 */
#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);
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
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;
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
}
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;
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);
}
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);
(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
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
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;
#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;
}
projects / emacs.git / commitdiff