Modified Files:
[elisp/egg.git] / egg / wnn.el
1 ;;; egg/wnn.el --- WNN Support (high level interface) in Egg
2 ;;;                Input Method Architecture
3
4 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
5 ;; Laboratory, JAPAN.
6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
7
8 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
9 ;;         KATAYAMA Yoshio <kate@pfu.co.jp> ; Korean, Chinese support.
10 ;;
11 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
12
13 ;; This file is part of EGG.
14
15 ;; EGG is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version.
19
20 ;; EGG is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23 ;; GNU General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
29
30 ;;; Commentary:
31
32 ;;; Code:
33
34 (require 'egg-edep)
35
36 (defgroup wnn nil
37   "Wnn interface for Tamagotchy"
38   :group 'egg)
39
40 (defconst wnn-support-languages '(Japanese Chinese-GB Chinese-CNS Korean))
41
42 (eval-when-compile
43   (defmacro WNN-const (c)
44     (cond ((eq c 'BUN_SENTOU) -1)
45           ((eq c 'NO_EXIST)  1)
46           ((eq c 'NO_MATCH) 10)
47           ((eq c 'IMA_OFF)   -4)
48           ((eq c 'IMA_ON)    -3)
49           ((eq c 'HINDO_NOP) -2)
50           ((eq c 'HINDO_INC) -3))))
51
52 (defconst wnn-conversion-backend
53   [ wnn-init
54
55     wnn-start-conversion
56       wnn-get-bunsetsu-converted
57       wnn-get-bunsetsu-source
58       wnn-list-candidates
59           wnn-get-number-of-candidates
60           wnn-get-current-candidate-number
61           wnn-get-all-candidates
62           wnn-decide-candidate
63       wnn-change-bunsetsu-length
64     wnn-end-conversion
65     wnn-start-reverse-conversion
66
67     wnn-fini
68  ])
69
70 ;; <env> ::= [ <proc> <env-id> <server-type> <dic-set> <rev-flag>
71 ;;             <daibunsetsu-info> ]
72
73 (defsubst wnnenv-create (proc env-id server-type dic-set rev-flag)
74   (vector proc env-id server-type dic-set rev-flag nil))
75
76 (defsubst wnnenv-get-proc (env)
77   (aref env 0))
78
79 (defsubst wnnenv-get-env-id (env)
80   (aref env 1))
81
82 (defsubst wnnenv-get-server-type (env)
83   (aref env 2))
84
85 (defsubst wnnenv-get-dictionary-set (env)
86   (aref env 3))
87
88 (defsubst wnnenv-get-reverse-flag (env)
89   (aref env 4))
90
91 (defsubst wnnenv-get-daibunsetsu-info (env)
92   (aref env 5))
93 (defsubst wnnenv-set-daibunsetsu-info (env d)
94   (aset env 5 d))
95
96 ;; <bunsetsu> ::= [ <env> <end> <start> <jiritsugo-end> <dic-no>
97 ;;                  <entry> <freq> <right-now> <hinshi> <status>
98 ;;                  <status-backward> <kangovect> <evaluation>
99 ;;
100 ;;                  <converted> <yomi> <fuzokugo>
101 ;;                  <zenkouho> <freq-down>
102 ;;                  <zenkouho-pos> ]
103 ;;
104 (defsubst wnn-bunsetsu-create (e end start jiritsugo-end dic-no entry freq
105                                right-now hinshi status status-backward
106                                kangovect evaluation)
107   (vector e end start jiritsugo-end dic-no entry freq right-now
108           hinshi status status-backward kangovect evaluation
109           nil nil nil nil nil nil))
110
111 (defsubst wnn-bunsetsu-get-env (bunsetsu)
112   (aref bunsetsu 0))
113
114 (defsubst wnn-bunsetsu-get-converted (bunsetsu)
115   (aref bunsetsu 13))
116 (defsubst wnn-bunsetsu-set-converted (bunsetsu converted)
117   (aset bunsetsu 13 converted))
118
119 (defsubst wnn-bunsetsu-get-hinshi (bunsetsu)
120   (aref bunsetsu 8))
121
122 (defsubst wnn-bunsetsu-get-dic-no (bunsetsu)
123   (aref bunsetsu 4))
124
125 (defsubst wnn-bunsetsu-get-entry (bunsetsu)
126   (aref bunsetsu 5))
127
128 (defsubst wnn-bunsetsu-get-right-now (bunsetsu)
129   (aref bunsetsu 7))
130
131 (defsubst wnn-bunsetsu-get-yomi (bunsetsu)
132   (aref bunsetsu 14))
133 (defsubst wnn-bunsetsu-set-yomi (bunsetsu yomi)
134   (aset bunsetsu 14 yomi))
135
136 (defsubst wnn-bunsetsu-get-fuzokugo (bunsetsu)
137   (aref bunsetsu 15))
138 (defsubst wnn-bunsetsu-set-fuzokugo (bunsetsu fuzokugo)
139   (aset bunsetsu 15 fuzokugo))
140
141 (defsubst wnn-bunsetsu-get-zenkouho (bunsetsu)
142   (aref bunsetsu 16))
143 (defsubst wnn-bunsetsu-set-zenkouho (bunsetsu z)
144   (aset bunsetsu 16 z))
145
146 (defsubst wnn-bunsetsu-get-freq-down (bunsetsu)
147   (aref bunsetsu 17))
148 (defsubst wnn-bunsetsu-set-freq-down (bunsetsu d)
149   (aset bunsetsu 17 d))
150
151 (defsubst wnn-bunsetsu-get-zenkouho-pos (bunsetsu)
152   (aref bunsetsu 18))
153 (defsubst wnn-bunsetsu-set-zenkouho-pos (bunsetsu zp)
154   (aset bunsetsu 18 zp))
155 \f
156 (defvar wnn-environments nil
157   "Environment for WNN kana-kanji conversion")
158
159 (defcustom wnn-jserver nil "jserver host list" :group 'wnn :type 'string)
160 (defcustom wnn-cserver nil "cserver host list" :group 'wnn :type 'string)
161 (defcustom wnn-tserver nil "tserver host list" :group 'wnn :type 'string)
162 (defcustom wnn-kserver nil "kserver host list" :group 'wnn :type 'string)
163
164 (defcustom wnn-jport 22273 "jserver port number" :group 'wnn :type 'integer)
165 (defcustom wnn-cport 22289 "cserver port number" :group 'wnn :type 'integer)
166 (defcustom wnn-tport 22321 "tserver port number" :group 'wnn :type 'integer)
167 (defcustom wnn-kport 22305 "kserver port number" :group 'wnn :type 'integer)
168
169 ;; The port number should be initialized from $WNNLIB/serverdefs by wnn-init
170 (defconst wnn-server-info-list
171   ;; language    locale  server  port     stream coding-system hostname
172   '((Japanese    "ja_JP" jserver wnn-jport "Wnn"  fixed-euc-jp wnn-jserver)
173     (Chinese-GB  "zh_CN" cserver wnn-cport "cWnn" fixed-euc-cn wnn-cserver)
174     (Chinese-CNS "zh_TW" tserver wnn-tport "tWnn" fixed-euc-tw wnn-tserver)
175     (Korean      "ko_KR" kserver wnn-kport "kWnn" fixed-euc-kr wnn-kserver)))
176
177 (defsubst wnn-server-get-info (lang)
178   (assq (or lang its-current-language) wnn-server-info-list))
179
180 (defsubst wnn-server-language (info)
181   (car info))
182
183 (defsubst wnn-server-locale (info)
184   (nth 1 info))
185
186 (defsubst wnn-server-type (info)
187   (nth 2 info))
188
189 (defsubst wnn-server-port (info)
190   (symbol-value (nth 3 info)))
191
192 (defsubst wnn-server-stream-name (info)
193   (nth 4 info))
194
195 (defsubst wnn-server-buffer-name (info)
196   (concat " *" (wnn-server-stream-name info) "*"))
197
198 (defsubst wnn-server-coding-system (info)
199   (nth 5 info))
200
201 (defsubst wnn-server-hostname (info)
202   (symbol-value (nth 6 info)))
203
204 (defun wnn-init ()
205   )
206
207 (defun wnn-start-conversion (yomi &optional language dic-set reverse)
208   "Convert YOMI string to kanji, and enter conversion mode.
209 Return the list of bunsetsu."
210   (let* ((server-info (wnn-server-get-info language))
211          (env (wnn-get-environment server-info dic-set reverse))
212          (result (wnnrpc-renbunsetsu-conversion env yomi
213                                                 (WNN-const BUN_SENTOU) "")))
214     (wnnenv-set-daibunsetsu-info env (car result))
215     (cdr result)))
216
217 (defun wnn-start-reverse-conversion (yomi &optional language dic-set)
218   (wnn-start-conversion yomi language dic-set t))
219
220 (defun wnn-get-bunsetsu-converted (bunsetsu)
221   (concat (wnn-bunsetsu-get-converted bunsetsu)
222           (wnn-bunsetsu-get-fuzokugo  bunsetsu)))
223
224 ;; WNN-UNIQ-CANDIDATES
225 ;;
226 ;; Here, IMNSHO, WNN is broken.
227 ;; WNN must/should return unique one.  The word is representative
228 ;; among possible words with same string literal.
229 ;;
230 ;; With no bunsetsu information to users, users have to chose
231 ;; the word based on the string literal only.
232 ;; How we could update frequency?
233 ;;
234 ;; We'll modify WNN in future.
235 ;;
236 ;; 
237 (defun wnn-uniq-candidates (bunsetsu bunsetsu-list)
238   (let ((hash-table (make-vector 31 0)) ; XXX why 31?
239         (l bunsetsu-list)
240         (i 0)
241         (n 0) sym0 result p b sym)
242     (setq sym0 (intern (wnn-get-bunsetsu-converted bunsetsu) hash-table))
243     (while l
244       (setq b (car l)
245             l (cdr l)
246             sym (intern (wnn-get-bunsetsu-converted b) hash-table))
247       (if (null (boundp sym))           ; new one
248           (let ((bl (cons b nil)))
249             (set sym b)
250             (if (eq sym0 sym)
251                 (wnn-bunsetsu-set-zenkouho-pos bunsetsu (setq n i)))
252             (if p
253                 (setq p (setcdr p bl))
254               (setq result (setq p bl)))
255             (setq i (1+ i)))))
256     (wnn-bunsetsu-set-zenkouho bunsetsu result)
257     n))
258
259 (defun wnn-list-candidates (bunsetsu prev-bunsetsu)
260   (let* ((candidates (wnn-bunsetsu-get-zenkouho bunsetsu))
261          (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu)
262                        (wnn-bunsetsu-get-fuzokugo bunsetsu)))
263          (converted (concat (wnn-bunsetsu-get-converted bunsetsu)
264                             (wnn-bunsetsu-get-fuzokugo bunsetsu)))
265          (env (wnn-bunsetsu-get-env bunsetsu))
266          prev-hinshi
267          prev-fuzokugo)
268     (if candidates
269         ;; We have the candidates already.  Return the current position.
270         (wnn-bunsetsu-get-zenkouho-pos bunsetsu)
271       (if (null prev-bunsetsu)
272           (setq prev-hinshi -1
273                 prev-fuzokugo "")
274         (setq prev-hinshi (wnn-bunsetsu-get-hinshi prev-bunsetsu)
275               prev-fuzokugo (wnn-bunsetsu-get-fuzokugo prev-bunsetsu)))
276       (setq candidates
277             (wnnrpc-get-bunsetsu-candidates env yomi
278                                             prev-hinshi prev-fuzokugo))
279       (wnn-uniq-candidates bunsetsu candidates))))
280
281 (defun wnn-get-number-of-candidates (bunsetsu)
282   (let ((l (wnn-bunsetsu-get-zenkouho bunsetsu)))
283     (if l
284         (length l)
285       nil)))
286
287 (defun wnn-get-current-candidate-number (bunsetsu)
288   (wnn-bunsetsu-get-zenkouho-pos bunsetsu))
289
290 (defun wnn-get-all-candidates (bunsetsu)
291   (let* ((l (wnn-bunsetsu-get-zenkouho bunsetsu))
292          (result (cons nil nil))
293          (r result))
294     (catch 'break
295       (while t
296         (let ((candidate (car l)))
297           (setcar r (concat (wnn-bunsetsu-get-converted candidate)
298                             (wnn-bunsetsu-get-fuzokugo candidate)))
299           (if (null (setq l (cdr l)))
300               (throw 'break nil)
301             (setq r (setcdr r (cons nil nil)))))))
302     result))
303
304 (defun wnn-decide-candidate (bunsetsu candidate-pos)
305   (let* ((candidate-list (wnn-bunsetsu-get-zenkouho bunsetsu))
306          (candidate (nth candidate-pos candidate-list)))
307     (wnn-bunsetsu-set-zenkouho candidate candidate-list)
308     (wnn-bunsetsu-set-zenkouho-pos candidate candidate-pos)
309     candidate))
310
311 ;;
312 ;;
313 (defun wnn-change-bunsetsu-length (b0 b1 b2 len)
314   (let ((yomi (concat
315                (wnn-get-bunsetsu-source b1)
316                (if b2 (wnn-get-bunsetsu-source b2))))
317         (env (wnn-bunsetsu-get-env b1))
318         yomi1 yomi2 prev-hinshi prev-fuzokugo
319         bunsetsu1 bunsetsu2)
320     (if (null b0)
321         (setq prev-hinshi -1
322               prev-fuzokugo "")
323       (setq prev-hinshi (wnn-bunsetsu-get-hinshi b0)
324             prev-fuzokugo (wnn-bunsetsu-get-fuzokugo b0)))
325     (setq yomi1 (substring yomi 0 len)
326           yomi2 (substring yomi len))
327     (setq bunsetsu1
328           (car (wnnrpc-tanbunsetsu-conversion env yomi1
329                                               prev-hinshi prev-fuzokugo)))
330     ;; Only set once.
331     (wnn-bunsetsu-set-freq-down bunsetsu1
332                                 (or (wnn-bunsetsu-get-freq-down b1)
333                                     (if b2
334                                         (list b1 b2)
335                                       (list b1))))
336     (if (< 0 (length yomi2))
337         (setq bunsetsu2
338               (cdr (wnnrpc-renbunsetsu-conversion
339                     env yomi2
340                     (wnn-bunsetsu-get-hinshi bunsetsu1)
341                     (wnn-bunsetsu-get-fuzokugo bunsetsu1))))
342       (setq bunsetsu2 nil))
343     (if bunsetsu2
344         (append (list bunsetsu1) bunsetsu2)
345       (list bunsetsu1))))
346
347
348 (defun wnn-get-bunsetsu-source (bunsetsu)
349   (concat (wnn-bunsetsu-get-yomi bunsetsu)
350           (wnn-bunsetsu-get-fuzokugo bunsetsu)))
351
352 (defun wnn-end-conversion (bunsetsu-info-list abort)
353   (if abort
354       ()
355     (let ((env (wnn-bunsetsu-get-env (car bunsetsu-info-list))))
356       (wnn-update-frequency env bunsetsu-info-list)
357       (wnnenv-set-daibunsetsu-info env nil))))
358
359 (defvar wnn-sticky-environment-flag nil
360   "*Flag which specifies sticky environment.")
361
362 (defmacro wnn-for-each-environment (lang env &rest body)
363   `(let* ((server-info (wnn-server-get-info ,lang))
364          (server-type (wnn-server-type server-info))
365          (env-list wnn-environments))
366     (if server-type
367         (while env-list
368           (let ((,env (car env-list)))
369             ,@body)
370           (setq env-list (cdr env-list))))))
371
372 (defun wnn-fini (lang &optional save-only)
373   (let* ((server-info (wnn-server-get-info lang))
374          (server-type (wnn-server-type server-info))
375          (l wnn-environments)
376          new-env-list del-list env proc)
377     (if server-type
378         (progn
379           (message "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9\e(B"
380                    (wnn-server-stream-name server-info))
381           (while l
382             (setq env (car l))
383             (if (eq (wnnenv-get-server-type env) server-type)
384                 (condition-case nil
385                     (progn
386                       (wnn-save-dictionaries env)
387                       (if (null save-only)
388                           (progn
389                             (setq del-list (nconc del-list (list env)))
390                             (if wnn-sticky-environment-flag
391                                 (wnnrpc-make-env-sticky env)
392                               (wnnrpc-make-env-unsticky env))
393                             (wnnrpc-disconnect env))))
394                   (error nil))
395               (setq new-env-list (nconc new-env-list (list env))))
396             (setq l (cdr l)))
397           (message "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?\e(B"
398                    (wnn-server-stream-name server-info))
399           (if (null save-only)
400               (progn
401                 (setq proc (and del-list (wnnenv-get-proc (car del-list))))
402                 (if (and proc (eq (process-status proc) 'open))
403                     (progn
404                       (wnnrpc-close proc)
405                       (kill-buffer (process-buffer proc))))
406                 (setq wnn-environments new-env-list)))))))
407
408 (defun wnn-close (lang)
409   (interactive (list (wnn-read-active-lang)))
410   (or (listp lang)
411       (setq lang (list lang)))
412   (while lang
413     (wnn-fini (car lang))
414     (setq lang (cdr lang))))
415
416 (defun wnn-dictionary-save (lang)
417   (interactive (list (wnn-read-active-lang)))
418   (or (listp lang)
419       (setq lang (list lang)))
420   (while lang
421     (wnn-fini (car lang) t)
422     (setq lang (cdr lang))))
423
424 (defun wnn-read-active-lang ()
425   (let ((completion-ignore-case t)
426         (env wnn-environments)
427         langs server server-list)
428     (while env
429       (setq server (wnnenv-get-server-type (car env))
430             env (cdr env))
431       (if (null (member server server-list))
432           (setq server-list (cons server server-list))))
433     (setq langs (delete nil
434                         (mapcar (lambda (info)
435                                   (if (memq (wnn-server-type info) server-list)
436                                       (wnn-server-language info)))
437                                 wnn-server-info-list)))
438     (if (<= (length langs) 1)
439         langs
440       (setq langs (cons (cons "All" langs)
441                         (mapcar (lambda (lang) (cons (symbol-name lang) lang))
442                                 langs)))
443       (cdr (assoc (completing-read "language? " langs nil t) langs)))))
444 \f
445 ;;
446 (defun wnn-comm-sentinel (proc reason)  ; assume it is close
447                                         ; tamago-971009 version
448   (let ((l wnn-environments)
449         env l1)
450     (kill-buffer (process-buffer proc))
451     ;; delete env from the list.
452     (while l
453       (setq env (car l))
454       (if (eq proc (wnnenv-get-proc env))
455           (progn
456             (if l1
457                 (setcdr l1 (cdr l))
458               (setq wnn-environments (cdr l)))
459             (setq l (cdr l)))
460         (setq l1 l
461               l (cdr l))))))
462
463 ;;
464 (defvar wnn-open-message)
465
466 (defun wnn-open (server-info)
467   "Establish the connection to WNN server.  Return process object."
468   ;; Open the session to WNN server, 
469   (let ((buf (generate-new-buffer (wnn-server-buffer-name server-info)))
470         (server-type (wnn-server-type server-info))
471         (hostname-list (wnn-server-hostname server-info))
472         (msg-form "WNN: connecting to %S at %s...")
473         hostname proc result msg)
474     (save-excursion
475       (set-buffer buf)
476       (erase-buffer)
477       (buffer-disable-undo)
478       (setq egg-fixed-euc (wnn-server-coding-system server-info))
479       (set-buffer-multibyte nil))
480     (cond
481      ((null hostname-list)
482       (setq hostname-list '("localhost")))
483      ((null (listp hostname-list))
484       (setq hostname-list (list hostname-list))))
485     (while (and hostname-list (null proc))
486       (setq hostname (car hostname-list)
487             hostname-list (cdr hostname-list))
488       (message msg-form server-type hostname)
489       (condition-case result
490           (setq proc (open-network-stream (wnn-server-stream-name server-info)
491                                           buf
492                                           hostname
493                                           (wnn-server-port server-info)))
494         (error nil))
495       (if proc
496           (progn
497             (process-kill-without-query proc)
498             (set-process-coding-system proc 'no-conversion 'no-conversion)
499             (set-process-sentinel proc 'wnn-comm-sentinel)
500             (set-marker-insertion-type (process-mark proc) t)
501             (setq result (wnnrpc-open proc
502                                       (if (equal hostname "localhost")
503                                           "unix"
504                                         (system-name))
505                                       (user-login-name)))
506             (if (< result 0)
507                 (progn
508                   (delete-process proc)
509                   (setq proc nil
510                         msg (format "Can't open WNN session (%s %S): %s"
511                                     hostname
512                                     (wnn-server-type server-info)
513                                     msg)))))))
514     (if proc
515         (progn
516           (setq wnn-open-message (format (concat msg-form "done")
517                                          server-type
518                                          hostname))
519           proc)
520       (kill-buffer buf)
521       (error "%s" (or msg (format "no %S available" server-type))))))
522
523 (defvar wnn-dictionary-specification-list
524   '((jserver
525      (nil nil ""
526           [2 10 2 45 100 200 5 1 40 -100 200 -100 200 80 200 200 200]
527           "pubdic/full.fzk"
528           ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
529           ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
530           ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
531           ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
532           ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
533           ["pubdic/special.dic"   ("special.h")  5 nil t]
534           ["pubdic/computer.dic"  ("computer.h") 5 nil t]
535           ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
536           ["pubdic/tankan.dic"    nil            1 nil nil]
537           ["pubdic/bio.dic"       ("bio.h")      1 nil t]
538           ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
539           ["wnncons/tankan2.dic"  nil            1 nil nil]
540           ["wnncons/tankan3.dic"  nil            1 nil nil]
541           [("ud")                 nil            5 t   t])
542      (nil t "R"
543           [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
544           "pubdic/full.fzk"
545           ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
546           ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
547           ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
548           ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
549           ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
550           ["pubdic/special.dic"   ("special.h")  5 nil t]
551           ["pubdic/computer.dic"  ("computer.h") 5 nil t]
552           ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
553           ["pubdic/tankan.dic"    nil            1 nil nil]
554           ["pubdic/bio.dic"       ("bio.h")      1 nil t]
555           ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
556           ["wnncons/tankan2.dic"  nil            1 nil nil]
557           ["wnncons/tankan3.dic"  nil            1 nil nil]
558           [("ud")                 nil            5 t   t]))
559     (cserver
560      (Q   nil "Q"
561           nil
562           "sys/full.con"
563           ["sys/QianMa.dic"       nil            1 nil nil])
564      (W   nil "W"
565           nil
566           "sys/full.con"
567           ["sys/WuBi.dic"         nil            1 nil nil])
568      (nil nil "PZ"
569           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
570           "sys/full.con"
571           ["sys/level_1.dic"      ("level_1.h")  4 nil t]
572           ["sys/level_2.dic"      ("level_2.h")  1 nil t]
573           ["sys/basic.dic"        ("basic.h")    7 nil t]
574           ["sys/computer.dic"     ("computer.h") 4 nil t]
575           ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
576           [("ud")                 nil            5 t   t])
577      (Q   t "QR"
578           nil
579           "sys/full.conR"
580           ["sys/QianMa.dic"       nil            1 nil nil])
581      (W   t "WR"
582           nil
583           "sys/full.conR"
584           ["sys/WuBi.dic"         nil            1 nil nil])
585      (nil t "PZR"
586           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
587           "sys/full.conR"
588           ["sys/level_1.dic"      ("level_1.h")  4 nil t]
589           ["sys/level_2.dic"      ("level_2.h")  1 nil t]
590           ["sys/basic.dic"        ("basic.h")    7 nil t]
591           ["sys/computer.dic"     ("computer.h") 4 nil t]
592           ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
593           [("ud")                 nil            5 t   t]))
594     (tserver
595      (nil nil ""
596           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
597           "sys/full.con"
598           ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
599           ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
600           [("ud")                 nil            5 t   t])
601      (nil t "R"
602           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
603           "sys/full.conR"
604           ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
605           ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
606           [("ud")                 nil            5 t   t]))
607     (kserver
608      (nil nil ""
609           [2 5 2 45 200 80 5 1 40 0 400 -100 400 80 200 2 200]
610           "sys/full.fzk"
611           ["sys/hword.dic"        ("hword.h")    5 nil t]
612           ["sys/single.dic"       ("single.h")   1 nil t]
613           [("ud")                 nil            2 t   t])
614      (nil t "R"
615           [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
616           "sys/full.fzk"
617           ["sys/hword.dic"        ("hword.h")    5 nil t]
618           ["sys/single.dic"       ("single.h")   1 nil t]
619           [("ud")                 nil            2 t   t]))))
620
621 (defsubst wnn-get-dic-spec (server)
622   (cdr (assoc server wnn-dictionary-specification-list)))
623
624 (defsubst wnn-dic-spec-dic-set (spec)
625   (nth 0 spec))
626
627 (defsubst wnn-dic-spec-reverse (spec)
628   (nth 1 spec))
629
630 (defsubst wnn-dic-spec-name (spec)
631   (nth 2 spec))
632
633 (defsubst wnn-dic-spec-param (spec)
634   (nth 3 spec))
635
636 (defsubst wnn-dic-spec-fuzokugo (spec)
637   (nth 4 spec))
638
639 (defsubst wnn-dic-spec-dic-list (spec)
640   (nthcdr 5 spec))
641
642
643 (defcustom wnn-usr-dic-dir (concat "usr/" (user-login-name))
644   "*Directory of user dictionary for Wnn."
645   :group 'wnn
646   :type 'string)
647
648 (defun wnn-filename (p)
649   ""
650   (cond ((consp p) (concat wnn-usr-dic-dir "/" (car p)))
651         (t p)))
652
653 (defun wnn-open-file (proc env-id filename)
654   "Open the file FILENAME on the environment ENV-ID on server process PROC.
655 Return file descripter.  NIL means NO-file.
656 On failure, return negate-encoded error code."
657   (if filename
658       (wnnrpc-open-file proc env-id filename)
659     nil))
660
661 (defun wnn-create-directory (proc env-id path)
662   "Create directory to the path."
663   (let ((dir (directory-file-name path))
664         create-list)
665     (while (and dir (/= (wnnrpc-access proc env-id 0 dir) 0))
666       (setq create-list (cons dir create-list)
667             dir (file-name-directory dir))
668       (if dir
669           (setq dir (directory-file-name dir))))
670     (if (null create-list)
671         t                               ; Already exist.
672       ;; Only query once.
673       (if (y-or-n-p (format "\e$B%G%#%l%/%H%j\e(B(%s)\e$B$,M-$j$^$;$s!#:n$j$^$9$+\e(B? " path))
674           (catch 'return
675             (while create-list
676               (let* ((dir (car create-list))
677                      (ret (wnnrpc-mkdir proc env-id dir)))
678                 (if (< ret 0)
679                     (progn
680                       (message "\e$B%G%#%l%/%H%j\e(B(%s)\e$B$N:n@.$K<:GT$7$^$7$?\e(B" dir)
681                       (throw 'return nil))))
682               (setq create-list (cdr create-list)))
683             ;; Success
684             (message "\e$B%G%#%l%/%H%j\e(B(%s)\e$B$r:n$j$^$7$?\e(B" path)
685             t)
686         ;; Failure
687         nil))))
688
689 (defun wnn-open-dictionary (proc env-id dicname mode)
690   (let ((dictionary (wnn-open-file proc env-id dicname)))
691     (if (null dictionary)
692         (throw 'wnn-set-dictionary-tag nil)
693       (while (< dictionary 0)
694         (let ((err-code (- dictionary)))
695           (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
696               (let ((msg (wnnrpc-get-error-message err-code)))
697                 (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B: %s" dicname msg)
698                 (throw 'wnn-set-dictionary-tag nil)) ; Failure
699             ;; Try to create new one
700             (if (and (y-or-n-p
701                       (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
702                               dicname))
703                      (wnn-create-directory proc env-id
704                                            (file-name-directory dicname))
705                      (= (wnnrpc-create-dictionary proc env-id dicname) 0))
706                 (progn
707                   (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" dicname)
708                   (setq dictionary
709                         (wnnrpc-open-file proc env-id dicname)))
710               (throw 'wnn-set-dictionary-tag nil)))))
711       dictionary)))
712
713 (defun wnn-open-frequency (proc env-id freqname mode dic)
714   (let ((frequency (wnn-open-file proc env-id freqname)))
715     (if (null frequency)
716         (setq frequency -1)
717       (while (< frequency 0)
718         (let ((err-code (- frequency)))
719           (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
720               (let ((msg (wnnrpc-get-error-message err-code)))
721                 (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B: %s" freqname msg)
722                 (throw 'wnn-set-dictionary-tag nil)) ; Failure
723             ;; Try to create new one
724             (if (and (y-or-n-p
725                       (format "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
726                               freqname))
727                      (wnn-create-directory proc env-id
728                                            (file-name-directory freqname))
729                      (= (wnnrpc-create-frequency proc env-id freqname dic) 0))
730                 (progn
731                   (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" freqname)
732                   (setq frequency
733                         (wnnrpc-open-file proc env-id freqname)))
734               (throw 'wnn-set-dictionary-tag nil))))))
735       frequency))
736
737 ;; Using local file (uploading/downloading) is not supported yet.
738 ;; Password is not supported (Password is questionable feature, anyway)
739 (defun wnn-set-dictionary (proc env-id reverse-flag dic-spec)
740   ""
741   (catch 'wnn-set-dictionary-tag
742     (let ((dicname (wnn-filename (aref dic-spec 0)))
743           (freqname (wnn-filename (aref dic-spec 1)))
744           (priority  (aref dic-spec 2))
745           (dic-mode  (aref dic-spec 3))
746           (freq-mode (aref dic-spec 4))
747           dictionary frequency)
748       (setq dictionary (wnn-open-dictionary proc env-id dicname dic-mode))
749       (setq frequency
750             (wnn-open-frequency proc env-id freqname freq-mode dictionary))
751       (wnn-set-dictionary-sub proc env-id reverse-flag
752                               dictionary frequency priority dic-mode
753                               freq-mode dicname freqname))))
754
755 (defun wnn-set-dictionary-sub (proc env-id reverse-flag
756                                dictionary frequency priority dic-mode
757                                freq-mode dicname freqname)
758   (let ((trying t))
759     (while trying
760       (let ((ret (wnnrpc-set-dictionary proc env-id reverse-flag
761                                         dictionary frequency
762                                         priority dic-mode freq-mode)))
763         (if (< ret 0)
764             (let ((err-code (- ret)))
765               (if (or (null freq-mode) (/= err-code (WNN-const NO_MATCH)))
766                   (let ((msg (wnnrpc-get-error-message (- ret))))
767                     (message "WNN: Error on setting dictionary (%s, %s): %s"
768                              dicname freqname msg)
769                     (setq trying nil))  ; done
770                 ;; No-match: Create new frequency and try it again
771                 (wnnrpc-discard-file proc env-id frequency) ; XXX: error?
772                 (setq frequency
773                       (wnn-query-del/create-frequency proc env-id freqname
774                                                       dictionary))))
775           ;; done sucessfully
776           (setq trying nil))))))
777
778 (defun wnn-query-del/create-frequency (proc env-id freqname dictionary)
779   (if (y-or-n-p
780        (format "\e$B<-=q$HIQEY\e(B(%s)\e$B$N@09g@-$,$"$j$^$;$s!#:n$jD>$7$^$9$+\e(B? "
781                freqname))
782       (progn
783         (wnnrpc-remove-file proc freqname) ; XXX: error?
784         (wnnrpc-create-frequency proc env-id freqname dictionary) ; XXX: error?
785         (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" freqname)
786         (wnnrpc-open-file proc env-id freqname)) ; XXX: error?
787     -1))
788
789 (defun wnn-get-environment (server-info &optional dic-set reverse)
790   "Return WNN Environemt for the conversion server specified
791 by SERVER-INFO.  If none, create new environment.  Optional
792 argument DIC-SET specifies dictionary set.  Optional argument
793 REVERSE specifies reverse conversion, if non nil."
794   (let ((server-type (wnn-server-type server-info))
795         (env wnn-environments)
796         proc spec e s)
797     (setq reverse (null (null reverse)))
798     (if (catch 'found
799           (while env
800             (setq e (car env))
801             (if (and (eq (wnnenv-get-server-type e) server-type)
802                      (eq (wnnenv-get-dictionary-set e) dic-set)
803                      (eq (wnnenv-get-reverse-flag e) reverse))
804                 (throw 'found t))
805             (setq env (cdr env))))
806         e
807       (setq proc (wnn-open server-info)
808             spec (wnn-get-dic-spec server-type))
809       (while spec
810         (setq s (car spec)
811               e (wnn-create-environment proc server-type s)
812               wnn-environments (cons e wnn-environments))
813         (if (and (eq (wnn-dic-spec-dic-set s) dic-set)
814                  (eq (wnn-dic-spec-reverse s) reverse))
815             (setq env e))
816         (setq spec (cdr spec)))
817       (if (null env)
818           (error "WNN: environment for %S%s (%s) not found"
819                  server-type
820                  (if dic-set (format "(%S)" dic-set) "")
821                  (if reverse 'reverse 'normal)))
822       (message "%s" wnn-open-message)
823       env)))
824
825 (defun wnn-create-environment (proc server-type spec)
826   ""
827   ;; Create new data structure: something like wnn_buf
828   ;; Process, Environment-ID and Daibunsetsu-info.
829   (let (env-id parameters filename fuzokugo-fid ret dic-set reverse)
830     (setq env-id (wnnrpc-connect proc (wnn-make-env-name spec)))
831     (if (< env-id 0)
832         (error "Can't connect new WNN environment: %s"
833                (wnnrpc-get-error-message (- env-id))))
834     (setq dic-set (wnn-dic-spec-dic-set spec)
835           reverse (wnn-dic-spec-reverse spec)
836           parameters (wnn-dic-spec-param spec)
837           filename (wnn-filename (wnn-dic-spec-fuzokugo spec))
838           fuzokugo-fid (wnn-open-file proc env-id filename))
839     (if (null fuzokugo-fid)
840         (setq fuzokugo-fid -1)
841       (if (< fuzokugo-fid 0)
842           (progn
843             (message "WNN: Can't open fuzokugo file (%s): %s"
844                      filename
845                      (wnnrpc-get-error-message (- fuzokugo-fid)))
846             (setq fuzokugo-fid -1))))
847     (setq ret (wnnrpc-set-fuzokugo-file proc env-id fuzokugo-fid))
848     (if (< ret 0)
849         (let ((msg (wnnrpc-get-error-message (- ret))))
850           (message "WNN: Error on setting fuzokugo (%s): %s" filename msg)))
851     (setq spec (wnn-dic-spec-dic-list spec))
852     (while spec
853       (wnn-set-dictionary proc env-id reverse (car spec))
854       (setq spec (cdr spec)))
855     (if parameters
856         (wnnrpc-set-conversion-parameters proc env-id parameters))
857     (wnnenv-create proc env-id server-type dic-set reverse)))
858
859 (defvar wnn-user-name nil)
860
861 (defun wnn-make-env-name (spec)
862   (or wnn-user-name
863       (setq wnn-user-name (getenv "WNNUSER"))
864       (setq wnn-user-name (user-login-name)))
865   (concat wnn-user-name (wnn-dic-spec-name spec)))
866
867 (defun wnn-update-frequency (env bunsetsu-info-list)
868   (let ((l bunsetsu-info-list))
869     (while l
870       (let* ((b (car l))
871              (fd (wnn-bunsetsu-get-freq-down b))
872              (z (wnn-bunsetsu-get-zenkouho b)))
873         (while fd
874           (let* ((fdb (car fd))
875                  (dic-no (wnn-bunsetsu-get-dic-no fdb))
876                  (entry (wnn-bunsetsu-get-entry fdb)))
877             (wnnrpc-set-frequency env dic-no entry
878                                   (WNN-const IMA_OFF) (WNN-const HINDO_NOP))
879             (setq fd (cdr fd))))
880         (while z
881           (let* ((zb (car z))
882                  (right-now (wnn-bunsetsu-get-right-now zb))
883                  (dic-no (wnn-bunsetsu-get-dic-no zb))
884                  (entry (wnn-bunsetsu-get-entry zb)))
885             (if (and (/= right-now 0) (/= dic-no -1))
886                 (wnnrpc-set-frequency env dic-no entry (WNN-const IMA_OFF)
887                                       (WNN-const HINDO_NOP)))
888             (setq z (cdr z))))
889         (let ((dic-no (wnn-bunsetsu-get-dic-no b))
890               (entry (wnn-bunsetsu-get-entry b)))
891           (if (/= dic-no -1)
892               (wnnrpc-set-frequency env dic-no entry 
893                                     (WNN-const IMA_ON)
894                                     (WNN-const HINDO_INC))))
895         (setq l (cdr l))))))
896 \f
897 ;;; XXX Need alternative implementation
898 ;(defun wnn-set-conversion-mode ()
899 ;  (jl-set-environment))
900
901 (defsubst wnn-dicinfo-entry (info) (aref info 0))
902 (defsubst wnn-dicinfo-id (info freq) (aref info (+ 1 freq)))
903 (defsubst wnn-dicinfo-mode (info freq) (aref info (+ 3 freq)))
904 (defsubst wnn-dicinfo-enable (info) (aref info 5))
905 (defsubst wnn-dicinfo-nice (info) (aref info 6))
906 (defsubst wnn-dicinfo-reverse (info) (aref info 7))
907 (defsubst wnn-dicinfo-comment (info) (aref info 8))
908 (defsubst wnn-dicinfo-name (info freq) (aref info (+ 9 freq)))
909 (defsubst wnn-dicinfo-passwd (info freq) (aref info (+ 11 freq)))
910 (defsubst wnn-dicinfo-type (info) (aref info 13))
911 (defsubst wnn-dicinfo-words (info) (aref info 14))
912 (defsubst wnn-dicinfo-local (info freq) (aref info (+ 15 freq)))
913
914 (defun wnn-save-dictionaries (env)
915   (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
916         (result 0) info freq)
917     (while (and dic-list
918                 (>= result 0))
919       (setq info (car dic-list)
920             dic-list (cdr dic-list)
921             freq 0)
922       (while (<= freq 1)
923         (if (and (> (wnn-dicinfo-id info freq) 0)
924                  (= (wnn-dicinfo-mode info freq) 0))
925             (if (= (wnn-dicinfo-local info freq) 1)
926                 (setq result (wnnrpc-write-file env
927                                                 (wnn-dicinfo-id info freq)
928                                                 (wnn-dicinfo-name info freq)))
929               (message "WNN: remote dictionary (%s) not supported yet"
930                        (wnn-dicinfo-name info freq))
931               (ding)
932               (sit-for 1)))
933         (if (< result 0)
934             (wnnrpc-disconnect env))
935         (setq freq (1+ freq))))))
936
937 (defun wnn-version (proc)
938   "Return version number string of WNN server."
939   (format "%x" (wnnrpc-version proc)))
940
941 (defun wnn-dai-bunsetsu-p ()
942   (jl-dai-top ))
943
944 (defun wnn-next-dai-bunsetsu-pos ()
945   XXX)
946 \f
947 ;;; not implemented yet (NIY)
948 (defun wnn-delete-dictionary ()
949   (dj-delete-dic XXX))
950
951 ;;; NIY, might never be implemented
952 (defun wnn-server-inspect ())
953
954 ;;; NIY
955 (defun wnn-list-dictionaries ()
956   (jl-dic-list))
957
958 ;;; NIY
959 (defun wnn-get-conversion-parameters ()
960   (js-get-parameters))
961
962 ;;; Dictionary management (word registration) is not implemented yet.
963
964 ;; XXX: local file loaded into the server: Not supported yet
965 ;(defun wnn-list-dictionaries (env)
966 ;  (wnnrpc-get-dictionary-list-with-environment env))
967
968 (defun wnn-find-dictionary-by-id (id dic-list)
969   (catch 'return
970     (while dic-list
971       (let ((dic (car dic-list)))
972         (if (= (wnndic-get-id dic) id)
973             (throw 'return dic)
974           (setq dic-list (cdr dic-list)))))))
975
976 (defun wnn-dict-name (dic)
977   (let ((name (wnndic-get-comment dic)))
978     (if (string= name "")
979         (file-name-nondirectory (wnndic-get-dictname dic))
980       name)))
981
982 (defun wnn-list-writable-dictionaries-byname (env)
983   (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
984         (w-id-list (wnnrpc-get-writable-dictionary-id-list env)))
985     (mapcar (function (lambda (id)
986                         (let ((dic (wnn-find-dictionary-by-id id dic-list)))
987                           (cons (wnn-dict-name dic) dic))))
988             w-id-list)))
989
990 (defun wnn-hinshi-list (env dic name)
991   (let ((dic-number (wnndic-get-id dic)))
992     (wnnrpc-get-hinshi-list env dic-number name)))
993
994 (defun wnn-hinshi-number (env hinshi-name)
995   (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi-name))
996
997 (defun wnn-add-word (env dic yomi kanji comment hinshi-id initial-freq)
998   (let ((dic-number (wnndic-get-id dic)))
999     (wnnrpc-add-word env dic-number yomi kanji comment
1000                      hinshi-id initial-freq)))
1001
1002 ;;; setup
1003
1004 (require 'egg)
1005 (load "egg/wnnrpc")
1006
1007 ;;;###autoload
1008 (defun egg-activate-wnn (&rest arg)
1009   "Activate Wnn backend of Tamagotchy."
1010   (egg-set-support-languages wnn-support-languages)
1011   (egg-set-conversion-backend wnn-conversion-backend
1012                               wnn-support-languages)
1013   (apply 'egg-mode arg))
1014
1015 ;;; egg/wnn.el ends here.