From 64baaff8c5f70b7d637ac37304c4377e955b3f09 Mon Sep 17 00:00:00 2001 From: "K. Handa" Date: Sun, 8 Oct 2017 11:48:01 +0900 Subject: [PATCH] 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. --- etc/NEWS | 7 +++++ lisp/composite.el | 14 +++++++++ lisp/language/misc-lang.el | 64 ++++++++++++++++++++++++++++++++++++-- 3 files changed, 82 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 62a9ea2181c..b75fbd65b7a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/composite.el b/lisp/composite.el index ab39e087e1f..72b0ffc8f48 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -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) diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 2843c7c9038..f6179dc1fbf 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -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) -- 2.39.5