Mercurial > hg > xemacs-beta

comparison lisp/egg/egg-sj3.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 262b8bb4a523
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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"))