|
70
|
1 ;; Kana Kanji Conversion Protocol Package for Egg
|
|
|
2 ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp)
|
|
|
3
|
|
|
4 ;; This file is part of Egg on Mule (Multilingal Environment)
|
|
|
5
|
|
|
6 ;; Egg is distributed in the forms of patches to GNU
|
|
|
7 ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
|
|
|
8 ;; LICENSE which is distributed along with GNU Emacs by the
|
|
|
9 ;; Free Software Foundation.
|
|
|
10
|
|
|
11 ;; Egg is distributed in the hope that it will be useful,
|
|
|
12 ;; but WITHOUT ANY WARRANTY; without even the implied
|
|
|
13 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
|
|
|
14 ;; PURPOSE. See the GNU EMACS GENERAL PUBLIC LICENSE for
|
|
|
15 ;; more details.
|
|
|
16
|
|
|
17 ;; You should have received a copy of the GNU EMACS GENERAL
|
|
|
18 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
|
|
|
19 ;; If not, write to the Free Software Foundation, 675 Mass
|
|
|
20 ;; Ave, Cambridge, MA 02139, USA.
|
|
|
21
|
|
|
22
|
|
|
23 ;;;
|
|
|
24 ;;; sj3-egg.el
|
|
|
25 ;;;
|
|
|
26 ;;; $B!V$?$^$4!W$N(B sj3 $B%P!<%8%g%s(B
|
|
|
27 ;;; $B$+$J4A;zJQ49%5!<%P$K(B sj3serv $B$r;H$$$^$9!#(B
|
|
|
28 ;;;
|
|
|
29 ;;; sj3-egg $B$K4X$9$kDs0F!"Cn>pJs$O(B kiyoji@sm.sony.co.jp $B$K$*Aw$j2<$5$$!#(B
|
|
|
30 ;;;
|
|
|
31 ;;; $B@P0f(B $B@6<!(B
|
|
|
32
|
|
|
33 (require 'egg)
|
|
|
34 (provide 'sj3-egg)
|
|
|
35 (if (not (boundp 'SJ3))
|
|
|
36 (require 'sj3-client))
|
|
|
37
|
|
|
38 ;;;; $B=$@5%a%b!(!((B
|
|
|
39 ;;;; Jul-20-93 by age@softlab.is.tsukuba.ac.jp (Eiji FURUKAWA)
|
|
|
40 ;;;; Bug fixed in diced-add, *sj3-bunpo-menu* and
|
|
|
41 ;;;; set-egg-henkan-mode-format.
|
|
|
42
|
|
|
43 ;;;; Mar-19-93 by K.Ishii
|
|
|
44 ;;;; DicEd is changed, edit-dict-item -> edit-dict
|
|
|
45
|
|
|
46 ;;;; Aug-6-92 by K.Ishii
|
|
|
47 ;;;; length $B$r(B string-width $B$KJQ99(B
|
|
|
48
|
|
|
49 ;;;; Jul-30-92 by K.Ishii
|
|
|
50 ;;;; set-default-usr-dic-directory $B$G:n$k<-=q%G%#%l%/%H%jL>$N=$@5(B
|
|
|
51 ;;;; jserver-host-name, $B4D6-JQ?t(B JSERVER $B$N:o=|(B
|
|
|
52 ;;;;
|
|
|
53
|
|
|
54 ;;;; Jul-7-92 by Y.Kawabe
|
|
|
55 ;;;; jserver-host-name $B$r%;%C%H$9$k:]$K4D6-JQ?t(B SJ3SERV $B$bD4$Y$k!#(B
|
|
|
56 ;;;; sj3fns.el $B$N%m!<%I$r$d$a$k!#(B
|
|
|
57
|
|
|
58 ;;;; Jun-2-92 by K.Ishii
|
|
|
59 ;;;; sj3-egg.el $B$r(B wnn-egg.el $B$HF1MM$KJ,3d(B
|
|
|
60
|
|
|
61 ;;;; May-14-92 by K.Ishii
|
|
|
62 ;;;; Mule $B$N(B wnn-egg.el $B$r(B sj3serv $B$H$NDL?.MQ$K=$@5(B
|
|
|
63
|
|
|
64 ;; XEmacs addition: (and remove disable-undo variable)
|
|
|
65 ;; For Emacs V18 compatibility
|
|
|
66 (and (not (fboundp 'buffer-disable-undo))
|
|
|
67 (fboundp 'buffer-flush-undo)
|
|
|
68 (defalias 'buffer-disable-undo 'buffer-flush-undo))
|
|
|
69
|
|
|
70 ;;;----------------------------------------------------------------------
|
|
|
71 ;;;
|
|
|
72 ;;; Version control routine
|
|
|
73 ;;;
|
|
|
74 ;;;----------------------------------------------------------------------
|
|
|
75
|
|
|
76 (defvar sj3-egg-version "3.00" "Version number of this version of Egg. ")
|
|
|
77 ;;; Last modified date: Thu Aug 4 21:18:11 1994
|
|
|
78
|
|
|
79 (and (equal (user-full-name) "Kiyoji Ishii")
|
|
|
80 (defun sj3-egg-version-update (arg)
|
|
|
81 (interactive "P")
|
|
|
82 (if (equal (buffer-name (current-buffer)) "sj3-egg.el")
|
|
|
83 (save-excursion
|
|
|
84 (goto-char (point-min))
|
|
|
85 (re-search-forward "(defvar sj3-egg-version \"[0-9]+\\.")
|
|
|
86 (let ((point (point))
|
|
|
87 (minor))
|
|
|
88 (search-forward "\"")
|
|
|
89 (backward-char 1)
|
|
|
90 (setq minor (string-to-int (buffer-substring point (point))))
|
|
|
91 (delete-region point (point))
|
|
|
92 (if (<= minor 8) (insert "0"))
|
|
|
93 (insert (int-to-string (1+ minor)))
|
|
|
94 (re-search-forward "Last modified date: ")
|
|
|
95 (kill-line)
|
|
|
96 (insert (current-time-string)))
|
|
|
97 (save-buffer)
|
|
|
98 (if arg (byte-compile-file (buffer-file-name)))
|
|
|
99 )))
|
|
|
100 )
|
|
|
101
|
|
|
102 ;;;----------------------------------------------------------------------
|
|
|
103 ;;;
|
|
|
104 ;;; KKCP package: Kana Kanji Conversion Protocol
|
|
|
105 ;;;
|
|
|
106 ;;; KKCP to SJ3SERV interface;
|
|
|
107 ;;;
|
|
|
108 ;;;----------------------------------------------------------------------
|
|
|
109
|
|
|
110 (defvar *KKCP:error-flag* t)
|
|
|
111
|
|
|
112 (defun KKCP:error (errorCode &rest form)
|
|
|
113 (cond((eq errorCode ':SJ3_SOCK_OPEN_FAIL)
|
|
|
114 (notify "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local"))
|
|
|
115 (if debug-on-error
|
|
|
116 (error "EGG: No SJ3SERV on %s is running." (or (get-sj3-host-name) "local"))
|
|
|
117 (error "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local"))))
|
|
|
118 ((eq errorCode ':SJ3_SERVER_DEAD)
|
|
|
119 (notify "EGG: %s $B>e$N(BSJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local"))
|
|
|
120 (if debug-on-error
|
|
|
121 (error "EGG: SJ3SERV on %s is dead." (or (get-sj3-host-name) "local"))
|
|
|
122 (error "EGG: %s $B>e$N(B SJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local"))))
|
|
|
123 ((and (consp errorCode)
|
|
|
124 (eq (car errorCode) ':SJ3_UNKNOWN_HOST))
|
|
|
125 (notify "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))
|
|
|
126 (if debug-on-error
|
|
|
127 (error "EGG: Host %s is unknown." (car(cdr errorCode)))
|
|
|
128 (error "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))))
|
|
|
129 ((and (consp errorCode)
|
|
|
130 (eq (car errorCode) ':SJ3_UNKNOWN_SERVICE))
|
|
|
131 (notify "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))
|
|
|
132 (if debug-on-error
|
|
|
133 (error "EGG: Service %s is unknown." (car(cdr errorCode)))
|
|
|
134 (error "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (cdr errorCode))))
|
|
|
135 (t
|
|
|
136 (notify "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form)
|
|
|
137 (if debug-on-error
|
|
|
138 (error "KKCP: %s failed because of %s." form errorCode)
|
|
|
139 (error "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form)))))
|
|
|
140
|
|
|
141 (defun KKCP:server-open (hostname loginname)
|
|
|
142 (let ((result (sj3-server-open hostname loginname)))
|
|
|
143 (cond((null sj3-error-code) result)
|
|
|
144 (t (KKCP:error sj3-error-code 'KKCP:server-open hostname loginname)))))
|
|
|
145
|
|
|
146 (defun KKCP:use-dict (dict &optional passwd)
|
|
|
147 (let ((result (sj3-server-open-dict dict passwd)))
|
|
|
148 (cond((null sj3-error-code) result)
|
|
|
149 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
150 (EGG:open-sj3)
|
|
|
151 (KKCP:use-dict dict passwd))
|
|
|
152 ((null *KKCP:error-flag*) result)
|
|
|
153 (t (KKCP:error sj3-error-code
|
|
|
154 'kkcp:use-dict dict)))))
|
|
|
155
|
|
|
156 (defun KKCP:make-dict (dict)
|
|
|
157 (let ((result (sj3-server-make-dict dict)))
|
|
|
158 (cond((null sj3-error-code) result)
|
|
|
159 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
160 (EGG:open-sj3)
|
|
|
161 (KKCP:make-dict dict))
|
|
|
162 ((null *KKCP:error-flag*) result)
|
|
|
163 (t (KKCP:error sj3-error-code
|
|
|
164 'kkcp:make-dict dict)))))
|
|
|
165
|
|
|
166 (defun KKCP:use-stdy (stdy)
|
|
|
167 (let ((result (sj3-server-open-stdy stdy)))
|
|
|
168 (cond((null sj3-error-code) result)
|
|
|
169 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
170 (EGG:open-sj3)
|
|
|
171 (KKCP:use-stdy stdy))
|
|
|
172 ((null *KKCP:error-flag*) result)
|
|
|
173 (t (KKCP:error sj3-error-code
|
|
|
174 'kkcp:use-stdy stdy)))))
|
|
|
175
|
|
|
176 (defun KKCP:make-stdy (stdy)
|
|
|
177 (let ((result (sj3-server-make-stdy stdy)))
|
|
|
178 (cond((null sj3-error-code) result)
|
|
|
179 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
180 (EGG:open-sj3)
|
|
|
181 (KKCP:make-stdy stdy))
|
|
|
182 ((null *KKCP:error-flag*) result)
|
|
|
183 (t (KKCP:error sj3-error-code
|
|
|
184 'kkcp:make-stdy stdy)))))
|
|
|
185
|
|
|
186 (defun KKCP:henkan-begin (henkan-string)
|
|
|
187 (let ((result (sj3-server-henkan-begin henkan-string)))
|
|
|
188 (cond((null sj3-error-code) result)
|
|
|
189 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
190 (EGG:open-sj3)
|
|
|
191 (KKCP:henkan-begin henkan-string))
|
|
|
192 ((null *KKCP:error-flag*) result)
|
|
|
193 (t (KKCP:error sj3-error-code 'KKCP:henkan-begin henkan-string)))))
|
|
|
194
|
|
|
195 (defun KKCP:henkan-next (bunsetu-no)
|
|
|
196 (let ((result (sj3-server-henkan-next bunsetu-no)))
|
|
|
197 (cond ((null sj3-error-code) result)
|
|
|
198 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
199 (EGG:open-sj3)
|
|
|
200 (KKCP:henkan-next bunsetu-no))
|
|
|
201 ((null *KKCP:error-flag*) result)
|
|
|
202 (t (KKCP:error sj3-error-code 'KKCP:henkan-next bunsetu-no)))))
|
|
|
203
|
|
|
204 (defun KKCP:henkan-kakutei (bunsetu-no jikouho-no)
|
|
|
205 ;;; NOTE: $B<!8uJd%j%9%H$,@_Dj$5$l$F$$$k$3$H$r3NG'$7$F;HMQ$9$k$3$H!#(B
|
|
|
206 (let ((result (sj3-server-henkan-kakutei bunsetu-no jikouho-no)))
|
|
|
207 (cond ((null sj3-error-code) result)
|
|
|
208 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
209 (EGG:open-sj3)
|
|
|
210 (KKCP:henkan-kakutei bunsetu-no jikouho-no))
|
|
|
211 ((null *KKCP:error-flag*) result)
|
|
|
212 (t (KKCP:error sj3-error-code 'KKCP:henkan-kakutei bunsetu-no jikouho-no)))))
|
|
|
213
|
|
|
214 (defun KKCP:bunsetu-henkou (bunsetu-no bunsetu-length)
|
|
|
215 (let ((result (sj3-server-bunsetu-henkou bunsetu-no bunsetu-length)))
|
|
|
216 (cond ((null sj3-error-code) result)
|
|
|
217 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
218 (EGG:open-sj3)
|
|
|
219 (KKCP:bunsetu-henkou bunsetu-no bunsetu-length))
|
|
|
220 ((null *KKCP:error-flag*) result)
|
|
|
221 (t (KKCP:error sj3-error-code 'kkcp:bunsetu-henkou bunsetu-no bunsetu-length)))))
|
|
|
222
|
|
|
223
|
|
|
224 (defun KKCP:henkan-quit ()
|
|
|
225 (let ((result (sj3-server-henkan-quit)))
|
|
|
226 (cond ((null sj3-error-code) result)
|
|
|
227 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
228 (EGG:open-sj3)
|
|
|
229 (KKCP:henkan-quit))
|
|
|
230 ((null *KKCP:error-flag*) result)
|
|
|
231 (t (KKCP:error sj3-error-code 'KKCP:henkan-quit)))))
|
|
|
232
|
|
|
233 (defun KKCP:henkan-end (&optional bunsetuno)
|
|
|
234 (let ((result (sj3-server-henkan-end bunsetuno)))
|
|
|
235 (cond ((null sj3-error-code) result)
|
|
|
236 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
237 (EGG:open-sj3)
|
|
|
238 (KKCP:henkan-end bunsetuno))
|
|
|
239 ((null *KKCP:error-flag*) result)
|
|
|
240 (t (KKCP:error sj3-error-code 'KKCP:henkan-end)))))
|
|
|
241
|
|
|
242 (defun KKCP:dict-add (dictno kanji yomi bunpo)
|
|
|
243 (let ((result (sj3-server-dict-add dictno kanji yomi bunpo)))
|
|
|
244 (cond ((null sj3-error-code) result)
|
|
|
245 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
246 (EGG:open-sj3)
|
|
|
247 (KKCP:dict-add dictno kanji yomi bunpo))
|
|
|
248 ((null *KKCP:error-flag*) result)
|
|
|
249 (t (KKCP:error sj3-error-code 'KKCP:dict-add dictno kanji yomi bunpo)))))
|
|
|
250
|
|
|
251 (defun KKCP:dict-delete (dictno kanji yomi bunpo)
|
|
|
252 (let ((result (sj3-server-dict-delete dictno kanji yomi bunpo)))
|
|
|
253 (cond ((null sj3-error-code) result)
|
|
|
254 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
255 (EGG:open-sj3)
|
|
|
256 (KKCP:dict-delete dictno kanji yomi bunpo))
|
|
|
257 ((null *KKCP:error-flag*) result)
|
|
|
258 (t (KKCP:error sj3-error-code 'KKCP:dict-delete dictno kanji yomi bunpo)))))
|
|
|
259
|
|
|
260 (defun KKCP:dict-info (dictno)
|
|
|
261 (let ((result (sj3-server-dict-info dictno)))
|
|
|
262 (cond ((null sj3-error-code) result)
|
|
|
263 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
264 (EGG:open-sj3)
|
|
|
265 (KKCP:dict-info dictno))
|
|
|
266 ((null *KKCP:error-flag*) result)
|
|
|
267 (t (KKCP:error sj3-error-code 'KKCP:dict-info dictno)))))
|
|
|
268
|
|
|
269 (defun KKCP:make-directory (pathname)
|
|
|
270 (let ((result (sj3-server-make-directory pathname)))
|
|
|
271 (cond ((null sj3-error-code) result)
|
|
|
272 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
273 (EGG:open-sj3)
|
|
|
274 (KKCP:make-directory pathname))
|
|
|
275 ((null *KKCP:error-flag*) result)
|
|
|
276 (t (KKCP:error sj3-error-code 'kkcp:make-directory pathname)))))
|
|
|
277
|
|
|
278 (defun KKCP:file-access (pathname mode)
|
|
|
279 (let ((result (sj3-server-file-access pathname mode)))
|
|
|
280 (cond ((null sj3-error-code)
|
|
|
281 (if (= result 0) t nil))
|
|
|
282 ((eq sj3-error-code ':sj3-no-connection)
|
|
|
283 (EGG:open-sj3)
|
|
|
284 (KKCP:file-access pathname mode))
|
|
|
285 ((null *KKCP:error-flag*) result)
|
|
|
286 (t (KKCP:error sj3-error-code 'kkcp:file-access pathname mode)))))
|
|
|
287
|
|
|
288 (defun KKCP:server-close ()
|
|
|
289 (let ((result (sj3-server-close)))
|
|
|
290 (cond ((null sj3-error-code) result)
|
|
|
291 ((null *KKCP:error-flag*) result)
|
|
|
292 (t (KKCP:error sj3-error-code 'KKCP:server-close)))))
|
|
|
293
|
|
|
294 ;;;----------------------------------------------------------------------
|
|
|
295 ;;;
|
|
|
296 ;;; Kana Kanji Henkan
|
|
|
297 ;;;
|
|
|
298 ;;;----------------------------------------------------------------------
|
|
|
299
|
|
|
300 ;;;
|
|
|
301 ;;; Entry functions for egg-startup-file
|
|
|
302 ;;;
|
|
|
303
|
|
|
304 (defvar *default-sys-dic-directory* "/usr/sony/dict/sj3")
|
|
|
305
|
|
|
306 (defun set-default-sys-dic-directory (pathname)
|
|
|
307 "$B%7%9%F%`<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B
|
|
|
308 PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B"
|
|
|
309
|
|
|
310 (setq pathname (substitute-in-file-name pathname))
|
|
|
311
|
|
|
312 (if (not (file-name-absolute-p pathname))
|
|
|
313 (error "Default directory must be absolute pathname")
|
|
|
314 (if (null (KKCP:file-access pathname 0))
|
|
|
315 (error
|
|
|
316 (format "System Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname))
|
|
|
317 (setq *default-sys-dic-directory* (file-name-as-directory pathname)))))
|
|
|
318
|
|
|
319 (defvar *default-usr-dic-directory* "/usr/sony/dict/sj3/user/$USER")
|
|
|
320
|
|
|
321 (defun set-default-usr-dic-directory (pathname)
|
|
|
322 "$BMxMQ<T<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B
|
|
|
323 PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B"
|
|
|
324
|
|
|
325 (setq pathname (file-name-as-directory (substitute-in-file-name pathname)))
|
|
|
326
|
|
|
327 (if (not (file-name-absolute-p pathname))
|
|
|
328 (error "Default directory must be absolute pathname")
|
|
|
329 (if (null (KKCP:file-access pathname 0))
|
|
|
330 (let ((updir (file-name-directory (substring pathname 0 -1))))
|
|
|
331 (if (null (KKCP:file-access updir 0))
|
|
|
332 (error
|
|
|
333 (format "User Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname))
|
|
|
334 (if (yes-or-no-p (format "User Default directory(%s) $B$r:n$j$^$9$+!)(B" pathname))
|
|
|
335 (progn
|
|
|
336 (KKCP:make-directory (directory-file-name pathname))
|
|
|
337 (notify "User Default directory(%s) $B$r:n$j$^$7$?!#(B" pathname))
|
|
|
338 nil ;;; do nothing
|
|
|
339 ))))
|
|
|
340 (setq *default-usr-dic-directory* pathname)))
|
|
|
341
|
|
|
342 (defun setsysdic (dict)
|
|
|
343 (let ((dictfile
|
|
|
344 (concat (if (not (file-name-absolute-p dict))
|
|
|
345 *default-sys-dic-directory*
|
|
|
346 "")
|
|
|
347 dict)))
|
|
|
348 (egg:setsysdict (expand-file-name dictfile))))
|
|
|
349
|
|
|
350 (defun setusrdic (dict)
|
|
|
351 (let ((dictfile
|
|
|
352 (concat (if (not (file-name-absolute-p dict))
|
|
|
353 *default-usr-dic-directory*
|
|
|
354 "")
|
|
|
355 dict)))
|
|
|
356 (egg:setusrdict (expand-file-name dictfile))))
|
|
|
357
|
|
|
358 (defvar egg:*dict-list* nil)
|
|
|
359
|
|
|
360 (defun setusrstdy (stdy)
|
|
|
361 (let ((stdyfile
|
|
|
362 (concat (if (not (file-name-absolute-p stdy))
|
|
|
363 *default-usr-dic-directory*
|
|
|
364 "")
|
|
|
365 stdy)))
|
|
|
366 (egg:setusrstdy (expand-file-name stdyfile))))
|
|
|
367
|
|
|
368 (defun egg:setsysdict (dict)
|
|
|
369 (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
|
|
|
370 (beep)
|
|
|
371 (notify "$B4{$KF1L>$N%7%9%F%`<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B"
|
|
|
372 (file-name-nondirectory dict))
|
|
|
373 )
|
|
|
374 ((null (KKCP:file-access dict 0))
|
|
|
375 (beep)
|
|
|
376 (notify "$B%7%9%F%`<-=q(B %s $B$,$"$j$^$;$s!#(B" dict))
|
|
|
377 (t(let* ((*KKCP:error-flag* nil)
|
|
|
378 (rc (KKCP:use-dict dict)))
|
|
|
379 (if (null rc)
|
|
|
380 (error "EGG: setsysdict failed. :%s" dict)
|
|
|
381 (setq egg:*dict-list*
|
|
|
382 (cons (cons (file-name-nondirectory dict) dict)
|
|
|
383 egg:*dict-list*)))))))
|
|
|
384
|
|
|
385 ;;; dict-no --> dict-name
|
|
|
386 (defvar egg:*usr-dict* nil)
|
|
|
387
|
|
|
388 ;;; dict-name --> dict-no
|
|
|
389 (defvar egg:*dict-menu* nil)
|
|
|
390
|
|
|
391 (defmacro push-end (val loc)
|
|
|
392 (list 'push-end-internal val (list 'quote loc)))
|
|
|
393
|
|
|
394 (defun push-end-internal (val loc)
|
|
|
395 (set loc
|
|
|
396 (if (eval loc)
|
|
|
397 (nconc (eval loc) (cons val nil))
|
|
|
398 (cons val nil))))
|
|
|
399
|
|
|
400 (defun egg:setusrdict (dict)
|
|
|
401 (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
|
|
|
402 (beep)
|
|
|
403 (notify "$B4{$KF1L>$NMxMQ<T<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B"
|
|
|
404 (file-name-nondirectory dict))
|
|
|
405 )
|
|
|
406 ((null (KKCP:file-access dict 0))
|
|
|
407 (notify "$BMxMQ<T<-=q(B %s $B$,$"$j$^$;$s!#(B" dict)
|
|
|
408 (if (yes-or-no-p (format "$BMxMQ<T<-=q(B %s $B$r:n$j$^$9$+!)(B" dict))
|
|
|
409 (let ((*KKCP:error-flag* nil))
|
|
|
410 (if (KKCP:make-dict dict)
|
|
|
411 (progn
|
|
|
412 (notify "$BMxMQ<T<-=q(B %s $B$r:n$j$^$7$?!#(B" dict)
|
|
|
413 (let* ((*KKCP:error-flag* nil)
|
|
|
414 (dict-no (KKCP:use-dict dict "")))
|
|
|
415 (cond((numberp dict-no)
|
|
|
416 (setq egg:*usr-dict*
|
|
|
417 (cons (cons dict-no dict) egg:*usr-dict*))
|
|
|
418 (push-end (cons (file-name-nondirectory dict)
|
|
|
419 dict-no) egg:*dict-menu*))
|
|
|
420 (t (error "EGG: setusrdict failed. :%s" dict)))))
|
|
|
421 (error "EGG: setusrdict failed. : %s" dict)))))
|
|
|
422 (t (let* ((*KKCP:error-flag* nil)
|
|
|
423 (dict-no (KKCP:use-dict dict "")))
|
|
|
424 (cond((numberp dict-no)
|
|
|
425 (setq egg:*usr-dict* (cons(cons dict-no dict)
|
|
|
426 egg:*usr-dict*))
|
|
|
427 (push-end (cons (file-name-nondirectory dict) dict-no)
|
|
|
428 egg:*dict-menu*)
|
|
|
429 (setq egg:*dict-list*
|
|
|
430 (cons (cons (file-name-nondirectory dict) dict)
|
|
|
431 egg:*dict-list*)))
|
|
|
432 (t (error "EGG: setusrdict failed. : %s" dict)))))))
|
|
|
433
|
|
|
434 (defun egg:setusrstdy (stdy)
|
|
|
435 (cond((null (KKCP:file-access stdy 0))
|
|
|
436 (notify "$B3X=,%U%!%$%k(B %s $B$,$"$j$^$;$s!#(B" stdy)
|
|
|
437 (if (yes-or-no-p (format "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$9$+!)(B" stdy))
|
|
|
438 (if (null (KKCP:make-stdy stdy))
|
|
|
439 (error "EGG: setusrstdy failed. : %s" stdy)
|
|
|
440 (notify "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$7$?!#(B" stdy)
|
|
|
441 (if (null (KKCP:use-stdy stdy))
|
|
|
442 (error "EGG: setusrstdy failed. : %s" stdy))
|
|
|
443 )))
|
|
|
444 (t (if (null (KKCP:use-stdy stdy))
|
|
|
445 (error "EGG: setusrstdy failed. : %s" stdy)))))
|
|
|
446
|
|
|
447
|
|
|
448 ;;;
|
|
|
449 ;;; SJ3 interface
|
|
|
450 ;;;
|
|
|
451
|
|
|
452 (defun get-sj3-host-name ()
|
|
|
453 (cond((and (boundp 'sj3-host-name) (stringp sj3-host-name))
|
|
|
454 sj3-host-name)
|
|
|
455 ((and (boundp 'sj3serv-host-name) (stringp sj3serv-host-name))
|
|
|
456 sj3serv-host-name)
|
|
|
457 (t(getenv "SJ3SERV")))) ; 92.7.7 by Y.Kawabe
|
|
|
458
|
|
|
459 (fset 'get-sj3serv-host-name (symbol-function 'get-sj3-host-name))
|
|
|
460
|
|
|
461 (defun set-sj3-host-name (name)
|
|
|
462 (interactive "sHost name: ")
|
|
|
463 (let ((*KKCP:error-flag* nil))
|
|
|
464 (disconnect-sj3))
|
|
|
465 (setq sj3-host-name name)
|
|
|
466 )
|
|
|
467
|
|
|
468 (defvar egg-default-startup-file "eggrc-sj3"
|
|
|
469 "*Egg startup file name (system default)")
|
|
|
470
|
|
|
471 (defvar egg-startup-file ".eggrc-sj3"
|
|
|
472 "*Egg startup file name.")
|
|
|
473
|
|
|
474 (defvar egg-startup-file-search-path (append '("~" ".") load-path)
|
|
|
475 "*List of directories to search for start up file to load.")
|
|
|
476
|
|
|
477 (defun egg:search-file (filename searchpath)
|
|
|
478 (let ((result nil))
|
|
|
479 (if (null (file-name-directory filename))
|
|
|
480 (let ((path searchpath))
|
|
|
481 (while (and path (null result ))
|
|
|
482 (let ((file (substitute-in-file-name
|
|
|
483 (expand-file-name filename (if (stringp (car path)) (car path) nil)))))
|
|
|
484 (if (file-exists-p file) (setq result file)
|
|
|
485 (setq path (cdr path))))))
|
|
|
486 (let((file (substitute-in-file-name (expand-file-name filename))))
|
|
|
487 (if (file-exists-p file) (setq result file))))
|
|
|
488 result))
|
|
|
489
|
|
|
490 (defun EGG:open-sj3 ()
|
|
|
491 (KKCP:server-open (or (get-sj3-host-name) (system-name))
|
|
|
492 (user-login-name))
|
|
|
493 (setq egg:*usr-dict* nil
|
|
|
494 egg:*dict-list* nil
|
|
|
495 egg:*dict-menu* nil)
|
|
|
496 (notify "$B%[%9%H(B %s $B$N(B SJ3 $B$r5/F0$7$^$7$?!#(B" (or (get-sj3-host-name) "local"))
|
|
|
497 (let ((eggrc (or (egg:search-file egg-startup-file egg-startup-file-search-path)
|
|
|
498 (egg:search-file egg-default-startup-file load-path))))
|
|
|
499 (if eggrc (load-file eggrc)
|
|
|
500 (progn
|
|
|
501 (KKCP:server-close)
|
|
|
502 (error "eggrc-search-path $B>e$K(B egg-startup-file $B$,$"$j$^$;$s!#(B")))))
|
|
|
503
|
|
|
504 (defun disconnect-sj3 ()
|
|
|
505 (interactive)
|
|
|
506 (KKCP:server-close))
|
|
|
507
|
|
|
508 (defun close-sj3 ()
|
|
|
509 (interactive)
|
|
|
510 (KKCP:server-close))
|
|
|
511
|
|
|
512 ;;;
|
|
|
513 ;;; Kanji henkan
|
|
|
514 ;;;
|
|
|
515
|
|
|
516 (defvar egg:*kanji-kanabuff* nil)
|
|
|
517
|
|
|
518 (defvar *bunsetu-number* nil)
|
|
|
519
|
|
|
520 (defun bunsetu-su ()
|
|
|
521 (sj3-bunsetu-suu))
|
|
|
522
|
|
|
523 (defun bunsetu-length (number)
|
|
|
524 (sj3-bunsetu-yomi-moji-suu number))
|
|
|
525
|
|
|
526 (defun kanji-moji-suu (str)
|
|
|
527 (let ((max (length str)) (count 0) (i 0))
|
|
|
528 (while (< i max)
|
|
|
529 (setq count (1+ count))
|
|
|
530 (if (< (aref str i) 128) (setq i (1+ i)) (setq i (+ i 3))))
|
|
|
531 count))
|
|
|
532
|
|
|
533 (defun bunsetu-position (number)
|
|
|
534 (let ((pos egg:*region-start*) (i 0))
|
|
|
535 (while (< i number)
|
|
|
536 (setq pos (+ pos (bunsetu-kanji-length i) (length egg:*bunsetu-kugiri*)))
|
|
|
537 (setq i (1+ i)))
|
|
|
538 pos))
|
|
|
539
|
|
|
540 (defun bunsetu-kanji-length (bunsetu-no)
|
|
|
541 (sj3-bunsetu-kanji-length bunsetu-no))
|
|
|
542
|
|
|
543 (defun bunsetu-kanji (number)
|
|
|
544 (sj3-bunsetu-kanji number))
|
|
|
545
|
|
|
546 (defun bunsetu-kanji-insert (bunsetu-no)
|
|
|
547 (sj3-bunsetu-kanji bunsetu-no (current-buffer)))
|
|
|
548
|
|
|
549 (defun bunsetu-set-kanji (bunsetu-no kouho-no)
|
|
|
550 (sj3-server-henkan-kakutei bunsetu-no kouho-no))
|
|
|
551
|
|
|
552 (defun bunsetu-yomi (number)
|
|
|
553 (sj3-bunsetu-yomi number))
|
|
|
554
|
|
|
555 (defun bunsetu-yomi-insert (bunsetu-no)
|
|
|
556 (sj3-bunsetu-yomi bunsetu-no (current-buffer)))
|
|
|
557
|
|
|
558 (defun bunsetu-yomi-equal (number yomi)
|
|
|
559 (sj3-bunsetu-yomi-equal number yomi))
|
|
|
560
|
|
|
561 (defun bunsetu-kouho-suu (bunsetu-no)
|
|
|
562 (let ((no (sj3-bunsetu-kouho-suu bunsetu-no)))
|
|
|
563 (if (< 1 no) no
|
|
|
564 (KKCP:henkan-next bunsetu-no)
|
|
|
565 (sj3-bunsetu-kouho-suu bunsetu-no))))
|
|
|
566
|
|
|
567 (defun bunsetu-kouho-list (number)
|
|
|
568 (let ((no (bunsetu-kouho-suu number)))
|
|
|
569 (if (= no 1)
|
|
|
570 (KKCP:henkan-next number))
|
|
|
571 (sj3-bunsetu-kouho-list number)))
|
|
|
572
|
|
|
573 (defun bunsetu-kouho-number (bunsetu-no)
|
|
|
574 (sj3-bunsetu-kouho-number bunsetu-no))
|
|
|
575
|
|
|
576 ;;;;
|
|
|
577 ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence
|
|
|
578 ;;;;
|
|
|
579
|
|
|
580 (defconst egg:*bunsetu-face* nil "*$BJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil")
|
|
|
581 (make-variable-buffer-local
|
|
|
582 (defvar egg:*bunsetu-overlay* nil "$BJ8@a$NI=<($K;H$&(B overlay"))
|
|
|
583
|
|
|
584 (defconst egg:*bunsetu-kugiri* " " "*$BJ8@a$N6h@Z$j$r<($9J8;zNs(B")
|
|
|
585
|
|
|
586
|
|
|
587 (defconst egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil")
|
|
|
588 (make-variable-buffer-local
|
|
|
589 (defvar egg:*henkan-overlay* nil "$BJQ49NN0h$NI=<($K;H$&(B overlay"))
|
|
|
590
|
|
|
591 (defconst egg:*henkan-open* "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B")
|
|
|
592 (defconst egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B")
|
|
|
593
|
|
|
594 (defun egg:henkan-face-on ()
|
|
|
595 (if (overlayp egg:*henkan-overlay*) nil
|
|
|
596 (setq egg:*henkan-overlay* (make-overlay 1 1 nil))
|
|
|
597 (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*) )
|
|
|
598 (move-overlay egg:*henkan-overlay* egg:*region-start* egg:*region-end* (current-buffer)) )
|
|
|
599
|
|
|
600 (defun egg:henkan-face-off ()
|
|
|
601 (and (overlayp egg:*henkan-overlay*)
|
|
|
602 (delete-overlay egg:*henkan-overlay*) ))
|
|
|
603
|
|
|
604 (defun henkan-region (start end)
|
|
|
605 (interactive "r")
|
|
|
606 (if (interactive-p) (set-mark (point))) ;;; to be fixed
|
|
|
607 (henkan-region-internal start end))
|
|
|
608
|
|
|
609 (defvar henkan-mode-indicator "$B4A(B")
|
|
|
610
|
|
|
611 (defun henkan-region-internal (start end)
|
|
|
612 "region$B$r$+$J4A;zJQ49$9$k!#(B"
|
|
|
613 (setq egg:*kanji-kanabuff* (buffer-substring start end))
|
|
|
614 (if overwrite-mode
|
|
|
615 (setq egg:*overwrite-mode-deleted-chars*
|
|
|
616 (if egg:*henkan-fence-mode* 0
|
|
|
617 (length egg:*kanji-kanabuff*))))
|
|
|
618 (setq *bunsetu-number* nil)
|
|
|
619 (let ((result (KKCP:henkan-begin egg:*kanji-kanabuff*)))
|
|
|
620 (if result
|
|
|
621 (progn
|
|
|
622 (mode-line-egg-mode-update henkan-mode-indicator)
|
|
|
623 (goto-char start)
|
|
|
624 (or (markerp egg:*region-start*)
|
|
|
625 (setq egg:*region-start* (make-marker)))
|
|
|
626 (or (markerp egg:*region-end*)
|
|
|
627 (setq egg:*region-end* (set-marker-type (make-marker) t)))
|
|
|
628 (if (null (marker-position egg:*region-start*))
|
|
|
629 (progn
|
|
|
630 ;;;(setq egg:*global-map-backup* (current-global-map))
|
|
|
631 (setq egg:*local-map-backup* (current-local-map))
|
|
|
632 ;; XEmacs change:
|
|
|
633 (buffer-disable-undo (current-buffer))
|
|
|
634 (goto-char start)
|
|
|
635 (delete-region start end)
|
|
|
636 (insert egg:*henkan-open*)
|
|
|
637 (set-marker egg:*region-start* (point))
|
|
|
638 (insert egg:*henkan-close*)
|
|
|
639 (set-marker egg:*region-end* egg:*region-start*)
|
|
|
640 (egg:henkan-face-on)
|
|
|
641 (goto-char egg:*region-start*)
|
|
|
642 )
|
|
|
643 (progn
|
|
|
644 (egg:fence-face-off)
|
|
|
645 (delete-region (- egg:*region-start* (length egg:*fence-open*))
|
|
|
646 egg:*region-start*)
|
|
|
647 (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*fence-close*)))
|
|
|
648 (goto-char egg:*region-start*)
|
|
|
649 (insert egg:*henkan-open*)
|
|
|
650 (set-marker egg:*region-start* (point))
|
|
|
651 (goto-char egg:*region-end*)
|
|
|
652 (let ((point (point)))
|
|
|
653 (insert egg:*henkan-close*)
|
|
|
654 (set-marker egg:*region-end* point))
|
|
|
655 (goto-char start)
|
|
|
656 (delete-region start end)
|
|
|
657 (egg:henkan-face-on))
|
|
|
658 )
|
|
|
659 (henkan-insert-kouho 0)
|
|
|
660 (henkan-goto-bunsetu 0)
|
|
|
661 ;;;(use-global-map henkan-mode-map)
|
|
|
662 ;;;(use-local-map nil)
|
|
|
663 (use-local-map henkan-mode-map)
|
|
|
664 )))
|
|
|
665 )
|
|
|
666
|
|
|
667 (defun henkan-paragraph ()
|
|
|
668 "Kana-kanji henkan paragraph at or after point."
|
|
|
669 (interactive )
|
|
|
670 (save-excursion
|
|
|
671 (forward-paragraph)
|
|
|
672 (let ((end (point)))
|
|
|
673 (backward-paragraph)
|
|
|
674 (henkan-region-internal (point) end ))))
|
|
|
675
|
|
|
676 (defun henkan-sentence ()
|
|
|
677 "Kana-kanji henkan sentence at or after point."
|
|
|
678 (interactive )
|
|
|
679 (save-excursion
|
|
|
680 (forward-sentence)
|
|
|
681 (let ((end (point)))
|
|
|
682 (backward-sentence)
|
|
|
683 (henkan-region-internal (point) end ))))
|
|
|
684
|
|
|
685 (defun henkan-word ()
|
|
|
686 "Kana-kanji henkan word at or after point."
|
|
|
687 (interactive)
|
|
|
688 (save-excursion
|
|
|
689 (re-search-backward "\\b\\w" nil t)
|
|
|
690 (let ((start (point)))
|
|
|
691 (re-search-forward "\\w\\b" nil t)
|
|
|
692 (henkan-region-internal start (point)))))
|
|
|
693
|
|
|
694 ;;;
|
|
|
695 ;;; Kana Kanji Henkan Henshuu mode
|
|
|
696 ;;;
|
|
|
697
|
|
|
698 (defun set-egg-henkan-mode-format (open close kugiri &optional henkan-face bunsetu-face)
|
|
|
699 "$BJQ49(B mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$OJQ49$N;OE@$r<($9J8;zNs$^$?$O(B nil$B!#(B
|
|
|
700 CLOSE$B$OJQ49$N=*E@$r<($9J8;zNs$^$?$O(B nil$B!#(B
|
|
|
701 KUGIRI$B$OJ8@a$N6h@Z$j$rI=<($9$kJ8;zNs$^$?$O(B nil$B!#(B
|
|
|
702 HENKAN-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"JQ496h4V$rI=<($9$k(B face $B$H$7$F;H$o$l$k!#(B
|
|
|
703 BUNSETU-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"CmL\$7$F$$$kJ8@a$rI=<($9$k(B face $B$H$7$F;H$o$l$k(B"
|
|
|
704
|
|
|
705 (interactive (list (read-string "$BJQ493+;OJ8;zNs(B: ")
|
|
|
706 (read-string "$BJQ49=*N;J8;zNs(B: ")
|
|
|
707 (read-string "$BJ8@a6h@Z$jJ8;zNs(B: ")
|
|
|
708 (cdr (assoc (completing-read "$BJQ496h4VI=<(B0@-(B: " egg:*face-alist*)
|
|
|
709 egg:*face-alist*))
|
|
|
710 (cdr (assoc (completing-read "$BJ8@a6h4VI=<(B0@-(B: " egg:*face-alist*)
|
|
|
711 egg:*face-alist*))
|
|
|
712 ))
|
|
|
713
|
|
|
714 (if (and (or (stringp open) (null open))
|
|
|
715 (or (stringp close) (null close))
|
|
|
716 (or (stringp kugiri) (null kugiri))
|
|
|
717 (or (null henkan-face) (memq henkan-face (face-list)))
|
|
|
718 (or (null bunsetu-face) (memq henkan-face (face-list))))
|
|
|
719 (progn
|
|
|
720 (setq egg:*henkan-open* (or open "")
|
|
|
721 egg:*henkan-close* (or close "")
|
|
|
722 egg:*bunsetu-kugiri* (or kugiri "")
|
|
|
723 egg:*henkan-face* henkan-face
|
|
|
724 egg:*bunsetu-face* bunsetu-face)
|
|
|
725 (if (overlayp egg:*henkan-overlay*)
|
|
|
726 (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*))
|
|
|
727 (if (overlayp egg:*bunsetu-overlay*)
|
|
|
728 (overlay-put egg:*bunsetu-overlay* 'face egg:*bunsetu-face*))
|
|
|
729
|
|
|
730 t)
|
|
|
731 (error "Wrong type of arguments: %1 %2 %3 %4 %5" open close kugiri henkan-face bunsetu-face)))
|
|
|
732
|
|
|
733 (defun henkan-insert-kouho (bunsetu-no)
|
|
|
734 (let ((max (bunsetu-su)) (i bunsetu-no))
|
|
|
735 (while (< i max)
|
|
|
736 (bunsetu-kanji-insert i)
|
|
|
737 (insert egg:*bunsetu-kugiri* )
|
|
|
738 (setq i (1+ i)))
|
|
|
739 (if (< bunsetu-no max) (delete-char (- (length egg:*bunsetu-kugiri*))))))
|
|
|
740
|
|
|
741 (defun henkan-kakutei ()
|
|
|
742 (interactive)
|
|
|
743 (egg:bunsetu-face-off *bunsetu-number*)
|
|
|
744 (egg:henkan-face-off)
|
|
|
745 (delete-region (- egg:*region-start* (length egg:*henkan-open*))
|
|
|
746 egg:*region-start*)
|
|
|
747 (delete-region egg:*region-start* egg:*region-end*)
|
|
|
748 (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
|
|
|
749 (goto-char egg:*region-start*)
|
|
|
750 (let ((i 0) (max (bunsetu-su)))
|
|
|
751 (while (< i max)
|
|
|
752 ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
|
|
|
753 (bunsetu-kanji-insert i)
|
|
|
754 (if (not overwrite-mode)
|
|
|
755 (undo-boundary))
|
|
|
756 (setq i (1+ i))
|
|
|
757 ))
|
|
|
758 (KKCP:henkan-end)
|
|
|
759 (egg:quit-egg-mode)
|
|
|
760 )
|
|
|
761
|
|
|
762 (defun henkan-kakutei-before-point ()
|
|
|
763 (interactive)
|
|
|
764 (egg:bunsetu-face-off *bunsetu-number*)
|
|
|
765 (egg:henkan-face-off)
|
|
|
766 (delete-region egg:*region-start* egg:*region-end*)
|
|
|
767 (goto-char egg:*region-start*)
|
|
|
768 (let ((i 0) (max *bunsetu-number*))
|
|
|
769 (while (< i max)
|
|
|
770 ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
|
|
|
771 (bunsetu-kanji-insert i)
|
|
|
772 (if (not overwrite-mode)
|
|
|
773 (undo-boundary))
|
|
|
774 (setq i (1+ i))
|
|
|
775 ))
|
|
|
776 (KKCP:henkan-end *bunsetu-number*)
|
|
|
777 (delete-region (- egg:*region-start* (length egg:*henkan-open*))
|
|
|
778 egg:*region-start*)
|
|
|
779 (insert egg:*fence-open*)
|
|
|
780 (set-marker egg:*region-start* (point))
|
|
|
781 (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
|
|
|
782 (goto-char egg:*region-end*)
|
|
|
783 (let ((point (point)))
|
|
|
784 (insert egg:*fence-close*)
|
|
|
785 (set-marker egg:*region-end* point))
|
|
|
786 (goto-char egg:*region-start*)
|
|
|
787 (egg:fence-face-on)
|
|
|
788 (let ((point (point))
|
|
|
789 (i *bunsetu-number*) (max (bunsetu-su)))
|
|
|
790 (while (< i max)
|
|
|
791 (bunsetu-yomi-insert i)
|
|
|
792 (setq i (1+ i)))
|
|
|
793 ;;;(insert "|")
|
|
|
794 ;;;(insert egg:*fence-close*)
|
|
|
795 ;;;(set-marker egg:*region-end* (point))
|
|
|
796 (goto-char point))
|
|
|
797 (setq egg:*mode-on* t)
|
|
|
798 ;;;(use-global-map fence-mode-map)
|
|
|
799 ;;;(use-local-map nil)
|
|
|
800 (use-local-map fence-mode-map)
|
|
|
801 (egg:mode-line-display))
|
|
|
802
|
|
|
803 (defun egg:set-bunsetu-face (no face switch)
|
|
|
804 (if (not switch)
|
|
|
805 (egg:bunsetu-face-off no) ;; JIC
|
|
|
806 (if (overlayp egg:*bunsetu-overlay*) nil
|
|
|
807 (setq egg:*bunsetu-overlay* (make-overlay 1 1 nil))
|
|
|
808 (overlay-put egg:*bunsetu-overlay* 'face egg:*bunsetu-face*))
|
|
|
809 (move-overlay egg:*bunsetu-overlay*
|
|
|
810 (if (eq face 'modeline)
|
|
|
811 (let ((point (bunsetu-position no)))
|
|
|
812 (+ point (1+ (char-boundary-p point))))
|
|
|
813 (bunsetu-position no))
|
|
|
814
|
|
|
815 (if (= no (1- (bunsetu-su)))
|
|
|
816 egg:*region-end*
|
|
|
817 (- (bunsetu-position (1+ no))
|
|
|
818 (length egg:*bunsetu-kugiri*)))
|
|
|
819 (current-buffer))))
|
|
|
820
|
|
|
821 (defun egg:bunsetu-face-on (no)
|
|
|
822 (egg:set-bunsetu-face no egg:*bunsetu-face* t))
|
|
|
823
|
|
|
824 (defun egg:bunsetu-face-off (no)
|
|
|
825 ;; ``no'' will be ignored
|
|
|
826 (and (overlayp egg:*bunsetu-overlay*)
|
|
|
827 (delete-overlay egg:*bunsetu-overlay*)) )
|
|
|
828
|
|
|
829 (defun henkan-goto-bunsetu (number)
|
|
|
830 (setq *bunsetu-number*
|
|
|
831 (check-number-range number 0 (1- (bunsetu-su))))
|
|
|
832 (goto-char (bunsetu-position *bunsetu-number*))
|
|
|
833 (egg:bunsetu-face-on *bunsetu-number*)
|
|
|
834 )
|
|
|
835
|
|
|
836 (defun henkan-forward-bunsetu ()
|
|
|
837 (interactive)
|
|
|
838 (henkan-goto-bunsetu (1+ *bunsetu-number*))
|
|
|
839 )
|
|
|
840
|
|
|
841 (defun henkan-backward-bunsetu ()
|
|
|
842 (interactive)
|
|
|
843 (henkan-goto-bunsetu (1- *bunsetu-number*))
|
|
|
844 )
|
|
|
845
|
|
|
846 (defun henkan-first-bunsetu ()
|
|
|
847 (interactive)
|
|
|
848 (henkan-goto-bunsetu 0))
|
|
|
849
|
|
|
850 (defun henkan-last-bunsetu ()
|
|
|
851 (interactive)
|
|
|
852 (henkan-goto-bunsetu (1- (bunsetu-su)))
|
|
|
853 )
|
|
|
854
|
|
|
855 (defun check-number-range (i min max)
|
|
|
856 (cond((< i min) max)
|
|
|
857 ((< max i) min)
|
|
|
858 (t i)))
|
|
|
859
|
|
|
860 (defun henkan-hiragana ()
|
|
|
861 (interactive)
|
|
|
862 (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 1)))
|
|
|
863
|
|
|
864 (defun henkan-katakana ()
|
|
|
865 (interactive)
|
|
|
866 (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 2)))
|
|
|
867
|
|
|
868 (defun henkan-next-kouho ()
|
|
|
869 (interactive)
|
|
|
870 (henkan-goto-kouho (1+ (bunsetu-kouho-number *bunsetu-number*))))
|
|
|
871
|
|
|
872 (defun henkan-previous-kouho ()
|
|
|
873 (interactive)
|
|
|
874 (henkan-goto-kouho (1- (bunsetu-kouho-number *bunsetu-number*))))
|
|
|
875
|
|
|
876 (defun henkan-goto-kouho (kouho-number)
|
|
|
877 (let ((point (point))
|
|
|
878 (yomi (bunsetu-yomi *bunsetu-number*))
|
|
|
879 (i *bunsetu-number*)
|
|
|
880 (max (bunsetu-su)))
|
|
|
881 (setq kouho-number
|
|
|
882 (check-number-range kouho-number
|
|
|
883 0
|
|
|
884 (1- (bunsetu-kouho-suu *bunsetu-number*))))
|
|
|
885 (while (< i max)
|
|
|
886 (if (bunsetu-yomi-equal i yomi)
|
|
|
887 (let ((p1 (bunsetu-position i)))
|
|
|
888 (delete-region p1
|
|
|
889 (+ p1 (bunsetu-kanji-length i)))
|
|
|
890 (goto-char p1)
|
|
|
891 (bunsetu-set-kanji i kouho-number)
|
|
|
892 (bunsetu-kanji-insert i)))
|
|
|
893 (setq i (1+ i)))
|
|
|
894 (goto-char point))
|
|
|
895 (egg:bunsetu-face-on *bunsetu-number*))
|
|
|
896
|
|
|
897 (defun henkan-bunsetu-chijime ()
|
|
|
898 (interactive)
|
|
|
899 (or (= (bunsetu-length *bunsetu-number*) 1)
|
|
|
900 (bunsetu-length-henko (1- (bunsetu-length *bunsetu-number*)))))
|
|
|
901
|
|
|
902 (defun henkan-bunsetu-nobasi ()
|
|
|
903 (interactive)
|
|
|
904 (if (not (= (1+ *bunsetu-number*) (bunsetu-su)))
|
|
|
905 (bunsetu-length-henko (1+ (bunsetu-length *bunsetu-number*)))))
|
|
|
906
|
|
|
907 (defun henkan-saishou-bunsetu ()
|
|
|
908 (interactive)
|
|
|
909 (bunsetu-length-henko 1))
|
|
|
910
|
|
|
911 (defun henkan-saichou-bunsetu ()
|
|
|
912 (interactive)
|
|
|
913 (let ((max (bunsetu-su)) (i *bunsetu-number*)
|
|
|
914 (l 0))
|
|
|
915 (while (< i max)
|
|
|
916 (setq l (+ l (bunsetu-length i)))
|
|
|
917 (setq i (1+ i)))
|
|
|
918 (bunsetu-length-henko l)))
|
|
|
919
|
|
|
920 (defun bunsetu-length-henko (length)
|
|
|
921 (let ((r (KKCP:bunsetu-henkou *bunsetu-number* length)))
|
|
|
922 (cond(r
|
|
|
923 (delete-region
|
|
|
924 (bunsetu-position *bunsetu-number*) egg:*region-end*)
|
|
|
925 (goto-char (bunsetu-position *bunsetu-number*))
|
|
|
926 (henkan-insert-kouho *bunsetu-number*)
|
|
|
927 (henkan-goto-bunsetu *bunsetu-number*))
|
|
|
928 (t
|
|
|
929 (egg:bunsetu-face-on *bunsetu-number*)))))
|
|
|
930
|
|
|
931 (defun henkan-quit ()
|
|
|
932 (interactive)
|
|
|
933 (egg:bunsetu-face-off *bunsetu-number*)
|
|
|
934 (egg:henkan-face-off)
|
|
|
935 (delete-region (- egg:*region-start* (length egg:*henkan-open*))
|
|
|
936 egg:*region-start*)
|
|
|
937 (delete-region egg:*region-start* egg:*region-end*)
|
|
|
938 (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
|
|
|
939 (goto-char egg:*region-start*)
|
|
|
940 (insert egg:*fence-open*)
|
|
|
941 (set-marker egg:*region-start* (point))
|
|
|
942 (insert egg:*kanji-kanabuff*)
|
|
|
943 (let ((point (point)))
|
|
|
944 (insert egg:*fence-close*)
|
|
|
945 (set-marker egg:*region-end* point)
|
|
|
946 )
|
|
|
947 (goto-char egg:*region-end*)
|
|
|
948 (egg:fence-face-on)
|
|
|
949 (KKCP:henkan-quit)
|
|
|
950 (setq egg:*mode-on* t)
|
|
|
951 ;;;(use-global-map fence-mode-map)
|
|
|
952 ;;;(use-local-map nil)
|
|
|
953 (use-local-map fence-mode-map)
|
|
|
954 (egg:mode-line-display)
|
|
|
955 )
|
|
|
956
|
|
|
957 (defun henkan-select-kouho ()
|
|
|
958 (interactive)
|
|
|
959 (if (not (eq (selected-window) (minibuffer-window)))
|
|
|
960 (let ((kouho-list (bunsetu-kouho-list *bunsetu-number*))
|
|
|
961 menu)
|
|
|
962 (setq menu
|
|
|
963 (list 'menu "$B<!8uJd(B:"
|
|
|
964 (let ((l kouho-list) (r nil) (i 0))
|
|
|
965 (while l
|
|
|
966 (setq r (cons (cons (car l) i) r))
|
|
|
967 (setq i (1+ i))
|
|
|
968 (setq l (cdr l)))
|
|
|
969 (reverse r))))
|
|
|
970 (henkan-goto-kouho
|
|
|
971 (menu:select-from-menu menu
|
|
|
972 (bunsetu-kouho-number *bunsetu-number*))))
|
|
|
973 (beep)))
|
|
|
974
|
|
|
975 (defun henkan-kakutei-and-self-insert ()
|
|
|
976 (interactive)
|
|
|
977 (setq unread-command-events (list last-command-char))
|
|
|
978 (henkan-kakutei))
|
|
|
979
|
|
|
980
|
|
|
981 (defvar henkan-mode-map (make-keymap))
|
|
|
982
|
|
|
983 (defvar henkan-mode-esc-map (make-keymap))
|
|
|
984
|
|
|
985 (let ((ch 0))
|
|
|
986 (while (<= ch 127)
|
|
|
987 (define-key henkan-mode-map (make-string 1 ch) 'undefined)
|
|
|
988 (define-key henkan-mode-esc-map (make-string 1 ch) 'undefined)
|
|
|
989 (setq ch (1+ ch))))
|
|
|
990
|
|
|
991 (let ((ch 32))
|
|
|
992 (while (< ch 127)
|
|
|
993 (define-key henkan-mode-map (make-string 1 ch) 'henkan-kakutei-and-self-insert)
|
|
|
994 (setq ch (1+ ch))))
|
|
|
995
|
|
|
996 (define-key henkan-mode-map "\e" henkan-mode-esc-map)
|
|
|
997 (define-key henkan-mode-map "\ei" 'undefined) ;; henkan-inspect-bunsetu
|
|
|
998 ;; not support for sj3
|
|
|
999 (define-key henkan-mode-map "\es" 'henkan-select-kouho)
|
|
|
1000 (define-key henkan-mode-map "\eh" 'henkan-hiragana)
|
|
|
1001 (define-key henkan-mode-map "\ek" 'henkan-katakana)
|
|
|
1002 (define-key henkan-mode-map "\e<" 'henkan-saishou-bunsetu)
|
|
|
1003 (define-key henkan-mode-map "\e>" 'henkan-saichou-bunsetu)
|
|
|
1004 (define-key henkan-mode-map " " 'henkan-next-kouho)
|
|
|
1005 (define-key henkan-mode-map "\C-@" 'henkan-next-kouho)
|
|
|
1006 (define-key henkan-mode-map "\C-a" 'henkan-first-bunsetu)
|
|
|
1007 (define-key henkan-mode-map "\C-b" 'henkan-backward-bunsetu)
|
|
|
1008 (define-key henkan-mode-map "\C-c" 'henkan-quit)
|
|
|
1009 (define-key henkan-mode-map "\C-d" 'undefined)
|
|
|
1010 (define-key henkan-mode-map "\C-e" 'henkan-last-bunsetu)
|
|
|
1011 (define-key henkan-mode-map "\C-f" 'henkan-forward-bunsetu)
|
|
|
1012 (define-key henkan-mode-map "\C-g" 'henkan-quit)
|
|
|
1013 (define-key henkan-mode-map "\C-h" 'help-command)
|
|
|
1014 (define-key henkan-mode-map "\C-i" 'henkan-bunsetu-chijime)
|
|
|
1015 (define-key henkan-mode-map "\C-j" 'undefined)
|
|
|
1016 (define-key henkan-mode-map "\C-k" 'henkan-kakutei-before-point)
|
|
|
1017 (define-key henkan-mode-map "\C-l" 'henkan-kakutei)
|
|
|
1018 (define-key henkan-mode-map "\C-m" 'henkan-kakutei)
|
|
|
1019 (define-key henkan-mode-map "\C-n" 'henkan-next-kouho)
|
|
|
1020 (define-key henkan-mode-map "\C-o" 'henkan-bunsetu-nobasi)
|
|
|
1021 (define-key henkan-mode-map "\C-p" 'henkan-previous-kouho)
|
|
|
1022 (define-key henkan-mode-map "\C-q" 'undefined)
|
|
|
1023 (define-key henkan-mode-map "\C-r" 'undefined)
|
|
|
1024 (define-key henkan-mode-map "\C-s" 'undefined)
|
|
|
1025 (define-key henkan-mode-map "\C-t" 'undefined)
|
|
|
1026 (define-key henkan-mode-map "\C-u" 'undefined)
|
|
|
1027 (define-key henkan-mode-map "\C-v" 'undefined)
|
|
|
1028 (define-key henkan-mode-map "\C-w" 'undefined)
|
|
|
1029 (define-key henkan-mode-map "\C-x" 'undefined)
|
|
|
1030 (define-key henkan-mode-map "\C-y" 'undefined)
|
|
|
1031 (define-key henkan-mode-map "\C-z" 'undefined)
|
|
|
1032 (define-key henkan-mode-map "\177" 'henkan-quit)
|
|
|
1033
|
|
|
1034 (defun henkan-help-command ()
|
|
|
1035 "Display documentation fo henkan-mode."
|
|
|
1036 (interactive)
|
|
|
1037 (with-output-to-temp-buffer "*Help*"
|
|
|
1038 (princ (substitute-command-keys henkan-mode-document-string))
|
|
|
1039 (print-help-return-message)))
|
|
|
1040
|
|
|
1041 (defvar henkan-mode-document-string "$B4A;zJQ49%b!<%I(B:
|
|
|
1042 $BJ8@a0\F0(B
|
|
|
1043 \\[henkan-first-bunsetu]\t$B@hF,J8@a(B\t\\[henkan-last-bunsetu]\t$B8eHxJ8@a(B
|
|
|
1044 \\[henkan-backward-bunsetu]\t$BD>A0J8@a(B\t\\[henkan-forward-bunsetu]\t$BD>8eJ8@a(B
|
|
|
1045 $BJQ49JQ99(B
|
|
|
1046 $B<!8uJd(B \\[henkan-previous-kouho] \t$BA08uJd(B \\[henkan-next-kouho]
|
|
|
1047 $BJ8@a?-$7(B \\[henkan-bunsetu-nobasi] \t$BJ8@a=L$a(B \\[henkan-bunsetu-chijime]
|
|
|
1048 $BJQ498uJdA*Br(B \\[henkan-select-kouho]
|
|
|
1049 $BJQ493NDj(B
|
|
|
1050 $BA4J8@a3NDj(B \\[henkan-kakutei] \t$BD>A0J8@a$^$G3NDj(B \\[henkan-kakutei-before-point]
|
|
|
1051 $BJQ49Cf;_(B \\[henkan-quit]
|
|
|
1052 ")
|
|
|
1053
|
|
|
1054 ;;;----------------------------------------------------------------------
|
|
|
1055 ;;;
|
|
|
1056 ;;; Dictionary management Facility
|
|
|
1057 ;;;
|
|
|
1058 ;;;----------------------------------------------------------------------
|
|
|
1059
|
|
|
1060 ;;;
|
|
|
1061 ;;; $B<-=qEPO?(B
|
|
|
1062 ;;;
|
|
|
1063
|
|
|
1064 ;;;;
|
|
|
1065 ;;;; User entry: toroku-region
|
|
|
1066 ;;;;
|
|
|
1067
|
|
|
1068 (defun remove-regexp-in-string (regexp string)
|
|
|
1069 (cond((not(string-match regexp string))
|
|
|
1070 string)
|
|
|
1071 (t(let ((str nil)
|
|
|
1072 (ostart 0)
|
|
|
1073 (oend (match-beginning 0))
|
|
|
1074 (nstart (match-end 0)))
|
|
|
1075 (setq str (concat str (substring string ostart oend)))
|
|
|
1076 (while (string-match regexp string nstart)
|
|
|
1077 (setq ostart nstart)
|
|
|
1078 (setq oend (match-beginning 0))
|
|
|
1079 (setq nstart (match-end 0))
|
|
|
1080 (setq str (concat str (substring string ostart oend))))
|
|
|
1081 str))))
|
|
|
1082
|
|
|
1083 (defun toroku-region (start end)
|
|
|
1084 (interactive "r")
|
|
|
1085 (let*((kanji
|
|
|
1086 (remove-regexp-in-string "[\0-\37]" (buffer-substring start end)))
|
|
|
1087 (yomi (read-hiragana-string
|
|
|
1088 (format "$B<-=qEPO?!X(B%s$B!Y(B $BFI$_(B :" kanji)))
|
|
|
1089 (type (menu:select-from-menu *sj3-bunpo-menu*))
|
|
|
1090 (dict-no
|
|
|
1091 (menu:select-from-menu (list 'menu "$BEPO?<-=qL>(B:" egg:*dict-menu*))))
|
|
|
1092 ;;;(if (string-match "[\0-\177]" kanji)
|
|
|
1093 ;;; (error "Kanji string contains hankaku character. %s" kanji))
|
|
|
1094 ;;;(if (string-match "[\0-\177]" yomi)
|
|
|
1095 ;;; (error "Yomi string contains hankaku character. %s" yomi))
|
|
|
1096 (KKCP:dict-add dict-no kanji yomi type)
|
|
|
1097 (let ((hinshi (nth 1 (assq type *sj3-bunpo-code*)))
|
|
|
1098 (gobi (nth 2 (assq type *sj3-bunpo-code*)))
|
|
|
1099 (dict-name (cdr (assq dict-no egg:*usr-dict*))))
|
|
|
1100 (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B"
|
|
|
1101 (if gobi (concat kanji " " gobi) kanji)
|
|
|
1102 (if gobi (concat yomi " " gobi) yomi)
|
|
|
1103 hinshi dict-name))))
|
|
|
1104
|
|
|
1105
|
|
|
1106
|
|
|
1107 ;;; (lsh 1 18)
|
|
|
1108 (defvar *sj3-bunpo-menu*
|
|
|
1109 '(menu "$BIJ;l(B:"
|
|
|
1110 (("$BL>;l(B" .
|
|
|
1111 (menu "$BIJ;l(B:$BL>;l(B:"
|
|
|
1112 (("$BL>;l(B" . 1)
|
|
|
1113 ("$BL>;l(B($B$*!D(B)" . 2)
|
|
|
1114 ("$BL>;l(B($B$4!D(B)" . 3)
|
|
|
1115 ("$BL>;l(B($B!DE*(B/$B2=(B)" . 4)
|
|
|
1116 ("$BL>;l(B($B$*!D$9$k(B)" . 5)
|
|
|
1117 ("$BL>;l(B($B!D$9$k(B)" . 6)
|
|
|
1118 ("$BL>;l(B($B$4!D$9$k(B)" . 7)
|
|
|
1119 ("$BL>;l(B($B!D$J(B/$B$K(B)" . 8)
|
|
|
1120 ("$BL>;l(B($B$*!D$J(B/$B$K(B)" . 9)
|
|
|
1121 ("$BL>;l(B($B$4!D$J(B/$B$K(B)" . 10)
|
|
|
1122 ("$BL>;l(B($BI{;l(B)" . 11))))
|
|
|
1123 ("$BBeL>;l(B" . 12)
|
|
|
1124 ("$BID;z(B" . 21)
|
|
|
1125 ("$BL>A0(B" . 22)
|
|
|
1126 ("$BCOL>(B" . 24)
|
|
|
1127 ("$B8)(B/$B6hL>(B" . 25)
|
|
|
1128 ("$BF0;l(B" .
|
|
|
1129 (menu "$BIJ;l(B:$BF0;l(B:"
|
|
|
1130 (("$B%5JQ8l44(B" . 80)
|
|
|
1131 ("$B%6JQ8l44(B" . 81)
|
|
|
1132 ("$B0lCJITJQ2=It(B" . 90)
|
|
|
1133 ("$B%+9T8^CJ8l44(B" . 91)
|
|
|
1134 ("$B%,9T8^CJ8l44(B" . 92)
|
|
|
1135 ("$B%59T8^CJ8l44(B" . 93)
|
|
|
1136 ("$B%?9T8^CJ8l44(B" . 94)
|
|
|
1137 ("$B%J9T8^CJ8l44(B" . 95)
|
|
|
1138 ("$B%P9T8^CJ8l44(B" . 96)
|
|
|
1139 ("$B%^9T8^CJ8l44(B" . 97)
|
|
|
1140 ("$B%i9T8^CJ8l44(B" . 98)
|
|
|
1141 ("$B%o9T8^CJ8l44(B" . 99))))
|
|
|
1142 ("$BO"BN;l(B" . 26)
|
|
|
1143 ("$B@\B3;l(B" . 27)
|
|
|
1144 ("$B=u?t;l(B" . 29)
|
|
|
1145 ("$B?t;l(B" . 30)
|
|
|
1146 ("$B@\F,8l(B" . 31)
|
|
|
1147 ("$B@\Hx8l(B" . 36)
|
|
|
1148 ("$BI{;l(B" . 45)
|
|
|
1149 ("$BI{;l(B2" . 46)
|
|
|
1150 ("$B7AMF;l8l44(B" . 60)
|
|
|
1151 ("$B7AMFF0;l8l44(B" . 71)
|
|
|
1152 ("$BC14A;z(B" . 189))))
|
|
|
1153
|
|
|
1154 (defvar *sj3-bunpo-code*
|
|
|
1155 '(
|
|
|
1156 ( 1 "$BL>;l(B" )
|
|
|
1157 ( 2 "$BL>;l(B($B$*!D(B)" )
|
|
|
1158 ( 3 "$BL>;l(B($B$4!D(B)" )
|
|
|
1159 ( 4 "$BL>;l(B($B!DE*(B/$B2=(B)" "$BE*(B" nil)
|
|
|
1160 ( 5 "$BL>;l(B($B$*!D$9$k(B)" "$B$9$k(B" nil)
|
|
|
1161 ( 6 "$BL>;l(B($B!D$9$k(B)" "$B$9$k(B" nil)
|
|
|
1162 ( 7 "$BL>;l(B($B$4!D$9$k(B)" "$B$9$k(B" nil)
|
|
|
1163 ( 8 "$BL>;l(B($B!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
|
|
|
1164 ( 9 "$BL>;l(B($B$*!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
|
|
|
1165 ( 10 "$BL>;l(B($B$4!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
|
|
|
1166 ( 11 "$BL>;l(B($BI{;l(B)" )
|
|
|
1167 ( 12 "$BBeL>;l(B" )
|
|
|
1168 ( 21 "$BID;z(B" )
|
|
|
1169 ( 22 "$BL>A0(B" )
|
|
|
1170 ( 24 "$BCOL>(B" )
|
|
|
1171 ( 25 "$B8)(B/$B6hL>(B" )
|
|
|
1172 ( 26 "$BO"BN;l(B" )
|
|
|
1173 ( 27 "$B@\B3;l(B" )
|
|
|
1174 ( 29 "$B=u?t;l(B" )
|
|
|
1175 ( 30 "$B?t;l(B" )
|
|
|
1176 ( 31 "$B@\F,8l(B" )
|
|
|
1177 ( 36 "$B@\Hx8l(B" )
|
|
|
1178 ( 45 "$BI{;l(B" )
|
|
|
1179 ( 46 "$BI{;l(B2" )
|
|
|
1180 ( 60 "$B7AMF;l8l44(B" "$B$$(B" ("" "" "" "" ""))
|
|
|
1181 ( 71 "$B7AMFF0;l8l44(B" "$B$K(B" ("" "" "" "" "") )
|
|
|
1182 ( 80 "$B%5JQ8l44(B" "$B$9$k(B" ("" "" "" "" ""))
|
|
|
1183 ( 81 "$B%6JQ8l44(B" "$B$:$k(B" ("" "" "" "" ""))
|
|
|
1184 ( 90 "$B0lCJITJQ2=It(B" "$B$k(B" ("" "" "" "" ""))
|
|
|
1185 ( 91 "$B%+9T8^CJ8l44(B" "$B$/(B" ("$B$+$J$$(B" "$B$-$^$9(B" "$B$/(B" "$B$/$H$-(B" "$B$1(B"))
|
|
|
1186 ( 92 "$B%,9T8^CJ8l44(B" "$B$0(B" ("$B$,$J$$(B" "$B$.$^$9(B" "" "" ""))
|
|
|
1187 ( 93 "$B%59T8^CJ8l44(B" "$B$9(B" ("" "" "" "" ""))
|
|
|
1188 ( 94 "$B%?9T8^CJ8l44(B" "$B$D(B" ("" "" "" "" ""))
|
|
|
1189 ( 95 "$B%J9T8^CJ8l44(B" "$B$L(B" ("" "" "" "" ""))
|
|
|
1190 ( 96 "$B%P9T8^CJ8l44(B" "$B$V(B" ("" "" "" "" ""))
|
|
|
1191 ( 97 "$B%^9T8^CJ8l44(B" "$B$`(B" ("" "" "" "" ""))
|
|
|
1192 ( 98 "$B%i9T8^CJ8l44(B" "$B$k(B" ("" "" "" "" ""))
|
|
|
1193 ( 99 "$B%o9T8^CJ8l44(B" "$B$&(B" ("" "" "" "" ""))
|
|
|
1194 ( 189 "$BC14A;z(B" )
|
|
|
1195 ( 190 "$BITDj(B" )
|
|
|
1196 ( 1000 "$B$=$NB>(B" )
|
|
|
1197 ))
|
|
|
1198
|
|
|
1199 ;;;
|
|
|
1200 ;;; $B<-=qJT=87O(B DicEd
|
|
|
1201 ;;;
|
|
|
1202
|
|
|
1203 (defvar *diced-window-configuration* nil)
|
|
|
1204
|
|
|
1205 (defvar *diced-dict-info* nil)
|
|
|
1206
|
|
|
1207 (defvar *diced-dno* nil)
|
|
|
1208
|
|
|
1209 ;;;;;
|
|
|
1210 ;;;;; User entry : edit-dict
|
|
|
1211 ;;;;;
|
|
|
1212
|
|
|
1213 (defun edit-dict ()
|
|
|
1214 (interactive)
|
|
|
1215 (let*((dict-no
|
|
|
1216 (menu:select-from-menu (list 'menu "$B<-=qL>(B:" egg:*dict-menu*)))
|
|
|
1217 (dict-name (file-name-nondirectory
|
|
|
1218 (cdr (assq dict-no egg:*usr-dict*))))
|
|
|
1219 (dict-info (KKCP:dict-info dict-no)))
|
|
|
1220 (if (null dict-info)
|
|
|
1221 (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B" dict-name)
|
|
|
1222 (progn
|
|
|
1223 (setq *diced-dno* dict-no)
|
|
|
1224 (setq *diced-window-configuration* (current-window-configuration))
|
|
|
1225 (pop-to-buffer "*Nihongo Dictionary Information*")
|
|
|
1226 (setq major-mode 'diced-mode)
|
|
|
1227 (setq mode-name "Diced")
|
|
|
1228 (setq mode-line-buffer-identification
|
|
|
1229 (concat "DictEd: " dict-name
|
|
|
1230 (make-string
|
|
|
1231 (max 0 (- 17 (string-width dict-name))) ? )
|
|
|
1232 ))
|
|
|
1233 (sit-for 0) ;; will redislay.
|
|
|
1234 ;;;(use-global-map diced-mode-map)
|
|
|
1235 (use-local-map diced-mode-map)
|
|
|
1236 (diced-display dict-info)
|
|
|
1237 ))))
|
|
|
1238
|
|
|
1239 (defun diced-redisplay ()
|
|
|
1240 (let ((dict-info (KKCP:dict-info *diced-dno*)))
|
|
|
1241 (if (null dict-info)
|
|
|
1242 (progn
|
|
|
1243 (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B"
|
|
|
1244 (file-name-nondirectory
|
|
|
1245 (cdr (assq *diced-dno* egg:*usr-dict*))))
|
|
|
1246 (diced-quit))
|
|
|
1247 (diced-display dict-info))))
|
|
|
1248
|
|
|
1249 (defun diced-display (dict-info)
|
|
|
1250 ;;; (values (list (record yomi kanji bunpo)))
|
|
|
1251 ;;; 0 1 2
|
|
|
1252 (setq *diced-dict-info* dict-info)
|
|
|
1253 (setq buffer-read-only nil)
|
|
|
1254 (erase-buffer)
|
|
|
1255 (let ((l-yomi
|
|
|
1256 (apply 'max
|
|
|
1257 (mapcar (function (lambda (l) (string-width (nth 0 l))))
|
|
|
1258 dict-info)))
|
|
|
1259 (l-kanji
|
|
|
1260 (apply 'max
|
|
|
1261 (mapcar (function (lambda (l) (string-width (nth 1 l))))
|
|
|
1262 dict-info))))
|
|
|
1263 (while dict-info
|
|
|
1264 (let*((yomi (nth 0 (car dict-info)))
|
|
|
1265 (kanji (nth 1 (car dict-info)))
|
|
|
1266 (bunpo (nth 2 (car dict-info)))
|
|
|
1267 (gobi (nth 2 (assq bunpo *sj3-bunpo-code*)))
|
|
|
1268 (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*))))
|
|
|
1269
|
|
|
1270 (insert " " yomi)
|
|
|
1271 (if gobi (insert " " gobi))
|
|
|
1272 (insert-char ?
|
|
|
1273 (- (+ l-yomi 10) (string-width yomi)
|
|
|
1274 (if gobi (+ 1 (string-width gobi)) 0)))
|
|
|
1275 (insert kanji)
|
|
|
1276 (if gobi (insert " " gobi))
|
|
|
1277 (insert-char ?
|
|
|
1278 (- (+ l-kanji 10) (string-width kanji)
|
|
|
1279 (if gobi (+ 1 (string-width gobi)) 0)))
|
|
|
1280 (insert hinshi ?\n)
|
|
|
1281 (setq dict-info (cdr dict-info))))
|
|
|
1282 (goto-char (point-min)))
|
|
|
1283 (setq buffer-read-only t))
|
|
|
1284
|
|
|
1285 (defun diced-add ()
|
|
|
1286 (interactive)
|
|
|
1287 (diced-execute t)
|
|
|
1288 (let*((kanji (read-from-minibuffer "$B4A;z!'(B"))
|
|
|
1289 (yomi (read-from-minibuffer "$BFI$_!'(B"))
|
|
|
1290 (bunpo (menu:select-from-menu *sj3-bunpo-menu*))
|
|
|
1291 (gobi (nth 2 (assq bunpo *sj3-bunpo-code*)))
|
|
|
1292 (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
|
|
|
1293 (item (if gobi (concat kanji " " gobi) kanji))
|
|
|
1294 (item-yomi (if gobi (concat yomi " " gobi) yomi))
|
|
|
1295 (dict-name (cdr (assq *diced-dno* egg:*usr-dict*))))
|
|
|
1296 (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$9!#(B"
|
|
|
1297 item item-yomi hinshi (file-name-nondirectory dict-name))
|
|
|
1298 (progn
|
|
|
1299 (KKCP:dict-add *diced-dno* kanji yomi bunpo)
|
|
|
1300 (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B"
|
|
|
1301 item item-yomi hinshi dict-name)
|
|
|
1302 (diced-redisplay)))))
|
|
|
1303
|
|
|
1304 (defun diced-delete ()
|
|
|
1305 (interactive)
|
|
|
1306 (beginning-of-line)
|
|
|
1307 (if (= (following-char) ? )
|
|
|
1308 (let ((buffer-read-only nil))
|
|
|
1309 (delete-char 1) (insert "D") (backward-char 1))))
|
|
|
1310
|
|
|
1311 (defun diced-undelete ()
|
|
|
1312 (interactive)
|
|
|
1313 (beginning-of-line)
|
|
|
1314 (if (= (following-char) ?D)
|
|
|
1315 (let ((buffer-read-only nil))
|
|
|
1316 (delete-char 1) (insert " ") (backward-char 1))
|
|
|
1317 (beep)))
|
|
|
1318
|
|
|
1319 (defun diced-quit ()
|
|
|
1320 (interactive)
|
|
|
1321 (setq buffer-read-only nil)
|
|
|
1322 (erase-buffer)
|
|
|
1323 (setq buffer-read-only t)
|
|
|
1324 (bury-buffer (get-buffer "*Nihongo Dictionary Information*"))
|
|
|
1325 (set-window-configuration *diced-window-configuration*)
|
|
|
1326 )
|
|
|
1327
|
|
|
1328 (defun diced-execute (&optional display)
|
|
|
1329 (interactive)
|
|
|
1330 (goto-char (point-min))
|
|
|
1331 (let ((no 0))
|
|
|
1332 (while (not (eobp))
|
|
|
1333 (if (= (following-char) ?D)
|
|
|
1334 (let* ((dict-item (nth no *diced-dict-info*))
|
|
|
1335 (yomi (nth 0 dict-item))
|
|
|
1336 (kanji (nth 1 dict-item))
|
|
|
1337 (bunpo (nth 2 dict-item))
|
|
|
1338 (gobi (nth 2 (assq bunpo *sj3-bunpo-code*)))
|
|
|
1339 (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
|
|
|
1340 (dict-name (cdr (assq *diced-dno* egg:*usr-dict*)))
|
|
|
1341 (item (if gobi (concat kanji " " gobi) kanji))
|
|
|
1342 (item-yomi (if gobi (concat yomi " " gobi) yomi)))
|
|
|
1343 (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$9!#(B"
|
|
|
1344 item item-yomi hinshi (file-name-nondirectory
|
|
|
1345 dict-name))
|
|
|
1346 (progn
|
|
|
1347 (KKCP:dict-delete *diced-dno* kanji yomi bunpo)
|
|
|
1348 (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$7$?!#(B"
|
|
|
1349 item item-yomi hinshi dict-name)
|
|
|
1350 ))))
|
|
|
1351 (setq no (1+ no))
|
|
|
1352 (forward-line 1)))
|
|
|
1353 (forward-line -1)
|
|
|
1354 (if (not display) (diced-redisplay)))
|
|
|
1355
|
|
|
1356 (defun diced-next-line ()
|
|
|
1357 (interactive)
|
|
|
1358 (beginning-of-line)
|
|
|
1359 (forward-line 1)
|
|
|
1360 (if (eobp) (progn (beep) (forward-line -1))))
|
|
|
1361
|
|
|
1362 (defun diced-end-of-buffer ()
|
|
|
1363 (interactive)
|
|
|
1364 (end-of-buffer)
|
|
|
1365 (forward-line -1))
|
|
|
1366
|
|
|
1367 (defun diced-scroll-down ()
|
|
|
1368 (interactive)
|
|
|
1369 (scroll-down)
|
|
|
1370 (if (eobp) (forward-line -1)))
|
|
|
1371
|
|
|
1372 (defun diced-mode ()
|
|
|
1373 "Mode for \"editing\" dictionaries.
|
|
|
1374 In diced, you are \"editing\" a list of the entries in dictionaries.
|
|
|
1375 You can move using the usual cursor motion commands.
|
|
|
1376 Letters no longer insert themselves. Instead,
|
|
|
1377
|
|
|
1378 Type a to Add new entry.
|
|
|
1379 Type d to flag an entry for Deletion.
|
|
|
1380 Type n to move cursor to Next entry.
|
|
|
1381 Type p to move cursor to Previous entry.
|
|
|
1382 Type q to Quit from DicEd.
|
|
|
1383 Type u to Unflag an entry (remove its D flag).
|
|
|
1384 Type x to eXecute the deletions requested.
|
|
|
1385 "
|
|
|
1386 )
|
|
|
1387
|
|
|
1388 (defvar diced-mode-map (let ((map (make-keymap))) (suppress-keymap map) map))
|
|
|
1389
|
|
|
1390 (define-key diced-mode-map "a" 'diced-add)
|
|
|
1391 (define-key diced-mode-map "d" 'diced-delete)
|
|
|
1392 (define-key diced-mode-map "n" 'diced-next-line)
|
|
|
1393 (define-key diced-mode-map "p" 'previous-line)
|
|
|
1394 (define-key diced-mode-map "q" 'diced-quit)
|
|
|
1395 (define-key diced-mode-map "u" 'diced-undelete)
|
|
|
1396 (define-key diced-mode-map "x" 'diced-execute)
|
|
|
1397
|
|
|
1398 (define-key diced-mode-map "\C-h" 'help-command)
|
|
|
1399 (define-key diced-mode-map "\C-n" 'diced-next-line)
|
|
|
1400 (define-key diced-mode-map "\C-p" 'previous-line)
|
|
|
1401 (define-key diced-mode-map "\C-v" 'scroll-up)
|
|
|
1402 (define-key diced-mode-map "\e<" 'beginning-of-buffer)
|
|
|
1403 (define-key diced-mode-map "\e>" 'diced-end-of-buffer)
|
|
|
1404 (define-key diced-mode-map "\ev" 'diced-scroll-down)
|
|
|
1405
|
|
|
1406 ;;; End of sj3-egg.el
|
|
|
1407 ;; 92.7.7 by Y.Kawabe -- commented out
|
|
|
1408 ;; (if (boundp 'SJ3)
|
|
|
1409 ;; (load-library "sj3fns"))
|
