1;;; 2;;; Copyright (c) 2003-2013 uim Project https://github.com/uim/uim 3;;; 4;;; All rights reserved. 5;;; 6;;; Redistribution and use in source and binary forms, with or without 7;;; modification, are permitted provided that the following conditions 8;;; are met: 9;;; 1. Redistributions of source code must retain the above copyright 10;;; notice, this list of conditions and the following disclaimer. 11;;; 2. Redistributions in binary form must reproduce the above copyright 12;;; notice, this list of conditions and the following disclaimer in the 13;;; documentation and/or other materials provided with the distribution. 14;;; 3. Neither the name of authors nor the names of its contributors 15;;; may be used to endorse or promote products derived from this software 16;;; without specific prior written permission. 17;;; 18;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND 19;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE 22;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28;;; SUCH DAMAGE. 29;;;; 30 31(require "generic.scm") 32 33;; Hangul IMs requires some generic-keys disabled. See the post "A 34;; question about the space bar" in uim@pdx.freedesktop.org 35;; mailinglist from David Oftedal at Fri, 02 Apr 2004 22:55:25 +0200 36(define hangul-proc-on-mode-with-preedit 37 (let* ((non-existent-key? (make-single-key-predicate "")) 38 (generic-next-candidate-key? non-existent-key?) 39 (generic-prev-candidate-key? non-existent-key?) 40 (generic-commit-key? non-existent-key?) 41 (generic-proc-input-state-with-preedit-with-this-env 42 (%%enclose-another-env generic-proc-input-state-with-preedit 43 (%%current-environment)))) 44 (lambda (gc key state rkc) ;; "gc" stands for "generic-context" 45 (generic-proc-input-state-with-preedit-with-this-env gc key state rkc)))) 46 47(define hangul-proc-on-mode 48 (let* ((non-existent-key? (make-single-key-predicate "")) 49 (generic-next-candidate-key? non-existent-key?) 50 (generic-prev-candidate-key? non-existent-key?) 51 (generic-commit-key? non-existent-key?) 52 (generic-proc-input-state-with-preedit 53 hangul-proc-on-mode-with-preedit) 54 (generic-proc-input-state-with-this-env 55 (%%enclose-another-env generic-proc-input-state (%%current-environment)))) 56 (lambda (gc key state) ;; "gc" stands for "generic-context" 57 (generic-proc-input-state-with-this-env gc key state)))) 58 59;; 'let*' is required rather than 'let' 60(define hangul-key-press-handler 61 (let* ((generic-proc-input-state hangul-proc-on-mode) 62 (generic-key-press-handler-with-this-env 63 (%%enclose-another-env generic-key-press-handler (%%current-environment)))) 64 (lambda (gc key state) 65 (generic-key-press-handler-with-this-env gc key state)))) 66 67(define hangul-register-im 68 (lambda (name lang code name-label short-desc init-arg) 69 (register-im 70 name 71 lang 72 code 73 name-label 74 short-desc 75 init-arg 76 generic-init-handler 77 #f ;; release-handler 78 context-mode-handler 79 hangul-key-press-handler 80 generic-key-release-handler 81 generic-reset-handler 82 generic-get-candidate-handler 83 generic-set-candidate-index-handler 84 context-prop-activate-handler 85 #f 86 generic-focus-in-handler 87 generic-focus-out-handler 88 generic-place-handler 89 generic-displace-handler 90 ))) 91 92(define hangul2-init-handler 93 (lambda (id im arg) 94 (require "hangul2.scm") 95 (generic-context-new id im hangul2-rule #t))) 96 97(define hangul3-init-handler 98 (lambda (id im arg) 99 (require "hangul3.scm") 100 (generic-context-new id im hangul3-rule #t))) 101 102(define romaja-init-handler 103 (lambda (id im arg) 104 (require "romaja.scm") 105 (generic-context-new id im romaja-rule #t))) 106 107(hangul-register-im 108 'hangul2 109 "ko" 110 "UTF-8" 111 (N_ "Hangul (2-beol)") 112 (N_ "2-beol style hangul input method") 113 hangul2-init-handler) 114 115;; hangul3 IM does not require generic-keys disabled 116(generic-register-im 117 'hangul3 118 "ko" 119 "UTF-8" 120 (N_ "Hangul (3-beol)") 121 (N_ "3-beol style hangul input method") 122 hangul3-init-handler) 123 124(hangul-register-im 125 'romaja 126 "ko" 127 "UTF-8" 128 (N_ "Hangul (Romaja)") 129 (N_ "Romaja input style hangul input method") 130 romaja-init-handler) 131