Improve support for shaping Egyptian Hieroglyphs

* src/composite.c (composition_gstring_lookup_cache): Renamed from
gstring_lookup_cache and made external.  All callers changed.
* src/composite.h (composition_gstring_lookup_cache): Add
prototype.
* src/font.c (Ffont_shape_gstring): Call
composition_gstring_lookup_cache and return the cached composition
if it is already in the cache.

* lisp/language/misc-lang.el (egyptian-shape-grouping): New
function.
(composition-function-table): Use egyptian-shape-grouping in
setting up compositions for Egyptian Hieroglyphs.  Fix the
composition setup for horizontal and vertical joiners.

lisp/language/misc-lang.el

@@ -149,11 +149,50 @@ thin (i.e. 1-dot width) space."
 ;; Hieroglyphs in "quadrats", as directed by the format controls,
 ;; which specify how the hieroglyphs should be joined horizontally and
 ;; vertically.
-(set-char-table-range
+(defun egyptian-shape-grouping (gstring direction)
- composition-function-table
+  (if (= (lgstring-char gstring 0) #x13437)
- '(#x13000 . #x1343F)
+      (let ((nchars (lgstring-char-len gstring))
- (list (vector "[\U00013000-\U0001343F]+"
+            (i 1)
-               0 'compose-gstring-for-graphic)))
+            (nesting 1)
+            ch)
+        ;; Find where this group ends.
+        (while (and (< i nchars) (> nesting 0))
+          (setq ch (lgstring-char gstring i))
+          (cond
+           ((= ch #x13437)
+            (setq nesting (1+ nesting)))
+           ((= ch #x13438)
+            (setq nesting (1- nesting))))
+          (setq i (1+ i)))
+        (when (zerop nesting)
+          ;; Make a new gstring from the characters that constitute a
+          ;; complete nested group.
+          (let ((new-header (make-vector (1+ i) nil))
+                (new-gstring (make-vector (+ i 2) nil)))
+            (aset new-header 0 (lgstring-font gstring))
+            (dotimes (j i)
+              (aset new-header (1+ j) (lgstring-char gstring j))
+              (lgstring-set-glyph new-gstring j (lgstring-glyph gstring j)))
+            (lgstring-set-header new-gstring new-header)
+            (font-shape-gstring new-gstring direction))))))
+
+(let ((hieroglyph "[\U00013000-\U0001342F]"))
+  ;; HORIZONTAL/VERTICAL JOINER and INSERT AT.../OVERLAY controls
+  (set-char-table-range
+   composition-function-table
+   '(#x13430 . #x13436)
+   (list (vector (concat hieroglyph "[\U00013430-\U00013436]" hieroglyph)
+                 ;; We use font-shape-gstring so that, if the font
+                 ;; doesn't support these controls, the glyphs are
+                 ;; displayed individually, and not as a single
+                 ;; grapheme cluster.
+                 1 'font-shape-gstring)))
+  ;; Grouping controls
+  (set-char-table-range
+   composition-function-table
+   #x13437
+   (list (vector "\U00013437[\U00013000-\U0001343F]+"
+                 0 'egyptian-shape-grouping))))
 
 (provide 'misc-lang)
 

src/composite.c

@@ -637,10 +637,8 @@ compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
 
 static Lisp_Object gstring_hash_table;
 
-static Lisp_Object gstring_lookup_cache (Lisp_Object);
+Lisp_Object
-
+composition_gstring_lookup_cache (Lisp_Object header)
-static Lisp_Object
-gstring_lookup_cache (Lisp_Object header)
 {
   struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
   ptrdiff_t i = hash_lookup (h, header, NULL);
@@ -1781,7 +1779,7 @@ should be ignored.  */)
 
   header = fill_gstring_header (frompos, frombyte,
 				topos, font_object, string);
-  gstring = gstring_lookup_cache (header);
+  gstring = composition_gstring_lookup_cache (header);
   if (! NILP (gstring))
     return gstring;
 

src/composite.h

@@ -330,6 +330,7 @@ extern int composition_update_it (struct composition_it *,
                                   ptrdiff_t, ptrdiff_t, Lisp_Object);
 
 extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t);
+extern Lisp_Object composition_gstring_lookup_cache (Lisp_Object);
 
 INLINE_HEADER_END
 

src/font.c

@@ -4461,6 +4461,10 @@ GSTRING.  */)
     signal_error ("Invalid glyph-string: ", gstring);
   if (! NILP (LGSTRING_ID (gstring)))
     return gstring;
+  Lisp_Object cached_gstring =
+    composition_gstring_lookup_cache (LGSTRING_HEADER (gstring));
+  if (! NILP (cached_gstring))
+    return cached_gstring;
   font_object = LGSTRING_FONT (gstring);
   CHECK_FONT_OBJECT (font_object);
   font = XFONT_OBJECT (font_object);