leim/quail/hangul.el

   1 ;;; hangul.el --- Korean Hangul input method
   2
   3 ;; Author: Jihyun Cho <jihyun.jo@gmail.com>
   4 ;; Keywords: multilingual, input method, Korean, Hangul
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; This file is to implement the following hangul automata:
  24 ;; - Hangul 2-Bulsik input method
  25 ;; - Hangul 3-Bulsik final input method
  26 ;; - Hangul 3-Bulsik 390 input method
  27
  28 ;;; Code:
  29
  30 (require 'quail)
  31 (require 'cl)
  32 (require 'hanja-util)
  33
  34 ;; Hangul double Jamo table.
  35 ;; The format is an alist of JAMO-TYPE vs. DOUBLE-JAMO-TABLE.
  36 ;;
  37 ;; JAMO-TYPE is a symbol `cho' for Choseong, `jung' for Jungseong, and
  38 ;; `jong' for Jongseong.
  39 ;;
  40 ;; DOUBLE-JAMO-TABLE is an alist of Jamo index vs. the vector of Jamo
  41 ;; indies that can be combined with the car part.
  42 ;;
  43 ;; Jamo index is a relative index in `hangul Compatibility Jamo' area
  44 ;; of the Unicode (i.e. 1 for U+3131).
  45
  46 (defconst hangul-djamo-table
  47   '((cho . ((1 . [1])                   ; Choseong
  48             (7 . [7])
  49             (18 . [18])
  50             (21 . [21])
  51             (24 . [24])))
  52     (jung . ((39 . [31 32 51])          ; Jungseong
  53              (44 . [35 36 51])
  54              (49 . [51])))
  55     (jong . ((1 . [1 21])               ; Jongseong
  56              (4 . [24 30])
  57              (9 . [1 17 18 21 28 29 30])
  58              (18 . [18 21])
  59              (21 . [21])))))
  60
  61 ;; Hangul 2-Bulsik keymap.
  62 ;; It converts an ASCII code A-Z, a-z, to the corresponding hangul
  63 ;; Jamo index.
  64
  65 (defconst hangul2-keymap
  66   [17 48 26 23 7 9 30 39 33 35 31 51 49 44 32 36 18 1 4 21 37 29 24 28 43 27])
  67
  68 ;; Hangul 3-Bulsik final keymap.  3-Bulsik use full keyboard layout.
  69 ;; Therefore, we must map all printable ASCII codes (`!' to `~')
  70 ;; to Hangul 3-Bulsik codes.
  71 ;; Other parts are the same as `hangul2-keymap'.
  72 (defconst hangul3-keymap
  73   [2 183 24 15 14 8220 120 39 126 8221 43 44 41 46 74 119 30 22 18 78 83
  74      68 73 85 79 52 110 44 62 46 33 10 7 63 27 12 5 11 69 48 55 49 50 51
  75      34 45 56 57 29 16 6 13 54 3 28 20 53 26 40 58 60 61 59 42 23 79 71
  76      86 72 66 84 96 109 115 93 116 122 113 118 121 21 67 4 70 99 74 9 1
  77      101 17 37 92 47 8251])
  78
  79 ;; Hangul 3-Bulsik 390 keymap.
  80 ;; The role is the same as `hangul3-keymap'.
  81 (defconst hangul390-keymap
  82   [24 34 35 36 37 38 120 40 41 42 43 44 45 46 73 119 30 22 18 77 82 67 72
  83       84 78 58 110 50 61 51 63 64 7 33 11 10 27 2 47 39 56 52 53 54 49 48
  84       57 62 29 68 6 59 55 16 28 20 60 26 91 92 93 94 95 96 23 78 70 85 71
  85       65 83 90 109 115 87 116 122 113 118 121 21 66 4 69 99 73 9 1 101 17
  86       123 124 125 126])
  87
  88 (defvar hangul-im-keymap
  89   (let ((map (make-sparse-keymap)))
  90     (define-key map "\d" 'hangul-delete-backward-char)
  91     (define-key map [f9] 'hangul-to-hanja-conversion)
  92     map)
  93   "Keymap for Hangul method.  It is used by all Hangul input method.")
  94
  95 ;; Current input character buffer. Store separated hangul character.
  96 ;; The first and second are Choseong position.
  97 ;; The third and forth are Jungseong position.
  98 ;; The fifth and sixth are Jongseong position.
  99 ;; The second, forth and sixth are double Jamo position.
 100 (defvar hangul-queue
 101   (make-vector 6 0))
 102
 103 (defsubst notzerop (number)
 104   (not (zerop number)))
 105
 106 (defsubst alphabetp (char)
 107   (or (and (>= char ?A) (<= char ?Z))
 108       (and (>= char ?a) (<= char ?z))))
 109
 110 (defun hangul-character (cho jung jong)
 111   "Convert CHO, JUNG, JONG to the precomposed `Hangul Syllables' character.
 112 CHO, JUNG, JONG are relative indices in `Hangul Compatibility Jamo' of unicode.
 113 Return a zero-length string if the conversion fails."
 114   (or
 115    (decode-char
 116     'ucs
 117     (if (and (/= cho 0) (/= jung 0))
 118         (+ #xac00
 119            (* 588
 120               (- cho
 121                  (cond ((< cho 3) 1)
 122                        ((< cho 5) 2)
 123                        ((< cho 10) 4)
 124                        ((< cho 20) 11)
 125                        (t 12))))
 126            (* 28 (- jung 31))
 127            (- jong
 128               (cond ((< jong 8) 0)
 129                     ((< jong 19) 1)
 130                     ((< jong 25) 2)
 131                     (t 3))))
 132       (+ #x3130
 133          (cond ((/= cho 0) cho)
 134                ((/= jung 0) jung)
 135                ((/= jong 0) jong)))))
 136    ""))
 137
 138 (defun hangul-insert-character (&rest queues)
 139   "Insert characters generated from QUEUEs.
 140 Each QUEUE has the same form as `hangul-queue'.
 141 Setup `quail-overlay' to the last character."
 142   (if (and mark-active transient-mark-mode)
 143       (progn
 144         (delete-region (region-beginning) (region-end))
 145         (deactivate-mark)))
 146   (quail-delete-region)
 147   (let ((first (car queues)))
 148     (insert
 149      (hangul-character
 150       (+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1)))
 151       (+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3)))
 152       (+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5))))))
 153   (move-overlay quail-overlay (overlay-start quail-overlay) (point))
 154   (dolist (queue (cdr queues))
 155     (insert
 156      (hangul-character
 157       (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1)))
 158       (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3)))
 159       (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))
 160     (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))
 161
 162 (defun hangul-djamo (jamo char1 char2)
 163   "Return the dobule Jamo index calculated from the arguments.
 164 JAMO is a type of Hangul Jamo; `cho', `jung', or `jong'.
 165 CHAR1 and CAHR2 are Hangul Jamo indices.
 166 Return nil if CHAR1 and CHAR2 can not combined."
 167   (let* ((jamo (cdr (assoc jamo hangul-djamo-table)))
 168          (char1 (cdr (assoc char1 jamo))))
 169     (if char1
 170         (let ((i (length char1)))
 171           (or (catch 'found
 172                 (while (> i 0)
 173                   (if (= char2 (aref char1 (1- i)))
 174                       (throw 'found i))
 175                   (setf i (1- i))))
 176               0))
 177       0)))
 178
 179 (defsubst hangul2-input-method-jaum (char)
 180   "Store Hangul Jamo indice CHAR in `hangul-queue'.
 181 It is a Hangul 2-Bulsik Jaum.
 182 This function processes a Hangul 2-Bulsik Jaum.
 183 The Hangul 2-Bulsik is composed of a Jaum and a Moum.
 184 The Jaum can be located in a Choseong position and a Jongseong position.
 185 Unless the function inserts CHAR to `hangul-queue',
 186 commit current `hangul-queue' and then set a new `hangul-queue',
 187 and insert CHAR to new `hangul-queue'."
 188   (if (cond ((zerop (aref hangul-queue 0))
 189              (aset hangul-queue 0 char))
 190             ((and (zerop (aref hangul-queue 1))
 191                   (zerop (aref hangul-queue 2))
 192                   (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
 193              (aset hangul-queue 1 char))
 194             ((and (zerop (aref hangul-queue 4))
 195                   (notzerop (aref hangul-queue 2))
 196                   (/= char 8)
 197                   (/= char 19)
 198                   (/= char 25)
 199                   (numberp
 200                    (hangul-character
 201                     (+ (aref hangul-queue 0)
 202                        (hangul-djamo
 203                         'cho
 204                         (aref hangul-queue 0)
 205                         (aref hangul-queue 1)))
 206                     (+ (aref hangul-queue 2)
 207                        (hangul-djamo
 208                         'jung
 209                         (aref hangul-queue 2)
 210                         (aref hangul-queue 3)))
 211                     char)))
 212              (aset hangul-queue 4 char))
 213             ((and (zerop (aref hangul-queue 5))
 214                   (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
 215                   (numberp
 216                    (hangul-character
 217                     (+ (aref hangul-queue 0)
 218                        (hangul-djamo
 219                         'cho
 220                         (aref hangul-queue 0)
 221                         (aref hangul-queue 1)))
 222                     (+ (aref hangul-queue 2)
 223                        (hangul-djamo
 224                         'jung
 225                         (aref hangul-queue 2)
 226                         (aref hangul-queue 3)))
 227                     (+ (aref hangul-queue 4)
 228                        (hangul-djamo
 229                         'jong
 230                         (aref hangul-queue 4)
 231                         char)))))
 232              (aset hangul-queue 5 char)))
 233       (hangul-insert-character hangul-queue)
 234     (hangul-insert-character hangul-queue
 235                              (setq hangul-queue (vector char 0 0 0 0 0)))))
 236
 237 (defsubst hangul2-input-method-moum (char)
 238   "Store Hangul Jamo indice CHAR in `hangul-queue'.
 239 It is a Hangul 2-Bulsik Moum.
 240 This function process a Hangul 2-Bulsik Moum.
 241 The Moum can be located in a Jungseong position.
 242 Other parts are the same as a `hangul2-input-method-jaum'."
 243   (if (cond ((zerop (aref hangul-queue 2))
 244              (aset hangul-queue 2 char))
 245             ((and (zerop (aref hangul-queue 3))
 246                   (zerop (aref hangul-queue 4))
 247                   (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
 248              (aset hangul-queue 3 char)))
 249       (hangul-insert-character hangul-queue)
 250     (let ((next-char (vector 0 0 char 0 0 0)))
 251       (cond ((notzerop (aref hangul-queue 5))
 252              (aset next-char 0 (aref hangul-queue 5))
 253              (aset hangul-queue 5 0))
 254             ((notzerop (aref hangul-queue 4))
 255              (aset next-char 0 (aref hangul-queue 4))
 256              (aset hangul-queue 4 0)))
 257       (hangul-insert-character hangul-queue
 258                                (setq hangul-queue next-char)))))
 259
 260 (defsubst hangul3-input-method-cho (char)
 261   "Store Hangul Jamo indice CHAR in `hangul-queue'.
 262 It is a Hangul 3-Bulsik Choseong.
 263 This function process a Hangul 3-Bulsik Choseong.
 264 The Hangul 3-Bulsik is composed of a Choseong, a Jungseong and a Jongseong.
 265 The Choseong can be located in a Choseong position.
 266 Other parts are the same as a `hangul2-input-method-jaum'."
 267   (if (cond ((and (zerop (aref hangul-queue 0))
 268                   (zerop (aref hangul-queue 4)))
 269              (aset hangul-queue 0 char))
 270             ((and (zerop (aref hangul-queue 1))
 271                   (zerop (aref hangul-queue 2))
 272                   (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
 273              (aset hangul-queue 1 char)))
 274       (hangul-insert-character hangul-queue)
 275     (hangul-insert-character hangul-queue
 276                              (setq hangul-queue (vector char 0 0 0 0 0)))))
 277
 278 (defsubst hangul3-input-method-jung (char)
 279   "Store Hangul Jamo indice CHAR in `hangul-queue'.
 280 It is a Hangul 3-Bulsik Jungseong.
 281 This function process a Hangul 3-Bulsik Jungseong.
 282 The Jungseong can be located in a Jungseong position.
 283 Other parts are the same as a `hangul3-input-method-cho'."
 284   (if (cond ((and (zerop (aref hangul-queue 2))
 285                   (zerop (aref hangul-queue 4)))
 286              (aset hangul-queue 2 char))
 287             ((and (zerop (aref hangul-queue 3))
 288                   (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
 289              (aset hangul-queue 3 char)))
 290       (hangul-insert-character hangul-queue)
 291     (hangul-insert-character hangul-queue
 292                              (setq hangul-queue (vector 0 0 char 0 0 0)))))
 293
 294 (defsubst hangul3-input-method-jong (char)
 295   "Store Hangul Jamo indice CHAR in `hangul-queue'.
 296 It is a Hangul 3-Bulsik Jongseong.
 297 This function process a Hangul 3-Bulsik Jongseong.
 298 The Jongseong can be located in a Jongseong position.
 299 Other parts are the same as a `hangul3-input-method-cho'."
 300   (if (cond ((and (zerop (aref hangul-queue 4))
 301                   (notzerop (aref hangul-queue 0))
 302                   (notzerop (aref hangul-queue 2))
 303                   (numberp
 304                    (hangul-character
 305                     (+ (aref hangul-queue 0)
 306                        (hangul-djamo
 307                         'cho
 308                         (aref hangul-queue 0)
 309                         (aref hangul-queue 1)))
 310                     (+ (aref hangul-queue 2)
 311                        (hangul-djamo
 312                         'jung
 313                         (aref hangul-queue 2)
 314                         (aref hangul-queue 3)))
 315                     char)))
 316              (aset hangul-queue 4 char))
 317             ((and (zerop (aref hangul-queue 5))
 318                   (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
 319                   (numberp
 320                    (hangul-character
 321                     (+ (aref hangul-queue 0)
 322                        (hangul-djamo
 323                         'cho
 324                         (aref hangul-queue 0)
 325                         (aref hangul-queue 1)))
 326                     (+ (aref hangul-queue 2)
 327                        (hangul-djamo
 328                         'jung
 329                         (aref hangul-queue 2)
 330                         (aref hangul-queue 3)))
 331                     (+ (aref hangul-queue 4)
 332                        (hangul-djamo
 333                         'jong
 334                         (aref hangul-queue 4)
 335                         char)))))
 336              (aset hangul-queue 6 char)))
 337       (hangul-insert-character hangul-queue)
 338     (if (zerop (apply '+ (append hangul-queue nil)))
 339         (hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
 340       (hangul-insert-character hangul-queue
 341                                (setq hangul-queue (vector 0 0 0 0 char 0))))))
 342
 343 (defun hangul-delete-backward-char ()
 344   "Delete the previous hangul character by Jaso units."
 345   (interactive)
 346   (let ((i 5))
 347     (while (and (> i 0) (zerop (aref hangul-queue i)))
 348       (setq i (1- i)))
 349     (aset hangul-queue i 0))
 350   (if (notzerop (apply '+ (append hangul-queue nil)))
 351       (hangul-insert-character hangul-queue)
 352     (delete-backward-char 1)))
 353
 354 (defun hangul-to-hanja-conversion ()
 355   "Convert the previous hangul character to the corresponding hanja character."
 356   (interactive)
 357   (let ((echo-keystrokes 0)
 358         delete-func
 359         hanja-character)
 360     (setq hanja-character (hangul-to-hanja-char (preceding-char)))
 361     (when hanja-character
 362       (delete-backward-char 1)
 363       (insert hanja-character)
 364       (setq hangul-queue (make-vector 6 0))
 365       (move-overlay quail-overlay (point) (point)))))
 366
 367 ;; Support function for `hangul2-input-method'.  Actually, this
 368 ;; function handles the Hangul 2-Bulsik.  KEY is an entered key code
 369 ;; used for looking up `hangul2-keymap'."
 370 (defun hangul2-input-method-internal (key)
 371   (let ((char (+ (aref hangul2-keymap (1- (% key 32)))
 372                  (cond ((or (= key ?O) (= key ?P)) 2)
 373                        ((or (= key ?E) (= key ?Q) (= key ?R)
 374                             (= key ?T) (= key ?W)) 1)
 375                        (t 0)))))
 376     (if (< char 31)
 377         (hangul2-input-method-jaum char)
 378       (hangul2-input-method-moum char))))
 379
 380 (defun hangul2-input-method (key)
 381   "2-Bulsik input method."
 382   (if (or buffer-read-only (not (alphabetp key)))
 383       (list key)
 384     (quail-setup-overlays nil)
 385     (let ((input-method-function nil)
 386           (echo-keystrokes 0)
 387           (help-char nil))
 388       (setq hangul-queue (make-vector 6 0))
 389       (hangul2-input-method-internal key)
 390       (unwind-protect
 391           (catch 'exit-input-loop
 392             (while t
 393               (let* ((seq (read-key-sequence nil))
 394                      (cmd (lookup-key hangul-im-keymap seq))
 395                      key)
 396                 (cond ((and (stringp seq)
 397                             (= 1 (length seq))
 398                             (setq key (aref seq 0))
 399                             (alphabetp key))
 400                        (hangul2-input-method-internal key))
 401                       ((commandp cmd)
 402                        (call-interactively cmd))
 403                       (t
 404                        (setq unread-command-events (listify-key-sequence seq))
 405                        (throw 'exit-input-loop nil))))))
 406         (quail-delete-overlays)))))
 407
 408 ;; Support function for `hangul3-input-method'.  Actually, this
 409 ;; function handles the Hangul 3-Bulsik final.  KEY is an entered key
 410 ;; code used for looking up `hangul3-keymap'."
 411 (defun hangul3-input-method-internal (key)
 412   (let ((char (aref hangul3-keymap (- key 33))))
 413     (cond ((and (> char 92) (< char 123))
 414            (hangul3-input-method-cho (- char 92)))
 415           ((and (> char 65) (< char 87))
 416            (hangul3-input-method-jung (- char 35)))
 417           ((< char 31)
 418            (hangul3-input-method-jong char))
 419           (t
 420            (setq hangul-queue (make-vector 6 0))
 421            (insert (decode-char 'ucs char))
 422            (move-overlay quail-overlay (point) (point))))))
 423
 424 (defun hangul3-input-method (key)
 425   "3-Bulsik final input method."
 426   (if (or buffer-read-only (< key 33) (>= key 127))
 427       (list key)
 428     (quail-setup-overlays nil)
 429     (let ((input-method-function nil)
 430           (echo-keystrokes 0)
 431           (help-char nil))
 432       (setq hangul-queue (make-vector 6 0))
 433       (hangul3-input-method-internal key)
 434       (unwind-protect
 435           (catch 'exit-input-loop
 436             (while t
 437               (let* ((seq (read-key-sequence nil))
 438                      (cmd (lookup-key hangul-im-keymap seq))
 439                      key)
 440                 (cond ((and (stringp seq)
 441                             (= 1 (length seq))
 442                             (setq key (aref seq 0))
 443                             (and (>= key 33) (< key 127)))
 444                        (hangul3-input-method-internal key))
 445                       ((commandp cmd)
 446                        (call-interactively cmd))
 447                       (t
 448                        (setq unread-command-events (listify-key-sequence seq))
 449                        (throw 'exit-input-loop nil))))))
 450         (quail-delete-overlays)))))
 451
 452 ;; Support function for `hangul390-input-method'.  Actually, this
 453 ;; function handles the Hangul 3-Bulsik 390.  KEY is an entered key
 454 ;; code used for looking up `hangul390-keymap'."
 455 (defun hangul390-input-method-internal (key)
 456   (let ((char (aref hangul390-keymap (- key 33))))
 457     (cond ((or (and (> char 86) (< char 91))
 458                (and (> char 96) (< char 123)))
 459            (hangul3-input-method-cho (- char (if (< char 97) 86 92))))
 460           ((and (> char 64) (< char 86))
 461            (hangul3-input-method-jung (- char 34)))
 462           ((< char 31)
 463            (hangul3-input-method-jong char))
 464           (t
 465            (setq hangul-queue (make-vector 6 0))
 466            (insert (decode-char 'ucs char))
 467            (move-overlay quail-overlay (point) (point))))))
 468
 469 (defun hangul390-input-method (key)
 470   "3-Bulsik 390 input method."
 471   (if (or buffer-read-only (< key 33) (>= key 127))
 472       (list key)
 473     (quail-setup-overlays nil)
 474     (let ((input-method-function nil)
 475           (echo-keystrokes 0)
 476           (help-char nil))
 477       (setq hangul-queue (make-vector 6 0))
 478       (hangul390-input-method-internal key)
 479       (unwind-protect
 480           (catch 'exit-input-loop
 481             (while t
 482               (let* ((seq (read-key-sequence nil))
 483                      (cmd (lookup-key hangul-im-keymap seq))
 484                      key)
 485                 (cond ((and (stringp seq)
 486                             (= 1 (length seq))
 487                             (setq key (aref seq 0))
 488                             (and (>= key 33) (< key 127)))
 489                        (hangul390-input-method-internal key))
 490                       ((commandp cmd)
 491                        (call-interactively cmd))
 492                       (t
 493                        (setq unread-command-events (listify-key-sequence seq))
 494                        (throw 'exit-input-loop nil))))))
 495         (quail-delete-overlays)))))
 496
 497 ;; Text shown by describe-input-method.  Set to a proper text by
 498 ;; hangul-input-method-activate.
 499 (defvar hangul-input-method-help-text nil)
 500 (make-variable-buffer-local 'hangul-input-method-help-text)
 501
 502 (defun hangul-input-method-activate (input-method func help-text &rest args)
 503   "Activate Hangul input method INPUT-METHOD.
 504 FUNC is a function to handle input key.
 505 HELP-TEXT is a text set in `hangul-input-method-help-text'."
 506   (setq inactivate-current-input-method-function 'hangul-input-method-inactivate
 507         describe-current-input-method-function 'hangul-input-method-help
 508         hangul-input-method-help-text help-text)
 509   (quail-delete-overlays)
 510   (if (eq (selected-window) (minibuffer-window))
 511       (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
 512   (set (make-local-variable 'input-method-function) func))
 513
 514 (defun hangul-input-method-inactivate ()
 515   "Inactivate the current Hangul input method."
 516   (interactive)
 517   (unwind-protect
 518       (progn
 519         (quail-hide-guidance)
 520         (quail-delete-overlays)
 521         (setq describe-current-input-method-function nil))
 522     (kill-local-variable 'input-method-function)))
 523
 524 (defun hangul-input-method-help ()
 525   "Describe the current Hangul input method."
 526   (interactive)
 527   (with-output-to-temp-buffer "*Help*"
 528     (princ hangul-input-method-help-text)))
 529
 530 (provide 'hangul)
 531
 532 ;; arch-tag: 26bc93fc-64ee-4fb1-b26d-22220d132dbe
 533 ;;; hangul.el ends here