lisp/leim/quail/tibetan.el

   1 ;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*-
   2
   3 ;; Copyright (C) 1997, 2001-2017 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