unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* hangul.el - new korean-hangul module
@ 2008-03-02 14:05 Jihyun Cho
  2008-03-06  9:17 ` Jihyun Cho
                   ` (2 more replies)
  0 siblings, 3 replies; 18+ messages in thread
From: Jihyun Cho @ 2008-03-02 14:05 UTC (permalink / raw)
  To: emacs-devel


[-- Attachment #1.1: Type: text/plain, Size: 389 bytes --]

Hi. I was implement new hangul input method.
The existing method used transition rules, which must define the transition
rules of 11,172.
But outside of the euc-kr area is not defined. So you can not input any
hangul characters in the unicode environment.

To implement the new method is hangul automata. so clearly.
Depending on the terminal coding of all the hangul characters to enter.

[-- Attachment #1.2: Type: text/html, Size: 407 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: hangul.el --]
[-- Type: text/x-emacs-lisp; name=hangul.el, Size: 14925 bytes --]

;;; hangul.el --- Korean Hangul input method

;; Author: Jihyun Cho <likesylph@gmail.com>
;; Keywords: multilingual, input method, Korean, Hangul

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This file is to implement the following hangul automata:
;; - Hangul 2-Bulsik input method
;; - Hangul 3-Bulsik input method

;;; Code:

(require 'quail)

(defconst hangul-djamo-table
  '((cho . ((1 . (1))
            (7 . (7))
            (18 . (18))
            (21 . (21))
            (24 . (24))))
    (jung . ((39 . (31 32 51))
             (44 . (35 36 51))
             (49 . (51))))
    (jong . ((1 . (1 21))
             (4 . (24 30))
             (9 . (1 17 18 21 28 29 30))
             (18 . (18 21))
             (21 . (21))))))

(defconst hangul2-keymap
  '(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))

(defconst hangul3-keymap
  '(2 183 24 15 14 8220 120 39 126 8221 43 44 41 46 74 119 30 22 18 78 83 68 73 85 79 52 110 44 62 46 33 10
    7 63 27 12 5 11 69 48 55 49 50 51 34 45 56 57 29 16 6 13 54 3 28 20 53 26 40 58 60 61 59 42 23 79
    71 86 72 66 84 96 109 115 93 116 122 113 118 121 21 67 4 70 99 74 9 1 101 17 37 92 47 8251))

(defsubst notzerop (number)
  (not (zerop number)))

(defsubst alphap (char)
  (or (and (>= char ?A) (<= char ?Z))
      (and (>= char ?a) (<= char ?z))))

(defun hangul-character (cho jung jong)
  (if (zerop (+ cho jung jong))
      (throw 'exit-input-loop nil)
      (or
       (decode-char
        'ucs
        (if (and (/= cho 0) (/= jung 0))
            (+ #xac00
               (* 588
                  (- cho
                     (cond ((< cho 3) 1)
                           ((< cho 5) 2)
                           ((< cho 10) 4)
                           ((< cho 20) 11)
                           (t 12))))
               (* 28 (- jung 31))
               (- jong
               (cond ((< jong 8) 0)
                     ((< jong 19) 1)
                     ((< jong 25) 2)
                     (t 3))))
            (+ #x3130
               (cond ((/= cho 0) cho)
               ((/= jung 0) jung)
               ((/= jong 0) jong)))))
       "")))

(defun hangul-insert-character (&rest queue)
  (quail-delete-region)
  (let ((first (car queue)))
    (insert
     (hangul-character
      (+ (nth 0 first) (hangul-djamo 'cho (nth 0 first) (nth 1 first)))
      (+ (nth 2 first) (hangul-djamo 'jung (nth 2 first) (nth 3 first)))
      (+ (nth 4 first) (hangul-djamo 'jong (nth 4 first) (nth 5 first))))))
  (move-overlay quail-overlay (overlay-start quail-overlay) (point))
  (dolist (elt (cdr queue))
    (insert
     (hangul-character
      (+ (nth 0 elt) (hangul-djamo 'cho (nth 0 elt) (nth 1 elt)))
      (+ (nth 2 elt) (hangul-djamo 'jung (nth 2 elt) (nth 3 elt)))
      (+ (nth 4 elt) (hangul-djamo 'jong (nth 4 elt) (nth 5 elt)))))
    (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))

(defun hangul-djamo (jamo char1 char2)
  (let* ((jamo (cdr (assoc jamo hangul-djamo-table)))
         (char1 (cdr (assoc char1 jamo))))
    (if char1
        (let ((i (length char1)))
          (or (catch 'found
                (while (> i 0)
                  (if (= char2 (nth (1- i) char1))
                      (throw 'found i))
                  (setf i (1- i))))
              0))
        0)))

(defsubst hangul2-input-method-jaum (char)
  "2-Bulsik Jaum"
  (if (cond ((zerop (nth 0 hangul-queue))
             (setf (nth 0 hangul-queue) char))
            ((and (zerop (nth 1 hangul-queue))
                  (zerop (nth 2 hangul-queue))
                  (notzerop (hangul-djamo 'cho (nth 0 hangul-queue) char)))
             (setf (nth 1 hangul-queue) char))
            ((and (zerop (nth 4 hangul-queue))
                  (notzerop (nth 2 hangul-queue))
                  (/= char 8)
                  (/= char 19)
                  (/= char 25)
                  (numberp
                   (hangul-character
                    (+ (nth 0 hangul-queue) (hangul-djamo 'cho (nth 0 hangul-queue) (nth 1 hangul-queue)))
                    (+ (nth 2 hangul-queue) (hangul-djamo 'jung (nth 2 hangul-queue) (nth 3 hangul-queue)))
                    char)))
             (setf (nth 4 hangul-queue) char))
            ((and (zerop (nth 5 hangul-queue))
                  (notzerop (hangul-djamo 'jong (nth 4 hangul-queue) char))
                  (numberp
                   (hangul-character
                    (+ (nth 0 hangul-queue) (hangul-djamo 'cho (nth 0 hangul-queue) (nth 1 hangul-queue)))
                    (+ (nth 2 hangul-queue) (hangul-djamo 'jung (nth 2 hangul-queue) (nth 3 hangul-queue)))
                    (+ (nth 4 hangul-queue) (hangul-djamo 'jong (nth 4 hangul-queue) char)))))
             (setf (nth 5 hangul-queue) char)))
      (hangul-insert-character hangul-queue)
      (hangul-insert-character hangul-queue (setq hangul-queue (list char 0 0 0 0 0)))))

(defsubst hangul2-input-method-moum (char)
  "2-Bulsik Moum"
  (if (cond ((zerop (nth 2 hangul-queue))
             (setf (nth 2 hangul-queue) char))
            ((and (zerop (nth 3 hangul-queue))
                  (zerop (nth 4 hangul-queue))
                  (notzerop (hangul-djamo 'jung (nth 2 hangul-queue) char)))
             (setf (nth 3 hangul-queue) char)))
      (hangul-insert-character hangul-queue)
      (let ((next-char (list 0 0 char 0 0 0)))
        (cond ((notzerop (nth 5 hangul-queue))
               (setf (nth 0 next-char) (nth 5 hangul-queue))
               (setf (nth 5 hangul-queue) 0))
              ((notzerop (nth 4 hangul-queue))
               (setf (nth 0 next-char) (nth 4 hangul-queue))
               (setf (nth 4 hangul-queue) 0)))
        (hangul-insert-character hangul-queue (setq hangul-queue next-char)))))

(defsubst hangul3-input-method-cho (char)
  (if (cond ((and (zerop (nth 0 hangul-queue))
                  (zerop (nth 4 hangul-queue)))
             (setf (nth 0 hangul-queue) char))
            ((and (zerop (nth 1 hangul-queue))
                  (notzerop (hangul-djamo 'cho (nth 0 hangul-queue) char)))
             (setf (nth 1 hangul-queue) char)))
      (hangul-insert-character hangul-queue)
      (hangul-insert-character hangul-queue (setq hangul-queue (list char 0 0 0 0 0)))))

(defsubst hangul3-input-method-jung (char)
  (if (cond ((and (zerop (nth 2 hangul-queue))
                  (zerop (nth 4 hangul-queue)))
             (setf (nth 2 hangul-queue) char))
            ((and (zerop (nth 3 hangul-queue))
                  (notzerop (hangul-djamo 'jung (nth 2 hangul-queue) char)))
             (setf (nth 3 hangul-queue) char)))
      (hangul-insert-character hangul-queue)
      (hangul-insert-character hangul-queue (setq hangul-queue (list 0 0 char 0 0 0)))))

(defsubst hangul3-input-method-jong (char)
  (if (cond ((and (zerop (nth 4 hangul-queue))
                  (notzerop (nth 0 hangul-queue))
                  (notzerop (nth 2 hangul-queue))
                  (numberp
                   (hangul-character
                    (+ (nth 0 hangul-queue) (hangul-djamo 'cho (nth 0 hangul-queue) (nth 1 hangul-queue)))
                    (+ (nth 2 hangul-queue) (hangul-djamo 'jung (nth 2 hangul-queue) (nth 3 hangul-queue)))
                    char)))
             (setf (nth 4 hangul-queue) char))
            ((and (zerop (nth 5 hangul-queue))
                  (notzerop (hangul-djamo 'jong (nth 4 hangul-queue) char))
                  (numberp
                   (hangul-character
                    (+ (nth 0 hangul-queue) (hangul-djamo 'cho (nth 0 hangul-queue) (nth 1 hangul-queue)))
                    (+ (nth 2 hangul-queue) (hangul-djamo 'jung (nth 2 hangul-queue) (nth 3 hangul-queue)))
                    (+ (nth 4 hangul-queue) (hangul-djamo 'jong (nth 4 hangul-queue) char)))))
             (setf (nth 5 hangul-queue) char)))
      (hangul-insert-character hangul-queue)
      (if (zerop (apply '+ hangul-queue))
          (hangul-insert-character (setq hangul-queue (list 0 0 0 0 char 0)))
          (hangul-insert-character hangul-queue (setq hangul-queue (list 0 0 0 0 char 0))))))

(defun hangul2-input-method-internal (key)
  (let ((char (+ (nth (1- (% key 32)) hangul2-keymap)
                 (cond ((or (= key ?O) (= key ?P)) 2)
                       ((or (= key ?E) (= key ?Q) (= key ?R) (= key ?T) (= key ?W)) 1)
                       (t 0)))))
    (if (< char 31)
        (hangul2-input-method-jaum char)
        (hangul2-input-method-moum char))))

(defun hangul2-input-method (key)
  "2-Bulsik input method"
  (if (or buffer-read-only (not (alphap key)))
      (list key)
      (quail-setup-overlays nil)
      (let ((input-method-function nil)
            (echo-keystrokes 0)
            (help-char nil)
            (hangul-queue (make-list 6 0)))
        (hangul2-input-method-internal key)
        (unwind-protect
             (catch 'exit-input-loop
               (while t
                 (let ((seq (read-key-sequence nil))
                       key)
                   (cond ((and (stringp seq)
                               (= 1 (length seq))
                               (setq key (aref seq 0))
                               (alphap key))
                          (hangul2-input-method-internal key))
                         ((and (stringp seq)
                               (= (aref seq 0) ?\d))
                          (let ((i 5))
                            (while (and (> i 0) (zerop (nth i hangul-queue)))
                              (setq i (1- i)))
                            (setf (nth i hangul-queue) 0))
                          (hangul-insert-character hangul-queue))
                         (t
                          (throw 'exit-input-loop (listify-key-sequence seq)))))))
          (quail-delete-overlays)))))

(defun hangul3-input-method-internal (key)
  (let ((char (nth (- key 33) hangul3-keymap)))
    (cond ((and (> char 92) (< char 123))
           (hangul3-input-method-cho (- char 92)))
          ((and (> char 65) (< char 87))
           (hangul3-input-method-jung (- char 35)))
          ((< char 31)
           (hangul3-input-method-jong char))
          (t
           (setq hangul-queue (make-list 6 0))
           (insert (decode-char 'ucs char))
           (move-overlay quail-overlay (point) (point))))))

(defun hangul3-input-method (key)
  "3-Bulsik input method"
  (if (or buffer-read-only (< key 33) (>= key 127))
      (list key)
      (quail-setup-overlays nil)
      (let ((input-method-function nil)
            (echo-keystrokes 0)
            (help-char nil)
            (hangul-queue (make-list 6 0)))
        (hangul3-input-method-internal key)
        (unwind-protect
             (catch 'exit-input-loop
               (while t
                 (let ((seq (read-key-sequence nil))
                       key)
                   (cond ((and (stringp seq)
                               (= 1 (length seq))
                               (setq key (aref seq 0))
                               (and (>= key 33) (< key 127)))
                          (hangul3-input-method-internal key))
                         ((and (stringp seq)
                               (= (aref seq 0) ?\d))
                          (let ((i 5))
                            (while (and (> i 0) (zerop (nth i hangul-queue)))
                              (setq i (1- i)))
                            (setf (nth i hangul-queue) 0))
                          (if (zerop (apply '+ hangul-queue))
                              (throw 'exit-input-loop (listify-key-sequence seq))
                              (hangul-insert-character hangul-queue)))
                         (t
                          (throw 'exit-input-loop (listify-key-sequence seq)))))))
          (quail-delete-overlays)))))

(defun hangul2-input-activate (&optional arg)
  "Activate Hangul 2-Bulsik input method."
  (if (and arg
           (< (prefix-numeric-value arg) 0))
      (unwind-protect
           (progn
             (quail-hide-guidance)
             (quail-delete-overlays)
             (setq describe-current-input-method-function nil))
        (kill-local-variable 'input-method-function))
      (setq inactivate-current-input-method-function 'hangul2-input-inactivate)
      (setq describe-current-input-method-function 'hangul2-input-help)
      (quail-delete-overlays)
      (if (eq (selected-window) (minibuffer-window))
          (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
      (set (make-local-variable 'input-method-function)
           'hangul2-input-method)))

(defun hangul2-input-inactivate ()
  "Inactivate Hangul 2-Bulsik input method."
  (interactive)
  (hangul2-input-activate -1))

(defun hangul2-input-help ()
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ "\
Input method: hangul2 (mode line indicator:한2)

New Hangul 2-Bulsik input method.")))

(defun hangul3-input-activate (&optional arg)
  "Activate Hangul 3-Bulsik input method."
  (if (and arg
           (< (prefix-numeric-value arg) 0))
      (unwind-protect
           (progn
             (quail-hide-guidance)
             (quail-delete-overlays)
             (setq describe-current-input-method-function nil))
        (kill-local-variable 'input-method-function))
      (setq inactivate-current-input-method-function 'hangul3-input-inactivate)
      (setq describe-current-input-method-function 'hangul3-input-help)
      (quail-delete-overlays)
      (if (eq (selected-window) (minibuffer-window))
          (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
      (set (make-local-variable 'input-method-function)
           'hangul3-input-method)))

(defun hangul3-input-inactivate ()
  "Inactivate Hangul 3-Bulsik input method."
  (interactive)
  (hangul3-input-activate -1))

(defun hangul3-input-help ()
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ "\
Input method: hangul3 (mode line indicator:한3)

New Hangul 3-Bulsik input method.")))

(register-input-method "korean-hangul" "UTF-8" 'hangul2-input-activate "한2"
                       "Hangul 2-Bulsik Input")

(register-input-method "korean-hangul3" "UTF-8" 'hangul3-input-activate "한3"
                       "Hangul 3-Bulsik Input")

(provide 'hangul)

;;; hangul.el ends here

^ permalink raw reply	[flat|nested] 18+ messages in thread

end of thread, other threads:[~2008-05-08 16:41 UTC | newest]

Thread overview: 18+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2008-03-02 14:05 hangul.el - new korean-hangul module Jihyun Cho
2008-03-06  9:17 ` Jihyun Cho
2008-03-06 12:01 ` Kenichi Handa
2008-03-06 12:18   ` David Kastrup
2008-03-12  0:49     ` Kenichi Handa
2008-03-12 14:27       ` Stefan Monnier
2008-04-03 12:44         ` Kenichi Handa
2008-04-03 15:26           ` Jihyun Cho
2008-04-19 10:29             ` Jihyun Cho
2008-04-19 23:18               ` Richard Stallman
2008-04-22  6:23                 ` Jihyun Cho
2008-04-22 20:09                   ` Richard Stallman
2008-04-22  7:36               ` Kenichi Handa
2008-04-24 16:42                 ` Jihyun Cho
2008-04-25 11:15                   ` Kenichi Handa
2008-05-08 16:41                     ` Jihyun Cho
2008-03-07  3:37   ` Jihyun Cho
2008-03-08 16:16 ` Jihyun Cho

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).