comparison lisp/language/tibet-util.el @ 29596:c3845ffcb423

Convert all tibetan-1-column characters to the corresponding tibetan characters. (tibetan-add-components): Delete code for the special treatment of 'a chung.

29595:df1f973a0120

(defun tibetan-add-components (components char)
  (let ((last (last components))
	(stack-upper '(tc . bc))
	(stack-under '(bc . tc))
	rule)
    ;; Special treatment for 'a chung.
    ;; If 'a follows a consonant, turn it into the subjoined form.
    (if (and (= char ?$(7"A(B)
	     (aref (char-category-set (car last)) ?0))
	(setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10

    (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 (eq char ?$(7"Q(B)		;; `$(7"Q(B' should not visible when composed.
	  (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) ?$(7"C(B)
	   (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B))))
      (setcar last ?$(7!"(B) ;; 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 ?$(7"R(B) ;; modified for new font by Tomabechi

			  (cdr (assoc (char-to-string (car last))
				      tibetan-base-to-subjoined-alist)))))
	(setq rule stack-under))))

    (if rule
	(setcdr last (list rule char)))))

;;;###autoload
(defun tibetan-compose-string (str)
  "Compose Tibetan string STR."
  (let ((idx 0))
    ;; `$(7"A(B' is included in the pattern for subjoined consonants
    ;; because we treat it specially in tibetan-add-components.
    (while (setq idx (string-match tibetan-composable-pattern str idx))
      (let ((from idx)
	    (to (match-end 0))
	    components)
	(if (eq (string-match tibetan-precomposition-rule-regexp str idx) idx)

      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	;; `$(7"A(B' is included in the pattern for subjoined consonants
	;; because we treat it specially in tibetan-add-components.
	(while (re-search-forward tibetan-composable-pattern nil t)
	  (let ((from (match-beginning 0))
		(to (match-end 0))
		components)
	    (goto-char from)

29596:c3845ffcb423

(defun tibetan-add-components (components char)
  (let ((last (last components))
	(stack-upper '(tc . bc))
	(stack-under '(bc . tc))
	rule comp-vowel tmp)
    ;; 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, $(7"A(B may follow directly a consonant without
    ;; any intervening vowel, as in 4$(7"90"914""0"""Q14"A0"A1!;(B=4$(7"90"91(B 4$(7""0""1(B 4$(7"A0"A1(B not 4$(7"90"91(B 4$(7""0""1(B $(7"Q(B 4$(7"A0"A1(B  
    ;;(if (and (= char ?$(7"A(B)
    ;;	     (aref (char-category-set (car last)) ?0))
    ;;	(setq char ?$(7"R(B)) ;; 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 '(?$(7"T(B ?$(7"V(B ?$(7"W(B ?$(7"X(B ?$(7"Y(B ?$(7"Z(B ?$(7"b(B))
	(setq comp-vowel
	      (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 (eq char ?$(7"Q(B)		;; `$(7"Q(B' should not visible when composed.
	  (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) ?$(7"C(B)
	   (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B))))
      (setcar last ?$(7!"(B) ;; 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 ?$(7"R(B) ;; modified for new font by Tomabechi

			  (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))
    ))

;;;###autoload
(defun tibetan-compose-string (str)
  "Compose Tibetan string STR."
  (let ((idx 0))
    ;; `$(7"A(B' is included in the pattern for subjoined consonants
    ;; because we treat it specially in tibetan-add-components.
    ;; (This feature is removed by Tomabechi 2000/06/08)
    (while (setq idx (string-match tibetan-composable-pattern str idx))
      (let ((from idx)
	    (to (match-end 0))
	    components)
	(if (eq (string-match tibetan-precomposition-rule-regexp str idx) idx)

      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	;; `$(7"A(B' is included in the pattern for subjoined consonants
	;; because we treat it specially in tibetan-add-components.
	;; (This feature is removed by Tomabechi 2000/06/08)
	(while (re-search-forward tibetan-composable-pattern nil t)
	  (let ((from (match-beginning 0))
		(to (match-end 0))
		components)
	    (goto-char from)