-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathtc.el
1698 lines (1534 loc) · 57.2 KB
/
tc.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; tc.el --- a Japanese input method with T-Code on Emacs
;; Copyright (C) 1989--2002 Kaoru Maeda, Yasushi Saito and KITAJIMA Akira.
;; Author: Kaoru Maeda <[email protected]>
;; Yasushi Saito <[email protected]>
;; KITAJIMA Akira <[email protected]>
;; Maintainer: KITAJIMA Akira
;; Keyword: input method, japanese
;; $Id: tc.el,v 1.60 2003/03/29 03:42:27 kitajima Exp $
;; This program 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 2 of the License, or
;; (at your option) any later version.
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
;;; Code:
(require 'tc-pre)
(require 'tc-sysdep)
;;
;; Variables for customization
;;
(defcustom tcode-bushu-ready-hook nil
"部首合成変換の初期化直後に実行されるフック。"
:type 'hook :group 'tcode)
(defvar tcode-bushu-on-demand 2
"部首合成変換辞書をいつ初期化するか。
0 : tc.el ロード時
1 : 初めてTコードモードに入ったとき
2 : 部首合成変換を開始したとき、
または文字のヘルプを見ようとしたとき")
(defcustom tcode-use-postfix-bushu-as-default nil
"* nil でないとき、jfで後置型部首合成変換を、77で前置型部首合成変換を行う。
nilの時にはその逆。" :type 'boolean :group 'tcode)
(defcustom tcode-use-prefix-mazegaki nil
"* 前置型(従来型)の交ぜ書き変換の時にt, 後置型(新型)の交ぜ書き変換の時にnil。
前置型では、fjを入力すると、読み入力モードに入り、その中で ' 'を入力すると
変換を行う。後置型では、fjを入力すると、ポイント前にある文字列を使って
変換を行う。"
:type 'boolean :group 'tcode)
(defvar tcode-kuten "。" "* 句点")
(make-variable-buffer-local 'tcode-kuten)
(defvar tcode-touten "、" "* 読点")
(make-variable-buffer-local 'tcode-touten)
(defvar tcode-switch-table-list
'(((tcode-touten . "、")
(tcode-kuten . "。"))
((tcode-touten . ", ")
(tcode-kuten . ". ")))
"テーブル中の変数値を切り替えるための表。")
(defcustom tcode-record-file-name "~/.tc-record"
"* non-nil のとき、Tコードの統計をこのファイルに記録する。"
:type 'string :group 'tcode)
(defcustom tcode-ready-hook nil
"Emacsを立ち上げてから最初にtcode-modeに入ったとき実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-mode-hook nil
"そのバッファで初めてtcode-modeに入ったとき実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-toggle-hook nil
"tcode-modeをトグルする度に実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-before-load-table-hook nil
"`tcode-load-table' によりテーブルを読み込む直前に実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-after-load-table-hook nil
"`tcode-load-table' によりテーブルを読み込む度に実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-before-read-stroke-hook nil
"2ストローク目以降のキーストロークを読む前に実行されるフック。"
:type 'hook :group 'tcode)
(defcustom tcode-clear-hook nil
"デフォールト状態に戻すときに実行されるフック。"
:type 'hook :group 'tcode)
(defvar tcode-auto-zap-table nil
"* non-nil のとき、ストローク表を次の打鍵で自動的に消す。")
(defcustom tcode-auto-help t
"* non-nil のとき、入力した文字のヘルプ表を自動的に表示する。
ただし、表示するのは、交ぜ書き変換や部首合成変換によって直接入力できる漢字を
挿入した場合のみ。
また、値がシンボル delete-the-char のときは、ヘルプを表示し、
さらに最後にヘルプの対象となった文字を消去する。
ただし、`input-method-verbose-flag' が nil でない場合は t となる
ので注意。"
:group 'tcode)
(defvar tcode-auto-remove-help-count nil
"* ヘルプ表を画面から無くすまでに呼ばれる `tcode-auto-remove-help' の回数。
関数 `tcode-auto-remove-help' は、この変数の回数だけ呼ばれると、
ヘルプ表を自動的に削除する。nil の場合は自動削除を行わない。")
(defcustom tcode-adjust-window-for-help nil
"* non-nil のとき、ヘルプを表示するウィンドウの大きさを自動的に調整する。"
:type 'boolean :group 'tcode)
(defcustom tcode-adjust-window-additional-height
(if (and (tcode-mule-4-p)
(= emacs-major-version 21))
1
0)
"* ヘルプを表示するウィンドウの高さに追加する高さ。"
:type 'integer :group 'tcode)
(defcustom tcode-display-help-delay 2
"* 直前の文字を入力してから仮想鍵盤を表示するまでの時間(秒)。
ただし、`input-method-verbose-flag' が nil でない場合は 2 となる
ので注意。"
:group 'tcode)
(defcustom tcode-verbose-message t
"* non-nil のとき、より多くのメッセージを表示する。
ただし、変数 `input-method-verbose-flag' が nil でない場合は、
この変数の値によらず、t が設定されている場合と同じ動作になるので注意。"
:type 'boolean :group 'tcode)
(defvar tcode-shift-lowercase nil
"Tコード入力時のシフトの場合に、大文字ではなく小文字を入力する。")
(defvar tcode-no-wait-display-help-command-list nil
"スペースの入力でヘルプ表のバッファを消す機能を使わないコマンドのリスト。
このリスト中のコマンドでは、 `tcode-display-help-buffer' により
ヘルプが表示された場合に、続けてスペースを入力したときでも
ヘルプ表は消えない。")
(defvar tcode-help-window-height-max 21
"* ヘルプを表示するためのウィンドウの高さの最大値")
(defvar tcode-cancel-stroke-list '(?\C-\? ?\C-h)
"文字入力を明示的に取り消すキーのリスト")
(defvar tcode-verbose-stroke-list '(? )
"文字入力の途中で、今までの入力をすべてそのまま挿入するキーのリスト")
;;
;; Global Variables
;;
(defvar tcode-mode-map nil
"tcode-mode のとき Tコードキー以外のキーのためのキーマップ。
このキーマップに登録するときは、`tcode-set-key'を用いる。
`tcode-key-translation-rule-table' を参照。")
(defvar tcode-key-translation-rule-table
;; 0 1 2 3 4 5 6 7 8 9
;; 10 11 12 13 14 15 16 17 18 19
;; 20 21 22 23 24 25 26 27 28 29
;; 30 31 32 33 34 35 36 37 38 39
;; 1 2 3 4 5 6 7 8 9 0
;; q w e r t y u i o p
;; a s d f g h j k l ;
;; z x c v b n m , . /
;; ! \" # $ % & ' ( ) * + , - . /
;; 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
;; @ A B C D E F G H I J K L M N O
;; P Q R S T U V W X Y Z [ \ ] ^ _
;; ` a b c d e f g h i j k l m n o
;; p q r s t u v w x y z { | } ~
[
-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 37 -1 38 39
09 00 01 02 03 04 05 06 07 08 -1 29 -1 -1 -1 -1
-1 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2
-2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -1 -1 -1 -1 -1
-1 20 34 32 22 12 23 24 25 17 26 27 28 36 35 18
19 10 13 21 14 16 33 11 31 15 30 -1 -1 -1 -1
]
"Tコードキー変換用テーブル。その1文字を入力したときの意味を表す。
0..39: Tコードキー。
-1: その文字。
-2: 対応する英小文字。
-3: `tcode-mode-map' にしたがったコマンド。
< -3: - (文字コード)。")
(defvar tcode-key-num 40
"Tコードで使うキーの数。標準で40。")
(defvar tcode-ext-keys nil
"Tコードキー40以上に対応するキーのリスト")
(defvar tcode-this-command-keys nil
"Tコードでコマンド呼び出しに使ったキーシーケンス(実際のキー)")
;;
;; These variables are set in a table file, e.g. tc-tbl.el.
;;
(defvar tcode-input-method nil "現在選択されている入力法")
(defvar tcode-transparent-mode-indicator nil)
(defvar tcode-tcode-mode-indicator nil)
(defvar tcode-alnum-2byte-tcode-mode-indicator nil)
(defvar tcode-hiragana-mode-indicator nil)
(defvar tcode-katakana-mode-indicator nil)
;;; 以下の変数は、tc-tbl.el などで値が設定され、
;;; 内部テーブル `tcode-table' にその内容が登録される。
(defvar tcode-tbl nil)
(defvar tcode-non-2-stroke-char-list nil)
(defvar tcode-another-table nil
"`tcode-verbose-stroke-list' のキーが押されたときに挿入する文字のテーブル。
値が nil ならばその文字を、vector で指定されていればキーに応じ
概当する文字を挿入する。")
(defvar tcode-special-commands-alist nil)
(defvar tcode-mode-help-string nil
"`tcode-mode-help' によって表示される文字列。
nil のときは `tcode-mode' から得る。")
(defvar tcode-stroke-file-name nil "ストローク表のパス名")
(defvar tcode-special-prefix-alist nil
"ヘルプで特別に扱うプレフィクスストロークのalist
要素は (stroke table-file stroke-to-string-prefix @draw-table-data)")
;;
;; misc. global variables
;;
;;; 入力コードの情報を保持するテーブル
(defvar tcode-table nil "変換に用いる表")
(defvar tcode-stroke-table nil)
(defvar tcode-stroke-table-size 511)
;;; 統計記録用の変数
(defvar tcode-input-chars 0)
(defvar tcode-number-strokes 0)
(defvar tcode-bushu-occurrence 0)
(defvar tcode-mazegaki-occurrence 0)
(defvar tcode-special-occurrence 0)
(defvar tcode-help-char nil "ヘルプの対象文字")
(defvar tcode-auto-remove-help-current-count 0)
(defvar tcode-window-configuration-before-help nil)
(defvar tcode-mode-in-minibuffer nil)
(defvar tcode-dictionaries nil)
;; (バッファ名 . ファイル名)のリスト。
(defconst tcode-stroke-buffer-name " *tcode: stroke*")
(defconst tcode-help-buffer-name "*T-Code Help*")
;;; input-method-verbose-flag 用
(defvar tcode-input-method-verbose-flag nil)
(defvar tcode-orig-auto-help nil)
(defvar tcode-orig-verbose-message nil)
(defvar tcode-orig-display-help-delay nil)
(defvar tcode-use-input-method nil) ; ***experimental***
(defvar tcode-input-filter-functions
'(((or tcode-katakana-mode tcode-shift-state) . japanese-katakana)
((and (boundp 'tcode-bushu-prefix-list)
tcode-bushu-prefix-list)
. tcode-bushu-prefix-convert)
(tcode-alnum-2-byte . tcode-1-to-2)))
(defvar tcode-shift-state nil)
(defvar tcode-input-command-list
'(asm-colon
asm-comment
c-electric-semi&comma
c-electric-slash
canna-self-insert-command
digit-argument
egg-self-insert-command
electric-c-brace
electric-c-semi
electric-c-terminator
electric-perl-terminator
org-self-insert-command
perl-electric-terminator
self-insert-command
sgml-slash
sql-magic-semicolon
sql-magic-go
tcode-electric-comma
tcode-self-insert-command
tcode-mazegaki-self-insert-or-convert)
"*TコードモードのときにはTコード入力に用いるコマンドのリスト。")
;;
;; Buffer Local Variables
;;
(defvar tcode-mode nil "Tコードモードのときt。")
(make-variable-buffer-local 'tcode-mode)
(defvar tcode-ready-in-this-buffer nil "このバッファ内でTコードの準備がOK")
(make-variable-buffer-local 'tcode-ready-in-this-buffer)
(defvar tcode-current-switch-table 0)
(make-variable-buffer-local 'tcode-current-switch-table)
(defvar tcode-alnum-2-byte nil
"英数字のバイト長切り換えフラグ。t では2バイト系、nil で1バイト系。")
(make-variable-buffer-local 'tcode-alnum-2-byte)
(defvar tcode-katakana-mode nil "現在カタカナモードかどうか")
(make-variable-buffer-local 'tcode-katakana-mode)
;;
;; キー配置・キーマップの設定
;;
(defvar tcode-key-layout "qwerty"
"*Tコードを用いるキーの配置。
`tcode-key-layout-list' に登録されている名前を設定する。")
(defvar tcode-key-layout-list
'(("qwerty" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?q ?w ?e ?r ?t ?y ?u ?i ?o ?p
?a ?s ?d ?f ?g ?h ?j ?k ?l ?\;
?z ?x ?c ?v ?b ?n ?m ?, ?. ?/))
("qwerty-jis-shift" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?q ?w ?e ?r ?t ?y ?u ?i ?o ?p
?a ?s ?d ?f ?g ?h ?j ?k ?l ?\;
?z ?x ?c ?v ?b ?n ?m ?, ?. ?/
?! ?\" ?# ?$ ?% ?& ?' ?( ?) ?~
?Q ?W ?E ?R ?T ?Y ?U ?I ?O ?P
?A ?S ?D ?F ?G ?H ?J ?K ?L ?+
?Z ?X ?C ?V ?B ?N ?M ?< ?> ??))
("qwerty-us-shift" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?q ?w ?e ?r ?t ?y ?u ?i ?o ?p
?a ?s ?d ?f ?g ?h ?j ?k ?l ?\;
?z ?x ?c ?v ?b ?n ?m ?, ?. ?/
?! ?\@ ?# ?$ ?% ?^ ?& ?* ?( ?)
?Q ?W ?E ?R ?T ?Y ?U ?I ?O ?P
?A ?S ?D ?F ?G ?H ?J ?K ?L ?:
?Z ?X ?C ?V ?B ?N ?M ?< ?> ??))
("dvorak" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?' ?, ?. ?p ?y ?f ?g ?c ?r ?l
?a ?o ?e ?u ?i ?d ?h ?t ?n ?s
?\; ?q ?j ?k ?x ?b ?m ?w ?v ?z))
("dvorak-shift" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?' ?, ?. ?p ?y ?f ?g ?c ?r ?l
?a ?o ?e ?u ?i ?d ?h ?t ?n ?s
?\; ?q ?j ?k ?x ?b ?m ?w ?v ?z
?! ?\@ ?# ?$ ?% ?^ ?& ?* ?( ?)
?\" ?< ?> ?P ?Y ?F ?G ?C ?R ?L
?A ?O ?E ?U ?I ?D ?H ?T ?N ?S
?: ?Q ?J ?K ?X ?B ?M ?W ?V ?Z)))
"*Tコードを用いるキー配置用のデータ。
具体的には、配列名とキー並びの組のリスト。
キー並びでは、左上から順に、入力される文字を40個または80個並べる。
80個並べた場合、後半の40個は、前半の40個のシフト時の文字として扱う。
コマンド`tcode-set-key-layout'で用いる。")
(defun tcode-set-key-layout (layout)
"Tコードで用いるキー配置を設定する。"
(interactive (let ((layout (completing-read
(format
"キー配置を選択してください。[%s] "
(car (car tcode-key-layout-list)))
tcode-key-layout-list)))
(list layout)))
(let ((table (make-vector (1+ (- ?~ ? )) -1))
(list (assoc layout tcode-key-layout-list)))
(unless list
(if (or (null layout)
(= (length layout) 0))
(unless (setq list (car tcode-key-layout-list))
(error "キー配置(tcode-key-layout-list)が定義されていません。"))
(let ((i 0))
(while (< i 40)
(if (= i 0)
(message "キーボードのキーを左上から順に押してください。")
(message "%d行%d列目>" (/ i 40) (% i 40)))
(setq list (cons (read-char) list)
i (1+ i)))
(setq list (cons layout (nreverse list))))))
(let ((i 0))
(mapcar (lambda (char)
(cond ((null char)
(aset table (- char ? ) -1))
((and tcode-shift-lowercase
(/= (upcase char) char))
(aset table (- char ? ) i)
(aset table (- (upcase char) ? ) -2))
(t
(aset table (- char ? ) i)))
(setq i (1+ i))
(if (= i 40) (setq i 100)))
(cdr list)))
(let ((char ? ))
(while (<= char ?~)
(if (lookup-key tcode-mode-map (char-to-string char))
(aset table (- char ? ) -3))
(setq char (1+ char))))
(let ((l tcode-ext-keys)
(i 40))
(while l
(if (car l)
(aset table (- (car l) ? ) i))
(setq i (1+ i)
l (cdr l))))
(setq tcode-key-layout layout)
(setq tcode-key-translation-rule-table table)
list))
(defun tcode-set-key (key func &optional type)
"Tコードモードのキーを設定する。
引数は次のとおり。
KEY ... 設定するキー。string、char、vector のいずれか。
FUNC ... TYPE がコマンドの場合の関数名。 TYPE が 'command または -3 以外の
場合は意味を持たない。(nil にしておけばよい)
TYPE ... 機能の種類。(変数 `tcode-key-translation-rule-table' 参照)
省略時は、FUNC が nil のとき 'literal で、そうでないときは
'command。
以下のシンボルも使える。
literal その文字。
lowercase 対応する英小文字。
command tcode-mode-map にしたがったコマンド。"
(interactive (list (progn
(message "Tコードモードで設定を行うキーは? ")
(setq key (read-char)))
(read-command (format "「%c」に割り当てるコマンドは? "
key))
prefix-arg))
;; type
(cond ((null type)
(setq type (if (if (called-interactively-p 'interactive) (commandp func) func)
-3 -1)))
((integerp type))
((eq type 'literal)
(setq type -1))
((eq type 'lowercase)
(setq type -2))
((eq type 'command)
(setq type -3))
(t
(error "TYPE がおかしい。")))
;; key
(cond ((char-or-string-p key)
(or (stringp key)
(setq key (char-to-string key))))
((vectorp key)
(setq key (char-to-string (aref key 0))))
(t
(error "KEY がおかしい。")))
;; set keymap address
(let ((addr (string-to-char key)))
(if (and (>= addr ? )
(<= addr ?~))
(when (> 0 (aref tcode-key-translation-rule-table (- addr ? )))
(aset tcode-key-translation-rule-table (- addr ? ) type))
(error "「%s」には割り当てられません。" key)))
;; set key binding
(define-key tcode-mode-map key (and (= type -3)
func)))
(unless tcode-mode-map
(setq tcode-mode-map (make-sparse-keymap))
(tcode-set-key "?" 'tcode-mode-help)
;; tcode-mode のときに、「|」で登録・変換
(tcode-set-key "|" 'tcode-mazegaki-make-entry-and-finish)
;; tcode-mode のときに、「!」で削除
(tcode-set-key "!" 'tcode-mazegaki-delete-entry-by-last-yomi)
;; tcode-mode のときに、「=」で補完・確定
(tcode-set-key "=" 'tcode-mazegaki-complete-and-convert))
(defun tcode-substitute-command-keys (string)
"`substitute-command-keys' を `tcode-mode-map' のもとで適用する。"
(let ((orig-map (current-local-map)))
(prog2
(use-local-map tcode-mode-map)
(substitute-command-keys string)
(use-local-map orig-map))))
(defun tcode-key-to-char (key)
"キーの番号から対応する文字を得る。"
(let ((max (length tcode-key-translation-rule-table))
(i 0))
(catch 'found
(while (< i max)
(if (= key (aref tcode-key-translation-rule-table i))
(throw 'found t))
(setq i (1+ i))))
(+ i ? )))
(defun tcode-char-to-key (c)
"Return virtual key code of character C.
See also `tcode-key-translation-rule-table'."
(if (or (< c ? ) (> c ?~))
-1
(aref tcode-key-translation-rule-table (- c ? ))))
;;
;; T-Code main
;;
(defun tcode-on-p ()
"Tコードモードがオンになっているかどうかを返す。"
(if (window-minibuffer-p (selected-window))
tcode-mode-in-minibuffer
tcode-mode))
(defun tcode-decode (strokes &optional table trace)
"Decode STROKES with TABLE.
TABLE defaults `tcode-table'.
TRACE is a sub-stroke-sequence that has already been processed for decoding.
Return (status . value) where:
STATUS VALUE
complete decoded value
incomplete sub-table
out-of-table sub-strokes on table"
(let* ((key (car strokes))
(table (or table
tcode-table))
(val (cond ((null table)
nil)
((vectorp table)
(and (< key (length table))
(aref table key)))
((and (consp table)
(not (eq (car table) 'lambda)))
(if (integerp (car table))
(if (= key (car table))
(cdr table))
(cdr (assq key table))))
(t
nil))))
(if (null val)
(cons 'out-of-table (nreverse trace))
(let ((cont-strokes (cdr strokes)))
(if cont-strokes
(tcode-decode cont-strokes val (cons key trace))
(cons (if (or (vectorp val)
(and (consp val)
(not (eq (car val) 'lambda))))
'incomplete
'complete)
(if (and (symbolp val)
(boundp val))
(eval val)
val)))))))
(defun tcode-default-key-binding (key)
"Return the binding for command KEY in non-tcode-mode."
(let (tcode-mode)
(key-binding key)))
(defun tcode-decode-chars (c &optional table trace)
"Decode C with TABLE.
Read characters if need.
TABLE defaults `tcode-table'.
TRACE is a sub-character-sequence that has already been processed for decoding.
Return value:
cons of (decoded value . character sequence)
where decoded value is one of:
char or string or function (symbol or lambda) ... code
nil ... no corresponding code
t ... cancel"
(let ((key (tcode-char-to-key c)))
(if (< key 0)
;; C is not a key on TABLE
(cons
(cond ((and trace
(memq c tcode-cancel-stroke-list))
t)
((and trace
(memq c tcode-verbose-stroke-list))
(let ((rval (and tcode-another-table
(tcode-decode (mapcar 'tcode-char-to-key
(nreverse trace))
tcode-another-table))))
(or (cdr rval)
(mapconcat 'char-to-string (nreverse trace) nil))))
((= key -1)
c)
((= key -2)
(downcase c))
((= key -3)
(lookup-key tcode-mode-map (char-to-string c)))
(t
(- key)))
(nreverse (cons c trace)))
;; C is a key on TABLE
(if (>= key 100)
(setq tcode-shift-state t
key (mod key 100)))
(let* ((rval (tcode-decode (list key) table))
(status (car rval))
(val (cdr rval)))
(cond ((eq status 'complete)
(cons val (nreverse (cons c trace))))
((eq status 'incomplete)
(setq tcode-number-strokes (1+ tcode-number-strokes))
(run-hooks 'tcode-before-read-stroke-hook)
(let ((show-table (sit-for tcode-display-help-delay)))
(unwind-protect
(let ((echo-keystrokes 0))
(if show-table
(tcode-display-help-buffer
(tcode-draw-current-table val)
t))
(condition-case nil
(tcode-decode-chars (read-char) val (cons c trace))
(t (cons t (nreverse trace)))))
(if show-table
(tcode-auto-remove-help t)))))
(t
nil))))))
(defun tcode-eval-action (action)
(cond ((null action)
(ding)
nil)
((eq action t)
(setq this-command 'keyboard-quit) ; dummy
nil)
((stringp action)
(string-to-list action))
((char-or-string-p action)
(list action))
(t
(undo-boundary)
(if (commandp action)
(progn
;; コマンドの実行
(setq prefix-arg current-prefix-arg
this-command action)
(command-execute action))
;; コマンドでない関数の実行
(funcall action)
(setq this-command 'lambda)) ; dummy
(setq tcode-special-occurrence
(1+ tcode-special-occurrence))
nil)))
(defun tcode-apply-filters (list)
(mapcar (lambda (alist)
(if (eval (car alist))
(let ((v (mapcar (lambda (c) (funcall (cdr alist) c))
list)))
(setq list (apply 'nconc
(mapcar (lambda (e) (if (stringp e)
(string-to-list e)
(list e)))
v))))))
tcode-input-filter-functions)
list)
(defun tcode-input-method (ch)
"The input method function for T-Code."
(setq last-command 'self-insert-command
last-command-event ch)
(if input-method-verbose-flag
(unless tcode-input-method-verbose-flag
;; push some variables' values
(setq tcode-orig-auto-help tcode-auto-help
tcode-orig-verbose-message tcode-verbose-message
tcode-orig-display-help-delay tcode-display-help-delay)
;; set new values
(setq tcode-auto-help t
tcode-verbose-message t
tcode-display-help-delay 2
tcode-input-method-verbose-flag t))
(if tcode-input-method-verbose-flag
;; pop pushed values
(setq tcode-auto-help tcode-orig-auto-help
tcode-verbose-message tcode-orig-verbose-message
tcode-display-help-delay tcode-orig-display-help-delay
tcode-input-method-verbose-flag nil)))
(let ((command (tcode-default-key-binding (char-to-string ch))))
(if (or (and (boundp 'overriding-terminal-local-map)
overriding-terminal-local-map)
(and (boundp 'overriding-local-map)
overriding-local-map)
(eq this-command 'quoted-insert)
(not (memq command tcode-input-command-list))
(not (tcode-on-p)))
;; pass input-method
(list ch)
;; prosess as input-method
(setq tcode-number-strokes (1+ tcode-number-strokes))
(catch 'cancel
(setq tcode-shift-state nil)
(let ((result (let ((input-method-function) ; disable
decoded evaled)
(setq decoded (tcode-decode-chars ch)
tcode-this-command-keys (cdr decoded)
evaled (tcode-eval-action (car decoded)))
(if evaled
(tcode-apply-filters evaled)
(throw 'cancel nil)))))
(if (and result
(car result))
(setq tcode-input-chars (+ tcode-input-chars (length result))
tcode-help-char (char-to-string (car (reverse result)))))
(if (not (tcode-on-p)) ; if T-Code is disabled with a command
; execution
(setq input-method-function nil))
result)))))
(defun tcode-insert (ch)
"CHをバッファに挿入する。"
(unless (stringp ch)
(setq ch (char-to-string ch)))
(let* ((p (point))
(arg (prefix-numeric-value current-prefix-arg))
(n (if (consp current-prefix-arg)
(/ (car current-prefix-arg) 2)
arg)))
(while (> n 0)
(insert ch)
(setq n (1- n)))
(if overwrite-mode
(let ((str (buffer-substring p (point))))
(delete-text-in-column nil (+ (current-column)
(string-width str)))))
(if (and (boundp 'self-insert-after-hook)
self-insert-after-hook)
(funcall self-insert-after-hook p (point)))
(tcode-do-auto-fill)
(run-hooks 'input-method-after-insert-chunk-hook)))
;;
;; 2バイト英数字
;;
(defvar tcode-alnum-1-to-2-table
(concat " ！”＃＄％＆’（）＊＋，−．／０１２３４５６７８９：；＜＝＞？"
"＠ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ［¥］＾＿"
"‘ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ｛｜｝‾")
"1バイト英数字 ' '..'~' を2バイト英数字へ変換/逆変換するためのテーブル")
(defun tcode-toggle-alnum-mode ()
(interactive)
(setq tcode-alnum-2-byte (not tcode-alnum-2-byte))
(tcode-mode-line-redisplay))
(defun tcode-check-alnum-1-to-2-table ()
(if (stringp tcode-alnum-1-to-2-table)
(setq tcode-alnum-1-to-2-table
(vconcat (string-to-list tcode-alnum-1-to-2-table)))))
(defun tcode-1-to-2-region (beg end)
"リージョン内の1バイト英数字を2バイトに変換する。"
(interactive "*r")
(tcode-check-alnum-1-to-2-table)
(save-excursion
(save-restriction
(goto-char beg)
(narrow-to-region beg end)
(let (char)
(while (progn (skip-chars-forward "^!-~" (point-max))
(< (point) (point-max)))
(setq char (following-char))
(tcode-delete-char 1)
(insert (char-to-string (tcode-1-to-2 char))))))))
(defun tcode-1-to-2 (char)
"1バイト英数字CHARを2バイトに変換する。"
(tcode-check-alnum-1-to-2-table)
(if (and (<= ?! char) (<= char ?~))
(aref tcode-alnum-1-to-2-table (- char ? ))
char))
(defun tcode-2-to-1-region (beg end)
"リージョン内の2バイト英数字を1バイトに変換する。"
(interactive "*r")
(tcode-check-alnum-1-to-2-table)
(save-excursion
(save-restriction
(goto-char beg)
(narrow-to-region beg end)
(let ((alnum-2byte-regexp (concat "["
(mapconcat 'char-to-string
tcode-alnum-1-to-2-table
nil)
"]+"))
str)
(while (re-search-forward alnum-2byte-regexp nil t)
(setq str (buffer-substring (match-beginning 0) (match-end 0)))
(delete-region (match-beginning 0) (match-end 0))
(insert (mapconcat (lambda (c)
(char-to-string (tcode-2-to-1 c)))
(string-to-list str)
nil)))))))
(defun tcode-2-to-1 (char)
"2バイト英数字CHARを1バイトに変換する。"
(tcode-check-alnum-1-to-2-table)
(let ((ch 0))
(catch 'found
(while (< ch 95)
(if (= (aref tcode-alnum-1-to-2-table ch) char)
(throw 'found (+ ch 32)))
(setq ch (1+ ch)))
char)))
;;
;; コード表
;;
(defun tcode-switch-variable (&optional arg)
"(`tcode-table' 中の) 変数の値を切り替える。
切り替える変数とその値は `tcode-switch-table-list' で指定する。
ARG が nil でないとき、ARG 番目の組に切り替える。"
(interactive "P")
(message
(mapconcat
'identity
(mapcar
(lambda (elm)
(set (car elm) (cdr elm)))
(let ((table (nth (setq tcode-current-switch-table
(if arg
(1- (prefix-numeric-value arg))
(1+ tcode-current-switch-table)))
tcode-switch-table-list)))
(unless table
(setq tcode-current-switch-table 0
table (car tcode-switch-table-list)))
table))
nil)))
(defun tcode-function-p (obj)
(cond ((or (null obj)
(arrayp obj))
nil)
((symbolp obj)
(fboundp obj))
((consp obj)
(eq (car obj) 'lambda))
(t
nil)))
(defun tcode-put-stroke-property (value strokes &optional without-overwrite)
(cond ((char-or-string-p value)
(let ((str (if (stringp value)
value
(char-to-string value))))
(when strokes
(if (not without-overwrite)
;; remove old property
(tcode-put-stroke-property
(cdr (tcode-decode (append strokes nil)))
nil
without-overwrite)))
(put (intern str tcode-stroke-table) 'stroke strokes)))
((and (symbolp value)
(boundp value))
(let ((value (eval value)))
(if (char-or-string-p value)
(tcode-put-stroke-property value strokes without-overwrite))))))
(defun tcode-set-stroke-property (table strokes &optional
without-overwrite prefix)
(cond ((or (null table)
(tcode-function-p table)))
((char-or-string-p table)
(tcode-put-stroke-property table (vconcat prefix strokes)
without-overwrite))
((consp table)
(mapcar (lambda (ent)
(tcode-set-stroke-property (cdr ent)
(append strokes
(list (car ent)))
without-overwrite prefix))
table))
((vectorp table)
(let ((i 0))
(while (< i (length table))
(tcode-set-stroke-property (aref table i)
(append strokes (list i))
without-overwrite prefix)
(setq i (1+ i)))))
((and (symbolp table)
(boundp table))
(tcode-set-stroke-property (eval table) strokes
without-overwrite prefix))))
;; pointer := symbol | (vector . pos) | (key . value)
(defun tcode-pointer-ref (pointer)
(cond ((symbolp pointer)
(symbol-value pointer))
((and (consp pointer) (vectorp (car pointer)))
(aref (car pointer) (cdr pointer)))
(t (cdr pointer))))
(defun tcode-pointer-set (pointer value)
(cond ((symbolp pointer)
(set pointer value))
((and (consp pointer) (vectorp (car pointer)))
(aset (car pointer) (cdr pointer) value))
(t (setcdr pointer value))))
(defun tcode-set-action (table-pointer strokes value)
"TABLE-POINTER 中の、キー入力 STROKES に相当する所に VALUE を設定する。"
(let ((table (tcode-pointer-ref table-pointer))
(key (car strokes)))
(unless (consp strokes)
(error "STROKES must be a non-null list: %s" strokes))
(unless (natnump key)
(error "KEY must be a non-negative integer: %s" key))
(unless (< key tcode-key-num)
(error "KEY must be less than %s: %s" tcode-key-num key))
(if (vectorp table)
(progn
(unless (< key (length table))
(setq table (vconcat table (make-vector (- key -1 (length table))
nil)))
(tcode-pointer-set table-pointer table))
(if (null (cdr strokes))
(aset table key value)
(tcode-set-action (cons table key) (cdr strokes) value)))
(let ((cell (assq key table)))
(unless cell
(setq cell (list key))
(tcode-pointer-set table-pointer (cons cell table)))
(if (null (cdr strokes))
(setcdr cell value)
(tcode-set-action cell (cdr strokes) value))
))))
(defun tcode-set-action-to-table (strokes value)
"コード入力用の内部テーブルに入力列 STROKES に対する VALUE を設定する。
動作(VALUE)として指定できるのは以下のとおり。
- コマンド (symbol) そのコマンドを実行する。
- 関数 (symbol, lambda式) その関数を引数なしで呼ぶ。
- 変数 (symbol) 評価した結果の動作を行う。
- 表 (vector) 更にその表に従った動作を行う。
- リスト (list) 更にそのリストに従った動作を行う。
- 文字列 (string) その文字列を挿入する。
- 文字 (char) その文字を挿入する。
入力列はキーの番地のリストまたはキーの番地。
キーの番地を指定すると、最後に SPC を押したときの動作を設定する。"
(cond ((consp strokes)
(tcode-set-stroke-property value strokes)
(tcode-set-action 'tcode-table strokes value))
((and (char-or-string-p strokes)
(not (stringp strokes)))
(unless tcode-another-table
(setq tcode-another-table (make-vector (max 40 strokes) nil)))
(aset tcode-another-table strokes value))
((null strokes)
(setq tcode-table value))
(t
(error "入力列の指定が無効です。"))))
(defun tcode-load-table-1 (filename &optional prefix)
(let ((k1 0) k2 newval char new-table)
(load filename)
(setq new-table (make-vector 40 nil))
(while (< k1 40)
(aset new-table k1 (make-vector 40 nil))
(setq k1 (1+ k1)))
(setq k1 0)
(while (< k1 40)
(let ((v (aref tcode-tbl k1)))
(if (null v)
()
(setq newval (vconcat (delq ? (string-to-list v))))
(unless (= (length newval) 40)
(error "Table corrupted at line %d." (1+ k1)))
(setq k2 0)
(while (< k2 40)
(unless (memq (setq char (aref newval k2))
tcode-non-2-stroke-char-list)