3bebcf9ae3e7a16a5a2c3267d6da6f3e5794d2c8
[elisp/tamago.git] / egg / wnn.el
1 ;;; egg/wnn.el --- WNN Support (high level interface) in Egg
2 ;;;                Input Method Architecture
3
4 ;; Copyright (C) 1999,2000 PFU LIMITED
5
6 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
7 ;;         KATAYAMA Yoshio <kate@pfu.co.jp>
8
9 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
10
11 ;; Keywords: mule, multilingual, input method
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
33 ;;; Code:
34
35 (require 'egg)
36 (require 'egg-edep)
37
38 (defgroup wnn nil
39   "Wnn interface for Tamago 4."
40   :group 'egg)
41
42 (defcustom wnn-auto-save-dictionaries 0
43   "*Save dictionaries automatically after N-th end conversion, if positive"
44   :group 'wnn :type 'integer)
45
46 (defcustom wnn-use-v3-eggrc nil
47   "*Enable old style eggrc, if non-NIL"
48   :group 'wnn :type 'boolean)
49
50 (defcustom wnn-use-bixing (not wnn-use-v3-eggrc)
51   "*Enable bixing (stroke) input-method, if non-NIL"
52   :group 'wnn :type 'boolean)
53
54 (defcustom wnn-force-set-environment nil
55   "*Regardless the existence of the Wnn environment in the server,
56 reset the environment, if non-NIL.  Otherwise, reset the environment
57 only when it is created."
58   :group 'wnn :type 'boolean)
59
60 (defcustom wnn-one-level-conversion nil
61   "*Don't use major clause (dai bunsetu/da wenjie/dae munjeol), if non-NIL."
62   :group 'wnn :type 'boolean)
63
64 (defcustom wnn-usr-dic-dir (concat "usr/" (user-login-name))
65   "*Directory of user dictionary for Wnn."
66   :group 'wnn
67   :type 'string)
68
69 (defcustom wnn-user-name (or (getenv "WNNUSER") (user-login-name))
70   "User name at Wnn server.  Default value is login name or
71 WNNUSER evironment variable, if it is defined."
72   :group 'wnn :type 'string)
73
74 (defcustom wnn-uniq-level 'wnn-uniq
75   "Uniq level for candidate selection.
76 wnn-no-uniq:    Use all candidates.
77 wnn-uniq-entry: Use only one among same dictionary entry candidates.
78 wnn-uniq:       Use only one among same hinshi candidates. (default)
79 wnn-uniq-kanji: Use only one among same kanji candidates."
80   :group 'wnn :type '(choice (const wnn-no-uniq)
81                              (const wnn-uniq-entry)
82                              (const wnn-uniq)
83                              (const wnn-uniq-kanji)))
84
85 (defcustom wnn-jserver nil
86   "jserver hostname list.  Use N-th port, if hostname is followed
87 by ':' and digit N."
88   :group 'wnn :type '(repeat string))
89 (defcustom wnn-cserver nil
90   "cserver hostname list.  Use N-th port, if hostname is followed
91 by ':' and digit N."
92   :group 'wnn :type '(repeat string))
93 (defcustom wnn-tserver nil
94   "tserver hostname list.  Use N-th port, if hostname is followed
95 by ':' and digit N."
96   :group 'wnn :type '(repeat string))
97 (defcustom wnn-kserver nil
98   "kserver hostname list.  Use N-th port, if hostname is followed
99  by ':' and digit N."
100   :group 'wnn :type '(repeat string))
101
102 (defcustom wnn-jport 22273 "jserver port number" :group 'wnn :type 'integer)
103 (defcustom wnn-cport 22289 "cserver port number" :group 'wnn :type 'integer)
104 (defcustom wnn-tport 22321 "tserver port number" :group 'wnn :type 'integer)
105 (defcustom wnn-kport 22305 "kserver port number" :group 'wnn :type 'integer)
106
107 (defmacro wnn-backend-plist ()
108   ''(egg-initialize-backend        wnn-init
109      egg-start-conversion          wnn-start-conversion
110      egg-get-bunsetsu-source       wnn-get-bunsetsu-source
111      egg-get-bunsetsu-converted    wnn-get-bunsetsu-converted
112      egg-get-source-language       wnn-get-source-language
113      egg-get-converted-language    wnn-get-converted-language
114      egg-major-bunsetsu-continue-p wnn-major-bunsetsu-continue-p
115      egg-list-candidates           wnn-list-candidates
116      egg-decide-candidate          wnn-decide-candidate
117      egg-special-candidate         wnn-special-candidate
118      egg-change-bunsetsu-length    wnn-change-bunsetsu-length
119      egg-bunsetsu-combinable-p     wnn-bunsetsu-combinable-p
120      egg-end-conversion            wnn-end-conversion
121      egg-word-inspection           wnn-word-inspection
122      egg-word-registration         wnn-word-registration))
123
124 (defun wnn-backend-func-name (name lang &optional env)
125   (intern (concat name "-" (symbol-name lang)
126                   (and env "-") (and env (symbol-name env)))))
127
128 (defun wnn-make-backend (lang env &optional source-lang converted-lang)
129   (let ((finalize (wnn-backend-func-name "wnn-finalize-backend" lang))
130         (backend (wnn-backend-func-name "wnn-backend" lang env)))
131     (if (null (fboundp finalize))
132         (progn
133           (fset finalize `(lambda () (wnn-finalize-backend ',lang)))
134           (egg-set-finalize-backend (list finalize))))
135     (if (null (get backend 'egg-start-conversion))
136         (setplist backend (apply 'list
137                                  'language lang
138                                  'source-language (or source-lang lang)
139                                  'converted-language (or converted-lang lang)
140                                  (wnn-backend-plist))))
141     backend))
142
143 (defun wnn-define-backend (lang env-name-list)
144   (mapcar (lambda (env)
145             (if (consp env)
146                 (wnn-define-backend lang env)
147               (wnn-make-backend lang env)))
148           env-name-list))
149
150 (wnn-make-backend 'Chinese-GB 'Q  'QianMa 'Chinese-GB)
151 (wnn-make-backend 'Chinese-GB 'QR 'Chinese-GB 'QianMa)
152 (wnn-make-backend 'Chinese-GB 'W  'WuBi 'Chinese-GB)
153 (wnn-make-backend 'Chinese-GB 'WR 'Chinese-GB 'WuBi)
154
155 (defconst wnn-backend-language-alist '((QianMa . Chinese-GB)
156                                        (WuBi . Chinese-GB)))
157
158 (defvar wnn-backend-alist nil)
159
160 (defun wnn-define-backend-alist (deflist)
161   (setq wnn-backend-alist
162         (mapcar (lambda (slot)
163                   (let* ((lang (car slot))
164                          (alt (cdr (assq lang wnn-backend-language-alist))))
165                     (cons lang (wnn-define-backend (or alt lang) (cdr slot)))))
166                 deflist)))
167
168 (defcustom wnn-backend-define-list
169   (if wnn-use-bixing
170       '((Japanese    ((nil nil R))   ((R   nil R)))
171         (Chinese-GB  ((PZ  PZ  PZR)) ((PZR PZ  PZR))
172                      ((QR  Q   QR))  ((WR  W   WR)))
173         (Chinese-CNS ((PZ  PZ  PZR)) ((PZR PZ  PZR)))
174         (Korean      ((nil nil R))   ((R   nil R)))
175         (QianMa      ((Q Q QR)))
176         (WuBi        ((W W WR))))
177     '((Japanese    ((nil nil R))   ((R   nil R)))
178       (Chinese-GB  ((PZ  PZ  PZR)) ((PZR PZ  PZR)))
179       (Chinese-CNS ((PZ  PZ  PZR)) ((PZR PZ  PZR)))
180       (Korean      ((nil nil R))   ((R   nil R)))))
181   "Alist of language and lists of the Wnn backend suffixes."
182   :group 'wnn
183   :set (lambda (sym value)
184          (set-default sym value)
185          (wnn-define-backend-alist value))
186   :type '(repeat
187           (cons
188            :tag "Language - Backend"
189            (choice :tag "Language"
190                    (const Japanese)
191                    (const Chinese-GB)
192                    (const Chinese-CNS)
193                    (const Korean)
194                    (const QianMa)
195                    (const WuBi)
196                    (symbol :tag "Other"))
197            (repeat
198             (cons
199              :tag "Backend Sequece"
200              (cons :tag "First Conversion Stage"
201                    (symbol :tag "Backend for Start Conversion")
202                    (repeat :tag "Backends for Reconvert"
203                            (symbol :tag "Backend")))
204              (repeat
205               :tag "Following Conversion Stages"
206               (cons
207                :tag "N-th Stage"
208                (symbol :tag "Backend for This Stage")
209                (repeat :tag "Backends for Reconvert"
210                        (symbol :tag "Backend")))))))))
211
212 (eval-when-compile
213   (defmacro WNN-const (c)
214     (cond ((eq c 'BUN_SENTOU)    -1)
215           ((eq c 'NO_EXIST)       1)
216           ((eq c 'NO_MATCH)      10)
217           ((eq c 'IMA_OFF)       -4)
218           ((eq c 'IMA_ON)        -3)
219           ((eq c 'CONNECT)        1)
220           ((eq c 'CONNECT_BK)     1)
221           ((eq c 'HIRAGANA)      -1)
222           ((eq c 'KATAKANA)     -11)
223           ((eq c 'IKEIJI_ENTRY) -50)
224           ((eq c 'LEARNING_LEN)   3)
225           ((eq c 'MUHENKAN_DIC)  -3)
226           ((eq c 'HINDO_NOP)     -2)
227           ((eq c 'HINDO_INC)     -3)
228           ((eq c 'DIC_RW)         0)
229           ((eq c 'DIC_RDONLY)     1)
230           ((eq c 'DIC_GROUP)      3)
231           ((eq c 'DIC_MERGE)      4)
232           ((eq c 'NOTRANS_LEARN)  1)
233           ((eq c 'BMODIFY_LEARN)  2)
234           ((eq c 'DIC_NO_TEMPS)   ?\x3f))))
235 \f
236 ;; Retern value of system-name may differ from hostname.
237 (defconst wnn-system-name
238   (or (with-temp-buffer
239         (condition-case nil
240             (call-process "hostname"
241                           nil `(,(current-buffer) nil) "hostname")
242           (error))
243         (goto-char (point-min))
244         (if (re-search-forward "[\0- ]" nil 0)
245             (goto-char (1- (point))))
246         (if (> (point) 1)
247             (buffer-substring 1 (point))))
248       (system-name)))
249
250 (egg-add-message
251  '((nil
252     (wnn-connect-error  "cannot connect to the server")
253     (wnn-fail-make-env  "cannot make the Wnn environment")
254     (wnn-dict-saving    "saving %s's frequency/dictionary information")
255     (wnn-dict-saved     "finish to save %s's frequency/dictionary information")
256     (wnn-dir-missing    "directory %s missing. Create it? ")
257     (wnn-dir-failed     "failed to create directory %s")
258     (wnn-dir-created    "directory %s created")
259     (wnn-dict-missing-1 "dictionary file %s is missing: %s")
260     (wnn-dict-missing-2 "dictionary file %s is missing. Create it? ")
261     (wnn-dict-created   "dictionary file %s is created")
262     (wnn-freq-missing-1 "frequency file %s is missing: %s")
263     (wnn-freq-missing-2 "frequency file %s is missing. Create it? ")
264     (wnn-freq-created   "frequency file %s is created")
265     (wnn-no-match       "unmatch dictionary and freq. file %s. Re-create it? ")
266     (wnn-re-create-freq "frequency file %s is re-created")
267     (wnn-pseud-bunsetsu "pseud clause")
268     (wnn-register-1     "dictionary name:")
269     (wnn-register-2     "clause class name")
270     (wnn-no-writable-d  "no writable dictionary"))
271    (Japanese
272     (wnn-connect-error  "\e$B%5!<%P$H@\B3$G$-$^$;$s$G$7$?\e(B")
273     (wnn-fail-make-env  "\e$B4D6-$r:n$k$3$H$O$G$-$^$;$s$G$7$?\e(B")
274     (wnn-dict-saving    "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9\e(B")
275     (wnn-dict-saved     "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?\e(B")
276     (wnn-dir-missing    "\e$B%G%#%l%/%H%j\e(B %s \e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? ")
277     (wnn-dir-failed     "\e$B%G%#%l%/%H%j\e(B %s \e$B$N:n@.$K<:GT$7$^$7$?\e(B")
278     (wnn-dir-created    "\e$B%G%#%l%/%H%j\e(B %s \e$B$r:n$j$^$7$?\e(B")
279     (wnn-dict-missing-1 "\e$B<-=q%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s\e(B: %s")
280     (wnn-dict-missing-2 "\e$B<-=q%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? ")
281     (wnn-dict-created   "\e$B<-=q%U%!%$%k\e(B %s \e$B$r:n$j$^$7$?\e(B")
282     (wnn-freq-missing-1 "\e$BIQEY%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s\e(B: %s")
283     (wnn-freq-missing-2 "\e$BIQEY%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? ")
284     (wnn-freq-created   "\e$BIQEY%U%!%$%k\e(B %s \e$B$r:n$j$^$7$?\e(B")
285     (wnn-no-match       "\e$B<-=q$HIQEY\e(B %s \e$B$N@09g@-$,$"$j$^$;$s!#:n$jD>$7$^$9$+\e(B? ")
286     (wnn-re-create-freq "\e$BIQEY%U%!%$%k\e(B %s \e$B$r:n$jD>$7$^$7$?\e(B")
287     (wnn-pseud-bunsetsu "\e$B5?;wJ8@a\e(B")
288     (wnn-register-1     "\e$BEPO?<-=qL>\e(B:")
289     (wnn-register-2     "\e$BIJ;lL>\e(B")
290     (wnn-no-writable-d  "\e$BEPO?2DG=$J<-=q$,$"$j$^$;$s\e(B"))
291    (Chinese-GB
292     (wnn-connect-error  "\e$A2;D\:M\e(Bserver\e$AA,=S\e(B")
293     (wnn-fail-make-env  "\e$A;7>32;D\44=(\e(B")
294     (wnn-dict-saving    "%s \e$A5DF56HND<~:M4G5dPEO"U}TZMK3v\e(B")
295     (wnn-dict-saved     "%s \e$A5DF56HND<~:M4G5dPEO"RQ>-MK3vAK\e(B")
296     (wnn-dir-missing    "\e$AD?B<\e(B %s \e$AC;SP!#R*=(A"Bp\e(B? ")
297     (wnn-dir-failed     "\e$AD?B<\e(B %s \e$A=(A"J'0\AK\e(B")
298     (wnn-dir-created    "\e$AD?B<\e(B %s \e$A=(A"AK\e(B")
299     (wnn-dict-missing-1 "\e$AWV5dND<~\e(B %s \e$AC;SP\e(B: %s")
300     (wnn-dict-missing-2 "\e$AWV5dND<~\e(B %s \e$AC;SP!#R*=(A"Bp\e(B? ")
301     (wnn-dict-created   "\e$AWV5dND<~\e(B %s \e$A=(A"AK\e(B")
302     (wnn-freq-missing-1 "\e$AF56HND<~\e(B %s \e$AC;SP\e(B: %s")
303     (wnn-freq-missing-2 "\e$AF56HND<~\e(B %s \e$AC;SP!#R*=(A"Bp\e(B? ")
304     (wnn-freq-created   "\e$AF56HND<~\e(B %s \e$A=(A"AK\e(B")
305     (wnn-no-match       "\e$AWV5d:MF56H\e(B %s \e$A5DU{:OPTC;SP!#R*TY=(A"Bp\e(B? ")
306     (wnn-re-create-freq "\e$AF56HND<~\e(B %s \e$ATY=(A"AK\e(B")
307     (wnn-pseud-bunsetsu "\e$ARIKFND=Z\e(B")
308     (wnn-register-1     "\e$A5GB<4G5dC{\e(B:")
309     (wnn-register-2     "\e$A4JPTC{\e(B")
310     (wnn-no-writable-d  "\e$AC;SP?ID\5GB<5D4G5d\e(B"))
311    (Chinese-CNS
312     (wnn-connect-error  "\e$(GDbWdLO\e(Bserver\e$(G]YZY\e(B")
313     (wnn-fail-make-env  "\e$(Gt?h:DbWd^6Pz\e(B")
314     (wnn-dict-saving    "%s \e$(GN{s"PyEFG5LOy0L(OjUIF_GcXMEx\e(B")
315     (wnn-dict-saved     "%s \e$(GN{s"PyEFG5LOy0L(OjUIDXenXMExD'\e(B")
316     (wnn-dir-missing    "\e$(GFxrg\e(B %s \e$(GJtH4!$SQPzG!cC\e(B? ")
317     (wnn-dir-failed     "\e$(GFxrg\e(B %s \e$(GPzG!FBZuD'\e(B")
318     (wnn-dir-created    "\e$(GFxrg\e(B %s \e$(GPzG!D'\e(B")
319     (wnn-dict-missing-1 "\e$(GGsL(EFG5\e(B %s \e$(GJtH4\e(B: %s")
320     (wnn-dict-missing-2 "\e$(GGsL(EFG5\e(B %s \e$(GJtH4!$SQPzG!cC\e(B? ")
321     (wnn-dict-created   "\e$(GGsL(EFG5\e(B %s \e$(GPzG!D'\e(B")
322     (wnn-freq-missing-1 "\e$(Gs"PyEFG5\e(B %s \e$(GJtH4\e(B: %s")
323     (wnn-freq-missing-2 "\e$(Gs"PyEFG5\e(B %s \e$(GJtH4!$SQPzG!cC\e(B? ")
324     (wnn-freq-created   "\e$(Gs"PyEFG5\e(B %s \e$(GPzG!D'\e(B")
325     (wnn-no-match       "\e$(GGsL(LOs"Py\e(B %s \e$(GN{plLOMLJtH4!$SQGBPzG!cC\e(B? ")
326     (wnn-re-create-freq "\e$(Gs"PyEFG5\e(B %s \e$(GGBPzG!D'\e(B")
327     (wnn-pseud-bunsetsu "\e$(GijH}EFeg\e(B")
328     (wnn-register-1     "\e$(G`trgy0L(GX\e(B:")
329     (wnn-register-2     "\e$(Gb$MLGX\e(B")
330     (wnn-no-writable-d  "\e$(GJtH4F+Wd`trgN{GsL(\e(B"))
331    (Korean
332     (wnn-connect-error  "\e$(C<-9v\e(B(Server) \e$(C?M\e(B \e$(CA"CKGR\e(B \e$(C<v\e(B \e$(C>x@>4O4Y\e(B")
333     (wnn-fail-make-env  "\e$(CH/0f@;\e(B \e$(C@[<:GR\e(B \e$(C<v\e(B \e$(C>x@>4O4Y\e(B")
334     (wnn-dict-saving    "%s \e$(C@G\e(B \e$(C:s55A$:8?M\e(B \e$(C;g@|A$:88&\e(B \e$(C<<@L:jGO0m\e(B \e$(C@V=@4O4Y\e(B")
335     (wnn-dict-saved     "%s \e$(C@G\e(B \e$(C:s55A$:8?M\e(B \e$(C;g@|A$:88&\e(B \e$(C<<@L:jG_=@4O4Y\e(B")
336     (wnn-dir-missing    "\e$(C5p7:Ed8.\e(B %s \e$(C@L\e(B \e$(C>x@>4O4Y#.@[<:GO0Z=@4O1n\e(B? ")
337     (wnn-dir-failed     "\e$(C5p7:Ed8.\e(B %s \e$(C@;\e(B \e$(C@[<:GR\e(B \e$(C<v\e(B \e$(C>x@>4O4Y\e(B")
338     (wnn-dir-created    "\e$(C5p7:Ed8.\e(B %s \e$(C@;\e(B \e$(C@[<:G_=@4O4Y\e(B")
339     (wnn-dict-missing-1 "\e$(C;g@|H-@O\e(B %s \e$(C@L\e(B \e$(C>x@>4O4Y\e(B: %s")
340     (wnn-dict-missing-2 "\e$(C;g@|H-@O\e(B %s \e$(C@L\e(B \e$(C>x@>4O4Y#.4Y=C\e(B \e$(C@[<:GO0Z=@4O1n\e(B? ")
341     (wnn-dict-created   "\e$(C;g@|H-@O\e(B %s \e$(C@;\e(B \e$(C@[<:G_=@4O4Y\e(B")
342     (wnn-freq-missing-1 "\e$(C:s55H-@O\e(B %s \e$(C@L\e(B \e$(C>x@>4O4Y\e(B: %s")
343     (wnn-freq-missing-2 "\e$(C:s55H-@O\e(B %s \e$(C@L\e(B \e$(C>x@>4O4Y#.4Y=C\e(B \e$(C@[<:GO0Z=@4O1n\e(B? ")
344     (wnn-freq-created   "\e$(C:s55H-@O\e(B %s \e$(C@;\e(B \e$(C@[<:G_=@4O4Y\e(B")
345     (wnn-no-match       "\e$(C;g@|0z\e(B \e$(C:s55\e(B %s \e$(C0!\e(B \e$(C8BAv\e(B \e$(C>J=@4O4Y#.4Y=C\e(B \e$(C@[<:GO0Z=@4O1n\e(B? ")
346     (wnn-re-create-freq "\e$(C:s55H-@O\e(B %s \e$(C@;\e(B \e$(C4Y=C\e(B \e$(C@[<:G_=@4O4Y\e(B")
347     (wnn-pseud-bunsetsu "\e$(C@G;g9.@}\e(B")
348     (wnn-register-1     "\e$(C5n7O;g@|8m\e(B:")
349     (wnn-register-2     "\e$(CG0;g8m\e(B")
350     (wnn-no-writable-d  "\e$(C5n7O\e(B \e$(C0!4IGQ\e(B \e$(CAvA$@L\e(B \e$(C>F4U4O4Y\e(B"))))
351 \f
352 ;; <env> ::= [ <proc> <env-id> <lang> <server-type> <wnn-version>
353 ;;             <backend> <tankan> <env-name> <auto-learn> <hinshi> ]
354
355 (defun wnnenv-create (proc env-id &optional server-type wnn-version
356                       backend tankan name)
357   (if name
358       (set (setq name (make-symbol name)) (make-vector 5 nil)))
359   (vector proc env-id server-type wnn-version backend tankan name
360           (make-vector 2 (WNN-const DIC_RDONLY))))
361
362 (defsubst wnnenv-get-proc (env)        (aref env 0))
363 (defsubst wnnenv-get-env-id (env)      (aref env 1))
364 (defsubst wnnenv-get-server-type (env) (aref env 2))
365 (defsubst wnnenv-get-wnn-version (env) (aref env 3))
366 (defsubst wnnenv-get-backend (env)     (aref env 4))
367 (defsubst wnnenv-get-tankan (env)      (aref env 5))
368
369 (defun wnnenv-get-client-file (env name)
370   (let ((hash (intern-soft name (symbol-value (aref env 6)))))
371     (and hash (symbol-value hash))))
372
373 (defun wnnenv-set-client-file (env name)
374   (set (intern (concat wnn-system-name "!" name) (symbol-value (aref env 6)))
375        name))
376
377 (defsubst wnnenv-get-hinshi (env h)    (or (get (aref env 6) h) -1))
378 (defsubst wnnenv-set-hinshi (env h v)  (put (aref env 6) h v))
379
380 (defsubst wnnenv-get-auto-learn (env)  (aref env 7))
381 (defsubst wnnenv-get-notrans (env)     (aref (wnnenv-get-auto-learn env) 0))
382 (defsubst wnnenv-get-bmodify (env)     (aref (wnnenv-get-auto-learn env) 1))
383 (defsubst wnnenv-set-notrans (env v)   (aset (wnnenv-get-auto-learn env) 0 v))
384 (defsubst wnnenv-set-bmodify (env v)   (aset (wnnenv-get-auto-learn env) 1 v))
385
386 (defsubst wnnenv-is-wnn6 (env)         (eq (wnnenv-get-wnn-version env) 'wnn6))
387
388 (defvar wnn-environments nil
389   "Environment for Wnn conversion server")
390
391 ;; <wnn-bunsetsu> ::= [ <env>
392 ;;                      <jirilen> <dic-no> <entry> <freq> <right-now> <hinshi>
393 ;;                      <status> <status-backward> <kangovect> <evaluation>
394 ;;                      <converted> <yomi> <fuzokugo>
395 ;;                      <dai-evaluation> <dai-continue> <change-top>
396 ;;                      <zenkouho-info> <freq-down> <fi-rel> <context> ]
397 ;;
398 ;; <zenkouho-info> ::= [ <pos> <list> <converted> <dai> <prev-b> <nxet-b> ]
399 ;;                    
400
401 (defsubst wnn-bunsetsu-create (env jirilen dic-no entry freq right-now hinshi
402                                status status-backward kangovect evaluation)
403   (egg-bunsetsu-create (wnnenv-get-backend env)
404                        (vector env jirilen dic-no entry freq right-now hinshi
405                                status status-backward kangovect evaluation
406                                nil nil nil nil nil nil nil nil nil nil)))
407
408 (defsubst wnn-bunsetsu-get-env (b)
409   (aref (egg-bunsetsu-get-info b) 0))
410 (defsubst wnn-bunsetsu-get-jirilen (b)
411   (aref (egg-bunsetsu-get-info b) 1))
412 (defsubst wnn-bunsetsu-get-dic-no (b)
413   (aref (egg-bunsetsu-get-info b) 2))
414 (defsubst wnn-bunsetsu-set-dic-no (b dic)
415   (aset (egg-bunsetsu-get-info b) 2 dic))
416 (defsubst wnn-bunsetsu-get-entry (b)
417   (aref (egg-bunsetsu-get-info b) 3))
418 (defsubst wnn-bunsetsu-set-entry (b ent)
419   (aset (egg-bunsetsu-get-info b) 3 ent))
420 (defsubst wnn-bunsetsu-get-freq (b)
421   (aref (egg-bunsetsu-get-info b) 4))
422 (defsubst wnn-bunsetsu-get-right-now (b)
423   (aref (egg-bunsetsu-get-info b) 5))
424 (defsubst wnn-bunsetsu-get-hinshi (b)
425   (aref (egg-bunsetsu-get-info b) 6))
426 (defsubst wnn-bunsetsu-get-status (b)
427   (aref (egg-bunsetsu-get-info b) 7))
428 (defsubst wnn-bunsetsu-get-status-backward (b)
429   (aref (egg-bunsetsu-get-info b) 8))
430 (defsubst wnn-bunsetsu-get-kangovect (b)
431   (aref (egg-bunsetsu-get-info b) 9))
432 (defsubst wnn-bunsetsu-get-evaluation (b)
433   (aref (egg-bunsetsu-get-info b) 10))
434
435 (defsubst wnn-bunsetsu-get-converted (b)
436   (aref (egg-bunsetsu-get-info b) 11))
437 (defsubst wnn-bunsetsu-set-converted (b cvt)
438   (aset (egg-bunsetsu-get-info b) 11 cvt))
439
440 (defsubst wnn-bunsetsu-get-yomi (b)
441   (aref (egg-bunsetsu-get-info b) 12))
442 (defsubst wnn-bunsetsu-set-yomi (b yomi)
443   (aset (egg-bunsetsu-get-info b) 12 yomi))
444
445 (defsubst wnn-bunsetsu-get-fuzokugo (b)
446   (aref (egg-bunsetsu-get-info b) 13))
447 (defsubst wnn-bunsetsu-set-fuzokugo (b fuzokugo)
448   (aset (egg-bunsetsu-get-info b) 13 fuzokugo))
449
450 (defsubst wnn-bunsetsu-get-dai-evaluation (b)
451   (aref (egg-bunsetsu-get-info b) 14))
452 (defsubst wnn-bunsetsu-set-dai-evaluation (b de)
453   (aset (egg-bunsetsu-get-info b) 14 de))
454
455 (defsubst wnn-bunsetsu-get-dai-continue (b)
456   (aref (egg-bunsetsu-get-info b) 15))
457 (defsubst wnn-bunsetsu-set-dai-continue (b dc)
458   (aset (egg-bunsetsu-get-info b) 15 dc))
459
460 (defsubst wnn-bunsetsu-get-change-top (b)
461   (aref (egg-bunsetsu-get-info b) 16))
462 (defsubst wnn-bunsetsu-set-change-top (b top)
463   (aset (egg-bunsetsu-get-info b) 16 top))
464
465 (defsubst wnn-bunsetsu-get-zenkouho (b)
466   (aref (egg-bunsetsu-get-info b) 17))
467 (defsubst wnn-bunsetsu-set-zenkouho (b z)
468   (aset (egg-bunsetsu-get-info b) 17 z))
469
470 (defsubst wnn-bunsetsu-get-freq-down (b)
471   (aref (egg-bunsetsu-get-info b) 18))
472 (defsubst wnn-bunsetsu-set-freq-down (b fd)
473   (aset (egg-bunsetsu-get-info b) 18 fd))
474
475 (defsubst wnn-bunsetsu-get-fi-rel (b)
476   (aref (egg-bunsetsu-get-info b) 19))
477 (defsubst wnn-bunsetsu-set-fi-rel (b fr)
478   (aset (egg-bunsetsu-get-info b) 19 fr))
479
480 (defsubst wnn-bunsetsu-get-context (b)
481   (aref (egg-bunsetsu-get-info b) 20))
482 (defsubst wnn-bunsetsu-set-context (b c)
483   (aset (egg-bunsetsu-get-info b) 20 c))
484
485 (defsubst wnn-zenkouho-create (pos list converted dai prev-b nxet-b)
486   (vector pos list converted dai prev-b nxet-b))
487
488 (defsubst wnn-bunsetsu-get-zenkouho-pos (b)
489   (aref (wnn-bunsetsu-get-zenkouho b) 0))
490 (defsubst wnn-bunsetsu-set-zenkouho-pos (b p)
491   (aset (wnn-bunsetsu-get-zenkouho b) 0 p))
492
493 (defsubst wnn-bunsetsu-get-zenkouho-list (b)
494   (aref (wnn-bunsetsu-get-zenkouho b) 1))
495 (defsubst wnn-bunsetsu-get-zenkouho-converted (b)
496   (aref (wnn-bunsetsu-get-zenkouho b) 2))
497 (defsubst wnn-bunsetsu-get-zenkouho-dai (b)
498   (aref (wnn-bunsetsu-get-zenkouho b) 3))
499 (defsubst wnn-bunsetsu-get-zenkouho-prev-b (b)
500   (aref (wnn-bunsetsu-get-zenkouho b) 4))
501 (defsubst wnn-bunsetsu-get-zenkouho-next-b (b)
502   (aref (wnn-bunsetsu-get-zenkouho b) 5))
503
504 (defsubst wnn-bunsetsu-connect-prev (bunsetsu)
505   (= (wnn-bunsetsu-get-status bunsetsu) (WNN-const CONNECT)))
506 (defsubst wnn-bunsetsu-connect-next (bunsetsu)
507   (= (wnn-bunsetsu-get-status-backward bunsetsu) (WNN-const CONNECT_BK)))
508
509 (defsubst wnn-context-create (dic-no entry jirilen hinshi fuzokugo
510                               converted freq right-now)
511   (vector dic-no entry jirilen hinshi fuzokugo
512           converted freq right-now
513           (egg-chars-in-period converted 0 (length converted))))
514
515 (defsubst wnn-context-dic-no (context)          (aref context 0))
516 (defsubst wnn-context-entry (context)           (aref context 1))
517 (defsubst wnn-context-jirilen (context)         (aref context 2))
518 (defsubst wnn-context-hinshi (context)          (aref context 3))
519 (defsubst wnn-context-fuzokugo (context)        (aref context 4))
520 (defsubst wnn-context-converted (context)       (aref context 5))
521 (defsubst wnn-context-right-now (context)       (aref context 6))
522 (defsubst wnn-context-set-right-now (context r) (aset context 6 r))
523 (defsubst wnn-context-freq (context)            (aref context 7))
524 (defsubst wnn-context-set-freq (context f)      (aset context 7 f))
525 (defsubst wnn-context-length (context)          (aref context 8))
526
527 (defun wnn-null-context ()
528   (list (wnn-context-create -2 0 0 0 "" "" 0 0)
529         (wnn-context-create -2 0 0 0 "" "" 0 0)))
530
531 (defun wnn-major-bunsetsu-set-context (bunsetsu-list context)
532   (while bunsetsu-list
533     (wnn-bunsetsu-set-context (car bunsetsu-list) context)
534     (setq bunsetsu-list (cdr bunsetsu-list))))
535
536 (defsubst wnn-bunsetsu-equal (bunsetsu-1 bunsetsu-2)
537   (and (= (wnn-bunsetsu-get-dic-no bunsetsu-1)
538           (wnn-bunsetsu-get-dic-no bunsetsu-2))
539        (= (wnn-bunsetsu-get-entry bunsetsu-1)
540           (wnn-bunsetsu-get-entry bunsetsu-2))
541        (= (wnn-bunsetsu-get-kangovect bunsetsu-1)
542           (wnn-bunsetsu-get-kangovect bunsetsu-2))
543        (equal (wnn-bunsetsu-get-converted bunsetsu-1)
544               (wnn-bunsetsu-get-converted bunsetsu-2))
545        (equal (wnn-bunsetsu-get-fuzokugo bunsetsu-1)
546               (wnn-bunsetsu-get-fuzokugo bunsetsu-2))))
547
548 (defun wnn-bunsetsu-list-equal (b1 b2)
549   (while (and b1 b2 (wnn-bunsetsu-equal (car b1) (car b2)))
550     (setq b1 (cdr b1)
551           b2 (cdr b2)))
552   (and (null b1) (null b2)))
553
554 (defun wnn-bunsetsu-list-copy (bunsetsu)
555   (mapcar (lambda (b)
556             (egg-bunsetsu-create (egg-bunsetsu-get-backend b)
557                                  (copy-sequence (egg-bunsetsu-get-info b))))
558           bunsetsu))
559 \f
560 (defconst wnn-server-info-list
561   ;; language    server  port      hostname    proc   coding-system
562   '((Japanese    jserver wnn-jport wnn-jserver "Wnn"  (fixed-euc-jp    fixed-euc-jp))
563     (Chinese-GB  cserver wnn-cport wnn-cserver "cWnn" (fixed-euc-py-cn fixed-euc-zy-cn))
564     (Chinese-CNS tserver wnn-tport wnn-tserver "tWnn" (fixed-euc-py-tw fixed-euc-zy-tw))
565     (Korean      kserver wnn-kport wnn-kserver "kWnn" (fixed-euc-kr    fixed-euc-kr))))
566
567 (defsubst wnn-server-get-info (lang)
568   (or (assq lang wnn-server-info-list)
569       (egg-error "unsupported language: %s" lang)))
570
571 (defsubst wnn-server-language (info)
572   (car info))
573 (defsubst wnn-server-type (info)
574   (nth 1 info))
575 (defsubst wnn-server-port (info)
576   (symbol-value (nth 2 info)))
577 (defsubst wnn-server-hostname (info)
578   (symbol-value (nth 3 info)))
579 (defsubst wnn-server-proc-name (info)
580   (nth 4 info))
581 (defsubst wnn-server-buffer-name (info)
582   (concat " *" (wnn-server-proc-name info) "*"))
583 (defsubst wnn-server-coding-system (info)
584   (nth 5 info))
585
586 (defconst wnn-accept-charset-alist
587   '((Chinese-CNS ascii chinese-sisheng chinese-cns11643-1 chinese-cns11643-2)))
588
589 (defsubst wnn-backend-get-language (backend)
590   (get backend 'language))
591
592 (defsubst wnn-backend-get-source-language (backend)
593   (get backend 'source-language))
594
595 (defsubst wnn-backend-get-converted-language (backend)
596   (get backend 'converted-language))
597
598 (defvar wnn-prev-context nil)
599
600 (defun wnn-start-conversion (backend yomi &optional context)
601   "Convert YOMI string to kanji, and enter conversion mode.
602 Return the list of bunsetsu."
603   (let ((accepts (cdr (assq (wnn-backend-get-source-language backend)
604                             wnn-accept-charset-alist)))
605         env hinshi fuzokugo result)
606     (if accepts
607         (let ((charsets (mapcar 'char-charset (string-to-list yomi))))
608           (while accepts
609              (setq charsets (delq (car accepts) charsets)
610                    accepts (cdr accepts)))
611           (if charsets
612               (egg-error "cannot handle %s" (car charsets)))))
613     (setq env (wnn-get-environment backend))
614     (cond ((eq (car (car-safe  context)) backend)
615            (setq wnn-prev-context (car context)
616                  context (cdr wnn-prev-context)
617                  hinshi (wnn-context-hinshi (nth 1 context))
618                  fuzokugo (wnn-context-fuzokugo (nth 1 context))))
619           ((listp context)
620            (setq wnn-prev-context (cons nil (wnn-null-context))
621                  context (cdr wnn-prev-context)
622                  hinshi (WNN-const BUN_SENTOU)
623                  fuzokugo ""))
624           ((eq (car wnn-prev-context) backend)
625            (setq context (cdr wnn-prev-context)
626                  hinshi (wnnenv-get-hinshi env 'noun)
627                  fuzokugo ""))
628           (t
629            (setq context (wnn-null-context)
630                  hinshi (wnnenv-get-hinshi env 'noun)
631                  fuzokugo "")))
632     (setq result (wnn-renbunsetsu-conversion env yomi hinshi fuzokugo nil
633                                              context))
634     (if (numberp result)
635         (egg-error "%s" (wnnrpc-get-error-message (- result))))
636     result))
637
638 (defun wnn-get-source-language (bunsetsu)
639   (wnn-backend-get-source-language (egg-bunsetsu-get-backend bunsetsu)))
640
641 (defun wnn-get-converted-language (bunsetsu)
642   (wnn-backend-get-converted-language (egg-bunsetsu-get-backend bunsetsu)))
643
644 (defun wnn-get-bunsetsu-converted (bunsetsu)
645   (concat (wnn-bunsetsu-get-converted bunsetsu)
646           (wnn-bunsetsu-get-fuzokugo  bunsetsu)))
647
648 (defun wnn-get-bunsetsu-source (bunsetsu)
649   (concat (wnn-bunsetsu-get-yomi bunsetsu)
650           (wnn-bunsetsu-get-fuzokugo bunsetsu)))
651
652 (defun wnn-get-major-bunsetsu-converted (bunsetsu)
653   (mapconcat 'wnn-get-bunsetsu-converted bunsetsu ""))
654
655 (defun wnn-get-major-bunsetsu-source (bunsetsu)
656   (mapconcat 'wnn-get-bunsetsu-source bunsetsu ""))
657
658 (defun wnn-major-bunsetsu-continue-p (bunsetsu)
659   (wnn-bunsetsu-get-dai-continue bunsetsu))
660
661 (defmacro wnn-uniq-hash-string (uniq-level)
662   `(mapconcat
663     (lambda (b)
664       (concat ,@(cond ((eq uniq-level 'wnn-uniq) 
665                        '((number-to-string (wnn-bunsetsu-get-hinshi b))))
666                       ((eq uniq-level 'wnn-uniq-entry)
667                        '((number-to-string (wnn-bunsetsu-get-dic-no b))
668                          "+"
669                          (number-to-string (wnn-bunsetsu-get-entry b)))))
670               "\0"
671               (wnn-bunsetsu-get-converted b)
672               "\0"
673               (wnn-bunsetsu-get-fuzokugo b)))
674     bunsetsu "\0"))
675
676 (defun wnn-uniq-hash (bunsetsu hash-table)
677   (intern (cond ((eq wnn-uniq-level 'wnn-uniq)
678                  (wnn-uniq-hash-string wnn-uniq))
679                 ((eq wnn-uniq-level 'wnn-uniq-entry)
680                  (wnn-uniq-hash-string wnn-uniq-entry))
681                 (t
682                  (wnn-uniq-hash-string nil)))
683           hash-table))
684
685 (defun wnn-uniq-candidates (candidates)
686   (if (eq wnn-uniq-level 'wnn-no-uniq)
687       candidates
688     (let ((hash-table (make-vector (length candidates) 0)))
689       (delq nil (mapcar (lambda (b)
690                           (let ((sym (wnn-uniq-hash b hash-table)))
691                             (if (null (boundp sym))
692                                 (set sym b))))
693                         candidates)))))
694
695 (defsubst wnn-uniq-bunsetsu-equal (bunsetsu-1 bunsetsu-2)
696   (and (or (eq wnn-uniq-level 'wnn-uniq-kanji)
697            (and (eq wnn-uniq-level 'wnn-uniq)
698                 (= (wnn-bunsetsu-get-hinshi bunsetsu-1)
699                    (wnn-bunsetsu-get-hinshi bunsetsu-2)))
700            (and (= (wnn-bunsetsu-get-dic-no bunsetsu-1)
701                    (wnn-bunsetsu-get-dic-no bunsetsu-2))
702                 (= (wnn-bunsetsu-get-entry bunsetsu-1)
703                    (wnn-bunsetsu-get-entry bunsetsu-2))
704                 (or (eq wnn-uniq-level 'wnn-uniq-entry)
705                     (= (wnn-bunsetsu-get-kangovect bunsetsu-1)
706                        (wnn-bunsetsu-get-kangovect bunsetsu-2)))))
707        (equal (wnn-bunsetsu-get-converted bunsetsu-1)
708               (wnn-bunsetsu-get-converted bunsetsu-2))
709        (equal (wnn-bunsetsu-get-fuzokugo bunsetsu-1)
710               (wnn-bunsetsu-get-fuzokugo bunsetsu-2))))
711
712 (defun wnn-uniq-bunsetsu-list-equal (b1 b2)
713   (while (and b1 b2 (wnn-uniq-bunsetsu-equal (car b1) (car b2)))
714     (setq b1 (cdr b1)
715           b2 (cdr b2)))
716   (and (null b1) (null b2)))
717
718 (defun wnn-candidate-pos (bunsetsu candidates)
719   (let ((n 0)
720         pos)
721     (while (and (null pos) candidates)
722       (if (wnn-uniq-bunsetsu-list-equal (car candidates) bunsetsu)
723           (setq pos n)
724         (setq candidates (cdr candidates)
725               n (1+ n))))
726     (or pos -1)))
727
728 (defun wnn-get-candidates-converted (candidates)
729   (mapcar 'wnn-get-major-bunsetsu-converted candidates))
730
731 (defun wnn-set-candidate-info (bunsetsu zenkouho)
732   (wnn-bunsetsu-set-zenkouho (car bunsetsu) zenkouho)
733   (mapcar (lambda (b) (wnn-bunsetsu-set-zenkouho b t)) (cdr bunsetsu)))
734
735 (defun wnn-list-candidates (bunsetsu prev-b next-b major)
736   (let* ((head (car bunsetsu))
737          (backend (egg-bunsetsu-get-backend head))
738          (env (wnn-bunsetsu-get-env head))
739          (yomi (wnn-get-major-bunsetsu-source bunsetsu))
740          (continue (eq (wnn-bunsetsu-get-zenkouho head) t))
741          pos cand converted hinshi fuzokugo v)
742     (if prev-b
743         (setq prev-b (egg-get-bunsetsu-tail prev-b)
744               hinshi (wnn-bunsetsu-get-hinshi prev-b)
745               fuzokugo (wnn-bunsetsu-get-fuzokugo prev-b))
746       (setq hinshi -1
747             fuzokugo ""))
748     (if next-b
749         (setq next-b (car next-b)
750               v (wnn-bunsetsu-get-kangovect next-b)))
751     (if (vectorp (wnn-bunsetsu-get-zenkouho head))
752         (setq pos (wnn-bunsetsu-get-zenkouho-pos head)
753               cand (wnn-bunsetsu-get-zenkouho-list head)))
754     (if (and pos
755              (wnn-bunsetsu-list-equal bunsetsu (nth pos cand))
756              (eq major (wnn-bunsetsu-get-zenkouho-dai head))
757              (eq prev-b (wnn-bunsetsu-get-zenkouho-prev-b head))
758              (eq next-b (wnn-bunsetsu-get-zenkouho-next-b head)))
759         (cons pos (wnn-bunsetsu-get-zenkouho-converted head))
760       (setq cand (wnn-get-bunsetsu-candidates env yomi hinshi fuzokugo v major))
761       (if (numberp cand)
762           (egg-error "%s" (wnnrpc-get-error-message (- cand))))
763       (setq pos (wnn-candidate-pos bunsetsu cand))
764       (cond ((< pos 0)
765              (setq cand (cons (wnn-bunsetsu-list-copy bunsetsu) cand)))
766             ((and (> pos 0)
767                   (null (eq (wnn-bunsetsu-get-zenkouho head) t)))
768              (setq cand (cons (nth pos cand) (delq (nth pos cand) cand)))))
769       (setq cand (wnn-uniq-candidates cand)
770             pos (wnn-candidate-pos bunsetsu cand)
771             converted (wnn-get-candidates-converted cand))
772       (wnn-set-candidate-info bunsetsu
773                               (wnn-zenkouho-create pos cand converted
774                                                    major prev-b next-b))
775       (wnn-add-freq-down head cand)
776       (cons pos converted))))
777
778 (defun wnn-decide-candidate (bunsetsu pos prev-b next-b)
779   (let* ((head (car bunsetsu))
780          (cand-list (wnn-bunsetsu-get-zenkouho-list head))
781          (cand (nth pos cand-list))
782          (c-head (car cand)))
783     (wnn-bunsetsu-set-zenkouho-pos head pos)
784     (wnn-bunsetsu-set-change-top c-head (wnn-bunsetsu-get-change-top head))
785     (wnn-bunsetsu-set-freq-down c-head (wnn-bunsetsu-get-freq-down head))
786     (wnn-merge-fi-rel c-head bunsetsu)
787     (wnn-major-bunsetsu-set-context cand (wnn-bunsetsu-get-context head))
788     (wnn-set-candidate-info cand (wnn-bunsetsu-get-zenkouho head))
789     (if (and prev-b (null wnn-one-level-conversion))
790         (progn
791           (setq prev-b (list (egg-get-bunsetsu-tail prev-b)))
792           (wnn-bunsetsu-set-dai-continue (car prev-b)
793                                          (wnn-bunsetsu-connect-prev c-head))))
794     (if next-b
795         (setq next-b (list (car next-b))))
796     (list cand prev-b next-b)))
797
798 (defun wnn-special-candidate (bunsetsu prev-b next-b major type)
799   (let* ((backend (egg-bunsetsu-get-backend (car bunsetsu)))
800          (lang (get backend 'language))
801          pos cand)
802     (when (and (eq lang (get backend 'source-language))
803                (eq lang (get backend 'converted-language)))
804       (setq pos (and (eq lang (get backend 'source-language))
805                      (eq lang (get backend 'converted-language))
806                      (cond ((eq lang 'Japanese)
807                             (cond ((eq type 'egg-hiragana) -1)
808                                   ((eq type 'egg-katakana) -2)))
809                            ((or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
810                             (cond ((eq type 'egg-pinyin) -1)
811                                   ((eq type 'egg-zhuyin) -1)))
812                            ((eq lang 'Korean)
813                             (cond ((eq type 'egg-hangul) -1))))))
814       (when pos
815         (setq cand (cdr (wnn-list-candidates bunsetsu prev-b next-b major))
816               pos (+ pos (length cand)))
817         (when (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS)))
818           (let ((converted (nth pos cand)))
819             (cond ((egg-pinyin-syllable converted)
820                    (cond ((eq type 'egg-pinyin)) ; OK
821                          ((eq type 'egg-zhuyin)
822                           (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type))
823                          (t (setq pos nil))))
824                   ((egg-zhuyin-syllable converted)
825                    (cond ((eq type 'egg-pinyin)
826                           (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type))
827                          ((eq type 'egg-zhuyin)) ; OK
828                          (t (setq pos nil))))
829                   (t (setq pos nil))))))
830       (when pos
831         (wnn-decide-candidate bunsetsu pos prev-b next-b)))))
832
833 (defun wnn-pinyin-zhuyin-bunsetsu (bunsetsu pos lang type)
834   (let ((b (nth pos (wnn-bunsetsu-get-zenkouho-list (car bunsetsu))))
835         (encoding (if (eq lang 'Chinese-GB)
836                       (if (eq type 'egg-pinyin)
837                           'fixed-euc-py-cn 'fixed-euc-zy-cn)
838                     (if (eq type 'egg-pinyin)
839                         'fixed-euc-py-tw 'fixed-euc-zy-tw)))
840         (converted (wnn-bunsetsu-get-zenkouho-converted (car bunsetsu)))
841         str)
842     (setcar (nthcdr pos converted)
843             (wnn-pinyin-zhuyin-string (nth pos converted) encoding))
844     (while b
845       (setq str (wnn-bunsetsu-get-converted (car b)))
846       (when str
847         (wnn-bunsetsu-set-converted
848          (car b)
849          (wnn-pinyin-zhuyin-string str encoding)))
850       (setq str (wnn-bunsetsu-get-fuzokugo (car b)))
851       (when str
852         (wnn-bunsetsu-set-fuzokugo
853          (car b)
854          (wnn-pinyin-zhuyin-string str encoding)))
855       (setq b (cdr b)))))
856
857 (defun wnn-pinyin-zhuyin-string (str encoding)
858   (decode-coding-string (encode-coding-string str encoding) encoding))
859
860 (defun wnn-change-bunsetsu-length (bunsetsu prev-b next-b len major)
861   (let ((backend (egg-bunsetsu-get-backend (car bunsetsu)))
862         (env (wnn-bunsetsu-get-env (car bunsetsu)))
863         (tail (egg-get-bunsetsu-tail prev-b))
864         (yomi (wnn-get-major-bunsetsu-source bunsetsu))
865         (context (wnn-bunsetsu-get-context (car bunsetsu)))
866         yomi1 yomi2 hinshi fuzokugo new)
867     (if tail
868         (setq hinshi (wnn-bunsetsu-get-hinshi tail)
869               fuzokugo (wnn-bunsetsu-get-fuzokugo tail))
870       (setq hinshi -1
871             fuzokugo ""))
872     (setq yomi1 (substring yomi 0 len)
873           yomi2 (concat (substring yomi len)
874                         (wnn-get-major-bunsetsu-source next-b)))
875     (setq new (wnn-tanbunsetsu-conversion env yomi1 hinshi fuzokugo nil major))
876     (if (numberp new)
877         (egg-error "%s" (wnnrpc-get-error-message (- new))))
878     (if (and prev-b (null wnn-one-level-conversion))
879         (wnn-bunsetsu-set-dai-continue tail
880                                        (wnn-bunsetsu-connect-prev (car new))))
881     (wnn-bunsetsu-set-change-top (car new) t)
882     (wnn-merge-freq-down (car new) bunsetsu)
883     (wnn-merge-fi-rel (car new) bunsetsu)
884     (wnn-merge-fi-rel (car new) next-b)
885     (wnn-major-bunsetsu-set-context new context)
886     (if (= (length yomi2) 0)
887         (setq next-b nil)
888       (setq tail (egg-get-bunsetsu-tail new)
889             next-b (wnn-renbunsetsu-conversion env yomi2
890                                                (wnn-bunsetsu-get-hinshi tail)
891                                                (wnn-bunsetsu-get-fuzokugo tail)
892                                                nil context))
893       (if (numberp next-b)
894           (egg-error "%s" (wnnrpc-get-error-message (- next-b))))
895       (if (and (null major) (null wnn-one-level-conversion))
896           (wnn-bunsetsu-set-dai-continue
897            tail
898            (wnn-bunsetsu-connect-prev (car next-b)))))
899     (list new prev-b next-b)))
900
901 (defun wnn-add-freq-down (bunsetsu down-list)
902   (let ((freq-down (wnn-bunsetsu-get-freq-down bunsetsu))
903         b-list b pair)
904     (while down-list
905       (setq b-list (car down-list)
906             down-list (cdr down-list))
907       (while b-list
908         (setq b (car b-list)
909               b-list (cdr b-list)
910               pair (cons (wnn-bunsetsu-get-dic-no b)
911                          (wnn-bunsetsu-get-entry b)))
912         (if (and (/= (wnn-bunsetsu-get-right-now b) 0)
913                  (/= (car pair) -1)
914                  (null (member pair freq-down)))
915             (setq freq-down (cons pair freq-down)))))
916     (wnn-bunsetsu-set-freq-down bunsetsu freq-down)))
917
918 (defun wnn-merge-freq-down (bunsetsu b-list)
919   (let ((freq-down0 (wnn-bunsetsu-get-freq-down bunsetsu))
920         freq-down1)
921     (while b-list
922       (setq freq-down1 (wnn-bunsetsu-get-freq-down (car b-list))
923             b-list (cdr b-list))
924       (while freq-down1
925         (if (null (member (car freq-down1) freq-down0))
926             (setq freq-down0 (cons (car freq-down1) freq-down0)))
927         (setq freq-down1 (cdr freq-down1)))
928     (wnn-bunsetsu-set-freq-down bunsetsu freq-down0))))
929
930 (defun wnn-merge-fi-rel (bunsetsu b-list)
931   (let ((fi-rel (cons nil (wnn-bunsetsu-get-fi-rel bunsetsu))))
932     (if (eq bunsetsu (car b-list))
933         (setq b-list (cdr b-list)))
934     (while b-list
935       (nconc fi-rel (wnn-bunsetsu-get-fi-rel (car b-list)))
936       (wnn-bunsetsu-set-fi-rel (car b-list) nil)
937       (setq b-list (cdr b-list)))
938     (wnn-bunsetsu-set-fi-rel bunsetsu (cdr fi-rel))))
939
940 (defun wnn-bunsetsu-combinable-p (bunsetsu1 bunsetsu2)
941   (eq (wnn-bunsetsu-get-env bunsetsu1)
942       (wnn-bunsetsu-get-env bunsetsu2)))
943
944 (defvar wnn-auto-save-dic-count 0)
945
946 (defun wnn-end-conversion (bunsetsu-list abort)
947   (unless abort
948     (let* ((head (car bunsetsu-list))
949            (env (wnn-bunsetsu-get-env head)))
950       (prog1
951           (if (wnnenv-is-wnn6 env)
952               (progn
953                 (wnn-clear-now-flag bunsetsu-list)
954                 (wnn-merge-fi-rel head (cdr bunsetsu-list))
955                 (wnnrpc-set-fi-priority env (wnn-bunsetsu-get-fi-rel head))
956                 (wnn-optimize-in-local bunsetsu-list)
957                 (wnn-optimize-in-server bunsetsu-list))
958             (wnn-clear-now-flag bunsetsu-list)
959             (wnn-count-up-frequency bunsetsu-list))
960         (setq wnn-auto-save-dic-count (1+ wnn-auto-save-dic-count))
961         (when (eq wnn-auto-save-dic-count wnn-auto-save-dictionaries)
962           (wnn-save-dictionaries env)
963           (setq wnn-auto-save-dic-count 0))))))
964
965 (defun wnn-clear-now-flag (bunsetsu-list)
966   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list))))
967     (while bunsetsu-list
968       (setq fd (wnn-bunsetsu-get-freq-down (car bunsetsu-list))
969             bunsetsu-list (cdr bunsetsu-list))
970       (while fd
971         (wnnrpc-set-frequency env (caar fd) (cdar fd)
972                               (WNN-const IMA_OFF) (WNN-const HINDO_NOP))
973         (setq fd (cdr fd))))))
974
975 (defun wnn-count-up-frequency (bunsetsu-list)
976   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
977         (context (wnn-null-context))
978         dic-no entry b)
979     (while bunsetsu-list
980       (setq b (car bunsetsu-list)
981             bunsetsu-list (cdr bunsetsu-list)
982             dic-no (wnn-bunsetsu-get-dic-no b)
983             entry (wnn-bunsetsu-get-entry b)
984             context (cons (wnn-context-create dic-no entry
985                                               (wnn-bunsetsu-get-jirilen b)
986                                               (wnn-bunsetsu-get-hinshi b)
987                                               (wnn-bunsetsu-get-fuzokugo b)
988                                               (wnn-bunsetsu-get-converted b)
989                                               (wnn-bunsetsu-get-right-now b)
990                                               (wnn-bunsetsu-get-freq b))
991                           context))
992       (wnnrpc-set-frequency env dic-no entry 
993                             (WNN-const IMA_ON) (WNN-const HINDO_INC)))
994     (list (car context) (nth 1 context))))
995
996 (defun wnn-optimize-in-local (bunsetsu-list)
997   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
998         b prev-b next-b major-top entry hinshi)
999     (setq next-b (car bunsetsu-list)
1000           bunsetsu-list (cdr bunsetsu-list))
1001     (cond
1002      ((eq (wnnenv-get-server-type env) 'jserver)
1003       (while next-b
1004         (setq major-top (null (and b (wnn-bunsetsu-get-dai-continue b)))
1005               prev-b b
1006               b next-b
1007               next-b (car bunsetsu-list)
1008               bunsetsu-list (cdr bunsetsu-list)
1009               hinshi (wnn-bunsetsu-get-hinshi b))
1010         (when (or
1011                (and (/= (wnnenv-get-notrans env) (WNN-const DIC_RDONLY))
1012                     (= (wnn-bunsetsu-get-dic-no b) -1)
1013                     (or (= (wnn-bunsetsu-get-entry b) (WNN-const HIRAGANA))
1014                         (= (wnn-bunsetsu-get-entry b) (WNN-const KATAKANA)))
1015                     (>= (wnn-bunsetsu-get-jirilen b) (WNN-const LEARNING_LEN)))
1016                (= (wnn-bunsetsu-get-entry b) (WNN-const IKEIJI_ENTRY)))
1017           (setq entry (wnn-notrans-auto-learning b))
1018           (when (/= entry -1)
1019             (wnn-bunsetsu-set-dic-no b (WNN-const MUHENKAN_DIC))
1020             (wnn-bunsetsu-set-entry b entry)))
1021         (cond
1022          ((and next-b
1023                major-top
1024                (wnn-bunsetsu-get-dai-continue b))
1025           (wnn-adjacent-learning b next-b))
1026          ((and prev-b
1027                (= hinshi (wnnenv-get-hinshi env 'rendaku))
1028                (equal (wnn-bunsetsu-get-fuzokugo prev-b) ""))
1029           (wnn-adjacent-learning prev-b b))
1030          ((and next-b
1031                (= hinshi (wnnenv-get-hinshi env 'settou)))
1032           (wnn-adjacent-learning b next-b))
1033          ((and (/= (wnnenv-get-bmodify env) (WNN-const DIC_RDONLY))
1034                (wnn-bunsetsu-get-change-top b)
1035                next-b
1036                (/= (wnn-bunsetsu-get-hinshi next-b)
1037                    (wnnenv-get-hinshi env 'rendaku))
1038                (/= hinshi (wnnenv-get-hinshi env 'settou)))
1039           (wnn-bmodify-learning b next-b)))))
1040      ((eq (wnnenv-get-server-type env) 'kserver)
1041       ;; Soory, not implemented
1042       nil))))
1043
1044 (defun wnn-notrans-auto-learning (bunsetsu)
1045   (let ((env (wnn-bunsetsu-get-env bunsetsu)))
1046     (wnnrpc-auto-learning env (WNN-const NOTRANS_LEARN)
1047                           (wnn-bunsetsu-get-yomi bunsetsu)
1048                           (wnn-bunsetsu-get-converted bunsetsu)
1049                           ""
1050                           (if (= (wnn-bunsetsu-get-entry bunsetsu)
1051                                  (WNN-const IKEIJI_ENTRY))
1052                               (wnn-bunsetsu-get-hinshi bunsetsu)
1053                             (wnnenv-get-hinshi env 'noun))
1054                           0)))
1055
1056 (defun wnn-adjacent-learning (bunsetsu1 bunsetsu2)
1057   (let ((env (wnn-bunsetsu-get-env bunsetsu1))
1058         (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu1)
1059                       (wnn-bunsetsu-get-yomi bunsetsu2)))
1060         (kanji (concat (wnn-bunsetsu-get-converted bunsetsu1)
1061                        (wnn-bunsetsu-get-converted bunsetsu2)))
1062         (hinshi (wnnenv-get-hinshi env 'noun)))
1063     (if (= (wnnenv-get-bmodify env) (WNN-const DIC_RW))
1064         (wnnrpc-auto-learning env (WNN-const BMODIFY_LEARN)
1065                               yomi kanji "" hinshi 0)
1066       (wnnrpc-temporary-learning env yomi kanji "" hinshi 0))))
1067
1068 (defun wnn-bmodify-learning (bunsetsu1 bunsetsu2)
1069   (let ((env (wnn-bunsetsu-get-env bunsetsu1))
1070         (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu1)
1071                       (wnn-bunsetsu-get-fuzokugo bunsetsu1)
1072                       (wnn-bunsetsu-get-yomi bunsetsu2)))
1073         (kanji (concat (wnn-bunsetsu-get-converted bunsetsu1)
1074                        (wnn-bunsetsu-get-fuzokugo bunsetsu1)
1075                        (wnn-bunsetsu-get-converted bunsetsu2)))
1076         (hinshi (wnn-bunsetsu-get-hinshi bunsetsu2)))
1077     (wnnrpc-auto-learning env (WNN-const BMODIFY_LEARN)
1078                           yomi kanji "" hinshi 0)))
1079
1080 (defun wnn-optimize-in-server (bunsetsu-list)
1081   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
1082         (context (wnn-bunsetsu-get-context (car bunsetsu-list)))
1083         b)
1084     (when (eq (wnnenv-get-server-type env) 'jserver)
1085       (wnn-context-set-right-now (car context) (WNN-const HINDO_NOP))
1086       (wnn-context-set-freq (car context) (WNN-const HINDO_NOP))
1087       (wnn-context-set-right-now (nth 1 context) (WNN-const HINDO_NOP))
1088       (wnn-context-set-freq (nth 1 context) (WNN-const HINDO_NOP))
1089       (while bunsetsu-list
1090         (setq b (car bunsetsu-list)
1091               bunsetsu-list (cdr bunsetsu-list)
1092               context (cons (wnn-context-create (wnn-bunsetsu-get-dic-no b)
1093                                                 (wnn-bunsetsu-get-entry b)
1094                                                 (wnn-bunsetsu-get-jirilen b)
1095                                                 (wnn-bunsetsu-get-hinshi b)
1096                                                 (wnn-bunsetsu-get-fuzokugo b)
1097                                                 (wnn-bunsetsu-get-converted b)
1098                                                 (WNN-const IMA_ON)
1099                                                 (WNN-const HINDO_INC))
1100                             context)))
1101       (prog1
1102           (list (car context) (nth 1 context))
1103         (wnnrpc-optimize-fi env (nreverse context))))))
1104
1105 (defun wnn-finalize-backend (lang &optional action)
1106   (let* ((save-inhibit-quit inhibit-quit)
1107          (inhibit-quit t)
1108          (server-info (wnn-server-get-info lang))
1109          (server-type (wnn-server-type server-info))
1110          (env-list wnn-environments)
1111          env proc-list saved)
1112     (when server-type
1113       (while env-list
1114         (setq env (car env-list)
1115               env-list (cdr env-list))
1116         (if (eq (wnnenv-get-server-type env) server-type)
1117             (condition-case err
1118                 (progn
1119                   (unless (memq (wnnenv-get-proc env) proc-list)
1120                     (setq proc-list (cons (wnnenv-get-proc env) proc-list)))
1121                   (unless (eq action 'disconnect-only)
1122                     (unless saved
1123                       (setq saved t)
1124                       (message (egg-get-message 'wnn-dict-saving)
1125                                (wnn-server-proc-name server-info)))
1126                     (let ((inhibit-quit save-inhibit-quit))
1127                       (wnn-save-dictionaries env)))
1128                   (unless (eq action 'save-only)
1129                     (wnnrpc-disconnect env)))
1130               ((error quit)
1131                (message "signal %S occured when dictionary saving" err)))))
1132       (if saved
1133           (message (egg-get-message 'wnn-dict-saved)
1134                    (wnn-server-proc-name server-info)))
1135       (unless (eq action 'save-only)
1136         (while proc-list
1137           (if (and (car proc-list)
1138                    (eq (process-status (car proc-list)) 'open))
1139               (wnnrpc-close (car proc-list)))
1140           (setq proc-list (cdr proc-list)))))))
1141
1142 (defun wnn-close (lang)
1143   "Save dictionaries and close the Wnn session."
1144   (interactive (list (wnn-read-active-lang)))
1145   (or (listp lang)
1146       (setq lang (list lang)))
1147   (while lang
1148     (wnn-finalize-backend (car lang))
1149     (setq lang (cdr lang))))
1150
1151 (defun wnn-disconnect (lang)
1152   "Disconnect the Wnn session without dictionary saving."
1153   (interactive (list (wnn-read-active-lang)))
1154   (or (listp lang)
1155       (setq lang (list lang)))
1156   (while lang
1157     (wnn-finalize-backend (car lang) 'disconnect-only)
1158     (setq lang (cdr lang))))
1159
1160 (defun wnn-dictionary-save (lang)
1161   "Save Wnn dictionaries."
1162   (interactive (list (wnn-read-active-lang)))
1163   (or (listp lang)
1164       (setq lang (list lang)))
1165   (while lang
1166     (wnn-finalize-backend (car lang) 'save-only)
1167     (setq lang (cdr lang))))
1168
1169 (defun wnn-read-active-lang ()
1170   (let ((completion-ignore-case t)
1171         (env wnn-environments)
1172         langs server server-list)
1173     (while env
1174       (setq server (wnnenv-get-server-type (car env))
1175             env (cdr env))
1176       (if (null (memq server server-list))
1177           (setq server-list (cons server server-list))))
1178     (setq langs (delq nil
1179                       (mapcar (lambda (info)
1180                                 (if (memq (wnn-server-type info) server-list)
1181                                     (wnn-server-language info)))
1182                               wnn-server-info-list)))
1183     (if (<= (length langs) 1)
1184         langs
1185       (setq langs (cons (cons "All" langs)
1186                         (mapcar (lambda (lang) (cons (symbol-name lang) lang))
1187                                 langs)))
1188       (cdr (assoc (completing-read "language? " langs nil t nil nil "All")
1189                   langs)))))
1190 \f
1191 ;;
1192 (defun wnn-comm-sentinel (proc reason)  ; assume it is close
1193   (let ((inhibit-quit t))
1194     (kill-buffer (process-buffer proc))
1195     ;; delete env from the list.
1196     (setq wnn-environments
1197           (delq nil (mapcar (lambda (env)
1198                               (if (null (eq (wnnenv-get-proc env) proc))
1199                                   env))
1200                               wnn-environments)))))
1201
1202 (defun wnn-open (server-info)
1203   "Establish the connection to WNN server.  Return process object."
1204   ;; Open the session to WNN server,
1205   (let ((save-inhibit-quit inhibit-quit)
1206         (inhibit-quit t)
1207         (server-type (wnn-server-type server-info))
1208         (port (wnn-server-port server-info))
1209         (hostname-list (wnn-server-hostname server-info))
1210         (proc-name (wnn-server-proc-name server-info))
1211         (msg-form "Wnn: connecting to %S at %s...")
1212         (user-name (user-login-name))
1213         buf hostname myname port-off proc result msg)
1214     (unwind-protect
1215         (progn
1216           (setq buf (generate-new-buffer (wnn-server-buffer-name server-info)))
1217           (save-excursion
1218             (set-buffer buf)
1219             (erase-buffer)
1220             (buffer-disable-undo)
1221             (set-buffer-multibyte nil)
1222             (setq egg-fixed-euc (wnn-server-coding-system server-info)))
1223           (or (consp hostname-list)
1224               (setq hostname-list (list hostname-list)))
1225           (while (and hostname-list (null proc))
1226             (setq hostname (or (car hostname-list) "")
1227                   hostname-list (cdr hostname-list)
1228                   myname (if (equal hostname "") "unix" wnn-system-name))
1229             (if (null (string-match ":" hostname))
1230                 (setq port-off 0)
1231               (setq port-off (string-to-int (substring hostname (match-end 0)))
1232                     hostname (substring hostname 0 (match-beginning 0))))
1233             (and (equal hostname "") (setq hostname "localhost"))
1234             (let ((inhibit-quit save-inhibit-quit))
1235               (if (and msg
1236                        (null (y-or-n-p (format "%s failed. Try to %s? "
1237                                                msg hostname))))
1238                   (egg-error "abort connect")))
1239             (setq msg (format "Wnn: connecting to %S at %s..."
1240                               server-type hostname))
1241             (message "%s" msg)
1242             (let ((inhibit-quit save-inhibit-quit))
1243               (condition-case nil
1244                   (setq proc (open-network-stream proc-name buf hostname
1245                                                   (+ port port-off)))
1246                 ((error quit))))
1247             (when proc
1248               (process-kill-without-query proc)
1249               (set-process-coding-system proc 'binary 'binary)
1250               (set-process-sentinel proc 'wnn-comm-sentinel)
1251               (set-marker-insertion-type (process-mark proc) t)
1252               (setq result (wnnrpc-open proc myname user-name))
1253               (when (numberp result)
1254                 (delete-process proc)
1255                 (setq proc nil))))
1256           (cons proc result))
1257       (if proc
1258           (message (concat msg "done"))
1259         (if buf (kill-buffer buf))
1260         (egg-error 'wnn-connect-error)))))
1261
1262 (defvar wnn-envspec-list nil)
1263 (defvar wnn-current-envspec nil)
1264 (defvar wnn-current-envspec-reverse nil)
1265 (defvar wnn-server-type nil)
1266 (defvar wnn-wnn6-server nil)
1267
1268 (defmacro wnn-envspec-conv-param-name-list ()
1269   ''(last-is-first complex okuri-learn okuri
1270      prefix-learn prefix suffix-learn common-learn freq-func
1271      numeric alphabet symbol yuragi rendaku bunsetsugiri muhenkan
1272      fi-relation-learn fi-freq-func))
1273
1274 (defmacro wnn-envspec-conv-param-length ()
1275   (length (wnn-envspec-conv-param-name-list)))
1276
1277 (defun wnn-envspec-create (env-name tankan stickey)
1278   (vector (and env-name (setq env-name (intern env-name)))
1279           (wnn-make-backend egg-language env-name)
1280           tankan stickey nil nil
1281           0 (make-vector (wnn-envspec-conv-param-length) 0)
1282           (list nil) (list nil) (list nil)))
1283
1284 (defsubst wnn-envspec-env-type (spec)           (aref spec 0))
1285 (defsubst wnn-envspec-backend (spec)            (aref spec 1))
1286 (defsubst wnn-envspec-tankan (spec)             (aref spec 2))
1287 (defsubst wnn-envspec-sticky (spec)             (aref spec 3))
1288 (defsubst wnn-envspec-param (spec)              (aref spec 4))
1289 (defsubst wnn-envspec-fuzokugo (spec)           (aref spec 5))
1290 (defsubst wnn-envspec-conv-vmask (spec)         (aref spec 6))
1291 (defsubst wnn-envspec-conv-param (spec)         (aref spec 7))
1292 (defsubst wnn-envspec-dic-list (spec)           (cdr (aref spec 8)))
1293 (defsubst wnn-envspec-fi-dic-list (spec)        (cdr (aref spec 9)))
1294 (defsubst wnn-envspec-autolearn-dic-list (spec) (cdr (aref spec 10)))
1295
1296 (defsubst wnn-envspec-set-param (spec param)
1297   (aset spec 4 param))
1298 (defsubst wnn-envspec-set-fuzokugo (spec fzk)
1299   (aset spec 5 fzk))
1300 (defsubst wnn-envspec-set-conv-vmask (spec val)
1301   (aset spec 6 val))
1302 (defsubst wnn-envspec-set-conv-param (spec num val)
1303   (aset (aref spec 7) num val))
1304 (defsubst wnn-envspec-add-dic-list (spec &rest dic)
1305   (nconc (aref spec 8) (list (apply 'vector dic))))
1306 (defsubst wnn-envspec-add-fi-dic-list (spec &rest dic)
1307   (nconc (aref spec 9) (list (apply 'vector dic))))
1308 (defsubst wnn-envspec-add-autolearn-dic-list (spec type &rest dic)
1309   (nconc (aref spec 10) (list (cons type (apply 'vector dic)))))
1310
1311 (eval-when-compile
1312   (defun wnn-conv-param (param)
1313     (- (wnn-envspec-conv-param-length)
1314        (length (memq param (wnn-envspec-conv-param-name-list))))))
1315
1316 (defmacro define-wnn-conv-param-func ()
1317   (let ((name-list (wnn-envspec-conv-param-name-list))
1318         (defs (list 'progn))
1319         n set get)
1320     (while name-list
1321       (setq n (car name-list)
1322             name-list (cdr name-list)
1323             set (intern (format "wnn-envspec-set-conv-param-%s" n))
1324             get (intern (format "wnn-get-conv-param-%s" n)))
1325       (nconc defs `((defsubst ,set (spec val)
1326                       (wnn-envspec-set-conv-param spec ,(wnn-conv-param n) val)
1327                       (wnn-envspec-set-conv-vmask
1328                        spec (logior (wnn-envspec-conv-vmask spec)
1329                                     ,(lsh 1 (wnn-conv-param n)))))
1330                     (defsubst ,get (param)
1331                       (aref param ,(wnn-conv-param n))))))
1332     defs))
1333
1334 (define-wnn-conv-param-func)
1335
1336 (defmacro wnn-arg-type-error (func)
1337   `(egg-error ,(format "%s: Wrong type argument" func)))
1338
1339 (defun wnn-define-environment (reverse &optional env-name tankan stickey)
1340   "Define a Wnn environment for normal/reverse conversion according
1341 to REVERSE.  ENV-NAME specifies suffix of the Wnn environment name.
1342 Make single character conversion (Tan-Kanji conversion) environment,
1343 if tankan is non-NIL.  Make the environment as sticky, if STICKEY
1344 is non-NIL."
1345   (if (and env-name (null (stringp env-name)))
1346       (wnn-arg-type-error wnn-define-environment))
1347   (setq env-name (if reverse (concat env-name "R") env-name)
1348         wnn-current-envspec (wnn-envspec-create env-name tankan stickey)
1349         wnn-current-envspec-reverse reverse
1350         wnn-envspec-list (nconc wnn-envspec-list 
1351                                 (list wnn-current-envspec))))
1352
1353 (defun wnn-set-fuzokugo (filename)
1354   (cond ((equal filename "")
1355          (setq filename nil))
1356         ((null (stringp filename))
1357          (wnn-arg-type-error wnn-set-fuzokugo)))
1358   (wnn-envspec-set-fuzokugo wnn-current-envspec filename))
1359
1360 (defmacro wnn-add-dict-param-check (func
1361                                     dict &optional freq prior drw dmax frw fmax
1362                                     dpass fpass rev)
1363   `(progn
1364      (if (or (and (null (stringp ,dict)) (null (stringp (car-safe ,dict))))
1365              ,@(if freq
1366                    `((and ,freq (null (stringp ,freq))
1367                           (null (stringp (car-safe ,freq))))))
1368              ,@(if prior `((null (integerp ,prior))))
1369              ,@(if drw
1370                    `((null (or (eq ,drw nil) (eq ,drw t)
1371                                (eq ,drw 0) (eq ,drw 1)
1372                                ,@(if dmax
1373                                      `((and wnn-wnn6-server
1374                                             ,@(let ((x `((eq ,drw 2))))
1375                                                 (when (>= dmax 3)
1376                                                   (nconc x `((eq ,drw 3))))
1377                                                 (when (>= dmax 4)
1378                                                   (nconc x `((eq ,drw 4))))
1379                                                 x))))))))
1380              ,@(if frw
1381                    `((null (or (eq ,frw nil) (eq ,frw t)
1382                                (eq ,frw 0) (eq ,frw 1)
1383                                ,@(if fmax
1384                                      `((and wnn-wnn6-server
1385                                             ,@(let ((x `((eq ,frw 2))))
1386                                                 (when (>= fmax 3)
1387                                                   (nconc x `((eq ,frw 3))))
1388                                                 (when (>= fmax 4)
1389                                                   (nconc x `((eq ,frw 4))))
1390                                                 x))))))))
1391              ,@(if dpass `((and ,dpass (null (stringp ,dpass)))))
1392              ,@(if fpass `((and ,fpass (null (stringp ,fpass))))))
1393          (wnn-arg-type-error ,func))
1394      (if (or (equal ,dict "") (equal (car-safe ,dict) ""))
1395          (egg-error ,(format "%s: Dictionary name should not be null." func)))
1396      ,@(if freq
1397            `((if (or (equal ,freq "") (equal (car-safe ,freq) ""))
1398                  (setq ,freq nil))))
1399      ,@(if rev
1400            `((setq ,rev (if ,rev (car ,rev) wnn-current-envspec-reverse))))))
1401
1402 (defmacro wnn-wnn6-env-func (func)
1403   `(or wnn-wnn6-server
1404        (egg-error ,(format "%s is available only on Wnn6" func))))
1405
1406 (defun wnn-add-dict (dict freq priority dict-rw freq-rw
1407                      &optional dict-passwd freq-passwd &rest reverse)
1408   (wnn-add-dict-param-check wnn-add-dict
1409                             dict freq priority dict-rw 4 freq-rw 2
1410                             dict-passwd freq-passwd reverse)
1411   (wnn-envspec-add-dic-list wnn-current-envspec
1412                             dict freq priority dict-rw freq-rw
1413                             dict-passwd freq-passwd reverse))
1414
1415 (defun wnn-add-fisys-dict (dict freq freq-rw &optional freq-passwd)
1416   (wnn-wnn6-env-func wnn-add-fisys-dict)
1417   (wnn-add-dict-param-check wnn-add-fisys-dict
1418                             dict freq nil nil nil freq-rw 3
1419                             nil freq-passwd)
1420   (wnn-envspec-add-fi-dic-list wnn-current-envspec
1421                                dict freq t nil freq-rw nil freq-passwd nil))
1422
1423 (defun wnn-add-fiusr-dict (dict freq dict-rw freq-rw
1424                            &optional dict-passwd freq-passwd)
1425   (wnn-wnn6-env-func wnn-add-fiusr-dict)
1426   (wnn-add-dict-param-check wnn-add-fiusr-dict
1427                             dict freq nil dict-rw 3 freq-rw 3
1428                             dict-passwd freq-passwd)
1429   (wnn-envspec-add-fi-dic-list wnn-current-envspec
1430                                dict freq nil dict-rw freq-rw
1431                                dict-passwd freq-passwd nil))
1432
1433 (defun wnn-add-notrans-dict (dict priority dict-rw 
1434                              &optional dict-passwd &rest reverse)
1435   (wnn-wnn6-env-func wnn-add-notrans-dict)
1436   (wnn-add-dict-param-check wnn-add-notrans-dict
1437                             dict nil priority dict-rw nil nil nil
1438                             dict-passwd nil reverse)
1439   (wnn-envspec-add-autolearn-dic-list wnn-current-envspec
1440                                       (WNN-const NOTRANS_LEARN)
1441                                       dict nil priority dict-rw nil
1442                                       dict-passwd nil reverse))
1443
1444 (defun wnn-add-bmodify-dict (dict priority dict-rw
1445                              &optional dict-passwd &rest reverse)
1446   (wnn-wnn6-env-func wnn-add-notrans-dict)
1447   (wnn-add-dict-param-check wnn-add-bmodify-dict
1448                             dict nil priority dict-rw nil nil nil
1449                             dict-passwd nil reverse)
1450   (wnn-envspec-add-autolearn-dic-list wnn-current-envspec
1451                                       (WNN-const BMODIFY_LEARN)
1452                                       dict nil priority dict-rw nil
1453                                       dict-passwd nil reverse))
1454
1455 (defun wnn-set-param (&rest args)
1456   (if (/= (length args) 17)
1457       (egg-error "wnn-set-param: Wrong number of arguments"))
1458   (mapcar (lambda (n)
1459             (if (null (integerp n))
1460                 (wnn-arg-type-error wnn-set-param)))
1461           args)
1462   (wnn-envspec-set-param wnn-current-envspec (apply 'vector args)))
1463
1464 (defmacro wnn-boolean-param-check (func flag)
1465   `(setq ,flag (cond ((or (eq ,flag 0) (eq ,flag nil)) 0)
1466                      ((or (eq ,flag 1) (eq ,flag t))   1)
1467                      (t (wnn-arg-type-error ,func)))))
1468
1469 (defun wnn-set-last-is-first-mode (flag)
1470   (wnn-wnn6-env-func wnn-set-last-is-first-mode)
1471   (wnn-boolean-param-check wnn-set-last-is-first-mode flag)
1472   (wnn-envspec-set-conv-param-last-is-first wnn-current-envspec flag))
1473
1474 (defun wnn-set-complex-conv-mode (flag)
1475   (wnn-wnn6-env-func wnn-set-complex-conv-mode)
1476   (wnn-boolean-param-check wnn-set-complex-conv-mode flag)
1477   (wnn-envspec-set-conv-param-complex wnn-current-envspec flag))
1478
1479 (defun wnn-set-okuri-learn-mode (flag)
1480   (wnn-wnn6-env-func wnn-set-okuri-learn-mode)
1481   (wnn-boolean-param-check wnn-set-okuri-learn-mode flag)
1482   (wnn-envspec-set-conv-param-okuri-learn wnn-current-envspec flag))
1483
1484 (defun wnn-set-okuri-flag (mode)
1485   (wnn-wnn6-env-func wnn-set-okuri-flag)
1486   (setq mode (cond ((or (eq mode -1) (eq mode 'regulation)) -1)
1487                    ((or (eq mode  0) (eq mode 'no))          0)
1488                    ((or (eq mode  1) (eq mode 'yes))         1)
1489                    (t (wnn-arg-type-error wnn-set-okuri-flag))))
1490   (wnn-envspec-set-conv-param-okuri wnn-current-envspec mode))
1491
1492 (defun wnn-set-prefix-learn-mode (flag)
1493   (wnn-wnn6-env-func wnn-set-prefix-learn-mode)
1494   (wnn-boolean-param-check wnn-set-prefix-learn-mode flag)
1495   (wnn-envspec-set-conv-param-prefix-learn wnn-current-envspec flag))
1496
1497 (defun wnn-set-prefix-flag (mode)
1498   (wnn-wnn6-env-func wnn-set-prefix-flag)
1499   (setq mode (cond ((or (eq mode 0) (eq mode 'hiragana)) 0)
1500                    ((or (eq mode 1) (eq mode 'kanji))    1)
1501                    (t (wnn-arg-type-error wnn-set-prefix-flag))))
1502   (wnn-envspec-set-conv-param-prefix wnn-current-envspec mode))
1503
1504 (defun wnn-set-suffix-learn-mode (flag)
1505   (wnn-wnn6-env-func wnn-set-suffix-learn-mode)
1506   (wnn-boolean-param-check wnn-set-suffix-learn-mode flag)
1507   (wnn-envspec-set-conv-param-suffix-learn wnn-current-envspec flag))
1508
1509 (defun wnn-set-common-learn-mode (flag)
1510   (wnn-wnn6-env-func wnn-set-common-learn-mode)
1511   (wnn-boolean-param-check wnn-set-common-learn-mode flag)
1512   (wnn-envspec-set-conv-param-common-learn wnn-current-envspec flag))
1513
1514 (defun wnn-set-freq-func-mode (mode)
1515   (wnn-wnn6-env-func wnn-set-freq-func-mode)
1516   (setq mode (cond ((or (eq mode 0) (eq mode 'not))    0)
1517                    ((or (eq mode 1) (eq mode 'always)) 1)
1518                    ((or (eq mode 2) (eq mode 'high))   2)
1519                    ((or (eq mode 3) (eq mode 'normal)) 3)
1520                    ((or (eq mode 4) (eq mode 'low))    4)
1521                    (t (wnn-arg-type-error wnn-set-freq-func-mode))))
1522   (wnn-envspec-set-conv-param-freq-func wnn-current-envspec mode))
1523
1524 (defun wnn-set-numeric-mode (mode)
1525   (wnn-wnn6-env-func wnn-set-numeric-mode)
1526   (setq mode (cond ((or (eq mode  -2) (eq mode 'han))       -2)
1527                    ((or (eq mode -12) (eq mode 'zen))      -12)
1528                    ((or (eq mode -13) (eq mode 'kan))      -13)
1529                    ((or (eq mode -15) (eq mode 'kansuuji)) -15)
1530                    ((or (eq mode -16) (eq mode 'kanold))   -16)
1531                    ((or (eq mode -17) (eq mode 'hancan))   -17)
1532                    ((or (eq mode -18) (eq mode 'zencan))   -18)
1533                    (t (wnn-arg-type-error wnn-set-numeric-mode))))
1534   (wnn-envspec-set-conv-param-numeric wnn-current-envspec mode))
1535
1536 (defun wnn-set-alphabet-mode (mode)
1537   (wnn-wnn6-env-func wnn-set-alphabet-mode)
1538   (setq mode (cond ((or (eq mode  -4) (eq mode 'han))  -4)
1539                    ((or (eq mode -30) (eq mode 'zen)) -30)
1540                    (t (wnn-arg-type-error wnn-set-alphabet-mode))))
1541   (wnn-envspec-set-conv-param-alphabet wnn-current-envspec mode))
1542
1543 (defun wnn-set-symbol-mode (mode)
1544   (wnn-wnn6-env-func wnn-set-symbol-mode)
1545   (setq mode (cond ((or (eq mode  -5) (eq mode 'han))  -5)
1546                    ((or (eq mode -40) (eq mode 'jis)) -40)
1547                    ((or (eq mode -41) (eq mode 'asc)) -41)
1548                    (t (wnn-arg-type-error wnn-set-symbol-mode))))
1549   (wnn-envspec-set-conv-param-symbol wnn-current-envspec mode))
1550
1551 (defun wnn-set-yuragi-mode (flag)
1552   (wnn-wnn6-env-func wnn-set-yuragi-mode)
1553   (wnn-boolean-param-check wnn-set-yuragi-mode flag)
1554   (wnn-envspec-set-conv-param-yuragi wnn-current-envspec flag))
1555
1556 (defun wnn-set-rendaku-mode (flag)
1557   (wnn-wnn6-env-func wnn-set-rendaku-mode)
1558   (wnn-boolean-param-check wnn-set-rendaku-mode flag)
1559   (wnn-envspec-set-conv-param-rendaku wnn-current-envspec flag))
1560 \f
1561 (defun wnn-renbunsetsu-conversion (env yomi hinshi fuzokugo v context)
1562   (let ((result
1563          (cond
1564           ((wnnenv-get-tankan env)
1565            (wnnrpc-tanbunsetsu-conversion env yomi hinshi fuzokugo v))
1566           ((wnnenv-is-wnn6 env)
1567            (wnnrpc-fi-renbunsetsu-conversion env yomi hinshi fuzokugo v
1568                                              context))
1569           (t
1570            (wnnrpc-renbunsetsu-conversion env yomi hinshi fuzokugo v)))))
1571     (prog1
1572         result
1573       (if wnn-one-level-conversion
1574           (while (consp result)
1575             (wnn-bunsetsu-set-dai-continue (car result) nil)
1576             (setq result (cdr result)))))))
1577
1578 (defun wnn-tanbunsetsu-conversion (env yomi hinshi fuzokugo v major)
1579   (if (or (null major)
1580           wnn-one-level-conversion
1581           (wnnenv-get-tankan env))
1582       (wnnrpc-tanbunsetsu-conversion env yomi hinshi fuzokugo v)
1583     (wnnrpc-daibunsetsu-conversion env yomi hinshi fuzokugo v)))
1584
1585 (defun wnn-get-bunsetsu-candidates (env yomi hinshi fuzokugo v major)
1586   (cond
1587    ((or wnn-one-level-conversion
1588         (wnnenv-get-tankan env))
1589     (let ((result (wnnrpc-get-bunsetsu-candidates env yomi hinshi fuzokugo v)))
1590       (prog1
1591           result
1592         (while (consp result)
1593           (wnn-bunsetsu-set-dai-continue (caar result) nil)
1594           (setq result (cdr result))))))
1595    ((null major)
1596     (wnnrpc-get-bunsetsu-candidates env yomi hinshi fuzokugo v))
1597    (t
1598     (wnnrpc-get-daibunsetsu-candidates env yomi hinshi fuzokugo v))))
1599
1600 (defsubst wnn-filename (p)
1601   (substitute-in-file-name
1602    (if (consp p) (concat wnn-usr-dic-dir "/" (car p)) p)))
1603
1604 (defsubst wnn-client-file-p (filename)
1605   (and (stringp filename)
1606        (= (aref filename 0) ?!)))
1607
1608 (defsubst wnn-client-filename (filename)
1609   (substitute-in-file-name (expand-file-name (substring filename 1) "~")))
1610
1611 (defun wnn-open-file (env filename)
1612   "Open the file FILENAME on the environment ENV.
1613 Return file ID.  NIL means NO-file.
1614 On failure, return negative error code."
1615   (and filename
1616        (if (wnn-client-file-p filename)
1617            (wnnrpc-file-send env (wnn-client-filename filename))
1618          (wnnrpc-file-read env (wnn-filename filename)))))
1619
1620 (defun wnn-create-directory (env path noquery)
1621   "Create directory to the path.  Retun non-NIL value on success."
1622   (if (wnn-client-file-p path)
1623       (let ((local-name (directory-file-name (file-name-directory
1624                                               (wnn-client-filename path)))))
1625         (cond
1626          ((file-directory-p local-name) t)
1627          ((or noquery
1628               (y-or-n-p (format (egg-get-message 'wnn-dir-missing)
1629                                 (file-name-directory path))))
1630           (make-directory local-name t)
1631           (if (file-directory-p local-name)
1632               (progn
1633                 (message (egg-get-message 'wnn-dir-created) path)
1634                 t)
1635             (message (egg-get-message 'wnn-dir-failed) path)
1636             nil))))
1637     (let ((name (directory-file-name (file-name-directory
1638                                       (wnn-filename path))))
1639           create-list)
1640       (setq path name)
1641       (while (and name (/= (wnnrpc-access env name 0) 0))
1642         (setq create-list (cons name create-list)
1643               name (file-name-directory name)
1644               name (and name (directory-file-name name))))
1645       (or (null create-list)
1646           (if (or noquery
1647                   (y-or-n-p (format (egg-get-message 'wnn-dir-missing) path)))
1648               (let ((result 0))
1649                 (while (and (>= result 0) create-list)
1650                   (setq result (wnnrpc-mkdir env (car create-list))
1651                         create-list (cdr create-list)))
1652                 (if (>= result 0)
1653                     (progn
1654                       (message (egg-get-message 'wnn-dir-created) path)
1655                       t)
1656                   (message (egg-get-message 'wnn-dir-failed) path)
1657                   nil)))))))
1658
1659 (defun wnn-file-remove (proc filename passwd)
1660   (let ((result (if (wnn-client-file-p filename)
1661                     (wnnrpc-file-remove-client
1662                      proc (wnn-client-filename filename) passwd)
1663                   (wnnrpc-file-remove proc (wnn-filename filename) passwd))))
1664     (or (= result 0)
1665         (progn
1666           (message (wnnrpc-get-error-message (- result)))
1667           nil))))
1668
1669 (defun wnn-open-dictionary (env fi name rw comment dpasswd fpasswd
1670                                 &optional noquery)
1671   (let ((dic-id (wnn-open-file env name)))
1672     (cond
1673      ((null dic-id)
1674       (message "Wnn: cannot omit dictionary name")
1675       nil)
1676      ((>= dic-id 0) dic-id)
1677      ((or (null rw) (/= dic-id (- (WNN-const NO_EXIST))))
1678       (message (egg-get-message 'wnn-dict-missing-1)
1679                name (wnnrpc-get-error-message (- dic-id)))
1680       nil)
1681      ((and (or noquery
1682                (y-or-n-p (format (egg-get-message 'wnn-dict-missing-2) name)))
1683            (wnn-create-directory env name noquery)
1684            (wnn-create-dictionary env name (wnnrpc-writable-dic-type env fi rw)
1685                                   comment dpasswd fpasswd))
1686       (message (egg-get-message 'wnn-dict-created) name)
1687       (setq dic-id (wnn-open-file env name))
1688       (if (>= dic-id 0)
1689           dic-id
1690         (message "%s" (wnnrpc-get-error-message (- dic-id)))
1691         nil)))))
1692
1693 (defun wnn-create-dictionary (env name type comment dpasswd fpasswd)
1694   "Create a dictionary file on the server or the client depending on name."
1695   (let ((result (if (wnn-client-file-p name)
1696                     (wnnrpc-dic-file-create-client
1697                      env (wnn-client-filename name) type
1698                      comment dpasswd fpasswd)
1699                   (wnnrpc-dic-file-create
1700                    env (wnn-filename name) type comment dpasswd fpasswd))))
1701     (or (= result 0)
1702         (progn
1703           (message (wnnrpc-get-error-message (- result)))
1704           nil))))
1705
1706 (defun wnn-open-frequency (env fi dic-id name rw comment passwd)
1707   (let ((freq-id (wnn-open-file env name)))
1708     (cond
1709      ((null freq-id) -1)
1710      ((>= freq-id 0) freq-id)
1711      ((or (null rw) (/= freq-id (- (WNN-const NO_EXIST))))
1712       (message (egg-get-message 'wnn-freq-missing-1)
1713                name (wnnrpc-get-error-message (- freq-id)))
1714       nil)
1715      ((and (y-or-n-p
1716             (format (egg-get-message 'wnn-freq-missing-2) name))
1717            (wnn-create-directory env name nil)
1718            (wnn-create-frequency env fi dic-id name comment passwd))
1719       (message (egg-get-message 'wnn-freq-created) name)
1720       (setq freq-id (wnn-open-file env name))
1721       (if (>= freq-id 0)
1722           freq-id
1723         (message "%s" (wnnrpc-get-error-message (- dic-id)))
1724         nil)))))
1725
1726 (defun wnn-create-frequency (env fi dic-id name comment passwd)
1727   "Create a frequency file on the server or the client depending on name."
1728   (let ((result (if (wnn-client-file-p name)
1729                     (wnnrpc-hindo-file-create-client
1730                      env fi dic-id (wnn-client-filename name) comment passwd)
1731                   (wnnrpc-hindo-file-create
1732                    env fi dic-id (wnn-filename name) comment passwd))))
1733     (or (= result 0)
1734         (progn
1735           (message (wnnrpc-get-error-message (- result)))
1736           nil))))
1737
1738 (defun wnn-set-dictionary (env fi dic-spec)
1739   ""
1740   (let ((dname (aref dic-spec 0))
1741         (fname (aref dic-spec 1))
1742         (prior (aref dic-spec 2))
1743         (drw   (aref dic-spec 3))
1744         (frw   (aref dic-spec 4))
1745         (dpass (aref dic-spec 5))
1746         (fpass (aref dic-spec 6))
1747         (rev   (aref dic-spec 7))
1748         did fid result)
1749     (cond
1750      ((numberp (setq dpass (wnnrpc-read-passwd-file dpass)))
1751       (message "%s" (wnnrpc-get-error-message (- dpass)))
1752       nil)
1753      ((numberp (setq fpass (if fname (wnnrpc-read-passwd-file fpass) "")))
1754       (message "%s" (wnnrpc-get-error-message (- fpass)))
1755       nil)
1756      ((and (setq did (wnn-open-dictionary env fi dname drw "" dpass fpass))
1757            (setq fid (wnn-open-frequency env fi did fname frw "" fpass)))
1758       (if fi
1759           (setq result (wnnrpc-set-fi-dictionary env did fid prior drw frw
1760                                                  dpass fpass))
1761         (setq drw (cond ((eq drw (WNN-const DIC_GROUP)) (WNN-const DIC_RW))
1762                         ((eq drw (WNN-const DIC_MERGE)) (WNN-const DIC_RDONLY))
1763                         (t drw))
1764               result (wnnrpc-set-dictionary env did fid prior drw frw
1765                                             dpass fpass rev)))
1766       (cond
1767        ((>= result 0) t)
1768        ((or (null frw) (/= result (- (WNN-const NO_MATCH))))
1769         (message "%s (%s): %s"
1770                  dname (if fname fname "")
1771                  (wnnrpc-get-error-message (- result)))
1772         nil)
1773        ((and (y-or-n-p (format (egg-get-message 'wnn-no-match) fname))
1774              (>= (wnnrpc-file-discard env fid) 0)
1775              (wnn-file-remove proc fname fpass)
1776              (wnn-create-frequency env fi did fname "" fpass))
1777         (message (egg-get-message 'wnn-re-create-freq) fname)
1778         (and (>= (setq fid (wnn-open-file env fname)) 0)
1779              (>= (wnnrpc-set-dictionary env 
1780                                         did fid prior drw frw
1781                                         dpass fpass rev)
1782                  0))))))))
1783
1784 (defun wnn-temporary-dic-add (env rev)
1785   (let ((result (wnnrpc-temporary-dic-loaded env)))
1786     (if (= result 0)
1787         (wnnrpc-temporary-dic-add env rev)
1788       result)))
1789
1790 (defun wnn-set-autolearn-dictionary (env type dic-spec)
1791   (let ((dname (aref dic-spec 0))
1792         (prior (aref dic-spec 2))
1793         (drw   (aref dic-spec 3))
1794         (dpass (aref dic-spec 5))
1795         (rev   (aref dic-spec 7))
1796         (did (wnnrpc-get-autolearning-dic env type))
1797         result)
1798     (or (numberp drw)
1799         (setq drw (if drw 0 1)))
1800     (cond
1801      ((< did 0)
1802       (message "%s" (wnnrpc-get-error-message (- did)))
1803       nil)
1804      ((> did 0)
1805       (setq result (wnn-temporary-dic-add env rev))
1806       (if (>= result 0)
1807           drw
1808         (message "%s" (wnnrpc-get-error-message (- result)))
1809         nil))
1810      ((numberp (setq dpass (wnnrpc-read-passwd-file dpass)))
1811       (message "%s" (wnnrpc-get-error-message (- dpass)))
1812       nil)
1813      ((setq did (wnn-open-dictionary env nil dname t "" dpass "" t))
1814       (if (and (>= (setq did (wnnrpc-set-dictionary env did -1 prior drw drw
1815                                                     dpass "" rev))
1816                    0)
1817                (>= (setq did (wnnrpc-set-autolearning-dic env type did)) 0)
1818                (>= (setq did (wnn-temporary-dic-add env rev)) 0))
1819           drw
1820         (message "%s" (wnnrpc-get-error-message (- did)))
1821         nil)))))
1822
1823 (defun wnn-search-environment (backend)
1824   (let ((env-list wnn-environments)
1825         env)
1826     (while (and (null env) env-list)
1827       (setq env (and (eq (wnnenv-get-backend (car env-list)) backend)
1828                      (car env-list))
1829             env-list (cdr env-list)))
1830     env))
1831
1832 (defun wnn-v3-eggrc-defines ()
1833   (if (null (fboundp 'set-wnn-reverse))
1834       (progn
1835         (fset 'set-wnn-reverse
1836               (lambda (arg)
1837                 (wnn-define-environment arg
1838                                         (and (or (eq wnn-server-type 'cserver)
1839                                                  (eq wnn-server-type 'tserver))
1840                                              "PZ"))))
1841         (fset 'is-wnn6-server (lambda () wnn-wnn6-server))
1842         (fset 'set-wnn-fuzokugo 'wnn-set-fuzokugo)
1843         (fset 'add-wnn-dict 'wnn-add-dict)
1844         (fset 'set-wnn-param 'wnn-set-param)
1845         (fset 'add-wnn-fisys-dict 'wnn-add-fisys-dict)
1846         (fset 'add-wnn-fiusr-dict 'wnn-add-fiusr-dict)
1847         (fset 'add-wnn-notrans-dict 'wnn-add-notrans-dict)
1848         (fset 'add-wnn-bmodify-dict 'wnn-add-bmodify-dict)
1849         (fset 'set-last-is-first-mode 'wnn-set-last-is-first-mode)
1850         (fset 'set-complex-conv-mode 'wnn-set-complex-conv-mode)
1851         (fset 'set-okuri-flag 'wnn-set-okuri-flag)
1852         (fset 'set-prefix-learn-mode 'wnn-set-prefix-learn-mode)
1853         (fset 'set-suffix-learn-mode 'wnn-set-suffix-learn-mode)
1854         (fset 'set-common-learn-mode 'wnn-set-common-learn-mode)
1855         (fset 'set-yuragi-mode 'wnn-set-yuragi-mode)
1856         (fset 'set-freq-func-mode 'wnn-set-freq-func-mode)
1857         (fset 'set-numeric-mode 'wnn-set-numeric-mode)
1858         (fset 'set-alphabet-mode 'wnn-set-alphabet-mode)
1859         (fset 'set-symbol-mode 'wnn-set-symbol-mode)
1860         (setq wnn-v3-defined t))))
1861
1862 (defun wnn-get-environment (backend)
1863   "Return Wnn Environemt for BACKEND.  If none, create new
1864 environment."
1865   (let ((env (wnn-search-environment backend))
1866         proc error)
1867     (or env
1868         (unwind-protect
1869             (let* ((language (wnn-backend-get-language backend))
1870                    (server-info (wnn-server-get-info language))
1871                    (server-type (wnn-server-type server-info))
1872                    version specs)
1873               (setq proc (wnn-open server-info)
1874                     version (cdr proc)
1875                     proc (car proc)
1876                     wnn-envspec-list nil)
1877               (condition-case err
1878                   (let ((wnn-server-type server-type)
1879                         (wnn-wnn6-server (eq version 'wnn6)))
1880                     (if wnn-use-v3-eggrc
1881                         (wnn-v3-eggrc-defines))
1882                     (egg-load-startup-file 'wnn language))
1883                 (egg-error
1884                  (setq error err)
1885                  (signal (car error) (cdr error))))
1886               (setq specs wnn-envspec-list)
1887               (while specs
1888                 (wnn-create-environment proc server-type version (car specs))
1889                 (setq specs (cdr specs)))
1890               (setq env (wnn-search-environment backend)))
1891           (if (and proc (null env))
1892               (progn
1893                 (wnnrpc-close proc)
1894                 (if error
1895                     (signal (car error) (cdr error))
1896                   (egg-error 'wnn-fail-make-env))))))))
1897
1898 ;; Create a new environment in the conversion server, if necessary.
1899 (defun wnn-create-environment (proc server-type version spec)
1900   (let* ((save-inhibit-quit inhibit-quit)
1901          (inhibit-quit t)
1902          (name (wnn-make-env-name spec))
1903          (backend (wnn-envspec-backend spec))
1904          (tankan (wnn-envspec-tankan spec))
1905          (sticky (wnn-envspec-sticky spec))
1906          (parameter (wnn-envspec-param spec))
1907          (fzk (wnn-envspec-fuzokugo spec))
1908          (dic-list (wnn-envspec-dic-list spec))
1909          (fi-dic-list (wnn-envspec-fi-dic-list spec))
1910          (autolearn-dic-list (wnn-envspec-autolearn-dic-list spec))
1911          exist env-id env fid cvmask param mode type dic-spec)
1912     (condition-case err
1913         (progn
1914           (setq exist (wnnrpc-env-exist proc name)
1915                 env-id (wnnrpc-connect proc name))
1916           (if (< env-id 0)
1917               (egg-error "%s" (wnnrpc-get-error-message (- env-id))))
1918           (setq env (wnnenv-create proc env-id server-type version
1919                                    backend tankan name))
1920           (cond
1921            ((or wnn-force-set-environment (= exist 0))
1922             (let ((inhibit-quit save-inhibit-quit))
1923               (and fzk
1924                    (or (< (setq fid (wnn-open-file env fzk)) 0)
1925                        (< (setq fid (wnnrpc-set-fuzokugo-file env fid)) 0))
1926                    (message "%s" (wnnrpc-get-error-message (- fid))))
1927               (while fi-dic-list
1928                 (wnn-set-dictionary env t (car fi-dic-list))
1929                 (setq fi-dic-list (cdr fi-dic-list)))
1930               (while dic-list
1931                 (wnn-set-dictionary env nil (car dic-list))
1932                 (setq dic-list (cdr dic-list)))
1933               (while autolearn-dic-list
1934                 (setq type (caar autolearn-dic-list)
1935                       dic-spec (cdar autolearn-dic-list)
1936                       autolearn-dic-list (cdr autolearn-dic-list)
1937                       mode (wnn-set-autolearn-dictionary env type dic-spec))
1938                 (if mode
1939                     (if (eq type (WNN-const NOTRANS_LEARN))
1940                         (progn
1941                           (wnnenv-set-notrans env mode)
1942                           (wnn-envspec-set-conv-param-muhenkan spec mode))
1943                       (wnnenv-set-bmodify env mode)
1944                       (wnn-envspec-set-conv-param-bunsetsugiri spec mode))))
1945               (if parameter
1946                   (wnnrpc-set-conversion-parameter env parameter))
1947               (setq cvmask (wnn-envspec-conv-vmask spec)
1948                     param (wnn-envspec-conv-param spec))
1949               (if (/= cvmask 0)
1950                   (wnnrpc-set-conversion-env-param env cvmask param))))
1951            ((eq version 'wnn6)
1952             (wnnenv-set-bmodify env (wnn-get-autolearning-dic-mode
1953                                      env (WNN-const BMODIFY_LEARN)))
1954             (wnnenv-set-notrans env (wnn-get-autolearning-dic-mode
1955                                      env (WNN-const NOTRANS_LEARN)))))
1956           (cond
1957            ((eq (wnnenv-get-server-type env) 'jserver)
1958             (wnn-set-hinshi env 'noun "\e$BL>;l\e(B")
1959             (when (wnnenv-is-wnn6 env)
1960               (wnn-set-hinshi env 'settou "\e$B@\F,8l\e(B(\e$B$*\e(B)")
1961               (wnn-set-hinshi env 'rendaku "\e$BO"By\e(B")))
1962            ((eq (wnnenv-get-server-type env) 'cserver)
1963             (wnn-set-hinshi env 'noun "\e$AFUM(C{\e(B"))
1964            ((eq (wnnenv-get-server-type env) 'tserver)
1965             (wnn-set-hinshi env 'noun "\e$(G_[]WGX\e(B"))
1966            ((eq (wnnenv-get-server-type env) 'kserver)
1967             (wnn-set-hinshi env 'noun "\e$(CY#^r\e(B")))
1968           (if sticky
1969               (wnnrpc-make-env-sticky env)
1970             (wnnrpc-make-env-unsticky env))
1971           (setq wnn-environments (nconc wnn-environments (list env))))
1972       ((egg-error quit)
1973        (if (eq (car err) 'egg-error)
1974            (message "%s" (nth 1 err)))
1975        (if env
1976            (progn
1977              (wnnrpc-disconnect env)
1978              (setq wnn-environments (delq env wnn-environments))))
1979        (if (eq (car err) 'quit)
1980            (signal 'quit (cdr err)))))))
1981
1982 (defun wnn-make-env-name (spec)
1983   (let ((env-type (wnn-envspec-env-type spec)))
1984     (concat wnn-user-name (if env-type (symbol-name env-type) ""))))
1985
1986 (defun wnn-set-hinshi (env sym name)
1987   (let ((hinshi (wnnrpc-hinshi-number (wnnenv-get-proc env) name)))
1988     (if (>= hinshi 0)
1989         (wnnenv-set-hinshi env sym hinshi))))
1990
1991 (defsubst wnn-dicinfo-entry (info)       (aref info 0))
1992 (defsubst wnn-dicinfo-id (info freq)     (aref info (+ 1 freq)))
1993 (defsubst wnn-dicinfo-mode (info freq)   (aref info (+ 3 freq)))
1994 (defsubst wnn-dicinfo-enable (info)      (aref info 5))
1995 (defsubst wnn-dicinfo-nice (info)        (aref info 6))
1996 (defsubst wnn-dicinfo-reverse (info)     (aref info 7))
1997 (defsubst wnn-dicinfo-comment (info)     (aref info 8))
1998 (defsubst wnn-dicinfo-name (info freq)   (aref info (+ 9 freq)))
1999 (defsubst wnn-dicinfo-passwd (info freq) (aref info (+ 11 freq)))
2000 (defsubst wnn-dicinfo-type (info)        (aref info 13))
2001 (defsubst wnn-dicinfo-words (info)       (aref info 14))
2002 (defsubst wnn-dicinfo-local (info freq)  (aref info (+ 15 freq)))
2003
2004 (defun wnn-get-autolearning-dic-mode (env type)
2005   (let* ((dic (wnnrpc-get-autolearning-dic env type))
2006          (info (and (> dic 0) (wnnrpc-get-dictionary-info env (1- dic)))))
2007     (if (vectorp (car-safe info))
2008         (wnn-dicinfo-mode (car info) 0)
2009       (WNN-const DIC_RDONLY))))
2010
2011 (defun wnn-get-dictionary-list-with-environment (env)
2012   (if (wnnenv-is-wnn6 env)
2013       (wnnrpc-get-fi-dictionary-list-with-environment env
2014                                                       (WNN-const DIC_NO_TEMPS))
2015     (wnnrpc-get-dictionary-list-with-environment env)))
2016
2017 (defun wnn-save-dictionaries (env)
2018   (let ((dic-list (wnn-get-dictionary-list-with-environment env))
2019         (result 0) info freq fid name local-name)
2020     (while dic-list
2021       (setq info (car dic-list)
2022             dic-list (cdr dic-list)
2023             freq 0)
2024       (while (<= freq 1)
2025         (setq fid (wnn-dicinfo-id info freq)
2026               name (wnn-dicinfo-name info freq))
2027         (if (and (> fid 0) (= (wnn-dicinfo-mode info freq) 0))
2028             (cond
2029              ((= (wnn-dicinfo-local info freq) 1)
2030               (wnnrpc-write-file env fid name))
2031              ((setq local-name (wnnenv-get-client-file env name))
2032               (wnnrpc-file-receive env fid local-name))
2033              ((and (setq local-name (wnn-file-loaded-client env name fid))
2034                    (file-writable-p local-name))
2035               (wnnrpc-file-receive env fid local-name))))
2036         (setq freq (1+ freq))))))
2037
2038 (defun wnn-file-loaded-client (env name fid)
2039   (let ((len (length wnn-system-name))
2040         local-name)
2041     (and (> (length name) len)
2042          (equal (substring name 0 len) wnn-system-name)
2043          (prog1
2044              (wnn-client-file-p (substring name len))
2045            (setq local-name (wnn-client-filename (substring name len))))
2046          (= (wnnrpc-file-loaded-local (wnnenv-get-proc env) local-name t) fid)
2047          local-name)))
2048
2049 (defun wnn-word-inspection (bunsetsu)
2050   (let ((env (wnn-bunsetsu-get-env bunsetsu))
2051         (converted (wnn-get-bunsetsu-converted bunsetsu))
2052         (yomi (wnn-bunsetsu-get-yomi bunsetsu))
2053         (fuzokugo (wnn-bunsetsu-get-fuzokugo bunsetsu))
2054         (hinshi-no (wnn-bunsetsu-get-hinshi bunsetsu))
2055         (dic-no (wnn-bunsetsu-get-dic-no bunsetsu))
2056         (entry (wnn-bunsetsu-get-entry bunsetsu))
2057         (now (wnn-bunsetsu-get-right-now bunsetsu))
2058         (freq (wnn-bunsetsu-get-freq bunsetsu))
2059         (evaluation (wnn-bunsetsu-get-evaluation bunsetsu))
2060         (evaluation-dai (or (wnn-bunsetsu-get-dai-evaluation bunsetsu) "---"))
2061         (kangovect (wnn-bunsetsu-get-kangovect bunsetsu))
2062         hinsi dic)
2063     (setq hinshi (wnnrpc-hinshi-name (wnnenv-get-proc env) hinshi-no))
2064     (setq dic (if (>= dic-no 0)
2065                   (wnn-dict-name (car (wnnrpc-get-dictionary-info env dic-no)))
2066                 (egg-get-message 'wnn-pseud-bunsetsu)))
2067     (message "%s %s+%s(%s %s:%s Freq:%s%s) S:%s D:%s V:%s "
2068              converted yomi fuzokugo hinshi dic entry
2069              (if (= now 1) "*" " ") freq evaluation evaluation-dai kangovect)))
2070 \f
2071 ;;; not implemented yet (NIY)
2072 (defun wnn-delete-dictionary ()
2073   (dj-delete-dic XXX))
2074
2075 ;;; NIY, might never be implemented
2076 (defun wnn-server-inspect ())
2077
2078 ;;; NIY
2079 (defun wnn-get-conversion-parameter ()
2080   (js-get-parameter))
2081
2082 ;;; Dictionary management (word registration) is not implemented yet.
2083
2084 (defun wnn-find-dictionary-by-id (id dic-list)
2085   (catch 'return
2086     (while dic-list
2087       (let ((dic (car dic-list)))
2088         (if (= (wnndic-get-id dic) id)
2089             (throw 'return dic)
2090           (setq dic-list (cdr dic-list)))))))
2091
2092 (defun wnn-dict-name (dic-info)
2093   (let ((comment (wnndic-get-comment dic-info))
2094         (name (wnndic-get-dictname dic-info)))
2095     (cond ((null (string= comment "")) comment)
2096           ((wnn-client-file-p name) name)
2097           (t (file-name-nondirectory name)))))
2098
2099 (defun wnn-list-writable-dictionaries-byname (env)
2100   (let ((dic-list (wnn-get-dictionary-list-with-environment env))
2101         (w-id-list (wnnrpc-get-writable-dictionary-id-list env)))
2102     (cond ((numberp w-id-list)
2103            (egg-error "%s" (wnnrpc-get-error-message (- w-id-list))))
2104           ((null w-id-list)
2105            (egg-error 'wnn-no-writable-d))
2106           (t
2107            (delq nil
2108                  (mapcar (lambda (id)
2109                            (let ((dic (wnn-find-dictionary-by-id id dic-list)))
2110                              (and dic (cons (wnn-dict-name dic) dic))))
2111                          w-id-list))))))
2112
2113 (defun wnn-word-registration (backend kanji yomi)
2114   (let (env dic dic-id hinshi result)
2115     (if (or (null (eq (egg-get-language 0 kanji)
2116                       (wnn-backend-get-converted-language backend)))
2117             (next-single-property-change 0 'egg-lang kanji)
2118             (null (eq (egg-get-language 0 yomi)
2119                       (wnn-backend-get-source-language backend)))
2120             (next-single-property-change 0 'egg-lang yomi))
2121         (egg-error "word registration: invalid character")
2122       (setq env (wnn-get-environment backend)
2123             dic (wnn-dictionary-select env)
2124             dic-id (wnndic-get-id dic)
2125             hinshi (wnn-hinshi-select env dic-id)
2126             result (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi))
2127       (or (< result 0)
2128           (setq result (wnnrpc-add-word env dic-id yomi kanji "" result 0)))
2129       (if (>= result 0)
2130           (list hinshi (wnn-dict-name dic))
2131         (egg-error (wnnrpc-get-error-message (- result)))))))
2132
2133 (defun wnn-dictionary-select (env)
2134   (menudiag-select (list 'menu
2135                          (egg-get-message 'wnn-register-1)
2136                          (wnn-list-writable-dictionaries-byname env))))
2137
2138 (defun wnn-hinshi-select (env dic-id)
2139   (menudiag-select (wnn-make-hinshi-menu
2140                     env dic-id "/"
2141                     (egg-get-message 'wnn-register-2))))
2142
2143 (defun wnn-make-hinshi-menu (env dic-id hinshi prompt)
2144   (let ((hinshi-list (wnnrpc-get-hinshi-list env dic-id hinshi)))
2145     (if (numberp hinshi-list)
2146         (egg-error "%s" (wnnrpc-get-error-message (- hinshi-list)))
2147       (list 'menu
2148             (format (if (equal hinshi "/") "%s:" "%s[%s]:")
2149                     prompt
2150                     (substring hinshi 0 (1- (length hinshi))))
2151             (mapcar (lambda (h)
2152                       (if (= (aref h (1- (length h))) ?/)
2153                           (cons h (wnn-make-hinshi-menu env dic-id h prompt))
2154                         h))
2155                     hinshi-list)))))
2156
2157 ;;; setup
2158
2159 (load "egg/wnnrpc")
2160 (run-hooks 'wnn-load-hook)
2161
2162 ;;;###autoload
2163 (defun egg-activate-wnn (&rest arg)
2164   "Activate Wnn backend of Tamago 4."
2165   (apply 'egg-mode (append arg wnn-backend-alist)))
2166
2167 ;;; egg/wnn.el ends here.