Function: tibetan-add-components

tibetan-add-components is a byte-compiled function defined in tibet-util.el.gz.

Signature

(tibetan-add-components COMPONENTS CHAR)

Source Code

;; Defined in /usr/src/emacs/lisp/language/tibet-util.el.gz
;;
;;; Functions for composing/decomposing Tibetan sequence.
;;
;; A Tibetan syllable is typically structured as follows:
;;
;;      [Prefix] C [C+] V [M] [Suffix [Post suffix]]
;;
;; where C's are all vertically stacked, V appears below or above
;; consonant cluster and M is always put above the C[C+]V combination.
;; (Sanskrit visarga, though it is a vowel modifier, is considered
;;  to be a punctuation.)
;;
;; Here are examples of the words "bsgrubs" and "hfauM"
;;
;;            བསྒྲུབས            ཧཱུཾ
;;
;;                             M
;;             b s b s         h
;;               g             fa
;;               r             u
;;               u
;;
;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
;; forms when they are used as subjoined consonant.  Consonant `r'
;; takes another special form when used as superjoined in such a case
;; as "rka", while it does not change its form when conjoined with
;; subjoined `'', `w' or `y' as in "rwa", "rya".

; Append a proper composition rule and glyph to COMPONENTS to compose
; CHAR with a composition that has COMPONENTS.

(defun tibetan-add-components (components char)
  (let ((last (last components))
	(stack-upper '(tc . bc))
	(stack-under '(bc . tc))
	rule comp-vowel)
    ;; Special treatment for 'a chung.
    ;; If 'a follows a consonant, turn it into the subjoined form.
    ;; * Disabled by Tomabechi 2000/06/09 *
    ;; Because in Unicode, འ may follow directly a consonant without
    ;; any intervening vowel, as in མཁ\x19008Eའ་=མ ཁ འ not མ ཁ \x19008E འ
    ;;(if (and (= char ?འ)
    ;;	     (aref (char-category-set (car last)) ?0))
    ;;	(setq char ?ཱ)) ;; modified for new font by Tomabechi 1999/12/10

    ;; Composite vowel signs are decomposed before being added
    ;; Added by Tomabechi 2000/06/08
    (if (memq char '(?ཱི ?ཱུ ?ྲྀ ?ཷ ?ླྀ ?ཹ ?ཱྀ))
	(setq comp-vowel
	      (copy-sequence
	       (cddr (assoc (char-to-string char)
			    tibetan-composite-vowel-alist)))
	      char
	      (cadr (assoc (char-to-string char)
			   tibetan-composite-vowel-alist))))
    (cond
     ;; Compose upper vowel sign vertically over.
     ((aref (char-category-set char) ?2)
      (setq rule stack-upper))

     ;; Compose lower vowel sign vertically under.
     ((aref (char-category-set char) ?3)
      (if (or (eq char ?\x19008E) ;; `\x19008E' and `཰' should not visible when composed.
	      (eq char #xF70))
	  (setq rule nil)
	(setq rule stack-under)))
     ;; Transform ra-mgo (superscribed r) if followed by a subjoined
     ;; consonant other than w, ', y, r.
     ((and (= (car last) ?ར)
	   (not (memq char '(?ྭ ?ཱ ?ྱ ?ྲ))))
      (setcar last ?\x190001) ;; modified for newfont by Tomabechi 1999/12/10
      (setq rule stack-under))
     ;; Transform initial base consonant if followed by a subjoined
     ;; consonant but 'a.
     (t
      (let ((laststr (char-to-string (car last))))
	(if (and (/= char ?ཱ) ;; modified for new font by Tomabechi
		 (string-match "[ཀ-ཛྷཞཟལ-ཀྵཪ]" laststr))
	    (setcar last (string-to-char
			  (cdr (assoc (char-to-string (car last))
				      tibetan-base-to-subjoined-alist)))))
	(setq rule stack-under))))

    (if rule
	(setcdr last (list rule char)))
    ;; Added by Tomabechi 2000/06/08
    (if comp-vowel
	(nconc last comp-vowel))
    ))