New option for handling ZWNJ in Arabic text rendering

Provide a new option 'arabic-shaper-ZWNJ-handling' that controls how
to display ZWNJ in Arabic text rendering (Bug#28339).
* lisp/language/misc-lang.el: Register arabic-shape-gstring in
composition-function-table.
(arabic-shaper-ZWNJ-handling): New variable.
(arabic-shape-log): New variable.
(arabic-shape-gstring): New function.
* lisp/composite.el (lgstring-remove-glyph): New function.
This commit is contained in:
K. Handa 2017-10-08 11:48:01 +09:00
parent 7a1133f1ff
commit 64baaff8c5
3 changed files with 82 additions and 3 deletions

View file

@ -491,6 +491,9 @@ Arguments may be quoted "like this", so that for example an absolute
path containing a space may be specified; quote escaping is not
supported.
** The new user option 'arabic-shaper-ZWNJ-handling' controls how to
handle ZWNJ in Arabic text rendering.
* Editing Changes in Emacs 26.1
@ -1850,6 +1853,10 @@ The new functions 'secondary-selection-to-region' and
end of the region from those of the secondary selection and vise
versa.
** New function 'lgstring-remove-glyph' can be used to modify a
gstring returned by the underlying layout engine (e.g. m17n-flt,
uniscribe).
* Changes in Emacs 26.1 on Non-Free Operating Systems

View file

@ -442,8 +442,10 @@ after a sequence of character events."
(defsubst lglyph-set-adjustment (glyph &optional xoff yoff wadjust)
(aset glyph 9 (vector (or xoff 0) (or yoff 0) (or wadjust 0))))
;; Return the shallow Copy of GLYPH.
(defsubst lglyph-copy (glyph) (copy-sequence glyph))
;; Insert GLYPH at the index IDX of GSTRING.
(defun lgstring-insert-glyph (gstring idx glyph)
(let ((nglyphs (lgstring-glyph-len gstring))
(i idx))
@ -459,6 +461,18 @@ after a sequence of character events."
(lgstring-set-glyph gstring i glyph)
gstring))
;; Remove glyph at IDX from GSTRING.
(defun lgstring-remove-glyph (gstring idx)
(setq gstring (copy-sequence gstring))
(lgstring-set-id gstring nil)
(let ((len (length gstring)))
(setq idx (+ idx 3))
(while (< idx len)
(aset gstring (1- idx) (aref gstring idx))
(setq idx (1+ idx)))
(aset gstring (1- len) nil))
gstring)
(defun compose-glyph-string (gstring from to)
(let ((glyph (lgstring-glyph gstring from))
from-pos to-pos)

View file

@ -75,12 +75,70 @@ and Italian.")))
(sample-text . "Persian فارسی")
(documentation . "Bidirectional editing is supported.")))
(defcustom arabic-shaper-ZWNJ-handling nil
"How to handle ZWMJ in Arabic text renderling.
This variable controls the way to handle a glyph for ZWNJ
returned by the underling shaping engine.
The default value is nil, which means that the ZWNJ glyph is
displayed as is.
If the value is `absorb', ZWNJ is absorbed into the previous
grapheme cluster, and not displayed.
If the value is `as-space', the glyph is displayed by a
thin (i.e. 1-dot width) space.
Customizing the value takes effect when you start Emacs next time."
:group 'mule
:version "26.1"
:type '(choice
(const :tag "default" nil)
(const :tag "as space" as-space)
(const :tag "absorb" absorb)))
;; Record error in arabic-change-gstring.
(defvar arabic-shape-log nil)
(defun arabic-shape-gstring (gstring)
(setq gstring (font-shape-gstring gstring))
(condition-case err
(when arabic-shaper-ZWNJ-handling
(let ((font (lgstring-font gstring))
(i 1)
(len (lgstring-glyph-len gstring))
(modified nil))
(while (< i len)
(let ((glyph (lgstring-glyph gstring i)))
(when (eq (lglyph-char glyph) #x200c)
(cond
((eq arabic-shaper-ZWNJ-handling 'as-space)
(if (> (- (lglyph-rbearing glyph) (lglyph-lbearing glyph)) 0)
(let ((space-glyph (aref (font-get-glyphs font 0 1 " ") 0)))
(when space-glyph
(lglyph-set-code glyph (aref space-glyph 3))
(lglyph-set-width glyph (aref space-glyph 4)))))
(lglyph-set-adjustment glyph 0 0 1)
(setq modified t))
((eq arabic-shaper-ZWNJ-handling 'absorb)
(let ((prev (lgstring-glyph gstring (1- i))))
(lglyph-set-from-to prev (lglyph-from prev) (lglyph-to glyph))
(setq gstring (lgstring-remove-glyph gstring i))
(setq len (1- len)))
(setq modified t)))))
(setq i (1+ i)))
(if modified
(lgstring-set-id gstring nil))))
(error (push err arabic-shape-log)))
gstring)
(set-char-table-range
composition-function-table
'(#x600 . #x74F)
(list (vector "[\u0600-\u074F\u200C\u200D]+" 0 'font-shape-gstring)
(vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
1 'font-shape-gstring)))
(list (vector "[\u0600-\u074F\u200C\u200D]+" 0
'arabic-shape-gstring)
(vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 1
'arabic-shape-gstring)))
(provide 'misc-lang)