219
|
1 ;;; skk-auto.el --- $BAw$j2>L>$N<+F0=hM}$N$?$a$N%W%m%0%i%`(B
|
|
2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
|
|
3 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
|
|
4
|
|
5 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
|
|
6 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
|
|
7 ;; Version: $Id: skk-auto.el,v 1.1 1997/12/02 08:48:37 steve Exp $
|
|
8 ;; Keywords: japanese
|
|
9 ;; Last Modified: $Date: 1997/12/02 08:48:37 $
|
|
10
|
|
11 ;; This program is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either versions 2, or (at your option)
|
|
14 ;; any later version.
|
|
15
|
|
16 ;; This program is distributed in the hope that it will be useful
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with SKK, see the file COPYING. If not, write to the Free
|
|
23 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
|
|
24 ;; MA 02111-1307, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27 ;; Following people contributed modifications to skk-server.el (Alphabetic
|
|
28 ;; order):
|
|
29 ;;
|
|
30 ;; Mikio Nakajima <minakaji@osaka.email.ne.jp>
|
|
31
|
|
32 ;;; Change log:
|
|
33 ;; version 1.0.6 released 1997.2.18 (derived from the skk.el 8.6)
|
|
34
|
|
35 ;;; Code:
|
|
36 (require 'skk-foreword)
|
|
37 (require 'skk-vars)
|
|
38
|
|
39 ;;; user variables
|
|
40 (defvar skk-kana-rom-vector
|
|
41 ["x" "a" "x" "i" "x" "u" "x" "e" "x" "o" "k" "g" "k" "g" "k" "g"
|
|
42 "k" "g" "k" "g" "s" "z" "s" "j" "s" "z" "s" "z" "s" "z" "t" "d"
|
|
43 "t" "d" "x" "t" "d" "t" "d" "t" "d" "n" "n" "n" "n" "n" "h" "b"
|
|
44 "p" "h" "b" "p" "h" "b" "p" "h" "b" "p" "h" "b" "p" "m" "m" "m"
|
|
45 "m" "m" "x" "y" "x" "y" "x" "y" "r" "r" "r" "r" "r" "x" "w" "x"
|
|
46 "x" "w" "n"]
|
|
47 "*skk-remove-common $B$G;HMQ$9$k$+$JJ8;z$+$i%m!<%^;z$X$NJQ49%k!<%k!#(B
|
|
48 $B2<5-$N3:Ev$9$k$+$JJ8;z$r$=$NJ8;z$N%m!<%^;z%W%l%U%#%C%/%9$G8=$o$7$?$b$N!#(B
|
|
49 $B$!(B $B$"(B $B$#(B $B$$(B $B$%(B $B$&(B $B$'(B $B$((B $B$)(B $B$*(B $B$+(B $B$,(B $B$-(B $B$.(B $B$/(B $B$0(B
|
|
50 $B$1(B $B$2(B $B$3(B $B$4(B $B$5(B $B$6(B $B$7(B $B$8(B $B$9(B $B$:(B $B$;(B $B$<(B $B$=(B $B$>(B $B$?(B $B$@(B
|
|
51 $B$A(B $B$B(B $B$C(B $B$D(B $B$E(B $B$F(B $B$G(B $B$H(B $B$I(B $B$J(B $B$K(B $B$L(B $B$M(B $B$N(B $B$O(B $B$P(B
|
|
52 $B$Q(B $B$R(B $B$S(B $B$T(B $B$U(B $B$V(B $B$W(B $B$X(B $B$Y(B $B$Z(B $B$[(B $B$\(B $B$](B $B$^(B $B$_(B $B$`(B
|
|
53 $B$a(B $B$b(B $B$c(B $B$d(B $B$e(B $B$f(B $B$g(B $B$h(B $B$i(B $B$j(B $B$k(B $B$l(B $B$m(B $B$n(B $B$o(B $B$p(B
|
|
54 $B$q(B $B$r(B $B$s(B
|
|
55 $B$=$l$>$l$N$+$JJ8;z$,Aw$j2>L>$G$"$k>l9g$K$I$N%m!<%^;z%W%l%U%#%C%/%9$rBP1~$5$;$k(B
|
|
56 $B$N$+$r;XDj$9$k$3$H$,$G$-$k!#!V$8!W!"!V$A!W!"!V$U!W$NJ8;z$K$D$$$F!"BP1~$9$k%m!<(B
|
|
57 $B%^;z%W%l%U%#%C%/%9$r(B \"z\", \"c\",\"f\" $B$KJQ99$r4uK>$9$k>l9g$b$"$k$G$"$m$&!#(B
|
|
58 skk-auto-okuri-process $B$NCM$,(B non-nil $B$N$H$-$N$_;2>H$5$l$k!#(B" )
|
|
59
|
|
60 (defvar skk-auto-load-hook nil
|
|
61 "*skk-auto.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
|
|
62
|
|
63 ;; internal valriables
|
|
64 ;;;###skk-autoload
|
|
65 (skk-deflocalvar skk-henkan-in-minibuff-flag nil
|
|
66 "$B%_%K%P%C%U%!$G<-=qEPO?$r9T$C$?$H$-$K$3$N%U%i%0$,N)$D!#(B
|
|
67 skk-remove-common $B$G;2>H$5$l$k!#(B" )
|
|
68
|
|
69 (skk-deflocalvar skk-okuri-index-min -1
|
|
70 "skk-henkan-list $B$N%$%s%G%/%9$G<+F0Aw$j=hM}$G8!:w$7$?:G=i$N8uJd$r;X$9$b$N!#(B" )
|
|
71
|
|
72 (skk-deflocalvar skk-okuri-index-max -1
|
|
73 "skk-henkan-list $B$N%$%s%G%/%9$G<+F0Aw$j=hM}$G8!:w$7$?:G8e$N8uJd$r;X$9$b$N!#(B" )
|
|
74
|
|
75 (defun skk-okuri-search ()
|
|
76 ;; skk-auto-okuri-process $B$,(B non-nil $B$J$i$P(B "Uresii" $B$N$h$&$KAw$j2>L>$b4^$a(B
|
|
77 ;; $B$F%?%$%W$7$F$bAw$j$"$j$N(B "$B4r$7$$(B" $B$rC5$7=P$9!#(B
|
|
78 (if (and skk-auto-okuri-process
|
|
79 (not (or skk-abbrev-mode skk-process-okuri-early
|
|
80 skk-henkan-okurigana ))
|
|
81 ;; we don't do auto-okuri-process if henkan key contains numerals.
|
|
82 (not (skk-numeric-p))
|
|
83 (> (length skk-henkan-key) skk-kanji-len) )
|
|
84 (let (l)
|
|
85 (setq skk-okuri-index-min (length skk-henkan-list)
|
|
86 l (skk-okuri-search-subr)
|
|
87 skk-okuri-index-max (+ skk-okuri-index-min (length l)) )
|
|
88 l )))
|
|
89
|
|
90 (defun skk-okuri-search-subr ()
|
|
91 ;; skk-okuri-search $B$N%5%V%k!<%A%s!#8+$D$1$?%(%s%H%j$N%j%9%H$rJV$9!#(B
|
|
92 (let* ((henkan-key skk-henkan-key)
|
|
93 (key (substring henkan-key 0 skk-kanji-len))
|
|
94 (len (length henkan-key))
|
|
95 (key1 (concat "\n" key))
|
|
96 key2 len2 key3 len3 okuri3
|
|
97 ;; $B8zN($,NI$$$h$&$K(B kanji-flag, mc-flag, enable-multibyte-characters
|
|
98 ;; $B$r(B nil $B$K$7$F$*$/!#(B
|
|
99 mc-flag
|
|
100 ;; enable-multibyte-characters
|
|
101 ;; case-fold-search $B$O!"<-=q%P%C%U%!$G$O>o$K(B nil$B!#(B
|
|
102 ;;case-fold-search
|
|
103 (inhibit-quit t)
|
|
104 key-cand-alist p q r s )
|
|
105 (save-match-data
|
|
106 (with-current-buffer (skk-get-jisyo-buffer skk-jisyo)
|
|
107 (goto-char skk-okuri-ari-min)
|
|
108 (while (search-forward key1 skk-okuri-ari-max t)
|
|
109 (setq p (point)
|
|
110 key2 (concat key (skk-buffer-substring
|
|
111 p (- (search-forward " ") 2) ))
|
|
112 len2 (length key2) )
|
|
113 (if (not (and (<= len2 len)
|
|
114 (string= key2 (substring henkan-key 0 len2)) ))
|
|
115 nil
|
|
116 (let ((cont t))
|
|
117 (skk-save-point
|
|
118 (end-of-line)
|
|
119 (setq q (point)) )
|
|
120 (while (and cont (search-forward "/[" q t))
|
|
121 (setq r (point))
|
|
122 (setq okuri3 (skk-buffer-substring r (1- (search-forward "/")))
|
|
123 key3 (concat key2 okuri3)
|
|
124 len3 (length key3) )
|
|
125 (if (not (and (<= len3 len)
|
|
126 (string= key3 (substring henkan-key 0 len3)) ))
|
|
127 nil
|
|
128 ;; finally found a candidate!
|
|
129 (let ((okuri
|
|
130 (concat okuri3 (substring henkan-key len3 len)) )
|
|
131 cand )
|
|
132 (while (not (eq (following-char) ?\]))
|
|
133 (setq cand
|
|
134 (concat
|
|
135 (skk-buffer-substring
|
|
136 (point)
|
|
137 (1- (search-forward "/" skk-okuri-ari-max t)) )
|
|
138 okuri ))
|
|
139 ;; $B8+=P$78l$,0c$C$F$b8uJd$,F1$8$3$H$,$"$jF@$k!#(B
|
|
140 ;; $B$+$s(Bz /$B46(B/[$B$8(B/$B46(B/]/
|
|
141 ;; $B$+$s(Bj /$B46(B/[$B$8(B/$B46(B/]/
|
|
142 ;; $B$J$I!#(B
|
|
143 (if (null (rassoc cand key-cand-alist))
|
|
144 (setq key-cand-alist (cons (cons key3 cand)
|
|
145 key-cand-alist ))))
|
|
146 ;; it is not necessary to seach for "\[" on this line
|
|
147 ;; any more
|
|
148 (setq cont nil) ))))))
|
|
149 ;; key3 $B$ND9$$$b$N=g$K%=!<%H$7$FJV$9!#(B
|
|
150 (mapcar (function
|
|
151 (lambda (x) (cdr x)) )
|
|
152 (sort (nreverse key-cand-alist)
|
|
153 (function (lambda (x y)
|
|
154 (string< (car y) (car x)) ))))))))
|
|
155
|
|
156 ;;;###skk-autoload
|
|
157 (defun skk-remove-common (word)
|
|
158 ;; skk-henkan-key $B$H(B word $B$N4V$K6&DL$NAw$j2>L>$r<h$j=|$-!"Aw$j2>L>0J30$NItJ,(B
|
|
159 ;; $B$NJ8;zNs$rJV$9!#(Bskk-henkan-key $B$H(B skk-henkan-okurigana $B$NCM$r%;%C%H$9$k!#(B
|
|
160 ;; $BNc$($P!"(Bword == $B;}$C$F$-$?(B $B$G$"$l$P!"(Bskk-henkan-key := "$B$b(Bt",
|
|
161 ;; skk-henkan-okurigana := "$B$C$F(B", word := "$B;}(B" $B$N$h$&$KJ,2r$7!"(Bword $B$rJV$9!#(B
|
|
162 ;; skk-auto-okuri-process $B$NCM$,(B non-nil $B$G$"$k$H$-$K$3$N4X?t$r;HMQ$9$k!#(B
|
|
163 (if (and (not (skk-numeric-p)) (not skk-abbrev-mode)
|
|
164 (or skk-henkan-in-minibuff-flag
|
|
165 (and (<= skk-okuri-index-min skk-henkan-count)
|
|
166 (<= skk-henkan-count skk-okuri-index-max) )))
|
|
167 (let ((midasi skk-henkan-key)
|
|
168 (midasi-len (length skk-henkan-key))
|
|
169 (word-len (length word))
|
|
170 (kanji-len2 (* 2 skk-kanji-len))
|
|
171 (mc-flag t)
|
|
172 (enable-multibyte-characters t)
|
|
173 (cont t)
|
|
174 char pos pos2 midasi-tail word-tail new-word okuri-first
|
|
175 new-skk-henkan-key )
|
|
176 (if (not (and (>= midasi-len kanji-len2) (>= word-len kanji-len2)))
|
|
177 nil
|
|
178 ;; check if both midasi and word end with the same ascii char.
|
|
179 (if (and (eq (aref midasi (1- midasi-len)) (aref word (1- word-len)))
|
|
180 (skk-alpha-char-p (aref midasi (1- midasi-len))) )
|
|
181 ;; if so chop off the char from midasi and word
|
|
182 (setq midasi (substring midasi 0 -1)
|
|
183 midasi-len (1- midasi-len)
|
|
184 word (substring word 0 -1)
|
|
185 word-len (1- word-len) ))
|
|
186 (setq midasi-tail (substring midasi (- midasi-len skk-kanji-len)
|
|
187 midasi-len )
|
|
188 word-tail (substring word (- word-len skk-kanji-len)
|
|
189 word-len ))
|
|
190 ;; $B$b$&>/$7E83+$G$-$=$&$@$,!"%P%$%H%3%s%Q%$%i!<$,%*%W%F%#%^%$%:$7$d(B
|
|
191 ;; $B$9$$$h$&$K(B not $B$rIU$1$k$@$1$K$7$F$*$/!#(B
|
|
192 (if (not (and (string= midasi-tail word-tail)
|
|
193 (or (and (skk-string<= "$B$!(B" midasi-tail)
|
|
194 (skk-string<= midasi-tail "$B$s(B") )
|
|
195 (member midasi-tail '("$B!"(B" "$B!#(B" "$B!$(B" "$B!%(B")) )))
|
|
196 nil
|
|
197 (setq pos (- word-len skk-kanji-len)
|
|
198 new-word new-skk-henkan-key )
|
|
199 (while (and cont (> pos 0))
|
|
200 (setq char (substring word (- pos skk-kanji-len) pos))
|
|
201 (if (and (skk-string<= "$B0!(B" char) (skk-string<= char "$Bt$(B"))
|
|
202 ;; char is the right-most Kanji
|
|
203 (setq cont nil)
|
|
204 (setq pos (- pos skk-kanji-len)) ))
|
|
205 (setq pos2 (- midasi-len (- word-len pos)))
|
|
206 ;; check if midasi and word has the same tail of length
|
|
207 (if (not (string= (substring midasi pos2 midasi-len)
|
|
208 (substring word pos word-len) ))
|
|
209 nil
|
|
210 (setq okuri-first (substring word pos (+ pos skk-kanji-len)))
|
|
211 (setq skk-henkan-okurigana
|
|
212 (if (and (string= okuri-first "$B$C(B")
|
|
213 (<= (+ pos kanji-len2) word-len) )
|
|
214 ;; in this case okuriga consits of two
|
|
215 ;; characters, e.g., $B!V;D$C$?!W(B
|
|
216 (substring word pos (+ pos kanji-len2))
|
|
217 okuri-first ))
|
|
218 (setq new-word (substring word 0 pos))
|
|
219 (setq new-skk-henkan-key
|
|
220 (concat
|
|
221 (substring midasi 0 pos2)
|
|
222 (cond ((string= okuri-first "$B$s(B")
|
|
223 "n" )
|
|
224 ((string= okuri-first "$B$C(B")
|
|
225 (aref skk-kana-rom-vector
|
|
226 (- (string-to-char
|
|
227 (substring
|
|
228 skk-henkan-okurigana
|
|
229 (1- kanji-len2) kanji-len2 ))
|
|
230 161 )))
|
|
231 (t (aref skk-kana-rom-vector
|
|
232 (- (string-to-char
|
|
233 (substring
|
|
234 skk-henkan-okurigana
|
|
235 (1- skk-kanji-len)
|
|
236 skk-kanji-len ))
|
|
237 161 ))))))
|
|
238 (if (not skk-henkan-in-minibuff-flag)
|
|
239 (setq word new-word
|
|
240 skk-henkan-key new-skk-henkan-key )
|
|
241 ;; ask if register as okuri-ari word.
|
|
242 (let (inhibit-quit) ; allow keyboard quit
|
|
243 (if (y-or-n-p
|
|
244 (format
|
|
245 (if skk-japanese-message-and-error
|
|
246 "%s /%s/ $B$rAw$j$"$j%(%s%H%j$H$7$FEPO?$7$^$9$+!)(B"
|
|
247 "Shall I register this as okuri-ari entry: %s /%s/ ? " )
|
|
248 new-skk-henkan-key new-word ))
|
|
249 (setq word new-word
|
|
250 skk-henkan-key new-skk-henkan-key )
|
|
251 (setq skk-henkan-okurigana nil
|
|
252 skk-okuri-char nil )
|
|
253 (message "") ))))))))
|
|
254 ;; $BJ,2r$7$?(B word ($BAw$j2>L>ItJ,$r=|$$$?$b$N(B) $B$rJV$9!#(B
|
|
255 word )
|
|
256
|
|
257 ;;;###skk-autoload
|
|
258 (defun skk-init-auto-okuri-variables ()
|
|
259 ;; skk-auto.el $B$NFbItJQ?t$r=i4|2=$9$k!#(B
|
|
260 (setq skk-henkan-in-minibuff-flag nil
|
|
261 skk-okuri-index-min -1
|
|
262 skk-okuri-index-max -1 ))
|
|
263
|
|
264 ;;;###skk-autoload
|
|
265 (defun skk-adjust-search-prog-list-for-auto-okuri ()
|
|
266 ;; skk-auto-okuri-process $B$,(B nil $B$G$"$l$P!"(Bskk-search-prog-list $B$+$i(B
|
|
267 ;; '(skk-okuri-search) $B$r>C$7!"(Bnon-nil $B$G$"$l$P2C$($k!#(B
|
|
268 ;;
|
|
269 ;; '(skk-okuri-search) $B$r2C$($k0LCV$K$D$$$F$O!"(Bskk-jisyo $B$N8e$,:GNI$+$I$&$+(B
|
|
270 ;; $B$OJ,$i$J$$$N$G!"%*%W%7%g%s$GJQ99$G$-$k$h$&$K$9$Y$-$@$,(B...$B!#(B
|
|
271 (if (not skk-auto-okuri-process)
|
|
272 (setq skk-search-prog-list
|
|
273 (delete '(skk-okuri-search) skk-search-prog-list) )
|
|
274 (if (null (member '(skk-okuri-search) skk-search-prog-list))
|
|
275 (let ((pl skk-search-prog-list)
|
|
276 (n 0) dic mark )
|
|
277 (while pl
|
|
278 (setq dic (car pl))
|
|
279 (if (eq (nth 1 dic) 'skk-jisyo)
|
|
280 (setq mark n
|
|
281 pl nil)
|
|
282 (setq pl (cdr pl)
|
|
283 n (1+ n) )))
|
|
284 (skk-middle-list skk-search-prog-list
|
|
285 (1+ mark) '((skk-okuri-search)) )))))
|
|
286
|
|
287 ;;(add-hook 'skk-mode-hook 'skk-adjust-search-prog-list-for-auto-okuri)
|
|
288
|
|
289 (run-hooks 'skk-auto-load-hook)
|
|
290 (provide 'skk-auto)
|
|
291 ;;; skk-auto.el ends here
|