leim/quail/tibetan.el

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