1
;; -*- mode: scheme; coding: utf-8 -*-
3
;;; byeoru.scm: a Hangul input module for uim.
5
;;; Copyright (c) 2003-2006 uim Project http://uim.freedesktop.org/
7
;;; All rights reserved.
9
;;; Redistribution and use in source and binary forms, with or without
10
;;; modification, are permitted provided that the following conditions
12
;;; 1. Redistributions of source code must retain the above copyright
13
;;; notice, this list of conditions and the following disclaimer.
14
;;; 2. Redistributions in binary form must reproduce the above copyright
15
;;; notice, this list of conditions and the following disclaimer in the
16
;;; documentation and/or other materials provided with the distribution.
17
;;; 3. Neither the name of authors nor the names of its contributors
18
;;; may be used to endorse or promote products derived from this software
19
;;; without specific prior written permission.
21
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
22
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
25
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
30
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
36
(require-custom "generic-key-custom.scm")
39
(require-custom "byeoru-custom.scm")
40
(require-custom "byeoru-key-custom.scm")
41
(require "byeoru-symbols.scm")
44
;;; --------------------------------------
45
;;; Hangul syllable composition routines
46
;;; --------------------------------------
48
;; These jamo names are different from those used in the Unicode standard,
49
;; which doesn't matter anyway.
50
(define byeoru-choseong-alist
53
(choseong-ssanggiyeog . 2)
56
(choseong-ssangdigeud . 5)
60
(choseong-ssangbieub . 9)
62
(choseong-ssangsios . 11)
65
(choseong-ssangjieuj . 14)
66
(choseong-chieuch . 15)
70
(choseong-hieuh . 19)))
72
(define byeoru-jungseong-alist
73
'((jungseong-void . 0)
96
(define byeoru-jongseong-alist
97
'((jongseong-void . 0)
98
(jongseong-giyeog . 1)
99
(jongseong-ssanggiyeog . 2)
100
(jongseong-giyeogsios . 3)
101
(jongseong-nieun . 4)
102
(jongseong-nieunjieuj . 5)
103
(jongseong-nieunhieuh . 6)
104
(jongseong-digeud . 7)
105
(jongseong-rieul . 8)
106
(jongseong-rieulgiyeog . 9)
107
(jongseong-rieulmieum . 10)
108
(jongseong-rieulbieub . 11)
109
(jongseong-rieulsios . 12)
110
(jongseong-rieultieut . 13)
111
(jongseong-rieulpieup . 14)
112
(jongseong-rieulhieuh . 15)
113
(jongseong-mieum . 16)
114
(jongseong-bieub . 17)
115
(jongseong-bieubsios . 18)
116
(jongseong-sios . 19)
117
(jongseong-ssangsios . 20)
118
(jongseong-ieung . 21)
119
(jongseong-jieuj . 22)
120
(jongseong-chieuch . 23)
121
(jongseong-kieuk . 24)
122
(jongseong-tieut . 25)
123
(jongseong-pieup . 26)
124
(jongseong-hieuh . 27)))
126
(define byeoru-compound-jamo-alist
127
'(((jungseong-o . jungseong-a ) . jungseong-wa )
128
((jungseong-o . jungseong-ae ) . jungseong-wae )
129
((jungseong-o . jungseong-i ) . jungseong-oe )
130
((jungseong-u . jungseong-eo ) . jungseong-wo )
131
((jungseong-u . jungseong-e ) . jungseong-we )
132
((jungseong-u . jungseong-i ) . jungseong-wi )
133
((jungseong-eu . jungseong-i ) . jungseong-ui )
134
((jongseong-giyeog . jongseong-sios ) . jongseong-giyeogsios )
135
((jongseong-nieun . jongseong-jieuj ) . jongseong-nieunjieuj )
136
((jongseong-nieun . jongseong-hieuh ) . jongseong-nieunhieuh )
137
((jongseong-rieul . jongseong-giyeog) . jongseong-rieulgiyeog)
138
((jongseong-rieul . jongseong-mieum ) . jongseong-rieulmieum )
139
((jongseong-rieul . jongseong-bieub ) . jongseong-rieulbieub )
140
((jongseong-rieul . jongseong-sios ) . jongseong-rieulsios )
141
((jongseong-rieul . jongseong-tieut ) . jongseong-rieultieut )
142
((jongseong-rieul . jongseong-pieup ) . jongseong-rieulpieup )
143
((jongseong-rieul . jongseong-hieuh ) . jongseong-rieulhieuh )
144
((jongseong-bieub . jongseong-sios ) . jongseong-bieubsios )))
146
(define byeoru-double-jamo-alist
147
'(((choseong-giyeog . choseong-giyeog ) . choseong-ssanggiyeog )
148
((choseong-digeud . choseong-digeud ) . choseong-ssangdigeud )
149
((choseong-bieub . choseong-bieub ) . choseong-ssangbieub )
150
((choseong-sios . choseong-sios ) . choseong-ssangsios )
151
((choseong-jieuj . choseong-jieuj ) . choseong-ssangjieuj )
152
((jongseong-giyeog . jongseong-giyeog) . jongseong-ssanggiyeog)
153
((jongseong-sios . jongseong-sios ) . jongseong-ssangsios )))
155
(define byeoru-transition-alist
156
(let ((sta '(start . 0))
157
(ch1 '(choseong . 1))
158
(ch2 '(choseong . 2))
159
(ch3 '(choseong . 3))
160
(ch4 '(choseong . 4))
161
(ju1 '(jungseong . 1))
162
(ju2 '(jungseong . 2))
163
(ju3 '(jungseong . 3))
164
(ju4 '(jungseong . 4))
165
(jo1 '(jongseong . 1))
166
(jo2 '(jongseong . 2))
167
(jo3 '(jongseong . 3))
168
(jo4 '(jongseong . 4)))
170
(list sta . (ch1 ch2 ch3 ch4 ju1 ju2 ju3 ju4 jo1 jo2 jo3 jo4))
171
(list ch1 . (ju1 ju2 ju3 ju4 jo1 jo2 jo3 jo4))
173
(list ch3 . (ch4 ju1 ju2 ju3 ju4 jo1 jo2 jo3 jo4))
174
(list ch4 . (ju1 ju2 ju3 ju4 jo1 jo2 jo3 jo4))
175
(list ju1 . (jo1 jo2 jo3 jo4))
177
(list ju3 . (ju4 jo1 jo2 jo3 jo4))
178
(list ju4 . (jo1 jo2 jo3 jo4))
184
;; Expands a key candidate list like
185
;; ((jongseong-bieub . (1 4)))
186
;; => ((jongseong-bieub . 1) (jongseong-bieub . 4)))
187
(define byeoru-expand-layout
189
(let ((layout (car args))
190
(kons (if (null? (cdr args)) cons list))
191
(kdr (if (null? (cdr args)) cdr cadr)))
193
(let ((cands (kdr elm1)))
198
(let ((class (car elm2))
201
(map (lambda (no) (cons class no)) nos)
207
(define byeoru-layout-hangul2
208
(byeoru-expand-layout
210
'(("q" (choseong-bieub . 1) (jongseong-bieub . (3 4)))
211
("w" (choseong-jieuj . 1) (jongseong-jieuj . (1 4)))
212
("e" (choseong-digeud . 1) (jongseong-digeud . 1))
213
("r" (choseong-giyeog . 1) (jongseong-giyeog . (3 4)))
214
("t" (choseong-sios . 1) (jongseong-sios . (1 4)))
215
("y" (jungseong-yo . 1))
216
("u" (jungseong-yeo . 1))
217
("i" (jungseong-ya . 1))
218
("o" (jungseong-ae . (1 4)))
219
("p" (jungseong-e . (1 4)))
220
("a" (choseong-mieum . 1) (jongseong-mieum . (1 4)))
221
("s" (choseong-nieun . 1) (jongseong-nieun . 3))
222
("d" (choseong-ieung . 1) (jongseong-ieung . 1))
223
("f" (choseong-rieul . 1) (jongseong-rieul . 3))
224
("g" (choseong-hieuh . 1) (jongseong-hieuh . (1 4)))
225
("h" (jungseong-o . 3))
226
("j" (jungseong-eo . (1 4)))
227
("k" (jungseong-a . (1 4)))
228
("l" (jungseong-i . (1 4)))
229
("z" (choseong-kieuk . 1) (jongseong-kieuk . 1))
230
("x" (choseong-tieut . 1) (jongseong-tieut . (1 4)))
231
("c" (choseong-chieuch . 1) (jongseong-chieuch . 1))
232
("v" (choseong-pieup . 1) (jongseong-pieup . (1 4)))
233
("b" (jungseong-yu . 1))
234
("n" (jungseong-u . 3))
235
("m" (jungseong-eu . 3))
237
("Q" (choseong-ssangbieub . 1))
238
("W" (choseong-ssangjieuj . 1))
239
("E" (choseong-ssangdigeud . 1))
240
("R" (choseong-ssanggiyeog . 1) (jongseong-ssanggiyeog . 5))
241
("T" (choseong-ssangsios . 1) (jongseong-ssangsios . 5))
242
("O" (jungseong-yae . 1))
243
("P" (jungseong-ye . 1)))))
245
;; The following definitions of 3-beol variants [final, 390, no-shift]
246
;; are based on the US keyboard layout. A user of a different layout
247
;; (such as dvorak, Japanese) may want to write their own definition
249
(define byeoru-layout-strict3final
250
(byeoru-expand-layout
253
("1" (jongseong-hieuh . 1))
254
("2" (jongseong-ssangsios . 5))
255
("3" (jongseong-bieub . 1))
256
("4" (jungseong-yo . 1))
257
("5" (jungseong-yu . 1))
258
("6" (jungseong-ya . 1))
259
("7" (jungseong-ye . 1))
260
("8" (jungseong-ui . 4))
261
("9" (jungseong-u . 2))
262
("0" (choseong-kieuk . 1))
265
("q" (jongseong-sios . 1))
266
("w" (jongseong-rieul . 1))
267
("e" (jungseong-yeo . 1))
268
("r" (jungseong-ae . (1 4)))
269
("t" (jungseong-eo . (1 4)))
270
("y" (choseong-rieul . 1))
271
("u" (choseong-digeud . (3 5)))
272
("i" (choseong-mieum . 1))
273
("o" (choseong-chieuch . 1))
274
("p" (choseong-pieup . 1))
278
("a" (jongseong-ieung . 1))
279
("s" (jongseong-nieun . 1))
280
("d" (jungseong-i . (1 4)))
281
("f" (jungseong-a . (1 4)))
282
("g" (jungseong-eu . 1))
283
("h" (choseong-nieun . 1))
284
("j" (choseong-ieung . 1))
285
("k" (choseong-giyeog . (3 5)))
286
("l" (choseong-jieuj . (3 5)))
287
(";" (choseong-bieub . (3 5)))
288
("'" (choseong-tieut . 1))
289
("z" (jongseong-mieum . 1))
290
("x" (jongseong-giyeog . 1))
291
("c" (jungseong-e . (1 4)))
292
("v" (jungseong-o . 1))
293
("b" (jungseong-u . 1))
294
("n" (choseong-sios . (3 5)))
295
("m" (choseong-hieuh . 1))
296
("/" (jungseong-o . 2))
298
("~" . 8251) ; U+203B, REFERENCE MARK
299
("!" (jongseong-ssanggiyeog . 5))
300
("@" (jongseong-rieulgiyeog . 4))
301
("#" (jongseong-jieuj . 1))
302
("$" (jongseong-rieulpieup . 4))
303
("%" (jongseong-rieultieut . 4))
305
("&" . 8220) ; U+201C, LEFT DOUBLE QUOTATION MARK
306
("*" . 8221) ; U+201D, RIGHT DOUBLE QUOTATION MARK
310
("Q" (jongseong-pieup . 1))
311
("W" (jongseong-tieut . 1))
312
("E" (jongseong-nieunjieuj . 4))
313
("R" (jongseong-rieulhieuh . 4))
314
("T" (jongseong-rieulsios . 4))
323
;; ("|" . 8361) ; U+20A9, WON SIGN
324
("A" (jongseong-digeud . 1))
325
("S" (jongseong-nieunhieuh . 4))
326
("D" (jongseong-rieulbieub . 4))
327
("F" (jongseong-rieulmieum . 4))
328
("G" (jungseong-yae . 1))
334
("\"" . 183) ; U+00B7, MIDDLE DOT
335
("Z" (jongseong-chieuch . 1))
336
("X" (jongseong-bieubsios . 4))
337
("C" (jongseong-kieuk . 1))
338
("V" (jongseong-giyeogsios . 4))
346
(define byeoru-layout-generous3final
347
(byeoru-expand-layout
350
("1" (jongseong-hieuh . (1 4)))
351
("2" (jongseong-ssangsios . 5))
352
("3" (jongseong-bieub . (3 4)))
353
("4" (jungseong-yo . 1))
354
("5" (jungseong-yu . 1))
355
("6" (jungseong-ya . 1))
356
("7" (jungseong-ye . 1))
357
("8" (jungseong-ui . 4))
358
("9" (jungseong-u . 3))
359
("0" (choseong-kieuk . 1))
362
("q" (jongseong-sios . (3 4 5)))
363
("w" (jongseong-rieul . 3))
364
("e" (jungseong-yeo . 1))
365
("r" (jungseong-ae . (1 4)))
366
("t" (jungseong-eo . (1 4)))
367
("y" (choseong-rieul . 1))
368
("u" (choseong-digeud . (3 5)))
369
("i" (choseong-mieum . 1))
370
("o" (choseong-chieuch . 1))
371
("p" (choseong-pieup . 1))
375
("a" (jongseong-ieung . 1))
376
("s" (jongseong-nieun . 3))
377
("d" (jungseong-i . (1 4)))
378
("f" (jungseong-a . (1 4)))
379
("g" (jungseong-eu . 3))
380
("h" (choseong-nieun . 1))
381
("j" (choseong-ieung . 1))
382
("k" (choseong-giyeog . (3 5)))
383
("l" (choseong-jieuj . (3 5)))
384
(";" (choseong-bieub . (3 5)))
385
("'" (choseong-tieut . 1))
386
("z" (jongseong-mieum . (1 4)))
387
("x" (jongseong-giyeog . (3 4 5)))
388
("c" (jungseong-e . (1 4)))
389
("v" (jungseong-o . 3))
390
("b" (jungseong-u . 3))
391
("n" (choseong-sios . (3 5)))
392
("m" (choseong-hieuh . 1))
393
("/" (jungseong-o . 3))
395
("~" . 8251) ; U+203B, REFERENCE MARK
396
("!" (jongseong-ssanggiyeog . 5))
397
("@" (jongseong-rieulgiyeog . 4))
398
("#" (jongseong-jieuj . (1 4)))
399
("$" (jongseong-rieulpieup . 4))
400
("%" (jongseong-rieultieut . 4))
402
("&" . 8220) ; U+201C, LEFT DOUBLE QUOTATION MARK
403
("*" . 8221) ; U+201D, RIGHT DOUBLE QUOTATION MARK
407
("Q" (jongseong-pieup . (1 4)))
408
("W" (jongseong-tieut . (1 4)))
409
("E" (jongseong-nieunjieuj . 4))
410
("R" (jongseong-rieulhieuh . 4))
411
("T" (jongseong-rieulsios . 4))
420
;; ("|" . 8361) ; U+20A9, WON SIGN
421
("A" (jongseong-digeud . 1))
422
("S" (jongseong-nieunhieuh . 4))
423
("D" (jongseong-rieulbieub . 4))
424
("F" (jongseong-rieulmieum . 4))
425
("G" (jungseong-yae . 1))
431
("\"". 183) ; U+00B7, MIDDLE DOT
432
("Z" (jongseong-chieuch . 1))
433
("X" (jongseong-bieubsios . 4))
434
("C" (jongseong-kieuk . 1))
435
("V" (jongseong-giyeogsios . 4))
443
(define byeoru-layout-strict390
444
(byeoru-expand-layout
446
'(("1" (jongseong-hieuh . 1))
447
("2" (jongseong-ssangsios . 5))
448
("3" (jongseong-bieub . (1 4)))
449
("4" (jungseong-yo . 1))
450
("5" (jungseong-yu . 1))
451
("6" (jungseong-ya . 1))
452
("7" (jungseong-ye . 1))
453
("8" (jungseong-ui . 4))
454
("9" (jungseong-u . 2))
455
("0" (choseong-kieuk . 1))
456
("q" (jongseong-sios . (1 4)))
457
("w" (jongseong-rieul . 3))
458
("e" (jungseong-yeo . 1))
459
("r" (jungseong-ae . (1 4)))
460
("t" (jungseong-eo . (1 4)))
461
("y" (choseong-rieul . 1))
462
("u" (choseong-digeud . (3 5)))
463
("i" (choseong-mieum . 1))
464
("o" (choseong-chieuch . 1))
465
("p" (choseong-pieup . 1))
466
("a" (jongseong-ieung . 1))
467
("s" (jongseong-nieun . 3))
468
("d" (jungseong-i . (1 4)))
469
("f" (jungseong-a . (1 4)))
470
("g" (jungseong-eu . 1))
471
("h" (choseong-nieun . 1))
472
("j" (choseong-ieung . 1))
473
("k" (choseong-giyeog . (3 5)))
474
("l" (choseong-jieuj . (3 5)))
475
(";" (choseong-bieub . (3 5)))
476
("'" (choseong-tieut . 1))
477
("z" (jongseong-mieum . 1))
478
("x" (jongseong-giyeog . 3))
479
("c" (jungseong-e . (1 4)))
480
("v" (jungseong-o . 1))
481
("b" (jungseong-u . 1))
482
("n" (choseong-sios . (3 5)))
483
("m" (choseong-hieuh . 1))
484
("/" (jungseong-o . 2))
486
("!" (jongseong-jieuj . (1 4)))
487
("Q" (jongseong-pieup . (1 4)))
488
("W" (jongseong-tieut . (1 4)))
489
("E" (jongseong-kieuk . 1))
490
("R" (jungseong-yae . 1))
497
("A" (jongseong-digeud . 1))
498
("S" (jongseong-nieunhieuh . 4))
499
("D" (jongseong-rieulgiyeog . 4))
500
("F" (jongseong-ssanggiyeog . 5))
506
("Z" (jongseong-chieuch . 1))
507
("X" (jongseong-bieubsios . 4))
508
("C" (jongseong-rieulmieum . 4))
509
("V" (jongseong-rieulhieuh . 4))
516
(define byeoru-layout-generous390
517
(byeoru-expand-layout
519
'(("1" (jongseong-hieuh . (1 4)))
520
("2" (jongseong-ssangsios . 5))
521
("3" (jongseong-bieub . (3 4)))
522
("4" (jungseong-yo . 1))
523
("5" (jungseong-yu . 1))
524
("6" (jungseong-ya . 1))
525
("7" (jungseong-ye . 1))
526
("8" (jungseong-ui . 4))
527
("9" (jungseong-u . 3))
528
("0" (choseong-kieuk . 1))
529
("q" (jongseong-sios . (3 4 5)))
530
("w" (jongseong-rieul . 3))
531
("e" (jungseong-yeo . 1))
532
("r" (jungseong-ae . (1 4)))
533
("t" (jungseong-eo . (1 4)))
534
("y" (choseong-rieul . 1))
535
("u" (choseong-digeud . (3 5)))
536
("i" (choseong-mieum . 1))
537
("o" (choseong-chieuch . 1))
538
("p" (choseong-pieup . 1))
539
("a" (jongseong-ieung . 1))
540
("s" (jongseong-nieun . 3))
541
("d" (jungseong-i . (1 4)))
542
("f" (jungseong-a . (1 4)))
543
("g" (jungseong-eu . 3))
544
("h" (choseong-nieun . 1))
545
("j" (choseong-ieung . 1))
546
("k" (choseong-giyeog . (3 5)))
547
("l" (choseong-jieuj . (3 5)))
548
(";" (choseong-bieub . (3 5)))
549
("'" (choseong-tieut . 1))
550
("z" (jongseong-mieum . (1 4)))
551
("x" (jongseong-giyeog . (3 4 5)))
552
("c" (jungseong-e . (1 4)))
553
("v" (jungseong-o . 3))
554
("b" (jungseong-u . 3))
555
("n" (choseong-sios . (3 5)))
556
("m" (choseong-hieuh . 1))
557
("/" (jungseong-o . 3))
559
("!" (jongseong-jieuj . (1 4)))
560
("Q" (jongseong-pieup . (1 4)))
561
("W" (jongseong-tieut . (1 4)))
562
("E" (jongseong-kieuk . 1))
563
("R" (jungseong-yae . 1))
570
("A" (jongseong-digeud . 1))
571
("S" (jongseong-nieunhieuh . 4))
572
("D" (jongseong-rieulgiyeog . 4))
573
("F" (jongseong-ssanggiyeog . 5))
579
("Z" (jongseong-chieuch . 1))
580
("X" (jongseong-bieubsios . 4))
581
("C" (jongseong-rieulmieum . 4))
582
("V" (jongseong-rieulhieuh . 4))
589
(define byeoru-layout-no-shift
590
(byeoru-expand-layout
593
("1" (jongseong-hieuh . (1 4)))
594
("2" (jongseong-ssangsios . 5))
595
("3" (jongseong-bieub . (3 4)))
596
("4" (jungseong-yo . 1))
597
("5" (jungseong-yu . 1))
598
("6" (jungseong-ya . 1))
599
("7" (jungseong-ye . 1))
600
("8" (jungseong-ui . 4))
601
("9" (choseong-kieuk . 1))
602
("0" (jungseong-yae . 1))
603
("-" (jongseong-jieuj . (1 4)))
604
("=" (jongseong-chieuch . 1))
605
("q" (jongseong-sios . (3 4 5)))
606
("w" (jongseong-rieul . 3))
607
("e" (jungseong-yeo . 1))
608
("r" (jungseong-ae . (1 4)))
609
("t" (jungseong-eo . (1 4)))
610
("y" (choseong-rieul . 1))
611
("u" (choseong-digeud . (3 5)))
612
("i" (choseong-mieum . 1))
613
("o" (choseong-chieuch . 1))
614
("p" (choseong-pieup . 1))
615
("[" (jongseong-tieut . (1 4)))
616
("]" (jongseong-pieup . (1 4)))
617
("\\" (jongseong-kieuk . 1))
618
("a" (jongseong-ieung . 1))
619
("s" (jongseong-nieun . 3))
620
("d" (jungseong-i . (1 4)))
621
("f" (jungseong-a . (1 4)))
622
("g" (jungseong-eu . 3))
623
("h" (choseong-nieun . 1))
624
("j" (choseong-ieung . 1))
625
("k" (choseong-giyeog . (3 5)))
626
("l" (choseong-jieuj . (3 5)))
627
(";" (choseong-bieub . (3 5)))
628
("'" (choseong-tieut . 1))
629
("z" (jongseong-mieum . (1 4)))
630
("x" (jongseong-giyeog . (3 4 5)))
631
("c" (jungseong-e . (1 4)))
632
("v" (jungseong-o . 3))
633
("b" (jungseong-u . 3))
634
("n" (choseong-sios . (3 5)))
635
("m" (choseong-hieuh . 1))
636
("/" (jongseong-digeud . 1))
638
("Q" (jongseong-sios . (3 4 5)))
639
("W" (jongseong-rieul . 3))
640
("E" (jungseong-yeo . 1))
641
("R" (jungseong-ae . (1 4)))
648
("A" (jongseong-ieung . 1))
651
("F" (jungseong-a . (1 4)))
660
("V" (jungseong-o . 3))
667
(define-record 'byeoru-automata
668
'((state-history ((start . 0)))
669
(candidate-history ())
670
(ordered-cand-hist ())
672
(composing-char (0 0 0))
673
(composed-char (0 0 0))))
675
(define (byeoru-choseong? jamo)
676
(assoc jamo byeoru-choseong-alist))
678
(define (byeoru-jungseong? jamo)
679
(assoc jamo byeoru-jungseong-alist))
681
(define (byeoru-jongseong? jamo)
682
(assoc jamo byeoru-jongseong-alist))
684
(define (byeoru-compound? jamo-key)
685
(find (lambda (item) (eq? jamo-key (cdr item)))
686
byeoru-compound-jamo-alist))
688
(define (byeoru-double? jamo-key)
689
(find (lambda (item) (eq? jamo-key (cdr item)))
690
byeoru-double-jamo-alist))
692
(define (byeoru-combine-compound jamo1 jamo2)
693
(let ((entry (assoc (cons jamo1 jamo2) byeoru-compound-jamo-alist)))
694
(and entry (cdr entry))))
696
(define (byeoru-combine-double jamo1 jamo2)
697
(let ((entry (assoc (cons jamo1 jamo2) byeoru-double-jamo-alist)))
698
(and entry (cdr entry))))
700
(define (byeoru-combine-comp-or-double jamo1 jamo2)
701
(if (eq? jamo1 jamo2)
702
(byeoru-combine-double jamo1 jamo2)
703
(byeoru-combine-compound jamo1 jamo2)))
705
(define (byeoru-jamo-key-class jamo-key)
707
((byeoru-choseong? jamo-key) 'choseong)
708
((byeoru-jungseong? jamo-key) 'jungseong)
709
((byeoru-jongseong? jamo-key) 'jongseong)))
711
(define (byeoru-jamo-keys-to-johab jamo-keys)
712
(let* ((jamos (reverse jamo-keys))
714
(lambda (class-test alist)
718
((class-test (car jamos))
719
(let ((code (cdr (assq
720
(if (and (not (null? (cdr jamos)))
721
(class-test (cadr jamos)))
722
(let ((j (byeoru-combine-comp-or-double
723
(car jamos) (cadr jamos))))
724
(set! jamos (cdr jamos))
728
(set! jamos (cdr jamos))
732
(cho (get-johab-code byeoru-choseong? byeoru-choseong-alist))
733
(jung (get-johab-code byeoru-jungseong? byeoru-jungseong-alist))
734
(jong (get-johab-code byeoru-jongseong? byeoru-jongseong-alist)))
735
(list cho jung jong)))
737
(define (byeoru-transition-allowed? state dest)
738
(let ((allowed (assoc state byeoru-transition-alist)))
739
(member dest (cdr allowed))))
741
(define (byeoru-comp-or-double-forbidden? state dest)
742
(let ((state-class (car state))
743
(state-no (cdr state))
744
(dest-class (car dest)))
745
(and (eq? state-class dest-class)
746
(or (= state-no 2) (= state-no 3)))))
748
(define (byeoru-automata-reset! ba)
749
(byeoru-automata-set-state-history! ba '((start . 0)))
750
(byeoru-automata-set-elected-keys! ba '())
751
(byeoru-automata-set-candidate-history! ba '())
752
(byeoru-automata-set-composing-char! ba '(0 0 0))
753
(byeoru-automata-set-ordered-cand-hist! ba '()))
755
(define (byeoru-automata-eat-ordered-key ba candidates)
756
;; candidates are not candidates in the sense used in Hangul to
757
;; Chinese conversion. A few jamo and state candidates are assigned
758
;; to each key. For example, '((choseong-giyeog . 1)
759
;; (jongseong-giyeog . 3) (jongseong-giyeog . 4))) are assigned to
760
;; "r" in the hangul2 layout, which means that "r" key can be
761
;; interpreted as one of the these three possibilities. They are
762
;; tried in the order from left to right, and the first one that can
763
;; be used for continuing syllable composition is used. If no
764
;; candidate can be used for composition, the syllable is completed,
765
;; and composition of a new syllable begins.
766
(let loop ((cands candidates))
767
(let* ((state (car (byeoru-automata-state-history ba)))
768
(state-class (car state))
769
(state-no (cdr state))
770
(elected-keys (byeoru-automata-elected-keys ba))
771
(cand-hist (byeoru-automata-candidate-history ba)))
776
;; No valid jamo candidate found, so we have to break the syllable.
777
(if (and (byeoru-jungseong? (caar candidates))
778
(eq? state-class 'jongseong)
779
(member state-no '(1 3 4))
780
(byeoru-choseong? (caar (car cand-hist))))
781
;; A 2-beol layout may give rise to a transformation like
782
;; (consonant vowel consonant) + vowel
783
;; => (consonant vowel) (consonant + vowel)
784
(let ((last-candidates (car cand-hist)))
785
(byeoru-automata-set-composed-char!
786
ba (byeoru-jamo-keys-to-johab (cdr elected-keys)))
787
(byeoru-automata-reset! ba)
788
(byeoru-automata-eat-ordered-key ba last-candidates)
789
(byeoru-automata-eat-ordered-key ba candidates))
790
;; For a 3-beol layout, just begin a new syllable with
793
(byeoru-automata-set-composed-char!
794
ba (byeoru-automata-composing-char ba))
795
(byeoru-automata-reset! ba)
796
(byeoru-automata-eat-ordered-key ba candidates)))
800
((let* ((cand (car cands))
801
(jamo-key (car cand))
803
(p-dest-class (byeoru-jamo-key-class jamo-key))
804
(p-dest (cons p-dest-class (if (= dest-no 5) 4 dest-no))))
806
(byeoru-transition-allowed? state p-dest)
808
;; dest-no 5 is used to control double-striking composition
809
;; of a double jamo, separately from composition of a
810
;; (heterogeneous) compound jamo.
812
(if (byeoru-double? jamo-key)
813
;; a double jamo key cannot be the second key
814
;; for a double jamo.
815
(not (byeoru-comp-or-double-forbidden? state p-dest))
816
;; jamo-key must be the second key for a double jamo,
817
(and (not (null? elected-keys)) ; so, a first key needed,
818
;; that is the same as jamo-key.
819
(eq? (car elected-keys) jamo-key))))
821
(if (byeoru-compound? jamo-key)
822
;; a compound jamo key cannot be the second key
823
;; for a compound jamo.
824
(not (byeoru-comp-or-double-forbidden? state p-dest))
825
;; jamo-key must be the second key for a compound,
826
(and (not (null? elected-keys)) ; so, a first key needed,
827
;; that can be combined with jamo-key.
828
(byeoru-combine-compound
829
(car elected-keys) jamo-key))))
831
(not (and (eq? p-dest-class 'jongseong)
832
(eq? state-class 'choseong)
833
;; cho -> jong transition is allowed in general,
834
;; but not in a 2-beol layout.
835
(byeoru-choseong? (caar candidates))))
837
;; A valid jamo candidate found. Keep composing.
839
(byeoru-automata-set-elected-keys!
840
ba (cons jamo-key elected-keys))
841
(byeoru-automata-set-candidate-history!
842
ba (cons candidates cand-hist))
843
(byeoru-automata-set-state-history!
844
ba (cons p-dest (byeoru-automata-state-history ba)))
845
(byeoru-automata-set-composing-char!
846
ba (byeoru-jamo-keys-to-johab
847
(byeoru-automata-elected-keys ba)))
852
(loop (cdr cands)))))))
854
(define (byeoru-orderedness)
855
(let ((can-be-orderless
856
(cadr (assoc byeoru-layout byeoru-layout-alist))))
857
(if can-be-orderless byeoru-jamo-orderedness 'ordered)))
859
(define (byeoru-cmp-class cands1 cands2)
860
(let* ((byeoru-class-order
862
(cdr (assoc class '((choseong . 1)
865
(jamo1 (caar cands1))
866
(jamo2 (caar cands2))
867
(order1 (byeoru-class-order (byeoru-jamo-key-class jamo1)))
868
(order2 (byeoru-class-order (byeoru-jamo-key-class jamo2))))
869
(if (= order1 order2)
870
(if (eq? jamo1 jamo2)
873
((byeoru-combine-compound jamo1 jamo2) -1)
874
((byeoru-combine-compound jamo2 jamo2) 1)
878
(define (byeoru-insert-candidates candidates cands-list)
879
(if (or (null? cands-list)
880
(>= (byeoru-cmp-class candidates (car cands-list)) 0))
881
(cons candidates cands-list)
882
(cons (car cands-list)
883
(byeoru-insert-candidates candidates (cdr cands-list)))))
885
(define (byeoru-test-list ba cands-list)
886
(let loop ((rev-cands-list (reverse cands-list)))
888
((null? rev-cands-list)
890
((eq? (byeoru-automata-eat-ordered-key ba (car rev-cands-list))
894
(loop (cdr rev-cands-list))))))
896
(define (byeoru-eat-list f ba lst)
897
(and (not (null? lst))
898
(let loop ((rev-lst (reverse lst)))
899
(let ((res (f ba (car rev-lst))))
900
(if (null? (cdr rev-lst))
902
(loop (cdr rev-lst)))))))
904
(define (byeoru-automata-eat-orderless-key ba candidates)
905
(let ((och (byeoru-automata-ordered-cand-hist ba))
906
(class (byeoru-jamo-key-class (caar candidates))))
907
;; Even though we allow keystroke orders to be interchanged, two
908
;; keystrokes of the same class should be consecutive. Otherwise,
909
;; we break the syllable.
910
(if (and (memq class (map (lambda (elm)
911
(byeoru-jamo-key-class (caar elm))) och))
912
(not (eq? class (byeoru-jamo-key-class (caar (car och)))))
913
;; But, in more-orderless mode, we only require that two
914
;; keystrokes of choseong class be consecutive, for
915
;; syllable breaks to be well defined. All other
916
;; disorders are allowed.
917
(or (not (eq? (byeoru-orderedness) 'more-orderless))
918
(eq? class 'choseong)))
919
(byeoru-automata-eat-ordered-key ba candidates)
920
(let* ((cand-hist (byeoru-automata-candidate-history ba))
921
(new-cand-hist (cons candidates cand-hist))
922
(new-sorted-cand-hist (byeoru-insert-candidates
923
candidates cand-hist))
925
(byeoru-automata-reset! ba)
926
(byeoru-test-list ba new-sorted-cand-hist))))
927
(if (eq? res 'char-break)
929
(byeoru-automata-reset! ba)
931
byeoru-automata-eat-ordered-key ba new-cand-hist)))
934
(define (byeoru-automata-eat-key ba candidates)
935
(let ((och (byeoru-automata-ordered-cand-hist ba))
937
(case (byeoru-orderedness)
939
(byeoru-automata-eat-ordered-key ba candidates))
940
((orderless more-orderless)
941
(byeoru-automata-eat-orderless-key ba candidates)))))
942
(byeoru-automata-set-ordered-cand-hist!
943
ba (if (eq? res 'char-break)
944
(byeoru-automata-candidate-history ba)
945
(cons candidates och)))
948
(define (byeoru-automata-backspace ba)
949
(and (not (null? (byeoru-automata-elected-keys ba)))
951
(byeoru-automata-set-elected-keys!
952
ba (cdr (byeoru-automata-elected-keys ba)))
953
(byeoru-automata-set-state-history!
954
ba (cdr (byeoru-automata-state-history ba)))
955
(byeoru-automata-set-candidate-history!
956
ba (cdr (byeoru-automata-candidate-history ba)))
957
(byeoru-automata-set-ordered-cand-hist!
958
ba (byeoru-automata-candidate-history ba))
959
(byeoru-automata-set-composing-char!
960
ba (byeoru-jamo-keys-to-johab (byeoru-automata-elected-keys ba))))
964
;;; ----------------------------
965
;;; Hangul encoding in Unicode
966
;;; ----------------------------
968
;; Hangul choseong giyeog, U+1100.
969
(define byeoru-ucs-code-choseong-giyeog 4352)
971
;; Hangul jungseong a, U+1161.
972
(define byeoru-ucs-code-jungseong-a 4449)
974
;; Hangul jongseong giyeog, U+11A8.
975
(define byeoru-ucs-code-jongseong-giyeog 4520)
977
;; Hangul choseong filler, U+115F.
978
(define byeoru-ucs-code-choseong-filler 4447)
980
;; Hangul jungseong filler, U+1160.
981
(define byeoru-ucs-code-jungseong-filler 4448)
983
;; Hangul syllables block begins at U+AC00, 가.
984
(define byeoru-ucs-code-ga 44032)
986
;; What I call johab here is not related to the KSSM combination
987
;; (johab) code, but is a list having the form (cho jung jong), where
988
;; each element is the number listed in
989
;; byeoru-{cho,jung,jong}seong-alist.
990
(define (byeoru-johab-to-ucs johab)
991
(let ((cho (car johab))
993
(jong (nth 2 johab)))
994
(+ byeoru-ucs-code-ga (* (- cho 1) 21 28) (* (- jung 1) 28) jong)))
996
;; This is the way an isolated jamo is encoded in the Unicode standard.
997
;; However, it doesn't seem to be well supported currently.
998
(define byeoru-choseong-jamo-utf8-list
999
(map ucs-to-utf8-string
1000
(cons byeoru-ucs-code-choseong-filler
1002
19 (lambda (n) (+ n byeoru-ucs-code-choseong-giyeog))))))
1004
(define byeoru-jungseong-jamo-utf8-list
1005
(map ucs-to-utf8-string
1006
(cons byeoru-ucs-code-jungseong-filler
1008
21 (lambda (n) (+ n byeoru-ucs-code-jungseong-a))))))
1010
(define byeoru-jongseong-jamo-utf8-list
1011
(cons "" (map ucs-to-utf8-string
1013
27 (lambda (n) (+ n byeoru-ucs-code-jongseong-giyeog))))))
1015
;; So we show an incomplete syllable as a sequence of
1016
;; Hangul compatibility jamos by default.
1017
(define byeoru-choseong-compatibility-jamo-utf8-list
1018
(cons "" (map ucs-to-utf8-string
1019
'(12593 12594 12596 12599 12600 12601 12609 12610 12611 12613
1020
12614 12615 12616 12617 12618 12619 12620 12621 12622))))
1022
(define byeoru-jungseong-compatibility-jamo-utf8-list
1023
(cons "" (map ucs-to-utf8-string
1024
'(12623 12624 12625 12626 12627 12628 12629 12630 12631 12632
1025
12633 12634 12635 12636 12637 12638 12639 12640 12641 12642
1028
(define byeoru-jongseong-compatibility-jamo-utf8-list
1029
(cons "" (map ucs-to-utf8-string
1030
'(12593 12594 12595 12596 12597 12598 12599 12601 12602 12603
1031
12604 12605 12606 12607 12608 12609 12610 12612 12613 12614
1032
12615 12616 12618 12619 12620 12621 12622))))
1034
(define (byeoru-johab-to-utf8-string johab)
1035
(let ((cho (car johab))
1037
(jong (nth 2 johab)))
1039
((and (= cho 0) (= jung 0) (= jong 0))
1041
;; We are basically using Normalization Form C.
1042
((and (not (= cho 0)) (not (= jung 0)))
1043
(ucs-to-utf8-string (byeoru-johab-to-ucs johab)))
1045
(let ((cho-l (if byeoru-compatibility-jamos-for-incomplete-syllables?
1046
byeoru-choseong-compatibility-jamo-utf8-list
1047
byeoru-choseong-jamo-utf8-list))
1048
(jung-l (if byeoru-compatibility-jamos-for-incomplete-syllables?
1049
byeoru-jungseong-compatibility-jamo-utf8-list
1050
byeoru-jungseong-jamo-utf8-list))
1051
(jong-l (if byeoru-compatibility-jamos-for-incomplete-syllables?
1052
byeoru-jongseong-compatibility-jamo-utf8-list
1053
byeoru-jongseong-jamo-utf8-list)))
1055
(nth cho cho-l) (nth jung jung-l) (nth jong jong-l)))))))
1058
;;; ------------------------
1059
;;; Input context handlers
1060
;;; ------------------------
1062
(define byeoru-romaja-rule
1063
(byeoru-expand-layout
1064
'(((("g")) ((choseong-giyeog . (3 5)) (jongseong-giyeog . (3 4 5))))
1065
;; gg, dd, bb, vv, ss, jj, zz are composed by automata.
1066
((("k" "k")) ((choseong-ssanggiyeog . 1) (jongseong-ssanggiyeog . 5)))
1067
((("q" "q")) ((choseong-ssanggiyeog . 1) (jongseong-ssanggiyeog . 5)))
1068
((("c")) ((choseong-ssanggiyeog . 1) (jongseong-ssanggiyeog . 5)))
1069
((("n")) ((choseong-nieun . 1) (jongseong-nieun . 3)))
1070
((("d")) ((choseong-digeud . (3 5)) (jongseong-digeud . 1)))
1071
((("t" "t")) ((choseong-ssangdigeud . 1)))
1072
((("r")) ((choseong-rieul . 1) (jongseong-rieul . 3)))
1073
((("l")) ((choseong-rieul . 1) (jongseong-rieul . 3)))
1074
((("m")) ((choseong-mieum . 1) (jongseong-mieum . (1 4))))
1075
((("b")) ((choseong-bieub . (3 5)) (jongseong-bieub . (3 4))))
1076
((("v")) ((choseong-bieub . (3 5)) (jongseong-bieub . (3 4))))
1077
((("p" "p")) ((choseong-ssangbieub . 1)))
1078
((("f" "f")) ((choseong-ssangbieub . 1)))
1079
((("s")) ((choseong-sios . (3 5)) (jongseong-sios . (3 4 5))))
1080
((("x")) ((choseong-ieung . 1)))
1081
((("n" "g")) ((jongseong-ieung . 1)))
1082
((("j")) ((choseong-jieuj . (3 5)) (jongseong-jieuj . (1 4))))
1083
((("z")) ((choseong-jieuj . (3 5)) (jongseong-jieuj . (1 4))))
1084
((("c" "h")) ((choseong-chieuch . 1) (jongseong-chieuch . 1)))
1085
((("k")) ((choseong-kieuk . 1) (jongseong-kieuk . 1)))
1086
((("q")) ((choseong-kieuk . 1) (jongseong-kieuk . 1)))
1087
((("t")) ((choseong-tieut . 1) (jongseong-tieut . (1 4))))
1088
((("p")) ((choseong-pieup . 1) (jongseong-pieup . (1 4))))
1089
((("f")) ((choseong-pieup . 1) (jongseong-pieup . (1 4))))
1090
((("h")) ((choseong-hieuh . 1) (jongseong-hieuh . (1 4))))
1091
((("a")) ((jungseong-a . 1)))
1092
((("a" "e")) ((jungseong-ae . 1)))
1093
((("y" "a")) ((jungseong-ya . 1)))
1094
((("i" "a")) ((jungseong-ya . 1)))
1095
((("y" "a" "e")) ((jungseong-yae . 1)))
1096
((("i" "a" "e")) ((jungseong-yae . 1)))
1097
((("e" "o")) ((jungseong-eo . 1)))
1098
((("e")) ((jungseong-e . 1)))
1099
((("y" "e" "o")) ((jungseong-yeo . 1)))
1100
((("i" "e" "o")) ((jungseong-yeo . 1)))
1101
((("y" "e")) ((jungseong-ye . 1)))
1102
((("i" "e")) ((jungseong-ye . 1)))
1103
((("o")) ((jungseong-o . 1)))
1104
((("w" "a")) ((jungseong-wa . 4)))
1105
((("u" "a")) ((jungseong-wa . 4)))
1106
((("o" "a")) ((jungseong-wa . 4)))
1107
((("w" "a" "e")) ((jungseong-wae . 4)))
1108
((("u" "a" "e")) ((jungseong-wae . 4)))
1109
((("o" "a" "e")) ((jungseong-wae . 4)))
1110
((("o" "e")) ((jungseong-oe . 4)))
1111
((("w" "o" "e")) ((jungseong-oe . 4)))
1112
((("u" "o" "e")) ((jungseong-oe . 4)))
1113
((("o" "i")) ((jungseong-oe . 4)))
1114
((("y" "o")) ((jungseong-yo . 1)))
1115
((("i" "o")) ((jungseong-yo . 1)))
1116
((("u")) ((jungseong-u . 1)))
1117
((("w")) ((jungseong-u . 1)))
1118
((("o" "o")) ((jungseong-u . 1)))
1119
((("w" "o")) ((jungseong-wo . 4)))
1120
((("w" "e" "o")) ((jungseong-wo . 4))) ; Not present in HWP.
1121
((("u" "o")) ((jungseong-wo . 4)))
1122
((("w" "e")) ((jungseong-we . 4)))
1123
((("u" "e")) ((jungseong-we . 4)))
1124
((("w" "i")) ((jungseong-wi . 4)))
1125
((("y" "u")) ((jungseong-yu . 1)))
1126
((("i" "u")) ((jungseong-yu . 1)))
1127
((("e" "u")) ((jungseong-eu . 1)))
1128
((("u" "i")) ((jungseong-ui . 4)))
1129
((("e" "u" "i")) ((jungseong-ui . 4)))
1130
((("i")) ((jungseong-i . 1)))
1131
((("y")) ((jungseong-i . 1)))
1132
((("e" "e")) ((jungseong-i . 1))))
1135
(define byeoru-context-rec-spec
1141
(list 'rkc #f) ; for romaja input.
1142
(list 'key-hist '())
1143
(list 'commit-by-word? byeoru-commit-by-word?)
1144
(list 'word-ustr #f)
1145
(list 'convl-ustr #f)
1146
(list 'convr-ustr #f)
1148
(list 'mode 'hangul)
1149
(list 'dic-entry #f)
1155
(define-record 'byeoru-context byeoru-context-rec-spec)
1156
(define byeoru-context-new-internal byeoru-context-new)
1158
(define (byeoru-context-new id im)
1159
(let ((bc (byeoru-context-new-internal id im)))
1160
(byeoru-context-set-widgets! bc byeoru-widgets)
1161
(byeoru-context-set-automata! bc (byeoru-automata-new))
1162
(byeoru-context-set-rkc! bc (rk-context-new byeoru-romaja-rule #f #f))
1163
(byeoru-context-set-word-ustr! bc (ustr-new))
1164
(byeoru-context-set-convl-ustr! bc (ustr-new))
1165
(byeoru-context-set-convr-ustr! bc (ustr-new))
1168
(define (byeoru-flush-automata bc)
1169
(let* ((ba (byeoru-context-automata bc))
1170
(composing (byeoru-johab-to-utf8-string
1171
(byeoru-automata-composing-char ba))))
1172
(if (not (string=? composing ""))
1174
(ustr-insert-elem! (byeoru-context-word-ustr bc) composing)
1175
(byeoru-automata-reset! ba)))
1176
(rk-flush (byeoru-context-rkc bc))
1177
(byeoru-context-set-key-hist! bc '())))
1179
(define (byeoru-make-whole-string bc)
1180
(let ((word (byeoru-context-word-ustr bc)))
1181
(apply string-append (ustr-whole-seq word))))
1183
(define (byeoru-clear! bc)
1184
(ustr-clear! (byeoru-context-word-ustr bc))
1185
(byeoru-context-set-mode! bc 'hangul))
1187
(define (byeoru-commit bc str)
1188
(if (not (string=? str "")) (im-commit bc str)))
1190
(define (byeoru-flush bc)
1191
(byeoru-flush-automata bc)
1192
(byeoru-commit bc (byeoru-make-whole-string bc))
1195
(define (byeoru-prepare-activation bc)
1197
(byeoru-update-preedit bc))
1199
(register-action 'action_byeoru_direct
1203
;; Change this to a more reasonable name.
1207
(not (byeoru-context-on bc)))
1209
(byeoru-prepare-activation bc)
1210
(byeoru-context-set-on! bc #f)))
1212
(register-action 'action_byeoru_hangulchar
1219
(and (byeoru-context-on bc)
1220
(not (byeoru-context-commit-by-word? bc))))
1222
(byeoru-prepare-activation bc)
1223
(byeoru-context-set-on! bc #t)
1224
(byeoru-context-set-commit-by-word?! bc #f)))
1226
(register-action 'action_byeoru_hangulword
1233
(and (byeoru-context-on bc)
1234
(byeoru-context-commit-by-word? bc)))
1236
(byeoru-prepare-activation bc)
1237
(byeoru-context-set-on! bc #t)
1238
(byeoru-context-set-commit-by-word?! bc #t)))
1240
(define byeoru-input-mode-actions
1241
'(action_byeoru_direct
1242
action_byeoru_hangulchar
1243
action_byeoru_hangulword))
1245
(define byeoru-widgets '(widget_byeoru_input_mode))
1247
(define default-widget_byeoru_input_mode 'action_byeoru_direct)
1249
(register-widget 'widget_byeoru_input_mode
1250
(activity-indicator-new byeoru-input-mode-actions)
1251
(actions-new byeoru-input-mode-actions))
1253
(define (byeoru-init-handler id im arg)
1254
(byeoru-context-new id im))
1256
;; Test that the input is not control-purpose but graphical character.
1257
;; This procedure is needed since byeoru-layout alists do not have
1258
;; modifier key information other than Shift.
1261
;; - CHECK: is this a right way to check shift-only?
1262
(define byeoru-non-control-key?
1263
(let ((shift-or-no-modifier? (make-key-predicate '("<Shift>" ""))))
1264
(lambda (key key-state)
1265
(shift-or-no-modifier? -1 key-state))))
1267
(define (byeoru-key-to-candidates key key-state)
1268
(and (byeoru-non-control-key? key key-state)
1269
(let* ((layout (symbol-value byeoru-layout))
1272
;; avoid case change due to caps lock.
1273
(if (shift-key-mask key-state)
1274
(char-upcase key) (char-downcase key))))
1275
(entry (assoc pressed-key layout)))
1277
(let ((candidates (cdr entry)))
1278
(if (number? candidates)
1279
(ucs-to-utf8-string candidates)
1282
(define byeoru-dic-filename "byeoru-dic.scm")
1283
(define byeoru-load-dic-hook '())
1284
(define byeoru-dic-loaded? #f)
1286
(define (byeoru-add-hook hook-sym proc)
1287
(set-symbol-value! hook-sym (cons proc (symbol-value hook-sym))))
1289
(define (byeoru-call-hook-procs hook)
1290
(for-each (lambda (proc) (proc)) hook))
1292
(define (byeoru-look-up-dic word)
1293
(if (not byeoru-dic-loaded?)
1295
(require byeoru-dic-filename)
1296
(byeoru-call-hook-procs byeoru-load-dic-hook)
1297
(set! byeoru-dic-loaded? #t)))
1298
(assoc word byeoru-dic))
1300
(define (byeoru-add-dic-entry kons)
1301
(let* ((id (car kons))
1302
(found (assoc id byeoru-dic)))
1304
(define (update-cands cands new-cands)
1307
(let ((new-str (if (pair? new) (car new) new)))
1311
(let ((elm-str (if (pair? elm) (car elm) elm)))
1312
(string=? elm-str new-str))) lis))))
1316
(set-cdr! found (update-cands (cdr found) (reverse (cdr kons))))
1317
(set! byeoru-dic (cons kons byeoru-dic)))))
1319
(define (byeoru-begin-conv bc)
1320
(byeoru-flush-automata bc)
1321
(let* ((word (byeoru-context-word-ustr bc))
1322
(convl (byeoru-context-convl-ustr bc))
1323
(convr (byeoru-context-convr-ustr bc))
1325
(ustr-set-whole-seq! convl (ustr-former-seq word))
1326
(ustr-cursor-move-beginning! convl)
1329
((ustr-cursor-at-end? convl)
1332
(ustr-set-whole-seq! convr (ustr-latter-seq convl))
1335
((ustr-cursor-at-beginning? convr)
1337
((byeoru-look-up-dic
1338
(apply string-append (ustr-former-seq convr))))
1340
(ustr-cursor-move-backward! convr)
1343
(ustr-cursor-move-forward! convl)
1346
(let ((max (- (length entry) 1)))
1347
(byeoru-context-set-dic-entry! bc entry)
1348
(byeoru-context-set-cands! bc (cdr entry))
1349
(byeoru-context-set-mode! bc 'conv)
1350
(byeoru-update-preedit bc)
1351
;; CHECK: is the following statement true?
1352
;; We should update the preedit to place the candidate window
1353
;; at a correct position.
1354
(im-activate-candidate-selector bc max byeoru-nr-candidate-max)
1355
(byeoru-context-set-cand-no! bc 0)
1356
(im-select-candidate bc 0)
1359
(define (byeoru-break-char bc)
1360
(let ((ba (byeoru-context-automata bc)))
1361
(ustr-insert-elem! (byeoru-context-word-ustr bc)
1362
(byeoru-johab-to-utf8-string
1363
(byeoru-automata-composed-char ba)))
1364
(if (not (byeoru-context-commit-by-word? bc))
1366
(byeoru-commit bc (byeoru-make-whole-string bc))
1367
(byeoru-clear! bc)))))
1369
;; Yes, I know this routine is ugly, but it works!
1370
;; This procedure uses an rk to translate, according to
1371
;; byeoru-romaja-rule, a sequence of romaja keys to a list of possible
1372
;; jamos, which is fed into a Hangul automata. When a new romaja key
1373
;; is pressed, the last-pressed key in the automata is backspaced and
1374
;; the updated key from the rk is pushed into the automata, until the
1375
;; rk sequence can grow no longer. It keeps track of the history of
1376
;; romaja key presses since the backspace key is supposed to delete a
1377
;; romaja, not a jamo.
1378
(define (byeoru-feed-romaja-key bc key key-state)
1380
(byeoru-non-control-key? key key-state)
1383
(define (flush-automata)
1384
(byeoru-flush-automata bc)
1385
(if (not (byeoru-context-commit-by-word? bc))
1387
(byeoru-commit bc (byeoru-make-whole-string bc))
1388
(byeoru-clear! bc))))
1390
;; Shift key forces a syllable under composition to be completed.
1391
;; E.g., gagga becomes 각가,
1392
;; while gaGga becomes 가까.
1393
(if (shift-key-mask key-state)
1395
(let* ((ba (byeoru-context-automata bc))
1396
(first-key? (null? (byeoru-context-key-hist bc)))
1397
(rkc (byeoru-context-rkc bc))
1398
(last-pend (rk-pending rkc))
1399
(last-seq (rk-context-seq rkc))
1400
(key-str (charcode->string (to-lower-char key)))
1401
(res (rk-push-key! rkc key-str))
1402
(pend (rk-pending rkc))
1403
(cur-seq (rk-current-seq rkc))
1404
(candidates (and (not (null? cur-seq)) (cadr cur-seq))))
1406
(define (byeoru-prepend-ieung)
1407
(byeoru-automata-backspace ba)
1408
(byeoru-automata-eat-key ba '((choseong-ieung . 1)))
1409
(byeoru-automata-eat-key ba candidates))
1412
(not (string=? pend ""))
1413
(list? candidates) (not (null? candidates))
1414
;; FIXME: remove (not (null? candidates))
1415
;; if sigscheme becomes in use.
1416
(let ((jungseong? (byeoru-jungseong? (caar candidates))))
1417
(if (not res) (byeoru-automata-backspace ba))
1418
;; CHECK: is res #f or '()?
1419
(if (and jungseong? (string=? last-pend "ng"))
1420
;; Note that HWP does not treat "ch" in this way.
1421
;; E.g., gochi becomes 고치
1422
;; while songi becomes 손기.
1424
(byeoru-automata-backspace ba)
1425
(byeoru-automata-eat-key ba '((jongseong-nieun . 1)))
1427
(byeoru-automata-eat-key ba '((choseong-giyeog . 1)))
1428
(byeoru-context-set-key-hist! bc '(103))
1429
(rk-push-key! rkc key-str)))
1430
(if (eq? (byeoru-automata-eat-key ba candidates) 'char-break)
1432
(byeoru-break-char bc)
1433
(byeoru-context-set-key-hist! bc '())
1435
(if (= (length (byeoru-automata-elected-keys ba)) 1)
1436
(byeoru-prepend-ieung)
1437
(byeoru-context-set-key-hist!
1438
bc (if (string=? last-pend "ch")
1440
(list (string->charcode (car last-seq))))))))
1441
(if (and jungseong? first-key?
1442
(not (and byeoru-shifted-romaja-isolates-vowel?
1443
(shift-key-mask key-state))))
1444
(byeoru-prepend-ieung)))
1445
(byeoru-context-set-key-hist!
1446
bc (cons key (byeoru-context-key-hist bc)))
1449
(define (byeoru-backspace-romaja bc)
1450
(let ((key-hist (byeoru-context-key-hist bc)))
1451
(and (not (null? key-hist))
1453
(byeoru-automata-reset! (byeoru-context-automata bc))
1454
(rk-flush (byeoru-context-rkc bc))
1455
(byeoru-context-set-key-hist! bc '())
1456
(let loop ((rev-key-hist (reverse (cdr key-hist))))
1457
(or (null? rev-key-hist)
1459
(byeoru-feed-romaja-key bc (car rev-key-hist) 0)
1460
(loop (cdr rev-key-hist)))))))))
1462
(define (byeoru-feed-hangul-key bc key key-state)
1463
(let ((candidates (byeoru-key-to-candidates key key-state)))
1464
(and (list? candidates) (not (null? candidates))
1465
;; Why should I check the length of candidates?
1466
;; Isn't scheme supposed to distinguish #f from an empty list?
1467
;; -> fixed in sigscheme.
1469
(if (eq? (byeoru-automata-eat-key (byeoru-context-automata bc)
1472
(byeoru-break-char bc))
1475
(define (byeoru-proc-input-state-with-preedit bc key key-state)
1476
(let* ((word (byeoru-context-word-ustr bc))
1477
(by-word? (byeoru-context-commit-by-word? bc)))
1479
(define (commit-former-string)
1480
(byeoru-commit bc (apply string-append (ustr-former-seq word)))
1481
(ustr-clear-former! word))
1486
((or (byeoru-latin-key? key key-state)
1487
(and byeoru-esc-turns-off? (eq? key 'escape)))
1489
(if (eq? key 'escape)
1491
(byeoru-context-set-on! bc #f))
1493
((byeoru-backspace-key? key key-state)
1494
(if (not (if (eq? byeoru-layout 'byeoru-layout-romaja)
1495
(byeoru-backspace-romaja bc)
1496
(byeoru-automata-backspace (byeoru-context-automata bc))))
1497
(ustr-cursor-delete-backside! word)))
1499
((and (byeoru-delete-key? key key-state) by-word?)
1500
(byeoru-flush-automata bc)
1501
(if (ustr-cursor-at-end? word)
1503
(byeoru-commit bc (byeoru-make-whole-string bc))
1506
(ustr-cursor-delete-frontside! word)))
1508
((and (byeoru-go-left-key? key key-state) by-word?)
1509
(byeoru-flush-automata bc)
1510
(ustr-cursor-move-backward! word))
1512
((and (byeoru-go-right-key? key key-state) by-word?)
1513
(byeoru-flush-automata bc)
1514
(if (ustr-cursor-at-end? word)
1516
(byeoru-commit bc (byeoru-make-whole-string bc))
1519
(ustr-cursor-move-forward! word)))
1521
((and (byeoru-beginning-of-preedit-key? key key-state) by-word?)
1522
(byeoru-flush-automata bc)
1523
(ustr-cursor-move-beginning! word))
1525
((and (byeoru-end-of-preedit-key? key key-state) by-word?)
1526
(byeoru-flush-automata bc)
1527
(if (ustr-cursor-at-end? word)
1529
(byeoru-commit bc (byeoru-make-whole-string bc))
1532
(ustr-cursor-move-end! word)))
1534
((byeoru-conversion-key? key key-state)
1535
(if (not (byeoru-begin-conv bc))
1536
(commit-former-string)))
1539
((if (eq? byeoru-layout 'byeoru-layout-romaja)
1540
(byeoru-feed-romaja-key bc key key-state)
1541
(byeoru-feed-hangul-key bc key key-state)))
1545
(byeoru-flush-automata bc)
1546
(let ((candidates (or (eq? byeoru-layout 'byeoru-layout-romaja)
1547
(byeoru-key-to-candidates key key-state))))
1548
(if (string? candidates)
1550
(ustr-insert-elem! word candidates)
1551
(commit-former-string))
1553
(commit-former-string)
1554
(im-commit-raw bc))))))))
1556
(define (byeoru-show-menu bc)
1557
(let* ((cands (append (byeoru-context-cache bc)
1559
'(commit-by-word-switch)))
1560
(max (length cands)))
1561
(byeoru-context-set-cands! bc cands)
1562
(byeoru-context-set-mode! bc 'menu)
1563
(im-activate-candidate-selector bc max max)
1564
(im-select-candidate bc (byeoru-context-menu-no bc))))
1566
(define (byeoru-proc-input-state-no-preedit bc key key-state)
1570
((byeoru-latin-key? key key-state)
1571
(byeoru-context-set-on! bc #f))
1573
((byeoru-conversion-key? key key-state)
1574
(byeoru-show-menu bc))
1577
((if (eq? byeoru-layout 'byeoru-layout-romaja)
1578
(byeoru-feed-romaja-key bc key key-state)
1579
(byeoru-feed-hangul-key bc key key-state)))
1581
;; Commit a single key.
1583
(let ((candidates (or (eq? byeoru-layout 'byeoru-layout-romaja)
1584
(byeoru-key-to-candidates key key-state))))
1585
(if (string? candidates)
1586
(byeoru-commit bc candidates)
1588
(if (and byeoru-esc-turns-off? (eq? key 'escape))
1589
(byeoru-context-set-on! bc #f))))))
1591
(define (byeoru-has-preedit? bc)
1592
(let ((ba (byeoru-context-automata bc)))
1593
(not (and (ustr-empty? (byeoru-context-word-ustr bc))
1594
(equal? (byeoru-automata-composing-char ba) '(0 0 0))))))
1596
(define (byeoru-proc-input-state bc key key-state)
1597
(if (byeoru-has-preedit? bc)
1598
(byeoru-proc-input-state-with-preedit bc key key-state)
1599
(byeoru-proc-input-state-no-preedit bc key key-state)))
1601
(define (byeoru-move-candidate bc offset)
1602
(let* ((cands (byeoru-context-cands bc))
1603
(max (length cands))
1604
(mode (byeoru-context-mode bc))
1606
((conv symbol) (byeoru-context-cand-no bc))
1607
((menu) (byeoru-context-menu-no bc)))
1609
(compensated-n (cond
1618
(byeoru-context-set-cand-no! bc compensated-n))
1620
(byeoru-context-set-menu-no! bc compensated-n)))
1621
(im-select-candidate bc compensated-n)))
1623
(define (byeoru-cancel-conv bc)
1624
(im-deactivate-candidate-selector bc)
1625
(case (byeoru-context-mode bc)
1627
(byeoru-context-set-mode! bc 'hangul)
1628
(if (not (byeoru-context-commit-by-word? bc))
1630
(byeoru-commit bc (byeoru-make-whole-string bc))
1631
(byeoru-clear! bc))))
1633
(byeoru-context-set-mode! bc 'hangul))
1635
(byeoru-show-menu bc))))
1637
(define (byeoru-commit-converted-part bc)
1638
(let* ((cands (byeoru-context-cands bc))
1639
(cand (nth (byeoru-context-cand-no bc) cands))
1640
(entry (byeoru-context-dic-entry bc))
1641
(convl (byeoru-context-convl-ustr bc))
1642
(convr (byeoru-context-convr-ustr bc))
1643
(word (byeoru-context-word-ustr bc)))
1645
(apply string-append
1646
(append (ustr-former-seq convl)
1647
(list (if (pair? cand) (car cand) cand)))))
1648
(set-cdr! entry (cons cand (delete cand cands eq?)))
1649
(im-deactivate-candidate-selector bc)
1650
(byeoru-context-set-mode! bc 'hangul)
1651
(ustr-set-former-seq! word (ustr-latter-seq convr))))
1653
(define (byeoru-select-menu-or-symbol bc)
1654
(let* ((cands (byeoru-context-cands bc))
1655
(cache (byeoru-context-cache bc)))
1657
(define (update-cache str)
1658
(let ((cached (find (lambda (elm) (string=? elm str)) cache)))
1659
(byeoru-context-set-cache!
1661
(cons cached (delete cached cache eq?))
1662
(let ((new-cache (cons str cache)))
1663
(if (> (length new-cache) byeoru-symbol-cache-size)
1664
(truncate-list new-cache
1665
byeoru-symbol-cache-size)
1668
(im-deactivate-candidate-selector bc)
1669
(case (byeoru-context-mode bc)
1671
(let ((cand (nth (byeoru-context-menu-no bc) cands)))
1674
(byeoru-commit bc cand)
1675
(byeoru-context-set-mode! bc 'hangul)
1676
(byeoru-context-set-menu-no! bc 0)
1677
(update-cache cand))
1679
(let ((max (length (cdr cand))))
1680
(byeoru-context-set-cands! bc (cdr cand))
1681
(byeoru-context-set-mode! bc 'symbol)
1682
(im-activate-candidate-selector
1683
bc max byeoru-nr-candidate-max)
1684
(byeoru-context-set-cand-no! bc 0)
1685
(im-select-candidate bc 0)))
1687
(byeoru-context-set-commit-by-word?!
1688
bc (not (byeoru-context-commit-by-word? bc)))
1689
(byeoru-context-set-mode! bc 'hangul)
1690
(byeoru-context-set-menu-no! bc 0)))))
1692
(let* ((cand (nth (byeoru-context-cand-no bc) cands))
1693
(str (if (number? cand)
1694
(ucs-to-utf8-string cand)
1696
(menu-item (nth (- (byeoru-context-menu-no bc) (length cache))
1697
byeoru-menu-symbols)))
1698
(byeoru-commit bc str)
1699
(set-cdr! menu-item (cons cand (delete cand cands eq?)))
1700
(set! byeoru-menu-symbols
1701
(cons menu-item (delete menu-item byeoru-menu-symbols eq?)))
1702
(byeoru-context-set-mode! bc 'hangul)
1703
(byeoru-context-set-menu-no! bc 0)
1704
(update-cache str))))))
1706
(define (byeoru-proc-other-states bc key key-state)
1708
((byeoru-prev-page-key? key key-state)
1709
(im-shift-page-candidate bc #f))
1710
((byeoru-next-page-key? key key-state)
1711
(im-shift-page-candidate bc #t))
1712
((byeoru-next-candidate-key? key key-state)
1713
(byeoru-move-candidate bc 1))
1714
((byeoru-prev-candidate-key? key key-state)
1715
(byeoru-move-candidate bc -1))
1716
((byeoru-cancel-key? key key-state)
1717
(byeoru-cancel-conv bc))
1718
((byeoru-commit-key? key key-state)
1719
(if (eq? (byeoru-context-mode bc) 'conv)
1720
(byeoru-commit-converted-part bc)
1721
(byeoru-select-menu-or-symbol bc)))))
1723
(define (byeoru-begin-input bc)
1724
(byeoru-context-set-on! bc #t))
1726
(define (byeoru-proc-raw-state bc key key-state)
1727
(if (byeoru-on-key? key key-state)
1728
(byeoru-begin-input bc)
1729
(im-commit-raw bc)))
1731
(define (byeoru-converting-state-preedit bc)
1732
(let ((convl (byeoru-context-convl-ustr bc))
1733
(convr (byeoru-context-convr-ustr bc))
1734
(word (byeoru-context-word-ustr bc))
1736
(if (byeoru-context-commit-by-word? bc) preedit-underline 0)))
1738
(and (not (ustr-cursor-at-beginning? convl))
1739
(cons preedit-underline
1740
(apply string-append (ustr-former-seq convl))))
1741
(cons (bit-or preedit-reverse underline preedit-cursor)
1742
(apply string-append (ustr-former-seq convr)))
1743
(and (not (ustr-cursor-at-end? convr))
1744
(cons preedit-underline
1745
(apply string-append (ustr-latter-seq convr))))
1746
;; (cons preedit-cursor "")
1747
(and (not (ustr-cursor-at-end? word))
1748
(cons preedit-underline
1749
(apply string-append (ustr-latter-seq word)))))))
1751
(define (byeoru-input-state-preedit bc)
1752
(let ((word (byeoru-context-word-ustr bc))
1753
(composing (byeoru-johab-to-utf8-string
1754
(byeoru-automata-composing-char
1755
(byeoru-context-automata bc))))
1756
;; Underlining a composing character leads to a confusing appearance.
1757
;; This should be made customizable.
1759
;; (if (byeoru-context-commit-by-word? bc) preedit-underline 0))
1762
(and (not (ustr-cursor-at-beginning? word))
1763
(cons preedit-underline
1764
(apply string-append (ustr-former-seq word))))
1765
(and (not (string=? composing ""))
1766
(cons preedit-reverse composing))
1767
(and (byeoru-has-preedit? bc)
1768
(cons preedit-cursor ""))
1769
(and (not (ustr-cursor-at-end? word))
1770
(cons preedit-underline
1771
(apply string-append (ustr-latter-seq word)))))))
1773
(define (byeoru-update-preedit bc)
1774
(let ((segments (if (byeoru-context-on bc)
1775
(if (eq? (byeoru-context-mode bc) 'conv)
1776
(byeoru-converting-state-preedit bc)
1777
(byeoru-input-state-preedit bc))
1779
(if (not (equal? segments (byeoru-context-preedit bc)))
1781
(byeoru-context-set-preedit! bc segments)
1782
(context-update-preedit bc segments)))))
1784
(define (byeoru-key-press-handler bc key key-state)
1786
;; (if (char-control? key) ; doesn't seem to work.
1787
;; (im-commit-raw bc)
1789
(if (byeoru-context-on bc)
1790
(if (eq? (byeoru-context-mode bc) 'hangul)
1791
(byeoru-proc-input-state bc key key-state)
1792
(byeoru-proc-other-states bc key key-state))
1793
(byeoru-proc-raw-state bc key key-state))
1797
(byeoru-update-preedit bc))
1799
(define (byeoru-key-release-handler bc key key-state)
1800
(if (or (char-control? key)
1801
(not (byeoru-context-on bc)))
1802
;; don't discard key release event for apps
1803
(im-commit-raw bc)))
1805
;; Check mouse click while composing, converting, etc.
1806
(define (byeoru-reset-handler bc)
1807
;; (ustr-insert-elem! (byeoru-context-word-ustr bc) "R!")
1808
(if (byeoru-context-on bc)
1810
(byeoru-flush-automata bc)
1811
(byeoru-commit bc (byeoru-make-whole-string bc))
1813
(byeoru-update-preedit bc))))
1815
(define (byeoru-get-candidate-handler bc idx accel-enum-hint)
1816
(let* ((cands (byeoru-context-cands bc))
1817
(cand (nth idx cands)))
1820
(list (if (byeoru-context-commit-by-word? bc) "글자단위" "단어단위")
1821
(digit->string (+ idx 1)) ""))
1823
(list (ucs-to-utf8-string cand)
1824
(digit->string (+ idx 1)) ""))
1826
;; What's the use of the last ""?
1827
(list cand (digit->string (+ idx 1)) ""))
1829
(list (car cand) (digit->string (+ idx 1)) ""))
1831
(list (string-append (car cand) " " (cdr cand))
1832
(digit->string (+ idx 1)) "")))))
1834
(define (byeoru-set-candidate-index-handler bc idx)
1835
(case (byeoru-context-mode bc)
1837
(byeoru-context-set-cand-no! bc idx))
1839
(byeoru-context-set-menu-no! bc idx))))
1845
byeoru-im-name-label
1846
byeoru-im-short-desc
1849
#f ; release-handler
1850
context-mode-handler
1851
byeoru-key-press-handler
1852
byeoru-key-release-handler
1853
byeoru-reset-handler
1854
byeoru-get-candidate-handler
1855
byeoru-set-candidate-index-handler
1856
context-prop-activate-handler
added
removed
scm/byeoru.scm
