lisp/leim/quail/tibetan.el

   1 ;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*-
   2
   3 ;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
   5 ;;   2006, 2007, 2008, 2009, 2010, 2011
   6 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   7 ;;   Registration Number H14PRO021
   8
   9 ;; Keywords: multilingual, input method, Tibetan
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;; Author: Toru TOMABECHI <Toru.Tomabechi@orient.unil.ch>
  27
  28 ;; Created: Feb. 17. 1997
  29
  30 ;; History:
  31 ;; 1997.03.13 Support for inputting special signs and punctuation added.
  32 ;;            (Only Ext. Wylie input)
  33
  34 ;;; Commentary:
  35
  36 ;;; Code:
  37
  38 (require 'quail)
  39 (require 'tibet-util)
  40
  41 ;; Now quail-current-key is set to Tibetan-Roman transcription.  We
  42 ;; set quail-current-str to the corresponding Tibetan string (composed
  43 ;; if necessary).  Both Wylie and TibKey input methods use this
  44 ;; function.
  45
  46 (defun quail-tibetan-update-translation (control-flag)
  47   (if (numberp control-flag)
  48       ;; Non-composable-character typed.
  49       (setq quail-current-str
  50             (buffer-substring (overlay-start quail-overlay)
  51                               (overlay-end quail-overlay))
  52             unread-command-events
  53             (append
  54              (substring quail-current-key control-flag)
  55              unread-command-events))
  56     ;; Special treatment of "-d..." and "-y...".
  57     (if (string-match "^-[dy]" quail-current-key)
  58         (setq quail-current-key (substring quail-current-key 1)))
  59     (let ((str (tibetan-transcription-to-tibetan quail-current-key)))
  60       ;; If quail-current-key is for punctuation, it can't be
  61       ;; transcribed by tibetan-transcription-to-tibetan, thus STR
  62       ;; contains ASCII string now.  In that case, use the current
  63       ;; characters set in quail-current-str.
  64       (if (> (aref str 0) 255)
  65           (setq quail-current-str (tibetan-compose-string str))
  66         (or quail-current-str
  67             (setq quail-current-str quail-current-key)))))
  68   control-flag)
  69
  70 ;;; Wylie transcription based input methods.
  71
  72 ;; Special alist for `འ'.  It must be treated as a subjoined
  73 ;; consonant if it follows a consonant.
  74 ;; * Removed by Tomabechi 2000/06/10 *
  75 ;; 'a chung must be explicitly typed as a vowel ("fa")
  76 ;; འ is now treated as normal base consonants
  77 ;; (defconst tibetan-wylie-quote-alist '(("'" . ?འ)))
  78
  79 ;; Special alist to avoid default stacking.
  80 (defconst tibetan-wylie-non-stacking-alist
  81   '(("-d" . "ད")
  82     ("-y" . "ཡ")))
  83
  84 ;; Punctuation characters are not transcribed.
  85
  86 (defconst tibetan-wylie-punctuation-alist
  87    '(("."  . " ")
  88      (":"  . "ཿ")
  89      (" "  . "་")
  90      ("/"  . "།")
  91      ("//" . "༎")
  92      ("////" . ["༎ ༎"])
  93      ("$"  . "༏")
  94      ("/\"" . "༐")                    ; Not defined in Ext. Wylie.
  95      ("&"  . "༐")
  96      (";"  . "༑")
  97      ("%"  . "༔")
  98      ("!"  . "༈")
  99      ("<"  . "༼")
 100      (">"  . "༽")
 101      ("@"  . "྅")
 102      ("*"  . ["༄༅"])
 103      ("#"  . ["༄༅༅"])
 104      ("^"  . "༆")
 105      ("0" . "༠")
 106      ("1" . "༡")
 107      ("2" . "༢")
 108      ("3" . "༣")
 109      ("4" . "༤")
 110      ("5" . "༥")
 111      ("6" . "༦")
 112      ("7" . "༧")
 113      ("8" . "༨")
 114      ("9" . "༩")
 115      ("-0" . "༳")
 116      ("-1" . "༪")
 117      ("-2" . "༫")
 118      ("-3" . "༬")
 119      ("-4" . "༭")
 120      ("-5" . "༮")
 121      ("-6" . "༯")
 122      ("-7" . "༰")
 123      ("-8" . "༱")
 124      ("-9" . "༲")
 125      ("|"  . "ༀ༁༂༃༇༉༊༒༓༕༖༗༘༙༚༛༜༝༞༟༴༶༸༺༻༾༿྾྿࿀࿁࿂࿃࿄࿅࿆࿇࿈࿉࿊࿋࿌࿏")))
 126
 127 (quail-define-package "tibetan-wylie" "Tibetan" "TIBw" t
 128 "Tibetan character input by Extended Wylie key assignment.
 129
 130     +-------------------------------------+
 131     |ཀ་ k |ཁ་ kh |ག་ g  |གྷ་ gh |ང་ ng|   ི i          །        /
 132     |ཅ་ c |ཆ་ ch |ཇ་ j  |       |ཉ་ ny|   ུ u          ༎       //
 133     |ཊ་ T |ཋ་ TH |ཌ་ D  |ཌྷ་ DH |ཎ་ N |   ེ e          ༎ ༎    ////
 134     |ཏ་ t |ཐ་ th |ད་ d  |དྷ་ dh |ན་ n |   ོ o          ༑       ;
 135     |པ་ p |ཕ་ ph |བ་ b  |བྷ་ bh |མ་ m |   ཻ ai (ee, E) ༏        $
 136     |ཙ་ ts|ཚ་ tsh|ཛ་ dz |ཛྷ་ dzh|ཝ་ w |   ཽ au (oo, O) ༐        &
 137     |ཞ་ zh|ཟ་ z  |འ་ \\='  |       |ཡ་ y |   ྀ I          ༄༅   *
 138     |ར་ r |ལ་ l  |ཤ་ sh |ཥ་ SH |ས་ s |   ཿ :         ༄༅༅  #
 139     |ཧ་ h |ཨ་ A  |ཀྵ་ kSH|       |      |   ཾ M           ༼ ༽   < >
 140     +-------------------------------------+   ༔  %
 141     (The consonant ཨ་ must be typed explicitly.)
 142
 143   NOT SPECIFIED IN EXT. WYLIE:
 144     +--------------------------------------------------------+
 145     |ྂ = ~ |ྃ = \\=` |྄ = , |྅ = @ |༷ = _o|༵ = _O|༆ = ^|
 146     +--------------------------------------------------------+
 147     |ྈ = x |ྉ = X |྆ = v |྇ = V |ྊ = q |ྋ = Q |
 148     +-----------------------------------------------+
 149
 150   SPECIAL KEYS
 151   +     :  Consonant Stacking
 152           (Consonant stacking for ordinary Tibetan is done automatically)
 153   -     : No Consonant Stacking
 154           (To suppress automatic stacking for \"g-y\",
 155             and to get da-drag in  -r-d, -l-d .)
 156   |     : Special signs.
 157
 158   Tsheg is assigned to SPC.  Space is assigned to period ‘.’.
 159 "
 160  nil nil nil nil nil nil nil nil
 161  'quail-tibetan-update-translation)
 162
 163 ;; Here we build up a Quail map for a Tibetan sequence the whole of
 164 ;; which can be one composition.
 165 ;;
 166 ;; A Tibetan syllable is typically structured as follows:
 167 ;;      [P] C [c+] V [M] [S [s]]
 168 ;;          ^^^^^^^^^^^^
 169 ;; where P:prefix, C:base consonant, c:subjoined consonant,
 170 ;; V:vowel, M:vowel modifier, S:suffix, s:post suffix.
 171 ;; In this pattern, the part indicated by "^^^" can be one composition.
 172
 173 ;;; modified by Tomabechi 1999/12/10
 174 ;;; modified by Tomabechi 2000/06/08
 175 ;;;             Allows infinite addition of vowels/modifiers
 176 ;;;             as specified in Unicode v.3
 177 (quail-install-map
 178  (quail-map-from-table
 179   '((base-state (tibetan-consonant-transcription-alist . svm-state)
 180                 (tibetan-precomposed-transcription-alist . svm-state)
 181                 (tibetan-wylie-non-stacking-alist . svm-state)
 182                 tibetan-subjoined-transcription-alist
 183                 tibetan-vowel-transcription-alist
 184                 tibetan-modifier-transcription-alist
 185                 tibetan-wylie-punctuation-alist)
 186     (svm-state ;;(tibetan-wylie-quote-alist . vm-state)
 187                 (tibetan-vowel-transcription-alist . vm-state)
 188                 (tibetan-subjoined-transcription-alist . svm-state)
 189                 (tibetan-modifier-transcription-alist . m-state))
 190     (vm-state (tibetan-vowel-transcription-alist . vm-state)
 191               (tibetan-modifier-transcription-alist . m-state))
 192     (m-state (tibetan-modifier-transcription-alist . m-state)))))
 193
 194 ;;;
 195 ;;; TibKey key alignment based input method
 196 ;;;
 197
 198 (defconst tibetan-tibkey-to-transcription-alist
 199   '(;; consonant
 200     ("`" . "`")                         ; sna ldan
 201     ("~" . "~")                         ; sna ldan + nada
 202     ("q" . "k")                         ; ka
 203     ("Q" ."kSH")                        ; kSHa
 204     ("w" . "kh")                        ; kha
 205     ("e" . "g")                         ; ga
 206     ("r" . "ng")                        ; nga
 207     ("t" . "c")                         ; ca
 208     ("T" . "I")                         ; gi gu log
 209     ("y" . "ch")                        ; cha
 210     ("u" . "j")                         ; ja
 211     ("i" . "ny")                        ; nya
 212     ("o" . "t")                         ; ta
 213     ("O" . "T")                         ; Ta
 214     ("p" . "th")                        ; tha
 215     ("P" . "TH")                        ; THa
 216     ("[" . "d")                         ; da
 217     ("{" . "D")                         ; Da
 218     ("]" . "n")                         ; na
 219     ("}" . "N")                         ; Na
 220     ("a" . "p")                         ; pa
 221     ("A" . "a")                         ; Vowel a (not used in original TibKey)
 222     ("s" . "ph")                        ; pha
 223     ("d" . "b")                         ; ba
 224     ("f" . "m")                         ; ma
 225     ("F" . "M")                         ; anusvara
 226     ("g" . "u")                         ; zhabs kyu
 227     ("G" . "i")                         ; gi gu
 228     ("H" . ",")                         ; virama
 229     ("j" . "o")                         ; naro
 230     ("J" . "e")                         ; 'greng bu
 231     ("k" . "ts")                        ; tsa
 232     ("l" . "tsh")                       ; tsha
 233     (";" . "dz")                        ; dza
 234     ("'" . "w")                         ; wa
 235     ("\"" . "+w")                       ; wa zur
 236     ("z" . "zh")                        ; zha
 237     ("x" . "z")                         ; za
 238     ("c" . "'")                         ; 'a
 239     ("C" . "+'")                        ; 'a chung
 240     ("v" . "y")                         ; ya
 241     ("V" . "+y")                        ; ya btags
 242     ("b" . "r")                         ; ra
 243     ("B" . "+r")                        ; ra btags
 244     ("n" . "l")                         ; la
 245     ("N" . "+l")                        ; la btags
 246     ("m" . "sh")                        ; sha
 247     ("M" . "SH")                        ; SHa
 248     ("," . "s")                         ; sa
 249     ("." . "h")                         ; ha
 250     ("/" . "A")                         ; Aa
 251     ;; subjoined
 252     ("hq" . "+k")                       ; ka
 253     ("hQ" ."+kSH")                      ; kSHa
 254     ("hw" . "+kh")                      ; kha
 255     ("he" . "+g")                       ; ga
 256     ("hr" . "+ng")                      ; nga
 257     ("ht" . "+c")                       ; ca
 258     ("hy" . "+ch")                      ; cha
 259     ("hu" . "+j")                       ; ja
 260     ("hi" . "+ny")                      ; nya
 261     ("ho" . "+t")                       ; ta
 262     ("hO" . "+T")                       ; Ta
 263     ("hp" . "+th")                      ; tha
 264     ("hP" . "+TH")                      ; THa
 265     ("h[" . "+d")                       ; da
 266     ("h{" . "+D")                       ; Da
 267     ("h]" . "+n")                       ; na
 268     ("h}" . "+N")                       ; Na
 269     ("ha" . "+p")                       ; pa
 270     ("hs" . "+ph")                      ; pha
 271     ("hd" . "+b")                       ; ba
 272     ("hf" . "+m")                       ; ma
 273     ("hk" . "+ts")                      ; tsa
 274     ("hl" . "+tsh")                     ; tsha
 275     ("h;" . "+dz")                      ; dza
 276     ("h'" . "+w")                       ; wa
 277     ("hz" . "+zh")                      ; zha
 278     ("hx" . "+z")                       ; za
 279     ("hc" . "+'")                       ; 'a
 280     ("hv" . "+y")                       ; ya
 281     ("hb" . "+r")                       ; ra
 282     ("hn" . "+l")                       ; la
 283     ("hm" . "+sh")                      ; sha
 284     ("hM" . "+SH")                      ; SHa
 285     ("h," . "+s")                       ; sa
 286     ("h." . "+h")                       ; ha
 287     ("h/" . "+A")                       ; Aa
 288     ;; Special rule for `ཡ' to avoid stacking.
 289     ("E" . "-y")
 290     ))
 291
 292 (defconst tibetan-consonant-tibkey-alist nil)
 293 (defconst tibetan-subjoined-tibkey-alist nil)
 294 (defconst tibetan-vowel-tibkey-alist nil)
 295 (defconst tibetan-modifier-tibkey-alist nil)
 296 (defconst tibetan-non-stacking-tibkey-alist nil)
 297
 298 (let ((type-list '("consonant" "subjoined" "vowel" "modifier" "non-stacking"))
 299       (tail tibetan-tibkey-to-transcription-alist)
 300       elt)
 301   (while tail
 302     (setq elt (car tail) tail (cdr tail))
 303     (let ((types type-list)
 304           type transcription trans-alist tibkey-alist)
 305       (while types
 306         (setq type (car types) types (cdr types))
 307         (setq trans-alist
 308               (if (string= type "non-stacking")
 309                   'tibetan-wylie-non-stacking-alist
 310                 (intern (format "tibetan-%s-transcription-alist" type)))
 311               transcription
 312               (cdr (assoc (cdr elt) (symbol-value trans-alist))))
 313         (when transcription
 314           (setq tibkey-alist (intern (format "tibetan-%s-tibkey-alist" type)))
 315           (set tibkey-alist
 316                (cons (cons (car elt) transcription)
 317                      (symbol-value tibkey-alist)))))
 318       (or tibkey-alist
 319           (error "No Tibetan transcription for %s" (cdr elt))))))
 320
 321 (defconst tibetan-punctuation-tibkey-alist
 322   '(("1" . "༡")
 323     ("!" . "༄")               ; nyi zla long
 324     ("2" . "༢")
 325     ("@" . "༅")                       ; nyi zla simple
 326     ("3" . "༣")
 327 ;;; ("#" )
 328     ("4" . "༤")
 329 ;;; ("$" )
 330     ("5" . "༥")
 331     ("%" . "༔")
 332     ("6" . "༦")
 333     ("^" . "༁")
 334     ("7" . "༧")
 335     ("8" . "༨")
 336 ;;; ("*" ) ; avagraha, not supported yet
 337     ("9" . "༩")
 338     ("(" . "༼")
 339     ("0" . "༠")
 340     (")" . "༽")
 341 ;;; ("-" ) ; emphatic, not yet supported
 342 ;;; ("_" ) ; id.
 343 ;;; ("=" ) ; special sign, not yet supported
 344     ("+" . "༑")
 345     ("\\" . "༏")
 346     ("|" . "༈")
 347     ("I" . "྅")                               ; avagraha
 348     (":" . "ཿ")
 349 ;;; (">" ?་) ; to be assigned to SPC
 350     (">" . " ")
 351     ("?" . "།")
 352     ("??" . "༎")
 353     ("????" . ["༎ ༎"])
 354     (" " . "་")
 355     ))
 356
 357 ;; Convert TibKey string to Tibetan-Roman transcription string.
 358 ;; If there's no proper conversion, return nil.
 359 (defun quail-tibkey-to-transcription (tibkey)
 360   (let ((len (length tibkey))
 361         (i 0)
 362         (trans-list nil))
 363     (while (< i len)
 364       (let ((last len)
 365             trans)
 366         (while (and (not trans) (> last i))
 367           (or (setq trans (cdr (assoc (substring tibkey i last)
 368                                       tibetan-tibkey-to-transcription-alist)))
 369               (setq last (1- last))))
 370         (if trans
 371             (setq trans-list (cons trans trans-list)
 372                   i last)
 373           (setq trans-list nil i len))))
 374     (apply 'concat (nreverse trans-list))))
 375
 376 (defvar quail-tibkey-characters nil)
 377
 378 (defun quail-tibkey-update-translation (control-flag)
 379   (if (integerp control-flag)
 380       ;; Non-composable-character typed.
 381       (setq quail-current-str
 382             (buffer-substring (overlay-start quail-overlay)
 383                               (overlay-end quail-overlay))
 384             unread-command-events
 385             (append
 386              (substring quail-current-key control-flag)
 387              unread-command-events))
 388     (let ((transcription (quail-tibkey-to-transcription quail-current-key)))
 389       (if (> (length transcription) 0)
 390           (let ((quail-current-key transcription))
 391             (setq control-flag
 392                   (quail-tibetan-update-translation control-flag)))
 393         (or quail-current-str
 394             (setq quail-current-str quail-current-key)))))
 395   control-flag)
 396
 397 (quail-define-package "tibetan-tibkey" "Tibetan" "TIBt" t
 398 "Tibetan character input by TibKey key assignment.
 399
 400 \(This implementation is still incomplete.
 401  Therefore, the following key assignment is a provisional one.)
 402
 403   [NOT SHIFTED]
 404
 405   +-------------------------------------------------------+
 406   |`ྃ|1༡|2༢|3༣|4༤|5༥|6༦|7༧|8༨|9༩|0༠|-  |=  |\\༈|
 407   +-------------------------------------------------------+
 408      |qཀ|wཁ|eག|rང|tཅ|yཆ|uཇ|iཉ|oཏ|pཐ|[ད|]ན|
 409      +-----------------------------------------------+
 410       |aཔ| sཕ| dབ|fམ|gུ|h  |jོ|kཙ|lཚ|;ཛ|\\='ཝ|
 411       +---------------------------------------------+
 412          |zཞ|xཟ|cའ|vཡ|bར|nལ|mཤ|,ས|.ཧ|/ཨ|
 413          +---------------------------------------+
 414   The key ‘h’ is used for consonant stacking.
 415
 416   [SHIFTED]
 417
 418   +----------------------------------------------------------+
 419   |~ྂ|!༄|@༅|#  |$  |%༔ |^༁|&  |*  |(༼|)༽|_  |+༑| |༈|
 420   +----------------------------------------------------------+
 421      |Qཀྵ|W  |E  |R  |Tྀ|Y  |U  |I྅|Oཊ|Pཋ|{ཌ|}ཎ|
 422      +-----------------------------------------------+
 423       |A  |S  |D  |Fཾ|Gི|H྄|Jེ|K  |L  |:ཿ|\"ྭ|
 424       +-------------------------------------------+
 425          |Z  |X  |Cཱ|Vྱ|Bྲ|Nླ|Mཥ|<  |>  |?། |
 426          +---------------------------------------+
 427
 428   DIFFERENCE FROM THE ORIGINAL TIBKEY:
 429
 430     1. Vowel ‘a’ should be typed explicitly by the key ‘A’.
 431        This is really inconvenient.  But to make the coding
 432        scheme clear, it is desirable to have an explicit
 433        vowel sign for ‘a’.
 434     2. Tsheg is assigned to SPC key.  You can input a space
 435        by typing ‘>’.
 436     4. To avoid the default stacking ���� and to obtain གཡ,
 437        type ‘E’ instead of ‘v’ (=ཡ).
 438     3. There are many characters that are not supported in the
 439        current implementation (especially special signs).
 440        I hope I'll complete in a future revision.
 441 "
 442  nil nil nil nil nil nil nil nil
 443  'quail-tibkey-update-translation)
 444
 445 (quail-install-map
 446  (quail-map-from-table
 447   '((base-state (tibetan-consonant-tibkey-alist . s-state)
 448                 (tibetan-non-stacking-tibkey-alist . s-state)
 449                 tibetan-subjoined-tibkey-alist
 450                 tibetan-vowel-tibkey-alist
 451                 tibetan-modifier-tibkey-alist
 452                 tibetan-punctuation-tibkey-alist)
 453     (s-state (tibetan-subjoined-tibkey-alist . s-state)
 454              (tibetan-vowel-tibkey-alist . m-state))
 455     (m-state tibetan-modifier-tibkey-alist))))
 456
 457 ;;; tibetan.el ends here