← Back to branch summary

~ubuntu-branches/debian/sid/emacs24/sid

« back to all changes in this revision

Viewing changes to lisp/language/tibet-util.el

  • Committer: Package Import Robot
  • Author(s): Rob Browning
  • Date: 2014-10-25 14:37:43 UTC
  • mfrom: (13.1.3 experimental)
  • Revision ID: package-import@ubuntu.com-20141025143743-m9q5reoyyyjq3p2h
Tags: 24.4+1-4
Update emacsen-common dependency as per policy.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/language/tibet-util.el
1
 
;;; tibet-util.el --- utilities for Tibetan   -*- coding: iso-2022-7bit; -*-
 
1
;;; tibet-util.el --- utilities for Tibetan   -*- coding: utf-8-emacs; -*-
2
2
 
3
 
;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
 
3
;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc.
4
4
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5
5
;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
6
6
;;   National Institute of Advanced Industrial Science and Technology (AIST)
35
35
;;; Code:
36
36
 
37
37
(defconst tibetan-obsolete-glyphs
38
 
  `(("$(7!=(B" . "$(7!=(B")                 ; 2 col <-> 1 col
39
 
    ("$(7!?(B" . "$(7!?(B")
40
 
    ("$(7!@(B" . "$(7!@(B")
41
 
    ("$(7!A(B" . "$(7!A(B")
42
 
    ("$(7"`(B" . "$(7"`(B")
43
 
    ("$(7!;(B" . "$(7!;(B")
44
 
    ("$(7!D(B" . "$(7!D(B")
 
38
  `(("།" . "།")                 ; 2 col <-> 1 col
 
39
    ("༏" . "༏")
 
40
    ("༐" . "༐")
 
41
    ("༑" . "༑")
 
42
    ("ཿ" . "ཿ")
 
43
    ("་" . "་")
 
44
    ("༔" . "༔")
45
45
    ;; Yes these are dirty. But ...
46
 
    ("$(7!>(B $(7!>(B" . ,(compose-string "$(7!>(B $(7!>(B" 0 3 [?$(7!>(B (Br . Bl) ?  (Br . Bl) ?$(7!>(B]))
47
 
    ("$(7!4!5!5(B" . ,(compose-string
48
 
                  "$(7#R#S#S#S(B" 0 4
49
 
                  [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B]))
50
 
    ("$(7!4!5(B" . ,(compose-string "$(7#R#S#S(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B]))
51
 
    ("$(7!6(B" . ,(compose-string "$(7#R#S!I(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (br . tr) ?$(7!I(B]))
52
 
    ("$(7!4(B"   . ,(compose-string "$(7#R#S(B" 0 2 [?$(7#R(B (Br . Bl) ?$(7#S(B]))))
 
46
    ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ?  (Br . Bl) ?༎]))
 
47
    ("༄༅༅" . ,(compose-string
 
48
                  "࿁࿂࿂࿂" 0 4
 
49
                  [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
 
50
    ("༄༅" . ,(compose-string "࿁࿂࿂" 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
 
51
    ("༆" . ,(compose-string "࿁࿂༙" 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
 
52
    ("༄"   . ,(compose-string "࿁࿂" 0 2 [?࿁ (Br . Bl) ?࿂]))))
53
53
 
54
54
;;;###autoload
55
55
(defun tibetan-char-p (ch)
136
136
;;;
137
137
;;; Here are examples of the words "bsgrubs" and "hfauM"
138
138
;;;
139
 
;;;            $(7"7"G###C"U"7"G(B            $(7"H"R"U"_(B
 
139
;;;            བསྒྲུབས            ཧཱུཾ
140
140
;;;
141
141
;;;                             M
142
142
;;;             b s b s         h
144
144
;;;               r             u
145
145
;;;               u
146
146
;;;
147
 
;;; Consonants `'' ($(7"A(B), `w' ($(7">(B), `y' ($(7"B(B), `r' ($(7"C(B) take special
 
147
;;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
148
148
;;; forms when they are used as subjoined consonant.  Consonant `r'
149
149
;;; takes another special form when used as superjoined in such a case
150
150
;;; as "rka", while it does not change its form when conjoined with
161
161
    ;; Special treatment for 'a chung.
162
162
    ;; If 'a follows a consonant, turn it into the subjoined form.
163
163
    ;; * Disabled by Tomabechi 2000/06/09 *
164
 
    ;; Because in Unicode, $(7"A(B may follow directly a consonant without
165
 
    ;; any intervening vowel, as in $(7"9"""Q"A!;(B=$(7"9(B $(7""(B $(7"A(B not $(7"9(B $(7""(B $(7"Q(B $(7"A(B
166
 
    ;;(if (and (= char ?$(7"A(B)
 
164
    ;; Because in Unicode, འ may follow directly a consonant without
 
165
    ;; any intervening vowel, as in མཁ����འ་=མ ཁ འ not མ ཁ ���� འ
 
166
    ;;(if (and (= char ?འ)
167
167
    ;;       (aref (char-category-set (car last)) ?0))
168
 
    ;;  (setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10
 
168
    ;;  (setq char ?ཱ)) ;; modified for new font by Tomabechi 1999/12/10
169
169
 
170
170
    ;; Composite vowel signs are decomposed before being added
171
171
    ;; Added by Tomabechi 2000/06/08
172
 
    (if (memq char '(?$(7"T(B ?$(7"V(B ?$(7"W(B ?$(7"X(B ?$(7"Y(B ?$(7"Z(B ?$(7"b(B))
 
172
    (if (memq char '(?ཱི ?ཱུ ?ྲྀ ?ཷ ?ླྀ ?ཹ ?ཱྀ))
173
173
        (setq comp-vowel
174
174
              (copy-sequence
175
175
               (cddr (assoc (char-to-string char)
184
184
 
185
185
     ;; Compose lower vowel sign vertically under.
186
186
     ((aref (char-category-set char) ?3)
187
 
      (if (or (eq char ?$(7"Q(B) ;; `$(7"Q(B' and `$,1FP(B' should not visible when composed.
 
187
      (if (or (eq char ?����) ;; `����' and `཰' should not visible when composed.
188
188
              (eq char #xF70))
189
189
          (setq rule nil)
190
190
        (setq rule stack-under)))
191
191
     ;; Transform ra-mgo (superscribed r) if followed by a subjoined
192
192
     ;; consonant other than w, ', y, r.
193
 
     ((and (= (car last) ?$(7"C(B)
194
 
           (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B))))
195
 
      (setcar last ?$(7!"(B) ;; modified for newfont by Tomabechi 1999/12/10
 
193
     ((and (= (car last) ?ར)
 
194
           (not (memq char '(?ྭ ?ཱ ?ྱ ?ྲ))))
 
195
      (setcar last ?����) ;; modified for newfont by Tomabechi 1999/12/10
196
196
      (setq rule stack-under))
197
197
     ;; Transform initial base consonant if followed by a subjoined
198
198
     ;; consonant but 'a.
199
199
     (t
200
200
      (let ((laststr (char-to-string (car last))))
201
 
        (if (and (/= char ?$(7"R(B) ;; modified for new font by Tomabechi
202
 
                 (string-match "[$(7"!(B-$(7"="?"@"D(B-$(7"J"K(B]" laststr))
 
201
        (if (and (/= char ?ཱ) ;; modified for new font by Tomabechi
 
202
                 (string-match "[ཀ-ཛྷཞཟལ-ཀྵཪ]" laststr))
203
203
            (setcar last (string-to-char
204
204
                          (cdr (assoc (char-to-string (car last))
205
205
                                      tibetan-base-to-subjoined-alist)))))
216
216
(defun tibetan-compose-string (str)
217
217
  "Compose Tibetan string STR."
218
218
  (let ((idx 0))
219
 
    ;; `$(7"A(B' is included in the pattern for subjoined consonants
 
219
    ;; `འ' is included in the pattern for subjoined consonants
220
220
    ;; because we treat it specially in tibetan-add-components.
221
221
    ;; (This feature is removed by Tomabechi 2000/06/08)
222
222
    (while (setq idx (string-match tibetan-composable-pattern str idx))
247
247
      (save-restriction
248
248
        (narrow-to-region beg end)
249
249
        (goto-char (point-min))
250
 
        ;; `$(7"A(B' is included in the pattern for subjoined consonants
 
250
        ;; `འ' is included in the pattern for subjoined consonants
251
251
        ;; because we treat it specially in tibetan-add-components.
252
252
        ;; (This feature is removed by Tomabechi 2000/06/08)
253
253
        (while (re-search-forward tibetan-composable-pattern nil t)
366
366
;;;
367
367
 
368
368
(defvar tibetan-canonicalize-for-unicode-alist
369
 
  '(("$(7"Q(B" . "")  ;; remove vowel a
370
 
    ("$(7"T(B" . "$(7"R"S(B") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0
371
 
    ("$(7"V(B" . "$(7"R"U(B")
372
 
    ("$(7"W(B" . "$(7#C"a(B")
373
 
    ("$(7"X(B" . "$(7#C"R"a(B")
374
 
    ("$(7"Y(B" . "$(7#D"a(B")
375
 
    ("$(7"Z(B" . "$(7#D"R"a(B")
376
 
    ("$(7"b(B" . "$(7"R"a(B"))
 
369
  '(("����" . "")       ;; remove vowel a
 
370
    ("ཱི" . "ཱི") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0
 
371
    ("ཱུ" . "ཱུ")
 
372
    ("ྲྀ" . "ྲྀ")
 
373
    ("ཷ" . "ྲཱྀ")
 
374
    ("ླྀ" . "ླྀ")
 
375
    ("ཹ" . "ླཱྀ")
 
376
    ("ཱྀ" . "ཱྀ"))
377
377
  "Rules for canonicalizing Tibetan vowels for Unicode.")
378
378
 
379
379
(defvar tibetan-canonicalize-for-unicode-regexp
380
 
  "[$(7"Q"T"V"W"X"Y"Z"b(B]"
 
380
  "[����ཱཱིུྲྀཷླྀཹཱྀ]"
381
381
  "Regexp for Tibetan vowels to be canonicalized in Unicode.")
382
382
 
383
383
(defun tibetan-canonicalize-for-unicode-region (from to)