-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathtc-mazegaki.el
1698 lines (1579 loc) · 60.6 KB
/
tc-mazegaki.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-mazegaki.el --- mazegaki conversion in T-Code
;; Copyright (C) 1996--2003 Kaoru Maeda, Yasushi Saito and KITAJIMA Akira.
;; Author: Kaoru Maeda <[email protected]>
;; Yasushi Saito <[email protected]>
;; KITAJIMA Akira <[email protected]>
;; Maintainer: KITAJIMA Akira
;; Created: 30 Apr 1996
;; Version: $Id: tc-mazegaki.el,v 1.38 2003/05/18 08:46:08 kitajima Exp $
;; Keywords: wp, japanese, input method
;; 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)
(defgroup mazegaki-conversion nil
"交ぜ書き変換"
:group 'tcode)
;;; カスタマイズできる変数
(defvar tcode-mazegaki-selected-candidate-register ?\[
"* 交ぜ書き変換で最後に確定した文字列を保存しておくレジスタ。
nil の場合には保存されない。")
(defvar tcode-mazegaki-dictionary-name "mazegaki.dic"
"交ぜ書き変換辞書のファイル名。")
(defconst tcode-mazegaki-buffer-name " *tcode: mazegaki dictionary*")
;; 交ぜ書き辞書のバッファ名
(unless (assq tcode-mazegaki-buffer-name tcode-dictionaries)
(setq tcode-dictionaries (cons (cons tcode-mazegaki-buffer-name
tcode-mazegaki-dictionary-name)
tcode-dictionaries)))
(defcustom tcode-mazegaki-yomi-max 10 "* 交ぜ書き変換の読みの最大文字数。"
:group 'mazegaki-conversion)
(defvar tcode-mazegaki-terminate-char-list
(mapcar (lambda (ch) (tcode-string-to-char ch))
'("、" "。" "，" "．" "・" "「" "」" "（" "）"))
"* 交ぜ書き変換の読みに含まれない2バイト文字のリスト。")
(defcustom tcode-mazegaki-init-hook nil
"* 最初に tc-mazegaki.el をロードするときに呼ばれる hook。"
:type 'hook :group 'mazegaki-conversion)
(defvar tcode-mazegaki-command-summary-alist
'(("縮める" . tcode-mazegaki-relimit-left)
("伸ばす" . tcode-mazegaki-relimit-right)
("確定" . tcode-mazegaki-finish)
("戻す" . tcode-mazegaki-restore-yomi-and-quit)
("一覧" . tcode-mazegaki-table-mode)
("次表または縮め" . tcode-mazegaki-select-candidate-or-relimit)
("登録&確定" . tcode-mazegaki-make-entry-and-finish))
"* `tcode-mazegaki-command-summary' で表示される機能の alist。")
(defvar tcode-mazegaki-enable-inflection t
"* nil でないとき、可変語尾変換ができる。")
(defvar tcode-mazegaki-prefix-mark
(if (or (tcode-nemacs-p)
(tcode-mule-1-p)
(and (boundp 'window-system)
(not window-system)))
(if (fboundp 'make-glyph)
(make-glyph "△")
"△")
nil)
"* 交ぜ書き変換の始点を表すしるし。")
(defvar tcode-mazegaki-face
(if (or (tcode-nemacs-p)
(tcode-mule-1-p)
(and (boundp 'window-system)
(not window-system)))
nil
(prog1
(make-face 'mazegaki-conversion)
(set-face-underline-p 'mazegaki-conversion t)))
"* 交ぜ書き変換の変換対象を表す文字列に用いるface。
mule2 以上または XEmacs の場合のみ有効。")
(defvar tcode-mazegaki-prefix-overlay nil)
(defvar tcode-mazegaki-stroke-priority-list
; キー配置
; 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
'(22 23 21 24 20
12 13 11 14 10
27 26 28 25 29
17 16 18 15 19)
"* 候補を並べるときの位置。
このリストにないキーは使用されない。")
(defvar tcode-mazegaki-alternative-select-first-keys
'(22)
"* 候補を二つの中から一つ選ぶ場合の、左側(第1候補)を選ぶキーのリスト。")
(defvar tcode-mazegaki-alternative-select-second-keys
'(23)
"* 候補を二つの中から一つ選ぶ場合の、右側(第2候補)を選ぶキーのリスト。")
(defvar tcode-mazegaki-complete-max 10
"* 補完の際に扱う候補の数の最大値。
候補がこの値以上なら補完は行わない。")
(defconst tcode-mazegaki-inflection-mark "—"
"読みが活用する場合に、活用語尾を表すためにつける文字列。")
(defvar tcode-mazegaki-max-suffix-length 4
"* 読みの中の活用語尾の最大文字数。")
(defcustom tcode-mazegaki-fixed-priority-count 4
"* 学習するときに、学習の対象外となる候補の数。
現在の読みについて、選択された候補の順番がこの数以下ならば、学習されない。"
:group 'mazegaki-conversion)
(defcustom tcode-mazegaki-inline-candidate-count 0
"* 候補が複数あっても、第1候補をインライン表示する回数"
:group 'mazegaki-conversion)
(defvar tcode-mazegaki-splitter "|"
"* 登録の際の、読みおよび漢字の区切りを表す正規表現")
;;; その他の変数
(defvar tcode-mazegaki-yomi-list nil
"変換開始時点でカーソルより前にあった文字のリスト。
カーソルの直前の文字が car、その前が cadr、以下同様。
最大 `tcode-mazegaki-yomi-max' 文字まで。")
(defvar tcode-mazegaki-current-yomi-length 0
"現在変換対象となっている文字列の長さ。
\(length tcode-mazegaki-yomi-list\)以下である。")
(defvar tcode-mazegaki-current-offset 0
"`tcode-mazegaki-yomi-list' の何番目の文字から読みとみなすか。")
(defvar tcode-mazegaki-current-yomi-point nil)
(defvar tcode-mazegaki-yomi-fixed nil
"可変長読み変換中ならば nil、そうでないなら t。
つまり、「fj」を前置して読みが入力された場合にはこの変数の値は t であり、
それ以外の場合は nil である。")
(defvar tcode-mazegaki-map nil "交ぜ書き変換中のキーマップ。")
(defvar tcode-mazegaki-mode nil "交ぜ書き変換中かどうかを表す変数。
実際には、交ぜ書き変換対象の先頭のポイントを保持している。")
(make-variable-buffer-local 'tcode-mazegaki-mode)
(defvar tcode-mazegaki-prefix nil)
(make-variable-buffer-local 'tcode-mazegaki-prefix)
(defvar tcode-mazegaki-suffix ""
"変換の対象外となる接尾語。")
(defvar tcode-mazegaki-conversion-overlay nil
"交ぜ書き変換の変換対象を表す overlay。")
(make-variable-buffer-local 'tcode-mazegaki-conversion-overlay)
(defvar tcode-mazegaki-inflection-only nil
"活用変換中かどうか。")
(defvar tcode-mazegaki-with-inflection nil
"活用する読みを変換対象としているかどうか。")
(defvar tcode-mazegaki-candidate-state nil
"交ぜ書き候補表示ステート。
'next 次候補表示のための中間状態
'one 候補がひとつしかなくインライン表示中
'priority 複数候補の最初の方をインライン表示中
'table 表形式で選択中
変換開始(変換直後または読み長さ変更直後)
→ 候補数によってoneまたはnext
next
candidate-indexが候補数より小さくかつ
inline-candidate-countより小さい
→ priority
else
→ table
one
SPC入力
→ 縮め
= 入力
→ one
priority
SPC入力
→ candidate-index++し、next
= 入力
→ table
table
SPC入力
→ 次ページ
")
(defvar tcode-mazegaki-candidate-index nil
"priorityステートでインライン表示中の候補は何番目か(0オリジン)。
See also variable `tcode-mazegaki-candidate-state'.")
(defvar tcode-mazegaki-start-marker nil)
(make-variable-buffer-local 'tcode-mazegaki-start-marker)
;;;; 辞書の検索と変換
(cond ((or (tcode-nemacs-p) (tcode-mule-1-p))
(defun tcode-mazegaki-delete-conversion-face ()
(if tcode-mazegaki-prefix-overlay
(save-excursion
(goto-char tcode-mazegaki-prefix-overlay)
(if (looking-at (regexp-quote tcode-mazegaki-prefix-mark))
(delete-char 1))))
(setq tcode-mazegaki-prefix-overlay nil))
(defun tcode-mazegaki-put-conversion-face ()
(let ((point (or tcode-mazegaki-mode
tcode-mazegaki-prefix)))
(when point
(save-excursion
(goto-char point)
(tcode-mazegaki-delete-conversion-face)
(setq tcode-mazegaki-prefix-overlay (point))
(insert tcode-mazegaki-prefix-mark))))))
((tcode-xemacs-p)
(defun tcode-mazegaki-put-conversion-face ()
"変換開始位置から point までを指定された face にする。
face の指定は変数 `tcode-mazegaki-prefix-mark' を設定することにより行う。"
(let ((point (or tcode-mazegaki-mode
tcode-mazegaki-prefix)))
(when point
(when tcode-mazegaki-prefix-mark
(setq tcode-mazegaki-prefix-overlay
(if (extentp tcode-mazegaki-prefix-overlay)
(set-extent-endpoints tcode-mazegaki-prefix-overlay
point
point)
(make-extent point point)))
(set-extent-begin-glyph tcode-mazegaki-prefix-overlay
tcode-mazegaki-prefix-mark))
(if (extentp tcode-mazegaki-conversion-overlay)
(set-extent-endpoints tcode-mazegaki-conversion-overlay
point
(point))
(setq tcode-mazegaki-conversion-overlay
(make-extent point (point)))
(set-extent-face tcode-mazegaki-conversion-overlay
tcode-mazegaki-face)))))
(defun tcode-mazegaki-delete-conversion-face ()
"交ぜ書き変換用の face と prefix を除く。"
(if (extentp tcode-mazegaki-prefix-overlay)
(detach-extent tcode-mazegaki-prefix-overlay))
(if (extentp tcode-mazegaki-conversion-overlay)
(detach-extent tcode-mazegaki-conversion-overlay))))
(t
(unless (fboundp 'make-overlay)
(require 'overlay))
;; face により変換対象領域を表示するための関数の定義
(defun tcode-mazegaki-put-conversion-face ()
"変換開始位置から point までを指定された face にする。
face の指定は変数 `tcode-mazegaki-face' を設定することにより行う。
変数 `tcode-mazegaki-prefix-mark' が設定されていれば、その文字列を
先頭に置く。"
(let ((point (or tcode-mazegaki-mode
tcode-mazegaki-prefix)))
(when point
;; prefix を置く。
(when tcode-mazegaki-prefix-mark
(setq tcode-mazegaki-prefix-overlay
(if (overlayp tcode-mazegaki-prefix-overlay)
(move-overlay tcode-mazegaki-prefix-overlay
point
point)
(make-overlay point point)))
(overlay-put tcode-mazegaki-prefix-overlay
'before-string
tcode-mazegaki-prefix-mark))
;; face を設定する。
(if (overlayp tcode-mazegaki-conversion-overlay)
(move-overlay tcode-mazegaki-conversion-overlay point (point))
(setq tcode-mazegaki-conversion-overlay
(make-overlay point (point)))
(overlay-put tcode-mazegaki-conversion-overlay
'face
tcode-mazegaki-face)))))
(defun tcode-mazegaki-delete-conversion-face ()
"交ぜ書き変換用の face と prefix を除く。"
(if (overlayp tcode-mazegaki-prefix-overlay)
(delete-overlay tcode-mazegaki-prefix-overlay))
(if (overlayp tcode-mazegaki-conversion-overlay)
(delete-overlay tcode-mazegaki-conversion-overlay)))))
;;;###autoload
(defun tcode-mazegaki-switch-to-dictionary ()
"current-buffer を交ぜ書き辞書に切り替える。
交ぜ書き辞書がまだ読み込まれていない場合には読み込む。"
(interactive)
(let ((buffer (tcode-set-work-buffer tcode-mazegaki-buffer-name
tcode-mazegaki-dictionary-name)))
(if (interactive-p)
(switch-to-buffer buffer))))
(defun tcode-mazegaki-construct-yomi (len &optional offset inflection)
"`tcode-mazegaki-yomi-list' から、長さ LEN の読みを作る。
OFFSET が指定されている場合は、OFFSET 文字は活用語尾とし、読みには含めず、
INFLECTION が nil でなければ `tcode-mazegaki-inflection-mark' で置き換える。"
(let ((list (mapcar 'cdr
(if offset
(nthcdr offset tcode-mazegaki-yomi-list)
tcode-mazegaki-yomi-list)))
(str ""))
(while (> len 0)
(setq str (concat (car list) str)
list (cdr list)
len (1- len)))
(if inflection
(concat str tcode-mazegaki-inflection-mark)
str)))
(defun tcode-mazegaki-list-to-string (list from len)
"文字の LIST の FROM から LEN 文字分の文字列を作る。"
(let ((str ""))
(setq list (nthcdr from list))
(while (> len 0)
(setq str (concat (cdr (car list)) str)
list (cdr list)
len (1- len)))
str))
(defun tcode-mazegaki-get-reverse-yomi-list ()
"現 point より後方にある日本語列または英単語一つのリストを返す。
リストの長さは最大 `tcode-mazegaki-yomi-max' 文字。"
(setq tcode-mazegaki-suffix ""
tcode-mazegaki-yomi-fixed tcode-mazegaki-mode)
(save-excursion
(let (context reverse-list)
(catch 'finish
(while (and (< (length reverse-list)
tcode-mazegaki-yomi-max)
(setq context
(tcode-scan-backward
1 tcode-mazegaki-terminate-char-list)))
(let ((ch (cdr (car context)))
(point (car (car context))))
(if (and reverse-list
(or (= (point) point)
(>= (count-lines point (point)) (if (bolp) 2 3))))
(throw 'finish nil))
(if (and (null reverse-list)
(memq (tcode-string-to-char ch)
tcode-mazegaki-terminate-char-list))
;; `tcode-mazegaki-terminate-char-list' にある文字をとばす。
(setq tcode-mazegaki-suffix
(concat ch tcode-mazegaki-suffix))
;; 読みを1字得る
(setq reverse-list (cons (car context) reverse-list))
(if (and tcode-mazegaki-prefix
(= point tcode-mazegaki-prefix))
(throw 'finish nil)))
(goto-char point))))
(nreverse reverse-list))))
(defun tcode-mazegaki-search-yomi (yomi)
"現在のバッファから YOMI を見つけ、 point を移動する。
見つからない場合は、 point はその YOMI があるべき場所に移動する。"
(let ((min (point-min))
(max (point-max))
str)
(catch 'found
(and (eobp)
(forward-line -1))
(while (< min max)
(beginning-of-line)
(cond ((string< (setq str (buffer-substring
(point)
(progn
(while (/= (tcode-following-char) ?/)
(tcode-forward-char 1))
(1- (point)))))
yomi)
;; もっと大きい
(forward-line 1)
(goto-char (ash (+ (setq min (point)) max) -1)))
((string< yomi str)
;; もっと小さい
(beginning-of-line)
(goto-char (ash (+ min (setq max (point))) -1)))
;; 見つけた
(t
(beginning-of-line)
(throw 'found (point))))))))
(defun tcode-mazegaki-lookup (new)
"現在の読みより短い最長の読みを探す。
NEW が nil でなければ、新しく探し始める。
見つかればその読みの長さおよび offset (常に 0) を、なければ nil を返す。
交ぜ書き辞書のポイントはその読みのところに移動する。"
(save-excursion
(setq tcode-mazegaki-with-inflection nil)
(tcode-mazegaki-switch-to-dictionary)
(let* ((max (length tcode-mazegaki-yomi-list))
(min (if tcode-mazegaki-yomi-fixed (1- max) 0))
(i (if new max (1- tcode-mazegaki-current-yomi-length))))
(catch 'found
(while (> i min)
(when (tcode-mazegaki-search-yomi (tcode-mazegaki-construct-yomi i))
(setq tcode-mazegaki-current-yomi-point (point))
(throw 'found (cons (car (nth (1- i) tcode-mazegaki-yomi-list))
(cons i 0))))
(setq i (1- i)))))))
(defun tcode-mazegaki-lookup-with-inflection (new)
"現在の読みより短い、活用する最長の読みを探す。
NEW が nil でなければ、新しく探し始める。
見つかればその読みの長さおよび offset を、なければ nil を返す。
交ぜ書き辞書のポイントはその読みのところに移動する。"
(save-excursion
(setq tcode-mazegaki-with-inflection t)
(tcode-mazegaki-switch-to-dictionary)
(let* ((max (length tcode-mazegaki-yomi-list))
(min 0)
(i (if new max tcode-mazegaki-current-yomi-length))
(offset (cond (new
(cond ((>= (+ i tcode-mazegaki-max-suffix-length)
max)
(- max i))
(tcode-mazegaki-yomi-fixed
-1)
(t
tcode-mazegaki-max-suffix-length)))
(tcode-mazegaki-yomi-fixed
-1)
(t
(1- tcode-mazegaki-current-offset)))))
(catch 'found
(while (> i min)
(while (>= offset 0)
(and (string-match "^[ぁ-ン]*$"
(tcode-mazegaki-construct-yomi offset))
(tcode-mazegaki-search-yomi
(tcode-mazegaki-construct-yomi i offset t))
(setq tcode-mazegaki-current-yomi-point (point))
(throw 'found (cons (car (nth (1- (+ i offset))
tcode-mazegaki-yomi-list))
(cons i offset))))
(setq offset (if tcode-mazegaki-yomi-fixed -1 (1- offset))))
(setq i (1- i)
offset (cond ((>= (+ i tcode-mazegaki-max-suffix-length)
max)
(- max i))
(tcode-mazegaki-yomi-fixed
-1)
(t
tcode-mazegaki-max-suffix-length))))))))
(defun tcode-mazegaki-lookup-reverse (new)
"現在の読みよりも長い最短の読みを見つける。
見つかればその読みの長さおよび offset (常に 0) を、なければ nil を返す。
交ぜ書き辞書のポイントはその読みのところに移動する。"
(save-excursion
(setq tcode-mazegaki-with-inflection nil)
(tcode-mazegaki-switch-to-dictionary)
(let* ((max (length tcode-mazegaki-yomi-list))
(i (cond (new (if tcode-mazegaki-yomi-fixed max 1))
(tcode-mazegaki-yomi-fixed (1+ max))
(t (1+ tcode-mazegaki-current-yomi-length)))))
(catch 'found
(while (<= i max)
(when (tcode-mazegaki-search-yomi (tcode-mazegaki-construct-yomi i))
(setq tcode-mazegaki-current-yomi-point (point))
(throw 'found (cons (car (nth (1- i) tcode-mazegaki-yomi-list))
(cons i 0))))
(setq i (1+ i)))))))
(defun tcode-mazegaki-lookup-with-inflection-reverse (new)
"現在の読みよりも長い最短の活用する読みを見つける。
見つかればその読みの長さおよび offset を、なければ nil を返す。
交ぜ書き辞書のポイントはその読みのところに移動する。"
(save-excursion
(setq tcode-mazegaki-with-inflection t)
(tcode-mazegaki-switch-to-dictionary)
(let* ((max (length tcode-mazegaki-yomi-list))
(i (if new 1 tcode-mazegaki-current-yomi-length))
(offset (cond (new (cond ((not tcode-mazegaki-yomi-fixed)
0)
((<= (- max i)
tcode-mazegaki-max-suffix-length)
(- max i))
(t
max)))
((or tcode-mazegaki-yomi-fixed
(>= tcode-mazegaki-current-offset
tcode-mazegaki-max-suffix-length))
max)
(t (1+ tcode-mazegaki-current-offset)))))
(catch 'found
(while (<= i max)
(while (<= (+ i offset) max)
(and (string-match "^[ぁ-ン]*$"
(tcode-mazegaki-construct-yomi offset))
(tcode-mazegaki-search-yomi
(tcode-mazegaki-construct-yomi i offset t))
(setq tcode-mazegaki-current-yomi-point (point))
(throw 'found (cons (car (nth (1- (+ i offset))
tcode-mazegaki-yomi-list))
(cons i offset))))
(setq offset (if (>= offset
tcode-mazegaki-max-suffix-length)
max
(1+ offset))))
(setq i (1+ i)
offset (cond ((not tcode-mazegaki-yomi-fixed)
0)
((<= (- max i)
tcode-mazegaki-max-suffix-length)
(- max i))
(t max))))))))
(defun tcode-mazegaki-erase-previous-candidate ()
"現在バッファに表示されている変換候補を消去する。"
(if tcode-mazegaki-mode
(delete-region tcode-mazegaki-mode (point))))
;;;###autoload
(defun tcode-mazegaki-convert (arg &optional inflection)
"現 point より後方にある日本語列を「読み」として交ぜ書き変換を試る。
ARG は次を意味する。
* C-u のみまたは - のみ
活用する語として変換(読みの長さは最長一致)
* 整数
その絶対値を読みの長さとして変換
ただし、変換するのは、正の場合は活用しない語、
負の場合は活用する語とする。
INFLECTION が nil でなければ、ARG の値によらず、活用する語として変換を行う。"
(interactive "*P")
(tcode-mazegaki-candidate-select-init)
(setq tcode-mazegaki-inflection-only (or (eq arg '-)
(and (integerp arg)
(< arg 0))
(and arg
(listp arg))
inflection))
(let ((tcode-mazegaki-yomi-max (if (integerp arg)
(if (>= arg 0) arg (- arg))
tcode-mazegaki-yomi-max)))
(unless (setq tcode-mazegaki-yomi-list
(tcode-mazegaki-get-reverse-yomi-list))
(let (tcode-auto-help)
(tcode-mazegaki-finish)
(error "読みがありません。"))))
(and (integerp arg)
(or tcode-mazegaki-yomi-fixed
(= (length tcode-mazegaki-yomi-list)
(if (>= arg 0) arg (- arg)))
(error "読みが短かすぎます。"))
(setq tcode-mazegaki-yomi-fixed t))
;; 辞書に読みがあるか調べ、あれば変換する。
(let ((with-inflection (and tcode-mazegaki-enable-inflection
(or inflection
(not (and (integerp arg)
(> arg 0)))))))
(let* ((tcode-mazegaki-enable-inflection with-inflection)
(yomi-info (or (and (not tcode-mazegaki-inflection-only)
(tcode-mazegaki-lookup t))
(and (or tcode-mazegaki-enable-inflection
tcode-mazegaki-inflection-only)
(tcode-mazegaki-lookup-with-inflection t)))))
(if yomi-info
;; 候補が見つかった。
(prog1
(setq tcode-mazegaki-current-yomi-length (car (cdr yomi-info))
tcode-mazegaki-current-offset (cdr (cdr yomi-info)))
;; i 文字の候補の先頭に印(△)をつける。
(save-excursion
(goto-char (car yomi-info))
(if tcode-mazegaki-mode
(if (/= tcode-mazegaki-mode (point))
(let (tcode-auto-help)
(tcode-mazegaki-finish)
(error "読みが長すぎます。")))
(setq tcode-mazegaki-mode (point))))
(condition-case nil
(let ((echo-keystrokes 0))
(tcode-mazegaki-put-conversion-face)
(tcode-mazegaki-select-candidate)
(while tcode-mazegaki-mode
(let* ((keyseq (read-char))
(command (lookup-key tcode-mazegaki-map
(char-to-string keyseq))))
(if (not (commandp command))
(progn
(tcode-mazegaki-finish)
(tcode-redo-command keyseq))
(setq prefix-arg current-prefix-arg
this-command command)
(command-execute command))))
(tcode-mazegaki-finish))
(quit
(ding)
(tcode-mazegaki-restore-yomi-and-quit))))
;; 候補が無かった。
(setq this-command 'tcode-mazegaki-begin-conversion)
; 登録を行うときに用いる細工
(ding)
(tcode-verbose-message
(tcode-substitute-command-keys
(concat "適当な漢字はありません"
" (「\\[tcode-mazegaki-make-entry-and-finish]」で登録)")))
nil))))
;;;###autoload
(defun tcode-mazegaki-begin-conversion (arg)
"交ぜ書き変換を開始する。"
(interactive "*P")
(undo-boundary)
(cond (tcode-mazegaki-mode
(if tcode-mazegaki-yomi-list
(tcode-mazegaki-get-reverse-yomi-list))
(tcode-mazegaki-convert arg))
(tcode-use-prefix-mazegaki
(tcode-mazegaki-put-prefix))
(t
(tcode-mazegaki-convert arg))))
;;;###autoload
(defun tcode-mazegaki-begin-alternate-conversion (arg)
"交ぜ書き変換を開始する。ただし、前置型・後置型が逆。"
(interactive "*P")
(call-interactively (if tcode-use-prefix-mazegaki
'tcode-mazegaki-convert
'tcode-mazegaki-put-prefix)))
;;;###autoload
(defun tcode-mazegaki-lookup-with-prefix (char-list)
"CHAR-LISTが読みの先頭になっている候補のリストを返す。"
(let ((tcode-mazegaki-yomi-list
(mapcar (lambda (e)
(cons 0 (char-to-string e)))
(reverse char-list)))
(prefix (regexp-quote (mapconcat 'char-to-string char-list nil)))
candidate-list
result)
(save-excursion
(tcode-mazegaki-switch-to-dictionary)
(tcode-mazegaki-search-yomi prefix)
(while (looking-at prefix)
(setq tcode-mazegaki-current-yomi-point (point)
candidate-list (nconc candidate-list
(tcode-mazegaki-get-candidate-list)))
(forward-line 1))
;; 重複の削除
(while candidate-list
(let ((candidate (car candidate-list)))
(setq result (nconc result (list candidate))
candidate-list (delete candidate candidate-list)))))
result))
;;;; 候補の選択
(defun tcode-mazegaki-candidate-select-init ()
"ステート情報を初期値に戻す。"
(setq tcode-mazegaki-candidate-state nil
tcode-mazegaki-candidate-index 0))
(defun tcode-mazegaki-find-kanji-entry ()
"現在の読みの(最初の)エントリまで交ぜ書き辞書の point を移動する。
正確には、point は最初のエントリの先頭にある\"/\"の直後に移動する。"
(tcode-mazegaki-switch-to-dictionary)
(goto-char tcode-mazegaki-current-yomi-point)
(beginning-of-line)
(search-forward " /" nil t))
(defun tcode-mazegaki-get-number-of-candidate ()
"現在の読みの候補の数を得る。"
(save-excursion
(tcode-mazegaki-find-kanji-entry)
(let ((noc 0)
(p (point)))
(while (not (eolp))
(if (= (following-char) ?/)
(setq noc (1+ noc)))
(tcode-forward-char 1))
noc)))
(defun tcode-mazegaki-get-candidate-list ()
"現在の読みから候補のリストを作る。"
(save-excursion
(tcode-mazegaki-find-kanji-entry)
(let (list)
(while (not (eolp))
(setq list (nconc list
(list (buffer-substring
(point)
(prog2
(search-forward "/" nil t)
(1- (point))))))))
list)))
(defun tcode-mazegaki-make-candidate-table (candidate-list)
" CANDIDATE-LIST から候補の表を作る。
候補の表における位置は、変数 `tcode-mazegaki-stroke-priority-list' に従う。"
(let ((plist tcode-mazegaki-stroke-priority-list)
(table (make-vector 40 nil)))
(while (and candidate-list plist)
(aset table (car plist) (car candidate-list))
(setq candidate-list (cdr candidate-list)
plist (cdr plist)))
table))
(defun tcode-mazegaki-select (candidate-table noc current-offset
&optional msg suffix)
"CANDIDATE-TABLE から候補を選択させる。
NOC (候補の数)と CURRENT-OFFSET から現在何番目の表を表示しているか計算する。"
(let* ((plist-size (length tcode-mazegaki-stroke-priority-list))
(whole-page (/ (+ noc (1- plist-size)) plist-size))
(page (- (1+ whole-page)
(/ (+ (- noc current-offset) (1- plist-size)) plist-size)))
(whole-table (or (and (catch 'found
;; 3段目以外を使うことを確かめる。
(mapcar (lambda (e) (if (or (< e 20)
(>= e 30))
(throw 'found t)))
tcode-mazegaki-stroke-priority-list)
nil)
(> whole-page 1))
;; 3段目以外に候補があるか調べる
(catch 'found
(let ((i 0))
(while (< i 40)
(and (aref candidate-table i)
(throw 'found t))
(setq i (if (= i 19) 30 (1+ i)))))))))
(if whole-table
(progn
(if suffix
(setq msg (concat msg " " suffix)))
(if (not (and (window-minibuffer-p (selected-window))
(null msg)))
(message (or msg "")))
(tcode-display-help-buffer
(tcode-draw-table candidate-table page whole-page) t))
(let ((candidate-list (mapcar (lambda (n)
(or (aref candidate-table n)
"-"))
'(20 21 22 23 24 25 26 27 28 29))))
(message
(concat msg
(if (= whole-page 1)
""
(format "(%d/%d) " page whole-page))
(apply 'format
(cons "[%s %s %s %s] %s %s [%s %s %s %s]"
candidate-list))
" "
suffix)))))
(let* ((echo-keystrokes 0)
(ch (read-char))
(key (tcode-char-to-key ch)))
(message "")
(if (< key 0)
ch
(or (aref candidate-table (mod key 40))
ch))))
(defun tcode-mazegaki-make-table-and-select (&optional
msg candidate-list inline)
"現在の読みから候補を選択させ、その文字列または文字(キー)を返す。"
(or candidate-list
(setq candidate-list (tcode-mazegaki-get-candidate-list)))
(let* ((noc (length candidate-list))
(plist-size (length tcode-mazegaki-stroke-priority-list))
(suffix (and tcode-mazegaki-with-inflection
(concat (tcode-mazegaki-construct-yomi
tcode-mazegaki-current-yomi-length
tcode-mazegaki-current-offset)
"("
(if (zerop tcode-mazegaki-current-offset)
tcode-mazegaki-inflection-mark
(tcode-mazegaki-construct-yomi
tcode-mazegaki-current-offset))
")"))))
(if (<= noc 1)
(car candidate-list)
(if (and inline
(= noc 2)
tcode-mazegaki-alternative-select-first-keys
tcode-mazegaki-alternative-select-second-keys)
(let ((first-candidate (car candidate-list))
(second-candidate (car (cdr candidate-list))))
(tcode-mazegaki-erase-previous-candidate)
(insert "{" first-candidate "," second-candidate "}")
(if tcode-mazegaki-with-inflection
(insert (tcode-mazegaki-construct-yomi
tcode-mazegaki-current-offset)
tcode-mazegaki-suffix))
(tcode-mazegaki-put-conversion-face)
(let* ((c (read-char))
(key (tcode-char-to-key c)))
(tcode-mazegaki-restore-yomi-and-quit t)
(cond ((memq key tcode-mazegaki-alternative-select-first-keys)
first-candidate)
((memq key tcode-mazegaki-alternative-select-second-keys)
second-candidate)
(t
c))))
;; noc >(=) 2
(save-excursion
(let ((current-offset 0)
(candidate (tcode-mazegaki-select
(tcode-mazegaki-make-candidate-table candidate-list)
noc 0 msg suffix)))
(while (and (char-or-string-p candidate)
(not (stringp candidate))
(or (= candidate ? )
(= candidate ?\C-?)
(= candidate ?\C-h)))
(setq current-offset (if (= candidate ? )
(+ current-offset plist-size)
(- current-offset plist-size)))
(if (>= current-offset noc)
(setq current-offset 0))
(if (< current-offset 0)
(let ((v current-offset))
(while (< (setq v (+ v plist-size)) noc)
(setq current-offset v))))
(setq candidate
(tcode-mazegaki-select
(tcode-mazegaki-make-candidate-table
(nthcdr current-offset candidate-list))
noc current-offset msg suffix)))
(tcode-auto-remove-help t)
candidate))))))
(defun tcode-mazegaki-show-candidate-inline (candidate)
"候補をインライン表示する。"
(tcode-mazegaki-erase-previous-candidate)
(insert candidate
(tcode-mazegaki-list-to-string
tcode-mazegaki-yomi-list
0
tcode-mazegaki-current-offset)
tcode-mazegaki-suffix)
(tcode-mazegaki-put-conversion-face))
(defun tcode-mazegaki-select-candidate ()
"現在の読みから候補を選択する。"
(let* ((candidate-list (tcode-mazegaki-get-candidate-list))
(noc (length candidate-list))
(msg (and (not (window-minibuffer-p (selected-window)))
(tcode-verbose-message "(? でヘルプ)"))))
(if (eq tcode-mazegaki-candidate-state 'priority)
(setq tcode-mazegaki-candidate-index
(1+ tcode-mazegaki-candidate-index)
tcode-mazegaki-candidate-state 'next))
(if (null tcode-mazegaki-candidate-state)
(setq tcode-mazegaki-candidate-state (if (= noc 1) 'one 'next)))
(if (eq tcode-mazegaki-candidate-state 'next)
(setq tcode-mazegaki-candidate-state
(if (and (< tcode-mazegaki-candidate-index noc)
(< tcode-mazegaki-candidate-index
tcode-mazegaki-inline-candidate-count))
'priority
'table)))
(cond ((eq tcode-mazegaki-candidate-state 'one)
(tcode-mazegaki-show-candidate-inline (car candidate-list))
(when (and tcode-mazegaki-yomi-fixed
(not tcode-mazegaki-enable-inflection))
(tcode-mazegaki-finish)
(setq msg nil))
(if msg
(message msg)))
((eq tcode-mazegaki-candidate-state 'priority)
(tcode-mazegaki-show-candidate-inline
(nth tcode-mazegaki-candidate-index candidate-list))
(if msg
(message msg)))
((eq tcode-mazegaki-candidate-state 'table)
(let ((selected-candidate (tcode-mazegaki-make-table-and-select
msg candidate-list t)))
(cond ((stringp selected-candidate)
(tcode-mazegaki-show-candidate-inline selected-candidate)
(tcode-mazegaki-finish))
((char-or-string-p selected-candidate)
(tcode-redo-command selected-candidate))))))))
(unless (memq 'tcode-mazegaki-select-candidate
tcode-no-wait-display-help-command-list)
(setq tcode-no-wait-display-help-command-list
(cons 'tcode-mazegaki-select-candidate
tcode-no-wait-display-help-command-list)))
(defun tcode-mazegaki-table-mode ()
"候補一覧表示に切り換える。"
(interactive)
(cond ((eq tcode-mazegaki-candidate-state 'one)
;; nop
)
((eq tcode-mazegaki-candidate-state 'priority)
(setq tcode-mazegaki-candidate-state 'table
tcode-mazegaki-candidate-index
(tcode-mazegaki-get-number-of-candidate))
(tcode-mazegaki-select-candidate))
(t
;; nop
)))
(defun tcode-mazegaki-select-candidate-from-table ()
"現在の読みから候補一覧表を作成し、そこから候補を選択する。"
(interactive "*")
(let ((selected-candidate (tcode-mazegaki-make-table-and-select
(and (not (window-minibuffer-p (selected-window)))
(tcode-verbose-message "(? でヘルプ)"))
nil t))
(noc (tcode-mazegaki-get-number-of-candidate)))
(cond ((stringp selected-candidate)
(tcode-mazegaki-show-candidate-inline selected-candidate)
(unless (and (= noc 1)
(or tcode-mazegaki-enable-inflection
(not tcode-mazegaki-yomi-fixed)))
(tcode-mazegaki-finish)))
((char-or-string-p selected-candidate)
(tcode-redo-command selected-candidate)))))
;;;; 読みの区切り直し・候補の確定
(defun tcode-mazegaki-restore-yomi-and-quit (&optional not-quit)
"読みの状態に戻して、交ぜ書き変換を終了する。
NOT-QUIT が nil でないときは、読みの状態に戻すだけで、終了はしない。"
(interactive "P")
(tcode-mazegaki-erase-previous-candidate)
(tcode-mazegaki-candidate-select-init) ; 念のため
(insert (tcode-mazegaki-list-to-string
tcode-mazegaki-yomi-list 0
(+ tcode-mazegaki-current-yomi-length
tcode-mazegaki-current-offset))
tcode-mazegaki-suffix)
(tcode-mazegaki-put-conversion-face)
(unless not-quit
(tcode-mazegaki-delete-conversion-face)
(unless (window-minibuffer-p (selected-window))
(message ""))
(tcode-do-auto-fill)
(setq tcode-mazegaki-mode nil
tcode-mazegaki-prefix nil)
(while tcode-mazegaki-start-marker
(goto-char (car tcode-mazegaki-start-marker))
(setq tcode-mazegaki-start-marker (cdr tcode-mazegaki-start-marker)))))
(defun tcode-mazegaki-relimit (length offset)
"現在の読みを区切り直し、候補を選択させる。
区切り直す読みは、長さ LENGTH と OFFSET とで表される。"
(tcode-mazegaki-candidate-select-init)
(save-excursion
(goto-char tcode-mazegaki-mode)
(let ((old-yomi-total (+ tcode-mazegaki-current-yomi-length
tcode-mazegaki-current-offset))
(new-yomi-total (+ length offset)))
(if (<= old-yomi-total new-yomi-total)
;; マークの前の読みを消す
(delete-region
(car (nth (- new-yomi-total old-yomi-total)
(nthcdr (1- old-yomi-total) tcode-mazegaki-yomi-list)))
(point))
;; マークの前に読みを入れる
(insert (tcode-mazegaki-list-to-string
tcode-mazegaki-yomi-list
new-yomi-total
(- old-yomi-total new-yomi-total)))))
(setq tcode-mazegaki-mode (point)))
(tcode-mazegaki-put-conversion-face)
(setq tcode-mazegaki-current-yomi-length length
tcode-mazegaki-current-offset offset)
(tcode-mazegaki-restore-yomi-and-quit t)
(tcode-mazegaki-select-candidate))
(defun tcode-mazegaki-relimit-right ()
"読みを縮める。"
(interactive)
(let ((p (save-excursion
(tcode-mazegaki-switch-to-dictionary)
(point)))