Function: hebrew-shape-gstring

hebrew-shape-gstring is a byte-compiled function defined in hebrew.el.gz.

Signature

(hebrew-shape-gstring GSTRING DIRECTION)

Source Code

;; Defined in /usr/src/emacs/lisp/language/hebrew.el.gz
;; Composition function for hebrew.  GSTRING is made of a Hebrew base
;; character followed by Hebrew diacritical marks, or is made of
;; single Hebrew diacritical mark.  Adjust GSTRING to display that
;; sequence properly.  The basic strategy is:
;;
;; (1) If there's single diacritical, add padding space to the left
;; and right of the glyph.
;;
;; (2) If the font has OpenType features for Hebrew, ask the OTF
;; driver the whole work.
;;
;; (3) If the font has precomposed glyphs, use them as far as
;; possible.  Adjust the remaining glyphs artificially.

(defun hebrew-shape-gstring (gstring direction)
  (let* ((font (lgstring-font gstring))
	 (otf (font-get font :otf))
	 (nchars (lgstring-char-len gstring))
	 header nglyphs base-width glyph precomposed val idx)
    (cond
     ((= nchars 1)
      ;; Independent diacritical mark.  Add padding space to left or
      ;; right so that the glyph doesn't overlap with the surrounding
      ;; chars.
      (setq glyph (lgstring-glyph gstring 0))
      (let ((width (lglyph-width glyph))
	    bearing)
	(if (< (setq bearing (lglyph-lbearing glyph)) 0)
	    (lglyph-set-adjustment glyph bearing 0 (- width bearing)))
	(if (> (setq bearing (lglyph-rbearing glyph)) width)
	    (lglyph-set-adjustment glyph 0 0 bearing))))

     ((or (assq 'hebr (car otf)) (assq 'hebr (cdr otf)))
      ;; FONT has OpenType features for Hebrew.
      (font-shape-gstring gstring direction))

     (t
      ;; FONT doesn't have OpenType features for Hebrew.
      ;; Try a precomposed glyph.
      ;; Now GSTRING is in this form:
      ;;   [[FONT CHAR1 CHAR2 ... CHARn] nil GLYPH1 GLYPH2 ... GLYPHn nil ...]
      (setq precomposed (hebrew-font-get-precomposed font)
	    header (lgstring-header gstring)
	    val (lookup-nested-alist header precomposed nil 1))
      (if (and (consp val) (vectorp (car val)))
	  ;; All characters can be displayed by a single precomposed glyph.
	  ;; Reform GSTRING to [HEADER nil PRECOMPOSED-GLYPH nil ...]
	  (let ((glyph (copy-sequence (car val))))
	    (lglyph-set-from-to glyph 0 (1- nchars))
	    (lgstring-set-glyph gstring 0 glyph)
	    (lgstring-set-glyph gstring 1 nil))
	(if (and (integerp val) (> val 2)
		 (setq glyph (lookup-nested-alist header precomposed val 1))
		 (consp glyph) (vectorp (car glyph)))
	    ;; The first (1- VAL) characters can be displayed by a
	    ;; precomposed glyph.  Provided that VAL is 3, the first
	    ;; two glyphs should be replaced by the precomposed glyph.
	    ;; In that case, reform GSTRING to:
	    ;;   [HEADER nil PRECOMPOSED-GLYPH GLYPH3 ... GLYPHn nil ...]
	    (let* ((ncmp (1- val))	; number of composed glyphs
		   (diff (1- ncmp)))	; number of reduced glyphs
	      (setq glyph (copy-sequence (car glyph)))
	      (lglyph-set-from-to glyph 0 (1- nchars))
	      (lgstring-set-glyph gstring 0 glyph)
	      (setq idx ncmp)
	      (while (< idx nchars)
		(setq glyph (lgstring-glyph gstring idx))
		(lglyph-set-from-to glyph 0 (1- nchars))
		(lgstring-set-glyph gstring (- idx diff) glyph)
		(setq idx (1+ idx)))
	      (lgstring-set-glyph gstring (- idx diff) nil)
	      (setq idx (- ncmp diff)
		    nglyphs (- nchars diff)))
	  (setq glyph (lgstring-glyph gstring 0))
	  (lglyph-set-from-to glyph 0 (1- nchars))
	  (setq idx 1 nglyphs nchars))
	;; 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 direction)
          (setq base-width (lglyph-width (lgstring-glyph gstring 0)))
          (while (< idx nglyphs)
            (setq glyph (lgstring-glyph gstring idx))
            (lglyph-set-from-to glyph 0 (1- nchars))
            (if (>= (lglyph-lbearing glyph) (lglyph-width glyph))
                ;; It seems that this glyph is designed to be rendered
                ;; before the base glyph.
                (lglyph-set-adjustment glyph (- base-width) 0 0)
              (if (>= (lglyph-lbearing glyph) 0)
                  ;; Align the horizontal center of this glyph to the
                  ;; horizontal center of the base glyph.
                  (let ((width (- (lglyph-rbearing glyph)
                                  (lglyph-lbearing glyph))))
                    (lglyph-set-adjustment glyph
                                           (- (/ (- base-width width) 2)
                                              (lglyph-lbearing glyph)
                                              base-width) 0 0))))
            (setq idx (1+ idx)))))))
    gstring))