Mercurial > hg > xemacs-beta

comparison lisp/skk/skk-auto.el @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents
children
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
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