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 ,(if (featurep 'xemacs)
 588                             'sisheng
 589                           'chinese-sisheng)
 590                  chinese-cns11643-1 chinese-cns11643-2)))
 591
 592 (defsubst wnn-backend-get-language (backend)
 593   (get backend 'language))
 594
 595 (defsubst wnn-backend-get-source-language (backend)
 596   (get backend 'source-language))
 597
 598 (defsubst wnn-backend-get-converted-language (backend)
 599   (get backend 'converted-language))
 600
 601 (defvar wnn-prev-context nil)
 602
 603 (defun wnn-start-conversion (backend yomi &optional context)
 604   "Convert YOMI string to kanji, and enter conversion mode.
 605 Return the list of bunsetsu."
 606   (let ((accepts (cdr (assq (wnn-backend-get-source-language backend)
 607                             wnn-accept-charset-alist)))
 608         env hinshi fuzokugo result)
 609     (if accepts
 610         (let ((charsets (mapcar 'char-charset (string-to-list yomi))))
 611           (while accepts
 612              (setq charsets (delq (car accepts) charsets)
 613                    accepts (cdr accepts)))
 614           (if charsets
 615               (egg-error "cannot handle %s" (car charsets)))))
 616     (setq env (wnn-get-environment backend))
 617     (cond ((eq (car (car-safe  context)) backend)
 618            (setq wnn-prev-context (car context)
 619                  context (cdr wnn-prev-context)
 620                  hinshi (wnn-context-hinshi (nth 1 context))
 621                  fuzokugo (wnn-context-fuzokugo (nth 1 context))))
 622           ((listp context)
 623            (setq wnn-prev-context (cons nil (wnn-null-context))
 624                  context (cdr wnn-prev-context)
 625                  hinshi (WNN-const BUN_SENTOU)
 626                  fuzokugo ""))
 627           ((eq (car wnn-prev-context) backend)
 628            (setq context (cdr wnn-prev-context)
 629                  hinshi (wnnenv-get-hinshi env 'noun)
 630                  fuzokugo ""))
 631           (t
 632            (setq context (wnn-null-context)
 633                  hinshi (wnnenv-get-hinshi env 'noun)
 634                  fuzokugo "")))
 635     (setq result (wnn-renbunsetsu-conversion env yomi hinshi fuzokugo nil
 636                                              context))
 637     (if (numberp result)
 638         (egg-error "%s" (wnnrpc-get-error-message (- result))))
 639     result))
 640
 641 (defun wnn-get-source-language (bunsetsu)
 642   (wnn-backend-get-source-language (egg-bunsetsu-get-backend bunsetsu)))
 643
 644 (defun wnn-get-converted-language (bunsetsu)
 645   (wnn-backend-get-converted-language (egg-bunsetsu-get-backend bunsetsu)))
 646
 647 (defun wnn-get-bunsetsu-converted (bunsetsu)
 648   (concat (wnn-bunsetsu-get-converted bunsetsu)
 649           (wnn-bunsetsu-get-fuzokugo  bunsetsu)))
 650
 651 (defun wnn-get-bunsetsu-source (bunsetsu)
 652   (concat (wnn-bunsetsu-get-yomi bunsetsu)
 653           (wnn-bunsetsu-get-fuzokugo bunsetsu)))
 654
 655 (defun wnn-get-major-bunsetsu-converted (bunsetsu)
 656   (mapconcat 'wnn-get-bunsetsu-converted bunsetsu ""))
 657
 658 (defun wnn-get-major-bunsetsu-source (bunsetsu)
 659   (mapconcat 'wnn-get-bunsetsu-source bunsetsu ""))
 660
 661 (defun wnn-major-bunsetsu-continue-p (bunsetsu)
 662   (wnn-bunsetsu-get-dai-continue bunsetsu))
 663
 664 (defmacro wnn-uniq-hash-string (uniq-level)
 665   `(mapconcat
 666     (lambda (b)
 667       (concat ,@(cond ((eq uniq-level 'wnn-uniq)
 668                        '((number-to-string (wnn-bunsetsu-get-hinshi b))))
 669                       ((eq uniq-level 'wnn-uniq-entry)
 670                        '((number-to-string (wnn-bunsetsu-get-dic-no b))
 671                          "+"
 672                          (number-to-string (wnn-bunsetsu-get-entry b)))))
 673               "\0"
 674               (wnn-bunsetsu-get-converted b)
 675               "\0"
 676               (wnn-bunsetsu-get-fuzokugo b)))
 677     bunsetsu "\0"))
 678
 679 (defun wnn-uniq-hash (bunsetsu hash-table)
 680   (intern (cond ((eq wnn-uniq-level 'wnn-uniq)
 681                  (wnn-uniq-hash-string wnn-uniq))
 682                 ((eq wnn-uniq-level 'wnn-uniq-entry)
 683                  (wnn-uniq-hash-string wnn-uniq-entry))
 684                 (t
 685                  (wnn-uniq-hash-string nil)))
 686           hash-table))
 687
 688 (defun wnn-uniq-candidates (candidates)
 689   (if (eq wnn-uniq-level 'wnn-no-uniq)
 690       candidates
 691     (let ((hash-table (make-vector (length candidates) 0)))
 692       (delq nil (mapcar (lambda (b)
 693                           (let ((sym (wnn-uniq-hash b hash-table)))
 694                             (if (null (boundp sym))
 695                                 (set sym b))))
 696                         candidates)))))
 697
 698 (defsubst wnn-uniq-bunsetsu-equal (bunsetsu-1 bunsetsu-2)
 699   (and (or (eq wnn-uniq-level 'wnn-uniq-kanji)
 700            (and (eq wnn-uniq-level 'wnn-uniq)
 701                 (= (wnn-bunsetsu-get-hinshi bunsetsu-1)
 702                    (wnn-bunsetsu-get-hinshi bunsetsu-2)))
 703            (and (= (wnn-bunsetsu-get-dic-no bunsetsu-1)
 704                    (wnn-bunsetsu-get-dic-no bunsetsu-2))
 705                 (= (wnn-bunsetsu-get-entry bunsetsu-1)
 706                    (wnn-bunsetsu-get-entry bunsetsu-2))
 707                 (or (eq wnn-uniq-level 'wnn-uniq-entry)
 708                     (= (wnn-bunsetsu-get-kangovect bunsetsu-1)
 709                        (wnn-bunsetsu-get-kangovect bunsetsu-2)))))
 710        (equal (wnn-bunsetsu-get-converted bunsetsu-1)
 711               (wnn-bunsetsu-get-converted bunsetsu-2))
 712        (equal (wnn-bunsetsu-get-fuzokugo bunsetsu-1)
 713               (wnn-bunsetsu-get-fuzokugo bunsetsu-2))))
 714
 715 (defun wnn-uniq-bunsetsu-list-equal (b1 b2)
 716   (while (and b1 b2 (wnn-uniq-bunsetsu-equal (car b1) (car b2)))
 717     (setq b1 (cdr b1)
 718           b2 (cdr b2)))
 719   (and (null b1) (null b2)))
 720
 721 (defun wnn-candidate-pos (bunsetsu candidates)
 722   (let ((n 0)
 723         pos)
 724     (while (and (null pos) candidates)
 725       (if (wnn-uniq-bunsetsu-list-equal (car candidates) bunsetsu)
 726           (setq pos n)
 727         (setq candidates (cdr candidates)
 728               n (1+ n))))
 729     (or pos -1)))
 730
 731 (defun wnn-get-candidates-converted (candidates)
 732   (mapcar 'wnn-get-major-bunsetsu-converted candidates))
 733
 734 (defun wnn-set-candidate-info (bunsetsu zenkouho)
 735   (wnn-bunsetsu-set-zenkouho (car bunsetsu) zenkouho)
 736   (mapcar (lambda (b) (wnn-bunsetsu-set-zenkouho b t)) (cdr bunsetsu)))
 737
 738 (defun wnn-list-candidates (bunsetsu prev-b next-b major)
 739   (let* ((head (car bunsetsu))
 740          (backend (egg-bunsetsu-get-backend head))
 741          (env (wnn-bunsetsu-get-env head))
 742          (yomi (wnn-get-major-bunsetsu-source bunsetsu))
 743          (continue (eq (wnn-bunsetsu-get-zenkouho head) t))
 744          pos cand converted hinshi fuzokugo v)
 745     (if prev-b
 746         (setq prev-b (egg-get-bunsetsu-tail prev-b)
 747               hinshi (wnn-bunsetsu-get-hinshi prev-b)
 748               fuzokugo (wnn-bunsetsu-get-fuzokugo prev-b))
 749       (setq hinshi -1
 750             fuzokugo ""))
 751     (if next-b
 752         (setq next-b (car next-b)
 753               v (wnn-bunsetsu-get-kangovect next-b)))
 754     (if (vectorp (wnn-bunsetsu-get-zenkouho head))
 755         (setq pos (wnn-bunsetsu-get-zenkouho-pos head)
 756               cand (wnn-bunsetsu-get-zenkouho-list head)))
 757     (if (and pos
 758              (wnn-bunsetsu-list-equal bunsetsu (nth pos cand))
 759              (eq major (wnn-bunsetsu-get-zenkouho-dai head))
 760              (eq prev-b (wnn-bunsetsu-get-zenkouho-prev-b head))
 761              (eq next-b (wnn-bunsetsu-get-zenkouho-next-b head)))
 762         (cons pos (wnn-bunsetsu-get-zenkouho-converted head))
 763       (setq cand (wnn-get-bunsetsu-candidates env yomi hinshi fuzokugo v major))
 764       (if (numberp cand)
 765           (egg-error "%s" (wnnrpc-get-error-message (- cand))))
 766       (setq pos (wnn-candidate-pos bunsetsu cand))
 767       (cond ((< pos 0)
 768              (setq cand (cons (wnn-bunsetsu-list-copy bunsetsu) cand)))
 769             ((and (> pos 0)
 770                   (null (eq (wnn-bunsetsu-get-zenkouho head) t)))
 771              (setq cand (cons (nth pos cand) (delq (nth pos cand) cand)))))
 772       (setq cand (wnn-uniq-candidates cand)
 773             pos (wnn-candidate-pos bunsetsu cand)
 774             converted (wnn-get-candidates-converted cand))
 775       (wnn-set-candidate-info bunsetsu
 776                               (wnn-zenkouho-create pos cand converted
 777                                                    major prev-b next-b))
 778       (wnn-add-freq-down head cand)
 779       (cons pos converted))))
 780
 781 (defun wnn-decide-candidate (bunsetsu pos prev-b next-b)
 782   (let* ((head (car bunsetsu))
 783          (cand-list (wnn-bunsetsu-get-zenkouho-list head))
 784          (cand (nth pos cand-list))
 785          (c-head (car cand)))
 786     (wnn-bunsetsu-set-zenkouho-pos head pos)
 787     (wnn-bunsetsu-set-change-top c-head (wnn-bunsetsu-get-change-top head))
 788     (wnn-bunsetsu-set-freq-down c-head (wnn-bunsetsu-get-freq-down head))
 789     (wnn-merge-fi-rel c-head bunsetsu)
 790     (wnn-major-bunsetsu-set-context cand (wnn-bunsetsu-get-context head))
 791     (wnn-set-candidate-info cand (wnn-bunsetsu-get-zenkouho head))
 792     (if (and prev-b (null wnn-one-level-conversion))
 793         (progn
 794           (setq prev-b (list (egg-get-bunsetsu-tail prev-b)))
 795           (wnn-bunsetsu-set-dai-continue (car prev-b)
 796                                          (wnn-bunsetsu-connect-prev c-head))))
 797     (if next-b
 798         (setq next-b (list (car next-b))))
 799     (list cand prev-b next-b)))
 800
 801 (defun wnn-special-candidate (bunsetsu prev-b next-b major type)
 802   (let* ((backend (egg-bunsetsu-get-backend (car bunsetsu)))
 803          (lang (get backend 'language))
 804          pos cand)
 805     (when (and (eq lang (get backend 'source-language))
 806                (eq lang (get backend 'converted-language)))
 807       (setq pos (and (eq lang (get backend 'source-language))
 808                      (eq lang (get backend 'converted-language))
 809                      (cond ((eq lang 'Japanese)
 810                             (cond ((eq type 'egg-hiragana) -1)
 811                                   ((eq type 'egg-katakana) -2)))
 812                            ((or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
 813                             (cond ((eq type 'egg-pinyin) -1)
 814                                   ((eq type 'egg-zhuyin) -1)))
 815                            ((eq lang 'Korean)
 816                             (cond ((eq type 'egg-hangul) -1))))))
 817       (when pos
 818         (setq cand (cdr (wnn-list-candidates bunsetsu prev-b next-b major))
 819               pos (+ pos (length cand)))
 820         (when (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS)))
 821           (let ((converted (nth pos cand)))
 822             (cond ((egg-pinyin-syllable converted)
 823                    (cond ((eq type 'egg-pinyin)) ; OK
 824                          ((eq type 'egg-zhuyin)
 825                           (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type))
 826                          (t (setq pos nil))))
 827                   ((egg-zhuyin-syllable converted)
 828                    (cond ((eq type 'egg-pinyin)
 829                           (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type))
 830                          ((eq type 'egg-zhuyin)) ; OK
 831                          (t (setq pos nil))))
 832                   (t (setq pos nil))))))
 833       (when pos
 834         (wnn-decide-candidate bunsetsu pos prev-b next-b)))))
 835
 836 (defun wnn-pinyin-zhuyin-bunsetsu (bunsetsu pos lang type)
 837   (let ((b (nth pos (wnn-bunsetsu-get-zenkouho-list (car bunsetsu))))
 838         (encoding (if (eq lang 'Chinese-GB)
 839                       (if (eq type 'egg-pinyin)
 840                           'fixed-euc-py-cn 'fixed-euc-zy-cn)
 841                     (if (eq type 'egg-pinyin)
 842                         'fixed-euc-py-tw 'fixed-euc-zy-tw)))
 843         (converted (wnn-bunsetsu-get-zenkouho-converted (car bunsetsu)))
 844         str)
 845     (setcar (nthcdr pos converted)
 846             (wnn-pinyin-zhuyin-string (nth pos converted) encoding))
 847     (while b
 848       (setq str (wnn-bunsetsu-get-converted (car b)))
 849       (when str
 850         (wnn-bunsetsu-set-converted
 851          (car b)
 852          (wnn-pinyin-zhuyin-string str encoding)))
 853       (setq str (wnn-bunsetsu-get-fuzokugo (car b)))
 854       (when str
 855         (wnn-bunsetsu-set-fuzokugo
 856          (car b)
 857          (wnn-pinyin-zhuyin-string str encoding)))
 858       (setq b (cdr b)))))
 859
 860 (defun wnn-pinyin-zhuyin-string (str encoding)
 861   (decode-coding-string (encode-coding-string str encoding) encoding))
 862
 863 (defun wnn-change-bunsetsu-length (bunsetsu prev-b next-b len major)
 864   (let ((backend (egg-bunsetsu-get-backend (car bunsetsu)))
 865         (env (wnn-bunsetsu-get-env (car bunsetsu)))
 866         (tail (egg-get-bunsetsu-tail prev-b))
 867         (yomi (wnn-get-major-bunsetsu-source bunsetsu))
 868         (context (wnn-bunsetsu-get-context (car bunsetsu)))
 869         yomi1 yomi2 hinshi fuzokugo new)
 870     (if tail
 871         (setq hinshi (wnn-bunsetsu-get-hinshi tail)
 872               fuzokugo (wnn-bunsetsu-get-fuzokugo tail))
 873       (setq hinshi -1
 874             fuzokugo ""))
 875     (setq yomi1 (substring yomi 0 len)
 876           yomi2 (concat (substring yomi len)
 877                         (wnn-get-major-bunsetsu-source next-b)))
 878     (setq new (wnn-tanbunsetsu-conversion env yomi1 hinshi fuzokugo nil major))
 879     (if (numberp new)
 880         (egg-error "%s" (wnnrpc-get-error-message (- new))))
 881     (if (and prev-b (null wnn-one-level-conversion))
 882         (wnn-bunsetsu-set-dai-continue tail
 883                                        (wnn-bunsetsu-connect-prev (car new))))
 884     (wnn-bunsetsu-set-change-top (car new) t)
 885     (wnn-merge-freq-down (car new) bunsetsu)
 886     (wnn-merge-fi-rel (car new) bunsetsu)
 887     (wnn-merge-fi-rel (car new) next-b)
 888     (wnn-major-bunsetsu-set-context new context)
 889     (if (= (length yomi2) 0)
 890         (setq next-b nil)
 891       (setq tail (egg-get-bunsetsu-tail new)
 892             next-b (wnn-renbunsetsu-conversion env yomi2
 893                                                (wnn-bunsetsu-get-hinshi tail)
 894                                                (wnn-bunsetsu-get-fuzokugo tail)
 895                                                nil context))
 896       (if (numberp next-b)
 897           (egg-error "%s" (wnnrpc-get-error-message (- next-b))))
 898       (if (and (null major) (null wnn-one-level-conversion))
 899           (wnn-bunsetsu-set-dai-continue
 900            tail
 901            (wnn-bunsetsu-connect-prev (car next-b)))))
 902     (list new prev-b next-b)))
 903
 904 (defun wnn-add-freq-down (bunsetsu down-list)
 905   (let ((freq-down (wnn-bunsetsu-get-freq-down bunsetsu))
 906         b-list b pair)
 907     (while down-list
 908       (setq b-list (car down-list)
 909             down-list (cdr down-list))
 910       (while b-list
 911         (setq b (car b-list)
 912               b-list (cdr b-list)
 913               pair (cons (wnn-bunsetsu-get-dic-no b)
 914                          (wnn-bunsetsu-get-entry b)))
 915         (if (and (/= (wnn-bunsetsu-get-right-now b) 0)
 916                  (/= (car pair) -1)
 917                  (null (member pair freq-down)))
 918             (setq freq-down (cons pair freq-down)))))
 919     (wnn-bunsetsu-set-freq-down bunsetsu freq-down)))
 920
 921 (defun wnn-merge-freq-down (bunsetsu b-list)
 922   (let ((freq-down0 (wnn-bunsetsu-get-freq-down bunsetsu))
 923         freq-down1)
 924     (while b-list
 925       (setq freq-down1 (wnn-bunsetsu-get-freq-down (car b-list))
 926             b-list (cdr b-list))
 927       (while freq-down1
 928         (if (null (member (car freq-down1) freq-down0))
 929             (setq freq-down0 (cons (car freq-down1) freq-down0)))
 930         (setq freq-down1 (cdr freq-down1)))
 931     (wnn-bunsetsu-set-freq-down bunsetsu freq-down0))))
 932
 933 (defun wnn-merge-fi-rel (bunsetsu b-list)
 934   (let ((fi-rel (cons nil (wnn-bunsetsu-get-fi-rel bunsetsu))))
 935     (if (eq bunsetsu (car b-list))
 936         (setq b-list (cdr b-list)))
 937     (while b-list
 938       (nconc fi-rel (wnn-bunsetsu-get-fi-rel (car b-list)))
 939       (wnn-bunsetsu-set-fi-rel (car b-list) nil)
 940       (setq b-list (cdr b-list)))
 941     (wnn-bunsetsu-set-fi-rel bunsetsu (cdr fi-rel))))
 942
 943 (defun wnn-bunsetsu-combinable-p (bunsetsu1 bunsetsu2)
 944   (eq (wnn-bunsetsu-get-env bunsetsu1)
 945       (wnn-bunsetsu-get-env bunsetsu2)))
 946
 947 (defvar wnn-auto-save-dic-count 0)
 948
 949 (defun wnn-end-conversion (bunsetsu-list abort)
 950   (unless abort
 951     (let* ((head (car bunsetsu-list))
 952            (env (wnn-bunsetsu-get-env head)))
 953       (prog1
 954           (if (wnnenv-is-wnn6 env)
 955               (progn
 956                 (wnn-clear-now-flag bunsetsu-list)
 957                 (wnn-merge-fi-rel head (cdr bunsetsu-list))
 958                 (wnnrpc-set-fi-priority env (wnn-bunsetsu-get-fi-rel head))
 959                 (wnn-optimize-in-local bunsetsu-list)
 960                 (wnn-optimize-in-server bunsetsu-list))
 961             (wnn-clear-now-flag bunsetsu-list)
 962             (wnn-count-up-frequency bunsetsu-list))
 963         (setq wnn-auto-save-dic-count (1+ wnn-auto-save-dic-count))
 964         (when (eq wnn-auto-save-dic-count wnn-auto-save-dictionaries)
 965           (wnn-save-dictionaries env)
 966           (setq wnn-auto-save-dic-count 0))))))
 967
 968 (defun wnn-clear-now-flag (bunsetsu-list)
 969   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list))))
 970     (while bunsetsu-list
 971       (setq fd (wnn-bunsetsu-get-freq-down (car bunsetsu-list))
 972             bunsetsu-list (cdr bunsetsu-list))
 973       (while fd
 974         (wnnrpc-set-frequency env (caar fd) (cdar fd)
 975                               (WNN-const IMA_OFF) (WNN-const HINDO_NOP))
 976         (setq fd (cdr fd))))))
 977
 978 (defun wnn-count-up-frequency (bunsetsu-list)
 979   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
 980         (context (wnn-null-context))
 981         dic-no entry b)
 982     (while bunsetsu-list
 983       (setq b (car bunsetsu-list)
 984             bunsetsu-list (cdr bunsetsu-list)
 985             dic-no (wnn-bunsetsu-get-dic-no b)
 986             entry (wnn-bunsetsu-get-entry b)
 987             context (cons (wnn-context-create dic-no entry
 988                                               (wnn-bunsetsu-get-jirilen b)
 989                                               (wnn-bunsetsu-get-hinshi b)
 990                                               (wnn-bunsetsu-get-fuzokugo b)
 991                                               (wnn-bunsetsu-get-converted b)
 992                                               (wnn-bunsetsu-get-right-now b)
 993                                               (wnn-bunsetsu-get-freq b))
 994                           context))
 995       (wnnrpc-set-frequency env dic-no entry
 996                             (WNN-const IMA_ON) (WNN-const HINDO_INC)))
 997     (list (car context) (nth 1 context))))
 998
 999 (defun wnn-optimize-in-local (bunsetsu-list)
1000   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
1001         b prev-b next-b major-top entry hinshi)
1002     (setq next-b (car bunsetsu-list)
1003           bunsetsu-list (cdr bunsetsu-list))
1004     (cond
1005      ((eq (wnnenv-get-server-type env) 'jserver)
1006       (while next-b
1007         (setq major-top (null (and b (wnn-bunsetsu-get-dai-continue b)))
1008               prev-b b
1009               b next-b
1010               next-b (car bunsetsu-list)
1011               bunsetsu-list (cdr bunsetsu-list)
1012               hinshi (wnn-bunsetsu-get-hinshi b))
1013         (when (or
1014                (and (/= (wnnenv-get-notrans env) (WNN-const DIC_RDONLY))
1015                     (= (wnn-bunsetsu-get-dic-no b) -1)
1016                     (or (= (wnn-bunsetsu-get-entry b) (WNN-const HIRAGANA))
1017                         (= (wnn-bunsetsu-get-entry b) (WNN-const KATAKANA)))
1018                     (>= (wnn-bunsetsu-get-jirilen b) (WNN-const LEARNING_LEN)))
1019                (= (wnn-bunsetsu-get-entry b) (WNN-const IKEIJI_ENTRY)))
1020           (setq entry (wnn-notrans-auto-learning b))
1021           (when (/= entry -1)
1022             (wnn-bunsetsu-set-dic-no b (WNN-const MUHENKAN_DIC))
1023             (wnn-bunsetsu-set-entry b entry)))
1024         (cond
1025          ((and next-b
1026                major-top
1027                (wnn-bunsetsu-get-dai-continue b))
1028           (wnn-adjacent-learning b next-b))
1029          ((and prev-b
1030                (= hinshi (wnnenv-get-hinshi env 'rendaku))
1031                (equal (wnn-bunsetsu-get-fuzokugo prev-b) ""))
1032           (wnn-adjacent-learning prev-b b))
1033          ((and next-b
1034                (= hinshi (wnnenv-get-hinshi env 'settou)))
1035           (wnn-adjacent-learning b next-b))
1036          ((and (/= (wnnenv-get-bmodify env) (WNN-const DIC_RDONLY))
1037                (wnn-bunsetsu-get-change-top b)
1038                next-b
1039                (/= (wnn-bunsetsu-get-hinshi next-b)
1040                    (wnnenv-get-hinshi env 'rendaku))
1041                (/= hinshi (wnnenv-get-hinshi env 'settou)))
1042           (wnn-bmodify-learning b next-b)))))
1043      ((eq (wnnenv-get-server-type env) 'kserver)
1044       ;; Soory, not implemented
1045       nil))))
1046
1047 (defun wnn-notrans-auto-learning (bunsetsu)
1048   (let ((env (wnn-bunsetsu-get-env bunsetsu)))
1049     (wnnrpc-auto-learning env (WNN-const NOTRANS_LEARN)
1050                           (wnn-bunsetsu-get-yomi bunsetsu)
1051                           (wnn-bunsetsu-get-converted bunsetsu)
1052                           ""
1053                           (if (= (wnn-bunsetsu-get-entry bunsetsu)
1054                                  (WNN-const IKEIJI_ENTRY))
1055                               (wnn-bunsetsu-get-hinshi bunsetsu)
1056                             (wnnenv-get-hinshi env 'noun))
1057                           0)))
1058
1059 (defun wnn-adjacent-learning (bunsetsu1 bunsetsu2)
1060   (let ((env (wnn-bunsetsu-get-env bunsetsu1))
1061         (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu1)
1062                       (wnn-bunsetsu-get-yomi bunsetsu2)))
1063         (kanji (concat (wnn-bunsetsu-get-converted bunsetsu1)
1064                        (wnn-bunsetsu-get-converted bunsetsu2)))
1065         (hinshi (wnnenv-get-hinshi env 'noun)))
1066     (if (= (wnnenv-get-bmodify env) (WNN-const DIC_RW))
1067         (wnnrpc-auto-learning env (WNN-const BMODIFY_LEARN)
1068                               yomi kanji "" hinshi 0)
1069       (wnnrpc-temporary-learning env yomi kanji "" hinshi 0))))
1070
1071 (defun wnn-bmodify-learning (bunsetsu1 bunsetsu2)
1072   (let ((env (wnn-bunsetsu-get-env bunsetsu1))
1073         (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu1)
1074                       (wnn-bunsetsu-get-fuzokugo bunsetsu1)
1075                       (wnn-bunsetsu-get-yomi bunsetsu2)))
1076         (kanji (concat (wnn-bunsetsu-get-converted bunsetsu1)
1077                        (wnn-bunsetsu-get-fuzokugo bunsetsu1)
1078                        (wnn-bunsetsu-get-converted bunsetsu2)))
1079         (hinshi (wnn-bunsetsu-get-hinshi bunsetsu2)))
1080     (wnnrpc-auto-learning env (WNN-const BMODIFY_LEARN)
1081                           yomi kanji "" hinshi 0)))
1082
1083 (defun wnn-optimize-in-server (bunsetsu-list)
1084   (let ((env (wnn-bunsetsu-get-env (car bunsetsu-list)))
1085         (context (wnn-bunsetsu-get-context (car bunsetsu-list)))
1086         b)
1087     (when (eq (wnnenv-get-server-type env) 'jserver)
1088       (wnn-context-set-right-now (car context) (WNN-const HINDO_NOP))
1089       (wnn-context-set-freq (car context) (WNN-const HINDO_NOP))
1090       (wnn-context-set-right-now (nth 1 context) (WNN-const HINDO_NOP))
1091       (wnn-context-set-freq (nth 1 context) (WNN-const HINDO_NOP))
1092       (while bunsetsu-list
1093         (setq b (car bunsetsu-list)
1094               bunsetsu-list (cdr bunsetsu-list)
1095               context (cons (wnn-context-create (wnn-bunsetsu-get-dic-no b)
1096                                                 (wnn-bunsetsu-get-entry b)
1097                                                 (wnn-bunsetsu-get-jirilen b)
1098                                                 (wnn-bunsetsu-get-hinshi b)
1099                                                 (wnn-bunsetsu-get-fuzokugo b)
1100                                                 (wnn-bunsetsu-get-converted b)
1101                                                 (WNN-const IMA_ON)
1102                                                 (WNN-const HINDO_INC))
1103                             context)))
1104       (prog1
1105           (list (car context) (nth 1 context))
1106         (wnnrpc-optimize-fi env (nreverse context))))))
1107
1108 (defun wnn-finalize-backend (lang &optional action)
1109   (let* ((save-inhibit-quit inhibit-quit)
1110          (inhibit-quit t)
1111          (server-info (wnn-server-get-info lang))
1112          (server-type (wnn-server-type server-info))
1113          (env-list wnn-environments)
1114          env proc-list saved)
1115     (when server-type
1116       (while env-list
1117         (setq env (car env-list)
1118               env-list (cdr env-list))
1119         (if (eq (wnnenv-get-server-type env) server-type)
1120             (condition-case err
1121                 (progn
1122                   (unless (memq (wnnenv-get-proc env) proc-list)
1123                     (setq proc-list (cons (wnnenv-get-proc env) proc-list)))
1124                   (unless (eq action 'disconnect-only)
1125                     (unless saved
1126                       (setq saved t)
1127                       (message (egg-get-message 'wnn-dict-saving)
1128                                (wnn-server-proc-name server-info)))
1129                     (let ((inhibit-quit save-inhibit-quit))
1130                       (wnn-save-dictionaries env)))
1131                   (unless (eq action 'save-only)
1132                     (wnnrpc-disconnect env)))
1133               ((error quit)
1134                (message "signal %S occured when dictionary saving" err)))))
1135       (if saved
1136           (message (egg-get-message 'wnn-dict-saved)
1137                    (wnn-server-proc-name server-info)))
1138       (unless (eq action 'save-only)
1139         (while proc-list
1140           (if (and (car proc-list)
1141                    (eq (process-status (car proc-list)) 'open))
1142               (wnnrpc-close (car proc-list)))
1143           (setq proc-list (cdr proc-list)))))))
1144
1145 (defun wnn-close (lang)
1146   "Save dictionaries and close the Wnn session."
1147   (interactive (list (wnn-read-active-lang)))
1148   (or (listp lang)
1149       (setq lang (list lang)))
1150   (while lang
1151     (wnn-finalize-backend (car lang))
1152     (setq lang (cdr lang))))
1153
1154 (defun wnn-disconnect (lang)
1155   "Disconnect the Wnn session without dictionary saving."
1156   (interactive (list (wnn-read-active-lang)))
1157   (or (listp lang)
1158       (setq lang (list lang)))
1159   (while lang
1160     (wnn-finalize-backend (car lang) 'disconnect-only)
1161     (setq lang (cdr lang))))
1162
1163 (defun wnn-dictionary-save (lang)
1164   "Save Wnn dictionaries."
1165   (interactive (list (wnn-read-active-lang)))
1166   (or (listp lang)
1167       (setq lang (list lang)))
1168   (while lang
1169     (wnn-finalize-backend (car lang) 'save-only)
1170     (setq lang (cdr lang))))
1171
1172 (defun wnn-read-active-lang ()
1173   (let ((completion-ignore-case t)
1174         (env wnn-environments)
1175         langs server server-list)
1176     (while env
1177       (setq server (wnnenv-get-server-type (car env))
1178             env (cdr env))
1179       (if (null (memq server server-list))
1180           (setq server-list (cons server server-list))))
1181     (setq langs (delq nil
1182                       (mapcar (lambda (info)
1183                                 (if (memq (wnn-server-type info) server-list)
1184                                     (wnn-server-language info)))
1185                               wnn-server-info-list)))
1186     (if (<= (length langs) 1)
1187         langs
1188       (setq langs (cons (cons "All" langs)
1189                         (mapcar (lambda (lang) (cons (symbol-name lang) lang))
1190                                 langs)))
1191       (cdr (assoc (completing-read "language? " langs nil t nil nil "All")
1192                   langs)))))
1193 \f
1194 ;;
1195 (defun wnn-comm-sentinel (proc reason)  ; assume it is close
1196   (let ((inhibit-quit t))
1197     (kill-buffer (process-buffer proc))
1198     ;; delete env from the list.
1199     (setq wnn-environments
1200           (delq nil (mapcar (lambda (env)
1201                               (if (null (eq (wnnenv-get-proc env) proc))
1202                                   env))
1203                               wnn-environments)))))
1204
1205 (defun wnn-open (server-info)
1206   "Establish the connection to WNN server.  Return process object."
1207   ;; Open the session to WNN server,
1208   (let ((save-inhibit-quit inhibit-quit)
1209         (inhibit-quit t)
1210         (server-type (wnn-server-type server-info))
1211         (port (wnn-server-port server-info))
1212         (hostname-list (wnn-server-hostname server-info))
1213         (proc-name (wnn-server-proc-name server-info))
1214         (msg-form "Wnn: connecting to %S at %s...")
1215         (user-name (user-login-name))
1216         buf hostname myname port-off proc result msg)
1217     (unwind-protect
1218         (progn
1219           (setq buf (generate-new-buffer (wnn-server-buffer-name server-info)))
1220           (save-excursion
1221             (set-buffer buf)
1222             (erase-buffer)
1223             (buffer-disable-undo)
1224             (set-buffer-multibyte nil)
1225             (setq egg-fixed-euc (wnn-server-coding-system server-info)))
1226           (or (consp hostname-list)
1227               (setq hostname-list (list hostname-list)))
1228           (while (and hostname-list (null proc))
1229             (setq hostname (or (car hostname-list) "")
1230                   hostname-list (cdr hostname-list)
1231                   myname (if (equal hostname "") "unix" wnn-system-name))
1232             (if (null (string-match ":" hostname))
1233                 (setq port-off 0)
1234               (setq port-off (string-to-int (substring hostname (match-end 0)))
1235                     hostname (substring hostname 0 (match-beginning 0))))
1236             (and (equal hostname "") (setq hostname "localhost"))
1237             (let ((inhibit-quit save-inhibit-quit))
1238               (if (and msg
1239                        (null (y-or-n-p (format "%s failed. Try to %s? "
1240                                                msg hostname))))
1241                   (egg-error "abort connect")))
1242             (setq msg (format "Wnn: connecting to %S at %s..."
1243                               server-type hostname))
1244             (message "%s" msg)
1245             (let ((inhibit-quit save-inhibit-quit))
1246               (condition-case nil
1247                   (setq proc (open-network-stream proc-name buf hostname
1248                                                   (+ port port-off)))
1249                 ((error quit))))
1250             (when proc
1251               (process-kill-without-query proc)
1252               (set-process-coding-system proc 'binary 'binary)
1253               (set-process-sentinel proc 'wnn-comm-sentinel)
1254               (set-marker-insertion-type (process-mark proc) t)
1255               (setq result (wnnrpc-open proc myname user-name))
1256               (when (numberp result)
1257                 (delete-process proc)
1258                 (setq proc nil))))
1259           (cons proc result))
1260       (if proc
1261           (message (concat msg "done"))
1262         (if buf (kill-buffer buf))
1263         (egg-error 'wnn-connect-error)))))
1264
1265 (defvar wnn-envspec-list nil)
1266 (defvar wnn-current-envspec nil)
1267 (defvar wnn-current-envspec-reverse nil)
1268 (defvar wnn-server-type nil)
1269 (defvar wnn-wnn6-server nil)
1270
1271 (defmacro wnn-envspec-conv-param-name-list ()
1272   ''(last-is-first complex okuri-learn okuri
1273      prefix-learn prefix suffix-learn common-learn freq-func
1274      numeric alphabet symbol yuragi rendaku bunsetsugiri muhenkan
1275      fi-relation-learn fi-freq-func))
1276
1277 (defmacro wnn-envspec-conv-param-length ()
1278   (length (wnn-envspec-conv-param-name-list)))
1279
1280 (defun wnn-envspec-create (env-name tankan stickey)
1281   (vector (and env-name (setq env-name (intern env-name)))
1282           (wnn-make-backend egg-language env-name)
1283           tankan stickey nil nil
1284           0 (make-vector (wnn-envspec-conv-param-length) 0)
1285           (list nil) (list nil) (list nil)))
1286
1287 (defsubst wnn-envspec-env-type (spec)           (aref spec 0))
1288 (defsubst wnn-envspec-backend (spec)            (aref spec 1))
1289 (defsubst wnn-envspec-tankan (spec)             (aref spec 2))
1290 (defsubst wnn-envspec-sticky (spec)             (aref spec 3))
1291 (defsubst wnn-envspec-param (spec)              (aref spec 4))
1292 (defsubst wnn-envspec-fuzokugo (spec)           (aref spec 5))
1293 (defsubst wnn-envspec-conv-vmask (spec)         (aref spec 6))
1294 (defsubst wnn-envspec-conv-param (spec)         (aref spec 7))
1295 (defsubst wnn-envspec-dic-list (spec)           (cdr (aref spec 8)))
1296 (defsubst wnn-envspec-fi-dic-list (spec)        (cdr (aref spec 9)))
1297 (defsubst wnn-envspec-autolearn-dic-list (spec) (cdr (aref spec 10)))
1298
1299 (defsubst wnn-envspec-set-param (spec param)
1300   (aset spec 4 param))
1301 (defsubst wnn-envspec-set-fuzokugo (spec fzk)
1302   (aset spec 5 fzk))
1303 (defsubst wnn-envspec-set-conv-vmask (spec val)
1304   (aset spec 6 val))
1305 (defsubst wnn-envspec-set-conv-param (spec num val)
1306   (aset (aref spec 7) num val))
1307 (defsubst wnn-envspec-add-dic-list (spec &rest dic)
1308   (nconc (aref spec 8) (list (apply 'vector dic))))
1309 (defsubst wnn-envspec-add-fi-dic-list (spec &rest dic)
1310   (nconc (aref spec 9) (list (apply 'vector dic))))
1311 (defsubst wnn-envspec-add-autolearn-dic-list (spec type &rest dic)
1312   (nconc (aref spec 10) (list (cons type (apply 'vector dic)))))
1313
1314 (eval-when-compile
1315   (defun wnn-conv-param (param)
1316     (- (wnn-envspec-conv-param-length)
1317        (length (memq param (wnn-envspec-conv-param-name-list))))))
1318
1319 (defmacro define-wnn-conv-param-func ()
1320   (let ((name-list (wnn-envspec-conv-param-name-list))
1321         (defs (list 'progn))
1322         n set get)
1323     (while name-list
1324       (setq n (car name-list)
1325             name-list (cdr name-list)
1326             set (intern (format "wnn-envspec-set-conv-param-%s" n))
1327             get (intern (format "wnn-get-conv-param-%s" n)))
1328       (nconc defs `((defsubst ,set (spec val)
1329                       (wnn-envspec-set-conv-param spec ,(wnn-conv-param n) val)
1330                       (wnn-envspec-set-conv-vmask
1331                        spec (logior (wnn-envspec-conv-vmask spec)
1332                                     ,(lsh 1 (wnn-conv-param n)))))
1333                     (defsubst ,get (param)
1334                       (aref param ,(wnn-conv-param n))))))
1335     defs))
1336
1337 (define-wnn-conv-param-func)
1338
1339 (defmacro wnn-arg-type-error (func)
1340   `(egg-error ,(format "%s: Wrong type argument" func)))
1341
1342 (defun wnn-define-environment (reverse &optional env-name tankan stickey)
1343   "Define a Wnn environment for normal/reverse conversion according
1344 to REVERSE.  ENV-NAME specifies suffix of the Wnn environment name.
1345 Make single character conversion (Tan-Kanji conversion) environment,
1346 if tankan is non-NIL.  Make the environment as sticky, if STICKEY
1347 is non-NIL."
1348   (if (and env-name (null (stringp env-name)))
1349       (wnn-arg-type-error wnn-define-environment))
1350   (setq env-name (if reverse (concat env-name "R") env-name)
1351         wnn-current-envspec (wnn-envspec-create env-name tankan stickey)
1352         wnn-current-envspec-reverse reverse
1353         wnn-envspec-list (nconc wnn-envspec-list
1354                                 (list wnn-current-envspec))))
1355
1356 (defun wnn-set-fuzokugo (filename)
1357   (cond ((equal filename "")
1358          (setq filename nil))
1359         ((null (stringp filename))
1360          (wnn-arg-type-error wnn-set-fuzokugo)))
1361   (wnn-envspec-set-fuzokugo wnn-current-envspec filename))
1362
1363 (defmacro wnn-add-dict-param-check (func
1364                                     dict &optional freq prior drw dmax frw fmax
1365                                     dpass fpass rev)
1366   `(progn
1367      (if (or (and (null (stringp ,dict)) (null (stringp (car-safe ,dict))))
1368              ,@(if freq
1369                    `((and ,freq (null (stringp ,freq))
1370                           (null (stringp (car-safe ,freq))))))
1371              ,@(if prior `((null (integerp ,prior))))
1372              ,@(if drw
1373                    `((null (or (eq ,drw nil) (eq ,drw t)
1374                                (eq ,drw 0) (eq ,drw 1)
1375                                ,@(if dmax
1376                                      `((and wnn-wnn6-server
1377                                             ,@(let ((x `((eq ,drw 2))))
1378                                                 (when (>= dmax 3)
1379                                                   (nconc x `((eq ,drw 3))))
1380                                                 (when (>= dmax 4)
1381                                                   (nconc x `((eq ,drw 4))))
1382                                                 x))))))))
1383              ,@(if frw
1384                    `((null (or (eq ,frw nil) (eq ,frw t)
1385                                (eq ,frw 0) (eq ,frw 1)
1386                                ,@(if fmax
1387                                      `((and wnn-wnn6-server
1388                                             ,@(let ((x `((eq ,frw 2))))
1389                                                 (when (>= fmax 3)
1390                                                   (nconc x `((eq ,frw 3))))
1391                                                 (when (>= fmax 4)
1392                                                   (nconc x `((eq ,frw 4))))
1393                                                 x))))))))
1394              ,@(if dpass `((and ,dpass (null (stringp ,dpass)))))
1395              ,@(if fpass `((and ,fpass (null (stringp ,fpass))))))
1396          (wnn-arg-type-error ,func))
1397      (if (or (equal ,dict "") (equal (car-safe ,dict) ""))
1398          (egg-error ,(format "%s: Dictionary name should not be null." func)))
1399      ,@(if freq
1400            `((if (or (equal ,freq "") (equal (car-safe ,freq) ""))
1401                  (setq ,freq nil))))
1402      ,@(if rev
1403            `((setq ,rev (if ,rev (car ,rev) wnn-current-envspec-reverse))))))
1404
1405 (defmacro wnn-wnn6-env-func (func)
1406   `(or wnn-wnn6-server
1407        (egg-error ,(format "%s is available only on Wnn6" func))))
1408
1409 (defun wnn-add-dict (dict freq priority dict-rw freq-rw
1410                      &optional dict-passwd freq-passwd &rest reverse)
1411   (wnn-add-dict-param-check wnn-add-dict
1412                             dict freq priority dict-rw 4 freq-rw 2
1413                             dict-passwd freq-passwd reverse)
1414   (wnn-envspec-add-dic-list wnn-current-envspec
1415                             dict freq priority dict-rw freq-rw
1416                             dict-passwd freq-passwd reverse))
1417
1418 (defun wnn-add-fisys-dict (dict freq freq-rw &optional freq-passwd)
1419   (wnn-wnn6-env-func wnn-add-fisys-dict)
1420   (wnn-add-dict-param-check wnn-add-fisys-dict
1421                             dict freq nil nil nil freq-rw 3
1422                             nil freq-passwd)
1423   (wnn-envspec-add-fi-dic-list wnn-current-envspec
1424                                dict freq t nil freq-rw nil freq-passwd nil))
1425
1426 (defun wnn-add-fiusr-dict (dict freq dict-rw freq-rw
1427                            &optional dict-passwd freq-passwd)
1428   (wnn-wnn6-env-func wnn-add-fiusr-dict)
1429   (wnn-add-dict-param-check wnn-add-fiusr-dict
1430                             dict freq nil dict-rw 3 freq-rw 3
1431                             dict-passwd freq-passwd)
1432   (wnn-envspec-add-fi-dic-list wnn-current-envspec
1433                                dict freq nil dict-rw freq-rw
1434                                dict-passwd freq-passwd nil))
1435
1436 (defun wnn-add-notrans-dict (dict priority dict-rw
1437                              &optional dict-passwd &rest reverse)
1438   (wnn-wnn6-env-func wnn-add-notrans-dict)
1439   (wnn-add-dict-param-check wnn-add-notrans-dict
1440                             dict nil priority dict-rw nil nil nil
1441                             dict-passwd nil reverse)
1442   (wnn-envspec-add-autolearn-dic-list wnn-current-envspec
1443                                       (WNN-const NOTRANS_LEARN)
1444                                       dict nil priority dict-rw nil
1445                                       dict-passwd nil reverse))
1446
1447 (defun wnn-add-bmodify-dict (dict priority dict-rw
1448                              &optional dict-passwd &rest reverse)
1449   (wnn-wnn6-env-func wnn-add-notrans-dict)
1450   (wnn-add-dict-param-check wnn-add-bmodify-dict
1451                             dict nil priority dict-rw nil nil nil
1452                             dict-passwd nil reverse)
1453   (wnn-envspec-add-autolearn-dic-list wnn-current-envspec
1454                                       (WNN-const BMODIFY_LEARN)
1455                                       dict nil priority dict-rw nil
1456                                       dict-passwd nil reverse))
1457
1458 (defun wnn-set-param (&rest args)
1459   (if (/= (length args) 17)
1460       (egg-error "wnn-set-param: Wrong number of arguments"))
1461   (mapcar (lambda (n)
1462             (if (null (integerp n))
1463                 (wnn-arg-type-error wnn-set-param)))
1464           args)
1465   (wnn-envspec-set-param wnn-current-envspec (apply 'vector args)))
1466
1467 (defmacro wnn-boolean-param-check (func flag)
1468   `(setq ,flag (cond ((or (eq ,flag 0) (eq ,flag nil)) 0)
1469                      ((or (eq ,flag 1) (eq ,flag t))   1)
1470                      (t (wnn-arg-type-error ,func)))))
1471
1472 (defun wnn-set-last-is-first-mode (flag)
1473   (wnn-wnn6-env-func wnn-set-last-is-first-mode)
1474   (wnn-boolean-param-check wnn-set-last-is-first-mode flag)
1475   (wnn-envspec-set-conv-param-last-is-first wnn-current-envspec flag))
1476
1477 (defun wnn-set-complex-conv-mode (flag)
1478   (wnn-wnn6-env-func wnn-set-complex-conv-mode)
1479   (wnn-boolean-param-check wnn-set-complex-conv-mode flag)
1480   (wnn-envspec-set-conv-param-complex wnn-current-envspec flag))
1481
1482 (defun wnn-set-okuri-learn-mode (flag)
1483   (wnn-wnn6-env-func wnn-set-okuri-learn-mode)
1484   (wnn-boolean-param-check wnn-set-okuri-learn-mode flag)
1485   (wnn-envspec-set-conv-param-okuri-learn wnn-current-envspec flag))
1486
1487 (defun wnn-set-okuri-flag (mode)
1488   (wnn-wnn6-env-func wnn-set-okuri-flag)
1489   (setq mode (cond ((or (eq mode -1) (eq mode 'regulation)) -1)
1490                    ((or (eq mode  0) (eq mode 'no))          0)
1491                    ((or (eq mode  1) (eq mode 'yes))         1)
1492                    (t (wnn-arg-type-error wnn-set-okuri-flag))))
1493   (wnn-envspec-set-conv-param-okuri wnn-current-envspec mode))
1494
1495 (defun wnn-set-prefix-learn-mode (flag)
1496   (wnn-wnn6-env-func wnn-set-prefix-learn-mode)
1497   (wnn-boolean-param-check wnn-set-prefix-learn-mode flag)
1498   (wnn-envspec-set-conv-param-prefix-learn wnn-current-envspec flag))
1499
1500 (defun wnn-set-prefix-flag (mode)
1501   (wnn-wnn6-env-func wnn-set-prefix-flag)
1502   (setq mode (cond ((or (eq mode 0) (eq mode 'hiragana)) 0)
1503                    ((or (eq mode 1) (eq mode 'kanji))    1)
1504                    (t (wnn-arg-type-error wnn-set-prefix-flag))))
1505   (wnn-envspec-set-conv-param-prefix wnn-current-envspec mode))
1506
1507 (defun wnn-set-suffix-learn-mode (flag)
1508   (wnn-wnn6-env-func wnn-set-suffix-learn-mode)
1509   (wnn-boolean-param-check wnn-set-suffix-learn-mode flag)
1510   (wnn-envspec-set-conv-param-suffix-learn wnn-current-envspec flag))
1511
1512 (defun wnn-set-common-learn-mode (flag)
1513   (wnn-wnn6-env-func wnn-set-common-learn-mode)
1514   (wnn-boolean-param-check wnn-set-common-learn-mode flag)
1515   (wnn-envspec-set-conv-param-common-learn wnn-current-envspec flag))
1516
1517 (defun wnn-set-freq-func-mode (mode)
1518   (wnn-wnn6-env-func wnn-set-freq-func-mode)
1519   (setq mode (cond ((or (eq mode 0) (eq mode 'not))    0)
1520                    ((or (eq mode 1) (eq mode 'always)) 1)
1521                    ((or (eq mode 2) (eq mode 'high))   2)
1522                    ((or (eq mode 3) (eq mode 'normal)) 3)
1523                    ((or (eq mode 4) (eq mode 'low))    4)
1524                    (t (wnn-arg-type-error wnn-set-freq-func-mode))))
1525   (wnn-envspec-set-conv-param-freq-func wnn-current-envspec mode))
1526
1527 (defun wnn-set-numeric-mode (mode)
1528   (wnn-wnn6-env-func wnn-set-numeric-mode)
1529   (setq mode (cond ((or (eq mode  -2) (eq mode 'han))       -2)
1530                    ((or (eq mode -12) (eq mode 'zen))      -12)
1531                    ((or (eq mode -13) (eq mode 'kan))      -13)
1532                    ((or (eq mode -15) (eq mode 'kansuuji)) -15)
1533                    ((or (eq mode -16) (eq mode 'kanold))   -16)
1534                    ((or (eq mode -17) (eq mode 'hancan))   -17)
1535                    ((or (eq mode -18) (eq mode 'zencan))   -18)
1536                    (t (wnn-arg-type-error wnn-set-numeric-mode))))
1537   (wnn-envspec-set-conv-param-numeric wnn-current-envspec mode))
1538
1539 (defun wnn-set-alphabet-mode (mode)
1540   (wnn-wnn6-env-func wnn-set-alphabet-mode)
1541   (setq mode (cond ((or (eq mode  -4) (eq mode 'han))  -4)
1542                    ((or (eq mode -30) (eq mode 'zen)) -30)
1543                    (t (wnn-arg-type-error wnn-set-alphabet-mode))))
1544   (wnn-envspec-set-conv-param-alphabet wnn-current-envspec mode))
1545
1546 (defun wnn-set-symbol-mode (mode)
1547   (wnn-wnn6-env-func wnn-set-symbol-mode)
1548   (setq mode (cond ((or (eq mode  -5) (eq mode 'han))  -5)
1549                    ((or (eq mode -40) (eq mode 'jis)) -40)
1550                    ((or (eq mode -41) (eq mode 'asc)) -41)
1551                    (t (wnn-arg-type-error wnn-set-symbol-mode))))
1552   (wnn-envspec-set-conv-param-symbol wnn-current-envspec mode))
1553
1554 (defun wnn-set-yuragi-mode (flag)
1555   (wnn-wnn6-env-func wnn-set-yuragi-mode)
1556   (wnn-boolean-param-check wnn-set-yuragi-mode flag)
1557   (wnn-envspec-set-conv-param-yuragi wnn-current-envspec flag))
1558
1559 (defun wnn-set-rendaku-mode (flag)
1560   (wnn-wnn6-env-func wnn-set-rendaku-mode)
1561   (wnn-boolean-param-check wnn-set-rendaku-mode flag)
1562   (wnn-envspec-set-conv-param-rendaku wnn-current-envspec flag))
1563 \f
1564 (defun wnn-renbunsetsu-conversion (env yomi hinshi fuzokugo v context)
1565   (let ((result
1566          (cond
1567           ((wnnenv-get-tankan env)
1568            (wnnrpc-tanbunsetsu-conversion env yomi hinshi fuzokugo v))
1569           ((wnnenv-is-wnn6 env)
1570            (wnnrpc-fi-renbunsetsu-conversion env yomi hinshi fuzokugo v
1571                                              context))
1572           (t
1573            (wnnrpc-renbunsetsu-conversion env yomi hinshi fuzokugo v)))))
1574     (prog1
1575         result
1576       (if wnn-one-level-conversion
1577           (while (consp result)
1578             (wnn-bunsetsu-set-dai-continue (car result) nil)
1579             (setq result (cdr result)))))))
1580
1581 (defun wnn-tanbunsetsu-conversion (env yomi hinshi fuzokugo v major)
1582   (if (or (null major)
1583           wnn-one-level-conversion
1584           (wnnenv-get-tankan env))
1585       (wnnrpc-tanbunsetsu-conversion env yomi hinshi fuzokugo v)
1586     (wnnrpc-daibunsetsu-conversion env yomi hinshi fuzokugo v)))
1587
1588 (defun wnn-get-bunsetsu-candidates (env yomi hinshi fuzokugo v major)
1589   (cond
1590    ((or wnn-one-level-conversion
1591         (wnnenv-get-tankan env))
1592     (let ((result (wnnrpc-get-bunsetsu-candidates env yomi hinshi fuzokugo v)))
1593       (prog1
1594           result
1595         (while (consp result)
1596           (wnn-bunsetsu-set-dai-continue (caar result) nil)
1597           (setq result (cdr result))))))
1598    ((null major)
1599     (wnnrpc-get-bunsetsu-candidates env yomi hinshi fuzokugo v))
1600    (t
1601     (wnnrpc-get-daibunsetsu-candidates env yomi hinshi fuzokugo v))))
1602
1603 (defsubst wnn-filename (p)
1604   (substitute-in-file-name
1605    (if (consp p) (concat wnn-usr-dic-dir "/" (car p)) p)))
1606
1607 (defsubst wnn-client-file-p (filename)
1608   (and (stringp filename)
1609        (= (aref filename 0) ?!)))
1610
1611 (defsubst wnn-client-filename (filename)
1612   (substitute-in-file-name (expand-file-name (substring filename 1) "~")))
1613
1614 (defun wnn-open-file (env filename)
1615   "Open the file FILENAME on the environment ENV.
1616 Return file ID.  NIL means NO-file.
1617 On failure, return negative error code."
1618   (and filename
1619        (if (wnn-client-file-p filename)
1620            (wnnrpc-file-send env (wnn-client-filename filename))
1621          (wnnrpc-file-read env (wnn-filename filename)))))
1622
1623 (defun wnn-create-directory (env path noquery)
1624   "Create directory to the path.  Retun non-NIL value on success."
1625   (if (wnn-client-file-p path)
1626       (let ((local-name (directory-file-name (file-name-directory
1627                                               (wnn-client-filename path)))))
1628         (cond
1629          ((file-directory-p local-name) t)
1630          ((or noquery
1631               (y-or-n-p (format (egg-get-message 'wnn-dir-missing)
1632                                 (file-name-directory path))))
1633           (make-directory local-name t)
1634           (if (file-directory-p local-name)
1635               (progn
1636                 (message (egg-get-message 'wnn-dir-created) path)
1637                 t)
1638             (message (egg-get-message 'wnn-dir-failed) path)
1639             nil))))
1640     (let ((name (directory-file-name (file-name-directory
1641                                       (wnn-filename path))))
1642           create-list)
1643       (setq path name)
1644       (while (and name (/= (wnnrpc-access env name 0) 0))
1645         (setq create-list (cons name create-list)
1646               name (file-name-directory name)
1647               name (and name (directory-file-name name))))
1648       (or (null create-list)
1649           (if (or noquery
1650                   (y-or-n-p (format (egg-get-message 'wnn-dir-missing) path)))
1651               (let ((result 0))
1652                 (while (and (>= result 0) create-list)
1653                   (setq result (wnnrpc-mkdir env (car create-list))
1654                         create-list (cdr create-list)))
1655                 (if (>= result 0)
1656                     (progn
1657                       (message (egg-get-message 'wnn-dir-created) path)
1658                       t)
1659                   (message (egg-get-message 'wnn-dir-failed) path)
1660                   nil)))))))
1661
1662 (defun wnn-file-remove (proc filename passwd)
1663   (let ((result (if (wnn-client-file-p filename)
1664                     (wnnrpc-file-remove-client
1665                      proc (wnn-client-filename filename) passwd)
1666                   (wnnrpc-file-remove proc (wnn-filename filename) passwd))))
1667     (or (= result 0)
1668         (progn
1669           (message (wnnrpc-get-error-message (- result)))
1670           nil))))
1671
1672 (defun wnn-open-dictionary (env fi name rw comment dpasswd fpasswd
1673                                 &optional noquery)
1674   (let ((dic-id (wnn-open-file env name)))
1675     (cond
1676      ((null dic-id)
1677       (message "Wnn: cannot omit dictionary name")
1678       nil)
1679      ((>= dic-id 0) dic-id)
1680      ((or (null rw) (/= dic-id (- (WNN-const NO_EXIST))))
1681       (message (egg-get-message 'wnn-dict-missing-1)
1682                name (wnnrpc-get-error-message (- dic-id)))
1683       nil)
1684      ((and (or noquery
1685                (y-or-n-p (format (egg-get-message 'wnn-dict-missing-2) name)))
1686            (wnn-create-directory env name noquery)
1687            (wnn-create-dictionary env name (wnnrpc-writable-dic-type env fi rw)
1688                                   comment dpasswd fpasswd))
1689       (message (egg-get-message 'wnn-dict-created) name)
1690       (setq dic-id (wnn-open-file env name))
1691       (if (>= dic-id 0)
1692           dic-id
1693         (message "%s" (wnnrpc-get-error-message (- dic-id)))
1694         nil)))))
1695
1696 (defun wnn-create-dictionary (env name type comment dpasswd fpasswd)
1697   "Create a dictionary file on the server or the client depending on name."
1698   (let ((result (if (wnn-client-file-p name)
1699                     (wnnrpc-dic-file-create-client
1700                      env (wnn-client-filename name) type
1701                      comment dpasswd fpasswd)
1702                   (wnnrpc-dic-file-create
1703                    env (wnn-filename name) type comment dpasswd fpasswd))))
1704     (or (= result 0)
1705         (progn
1706           (message (wnnrpc-get-error-message (- result)))
1707           nil))))
1708
1709 (defun wnn-open-frequency (env fi dic-id name rw comment passwd)
1710   (let ((freq-id (wnn-open-file env name)))
1711     (cond
1712      ((null freq-id) -1)
1713      ((>= freq-id 0) freq-id)
1714      ((or (null rw) (/= freq-id (- (WNN-const NO_EXIST))))
1715       (message (egg-get-message 'wnn-freq-missing-1)
1716                name (wnnrpc-get-error-message (- freq-id)))
1717       nil)
1718      ((and (y-or-n-p
1719             (format (egg-get-message 'wnn-freq-missing-2) name))
1720            (wnn-create-directory env name nil)
1721            (wnn-create-frequency env fi dic-id name comment passwd))
1722       (message (egg-get-message 'wnn-freq-created) name)
1723       (setq freq-id (wnn-open-file env name))
1724       (if (>= freq-id 0)
1725           freq-id
1726         (message "%s" (wnnrpc-get-error-message (- dic-id)))
1727         nil)))))
1728
1729 (defun wnn-create-frequency (env fi dic-id name comment passwd)
1730   "Create a frequency file on the server or the client depending on name."
1731   (let ((result (if (wnn-client-file-p name)
1732                     (wnnrpc-hindo-file-create-client
1733                      env fi dic-id (wnn-client-filename name) comment passwd)
1734                   (wnnrpc-hindo-file-create
1735                    env fi dic-id (wnn-filename name) comment passwd))))
1736     (or (= result 0)
1737         (progn
1738           (message (wnnrpc-get-error-message (- result)))
1739           nil))))
1740
1741 (defun wnn-set-dictionary (env fi dic-spec)
1742   ""
1743   (let ((dname (aref dic-spec 0))
1744         (fname (aref dic-spec 1))
1745         (prior (aref dic-spec 2))
1746         (drw   (aref dic-spec 3))
1747         (frw   (aref dic-spec 4))
1748         (dpass (aref dic-spec 5))
1749         (fpass (aref dic-spec 6))
1750         (rev   (aref dic-spec 7))
1751         did fid result)
1752     (cond
1753      ((numberp (setq dpass (wnnrpc-read-passwd-file dpass)))
1754       (message "%s" (wnnrpc-get-error-message (- dpass)))
1755       nil)
1756      ((numberp (setq fpass (if fname (wnnrpc-read-passwd-file fpass) "")))
1757       (message "%s" (wnnrpc-get-error-message (- fpass)))
1758       nil)
1759      ((and (setq did (wnn-open-dictionary env fi dname drw "" dpass fpass))
1760            (setq fid (wnn-open-frequency env fi did fname frw "" fpass)))
1761       (if fi
1762           (setq result (wnnrpc-set-fi-dictionary env did fid prior drw frw
1763                                                  dpass fpass))
1764         (setq drw (cond ((eq drw (WNN-const DIC_GROUP)) (WNN-const DIC_RW))
1765                         ((eq drw (WNN-const DIC_MERGE)) (WNN-const DIC_RDONLY))
1766                         (t drw))
1767               result (wnnrpc-set-dictionary env did fid prior drw frw
1768                                             dpass fpass rev)))
1769       (cond
1770        ((>= result 0) t)
1771        ((or (null frw) (/= result (- (WNN-const NO_MATCH))))
1772         (message "%s (%s): %s"
1773                  dname (if fname fname "")
1774                  (wnnrpc-get-error-message (- result)))
1775         nil)
1776        ((and (y-or-n-p (format (egg-get-message 'wnn-no-match) fname))
1777              (>= (wnnrpc-file-discard env fid) 0)
1778              (wnn-file-remove proc fname fpass)
1779              (wnn-create-frequency env fi did fname "" fpass))
1780         (message (egg-get-message 'wnn-re-create-freq) fname)
1781         (and (>= (setq fid (wnn-open-file env fname)) 0)
1782              (>= (wnnrpc-set-dictionary env
1783                                         did fid prior drw frw
1784                                         dpass fpass rev)
1785                  0))))))))
1786
1787 (defun wnn-temporary-dic-add (env rev)
1788   (let ((result (wnnrpc-temporary-dic-loaded env)))
1789     (if (= result 0)
1790         (wnnrpc-temporary-dic-add env rev)
1791       result)))
1792
1793 (defun wnn-set-autolearn-dictionary (env type dic-spec)
1794   (let ((dname (aref dic-spec 0))
1795         (prior (aref dic-spec 2))
1796         (drw   (aref dic-spec 3))
1797         (dpass (aref dic-spec 5))
1798         (rev   (aref dic-spec 7))
1799         (did (wnnrpc-get-autolearning-dic env type))
1800         result)
1801     (or (numberp drw)
1802         (setq drw (if drw 0 1)))
1803     (cond
1804      ((< did 0)
1805       (message "%s" (wnnrpc-get-error-message (- did)))
1806       nil)
1807      ((> did 0)
1808       (setq result (wnn-temporary-dic-add env rev))
1809       (if (>= result 0)
1810           drw
1811         (message "%s" (wnnrpc-get-error-message (- result)))
1812         nil))
1813      ((numberp (setq dpass (wnnrpc-read-passwd-file dpass)))
1814       (message "%s" (wnnrpc-get-error-message (- dpass)))
1815       nil)
1816      ((setq did (wnn-open-dictionary env nil dname t "" dpass "" t))
1817       (if (and (>= (setq did (wnnrpc-set-dictionary env did -1 prior drw drw
1818                                                     dpass "" rev))
1819                    0)
1820                (>= (setq did (wnnrpc-set-autolearning-dic env type did)) 0)
1821                (>= (setq did (wnn-temporary-dic-add env rev)) 0))
1822           drw
1823         (message "%s" (wnnrpc-get-error-message (- did)))
1824         nil)))))
1825
1826 (defun wnn-search-environment (backend)
1827   (let ((env-list wnn-environments)
1828         env)
1829     (while (and (null env) env-list)
1830       (setq env (and (eq (wnnenv-get-backend (car env-list)) backend)
1831                      (car env-list))
1832             env-list (cdr env-list)))
1833     env))
1834
1835 (defun wnn-v3-eggrc-defines ()
1836   (if (null (fboundp 'set-wnn-reverse))
1837       (progn
1838         (fset 'set-wnn-reverse
1839               (lambda (arg)
1840                 (wnn-define-environment arg
1841                                         (and (or (eq wnn-server-type 'cserver)
1842                                                  (eq wnn-server-type 'tserver))
1843                                              "PZ"))))
1844         (fset 'is-wnn6-server (lambda () wnn-wnn6-server))
1845         (fset 'set-wnn-fuzokugo 'wnn-set-fuzokugo)
1846         (fset 'add-wnn-dict 'wnn-add-dict)
1847         (fset 'set-wnn-param 'wnn-set-param)
1848         (fset 'add-wnn-fisys-dict 'wnn-add-fisys-dict)
1849         (fset 'add-wnn-fiusr-dict 'wnn-add-fiusr-dict)
1850         (fset 'add-wnn-notrans-dict 'wnn-add-notrans-dict)
1851         (fset 'add-wnn-bmodify-dict 'wnn-add-bmodify-dict)
1852         (fset 'set-last-is-first-mode 'wnn-set-last-is-first-mode)
1853         (fset 'set-complex-conv-mode 'wnn-set-complex-conv-mode)
1854         (fset 'set-okuri-flag 'wnn-set-okuri-flag)
1855         (fset 'set-prefix-learn-mode 'wnn-set-prefix-learn-mode)
1856         (fset 'set-suffix-learn-mode 'wnn-set-suffix-learn-mode)
1857         (fset 'set-common-learn-mode 'wnn-set-common-learn-mode)
1858         (fset 'set-yuragi-mode 'wnn-set-yuragi-mode)
1859         (fset 'set-freq-func-mode 'wnn-set-freq-func-mode)
1860         (fset 'set-numeric-mode 'wnn-set-numeric-mode)
1861         (fset 'set-alphabet-mode 'wnn-set-alphabet-mode)
1862         (fset 'set-symbol-mode 'wnn-set-symbol-mode)
1863         (setq wnn-v3-defined t))))
1864
1865 (defun wnn-get-environment (backend)
1866   "Return Wnn Environemt for BACKEND.  If none, create new
1867 environment."
1868   (let ((env (wnn-search-environment backend))
1869         proc error)
1870     (or env
1871         (unwind-protect
1872             (let* ((language (wnn-backend-get-language backend))
1873                    (server-info (wnn-server-get-info language))
1874                    (server-type (wnn-server-type server-info))
1875                    version specs)
1876               (setq proc (wnn-open server-info)
1877                     version (cdr proc)
1878                     proc (car proc)
1879                     wnn-envspec-list nil)
1880               (condition-case err
1881                   (let ((wnn-server-type server-type)
1882                         (wnn-wnn6-server (eq version 'wnn6)))
1883                     (if wnn-use-v3-eggrc
1884                         (wnn-v3-eggrc-defines))
1885                     (egg-load-startup-file 'wnn language))
1886                 (egg-error
1887                  (setq error err)
1888                  (signal (car error) (cdr error))))
1889               (setq specs wnn-envspec-list)
1890               (while specs
1891                 (wnn-create-environment proc server-type version (car specs))
1892                 (setq specs (cdr specs)))
1893               (setq env (wnn-search-environment backend)))
1894           (if (and proc (null env))
1895               (progn
1896                 (wnnrpc-close proc)
1897                 (if error
1898                     (signal (car error) (cdr error))
1899                   (egg-error 'wnn-fail-make-env))))))))
1900
1901 ;; Create a new environment in the conversion server, if necessary.
1902 (defun wnn-create-environment (proc server-type version spec)
1903   (let* ((save-inhibit-quit inhibit-quit)
1904          (inhibit-quit t)
1905          (name (wnn-make-env-name spec))
1906          (backend (wnn-envspec-backend spec))
1907          (tankan (wnn-envspec-tankan spec))
1908          (sticky (wnn-envspec-sticky spec))
1909          (parameter (wnn-envspec-param spec))
1910          (fzk (wnn-envspec-fuzokugo spec))
1911          (dic-list (wnn-envspec-dic-list spec))
1912          (fi-dic-list (wnn-envspec-fi-dic-list spec))
1913          (autolearn-dic-list (wnn-envspec-autolearn-dic-list spec))
1914          exist env-id env fid cvmask param mode type dic-spec)
1915     (condition-case err
1916         (progn
1917           (setq exist (wnnrpc-env-exist proc name)
1918                 env-id (wnnrpc-connect proc name))
1919           (if (< env-id 0)
1920               (egg-error "%s" (wnnrpc-get-error-message (- env-id))))
1921           (setq env (wnnenv-create proc env-id server-type version
1922                                    backend tankan name))
1923           (cond
1924            ((or wnn-force-set-environment (= exist 0))
1925             (let ((inhibit-quit save-inhibit-quit))
1926               (and fzk
1927                    (or (< (setq fid (wnn-open-file env fzk)) 0)
1928                        (< (setq fid (wnnrpc-set-fuzokugo-file env fid)) 0))
1929                    (message "%s" (wnnrpc-get-error-message (- fid))))
1930               (while fi-dic-list
1931                 (wnn-set-dictionary env t (car fi-dic-list))
1932                 (setq fi-dic-list (cdr fi-dic-list)))
1933               (while dic-list
1934                 (wnn-set-dictionary env nil (car dic-list))
1935                 (setq dic-list (cdr dic-list)))
1936               (while autolearn-dic-list
1937                 (setq type (caar autolearn-dic-list)
1938                       dic-spec (cdar autolearn-dic-list)
1939                       autolearn-dic-list (cdr autolearn-dic-list)
1940                       mode (wnn-set-autolearn-dictionary env type dic-spec))
1941                 (if mode
1942                     (if (eq type (WNN-const NOTRANS_LEARN))
1943                         (progn
1944                           (wnnenv-set-notrans env mode)
1945                           (wnn-envspec-set-conv-param-muhenkan spec mode))
1946                       (wnnenv-set-bmodify env mode)
1947                       (wnn-envspec-set-conv-param-bunsetsugiri spec mode))))
1948               (if parameter
1949                   (wnnrpc-set-conversion-parameter env parameter))
1950               (setq cvmask (wnn-envspec-conv-vmask spec)
1951                     param (wnn-envspec-conv-param spec))
1952               (if (/= cvmask 0)
1953                   (wnnrpc-set-conversion-env-param env cvmask param))))
1954            ((eq version 'wnn6)
1955             (wnnenv-set-bmodify env (wnn-get-autolearning-dic-mode
1956                                      env (WNN-const BMODIFY_LEARN)))
1957             (wnnenv-set-notrans env (wnn-get-autolearning-dic-mode
1958                                      env (WNN-const NOTRANS_LEARN)))))
1959           (cond
1960            ((eq (wnnenv-get-server-type env) 'jserver)
1961             (wnn-set-hinshi env 'noun "\e$BL>;l\e(B")
1962             (when (wnnenv-is-wnn6 env)
1963               (wnn-set-hinshi env 'settou "\e$B@\F,8l\e(B(\e$B$*\e(B)")
1964               (wnn-set-hinshi env 'rendaku "\e$BO"By\e(B")))
1965            ((eq (wnnenv-get-server-type env) 'cserver)
1966             (wnn-set-hinshi env 'noun "\e$AFUM(C{\e(B"))
1967            ((eq (wnnenv-get-server-type env) 'tserver)
1968             (wnn-set-hinshi env 'noun "\e$(G_[]WGX\e(B"))
1969            ((eq (wnnenv-get-server-type env) 'kserver)
1970             (wnn-set-hinshi env 'noun "\e$(CY#^r\e(B")))
1971           (if sticky
1972               (wnnrpc-make-env-sticky env)
1973             (wnnrpc-make-env-unsticky env))
1974           (setq wnn-environments (nconc wnn-environments (list env))))
1975       ((egg-error quit)
1976        (if (eq (car err) 'egg-error)
1977            (message "%s" (nth 1 err)))
1978        (if env
1979            (progn
1980              (wnnrpc-disconnect env)
1981              (setq wnn-environments (delq env wnn-environments))))
1982        (if (eq (car err) 'quit)
1983            (signal 'quit (cdr err)))))))
1984
1985 (defun wnn-make-env-name (spec)
1986   (let ((env-type (wnn-envspec-env-type spec)))
1987     (concat wnn-user-name (if env-type (symbol-name env-type) ""))))
1988
1989 (defun wnn-set-hinshi (env sym name)
1990   (let ((hinshi (wnnrpc-hinshi-number (wnnenv-get-proc env) name)))
1991     (if (>= hinshi 0)
1992         (wnnenv-set-hinshi env sym hinshi))))
1993
1994 (defsubst wnn-dicinfo-entry (info)       (aref info 0))
1995 (defsubst wnn-dicinfo-id (info freq)     (aref info (+ 1 freq)))
1996 (defsubst wnn-dicinfo-mode (info freq)   (aref info (+ 3 freq)))
1997 (defsubst wnn-dicinfo-enable (info)      (aref info 5))
1998 (defsubst wnn-dicinfo-nice (info)        (aref info 6))
1999 (defsubst wnn-dicinfo-reverse (info)     (aref info 7))
2000 (defsubst wnn-dicinfo-comment (info)     (aref info 8))
2001 (defsubst wnn-dicinfo-name (info freq)   (aref info (+ 9 freq)))
2002 (defsubst wnn-dicinfo-passwd (info freq) (aref info (+ 11 freq)))
2003 (defsubst wnn-dicinfo-type (info)        (aref info 13))
2004 (defsubst wnn-dicinfo-words (info)       (aref info 14))
2005 (defsubst wnn-dicinfo-local (info freq)  (aref info (+ 15 freq)))
2006
2007 (defun wnn-get-autolearning-dic-mode (env type)
2008   (let* ((dic (wnnrpc-get-autolearning-dic env type))
2009          (info (and (> dic 0) (wnnrpc-get-dictionary-info env (1- dic)))))
2010     (if (vectorp (car-safe info))
2011         (wnn-dicinfo-mode (car info) 0)
2012       (WNN-const DIC_RDONLY))))
2013
2014 (defun wnn-get-dictionary-list-with-environment (env)
2015   (if (wnnenv-is-wnn6 env)
2016       (wnnrpc-get-fi-dictionary-list-with-environment env
2017                                                       (WNN-const DIC_NO_TEMPS))
2018     (wnnrpc-get-dictionary-list-with-environment env)))
2019
2020 (defun wnn-save-dictionaries (env)
2021   (let ((dic-list (wnn-get-dictionary-list-with-environment env))
2022         (result 0) info freq fid name local-name)
2023     (while dic-list
2024       (setq info (car dic-list)
2025             dic-list (cdr dic-list)
2026             freq 0)
2027       (while (<= freq 1)
2028         (setq fid (wnn-dicinfo-id info freq)
2029               name (wnn-dicinfo-name info freq))
2030         (if (and (> fid 0) (= (wnn-dicinfo-mode info freq) 0))
2031             (cond
2032              ((= (wnn-dicinfo-local info freq) 1)
2033               (wnnrpc-write-file env fid name))
2034              ((setq local-name (wnnenv-get-client-file env name))
2035               (wnnrpc-file-receive env fid local-name))
2036              ((and (setq local-name (wnn-file-loaded-client env name fid))
2037                    (file-writable-p local-name))
2038               (wnnrpc-file-receive env fid local-name))))
2039         (setq freq (1+ freq))))))
2040
2041 (defun wnn-file-loaded-client (env name fid)
2042   (let ((len (length wnn-system-name))
2043         local-name)
2044     (and (> (length name) len)
2045          (equal (substring name 0 len) wnn-system-name)
2046          (prog1
2047              (wnn-client-file-p (substring name len))
2048            (setq local-name (wnn-client-filename (substring name len))))
2049          (= (wnnrpc-file-loaded-local (wnnenv-get-proc env) local-name t) fid)
2050          local-name)))
2051
2052 (defun wnn-word-inspection (bunsetsu)
2053   (let ((env (wnn-bunsetsu-get-env bunsetsu))
2054         (converted (wnn-get-bunsetsu-converted bunsetsu))
2055         (yomi (wnn-bunsetsu-get-yomi bunsetsu))
2056         (fuzokugo (wnn-bunsetsu-get-fuzokugo bunsetsu))
2057         (hinshi-no (wnn-bunsetsu-get-hinshi bunsetsu))
2058         (dic-no (wnn-bunsetsu-get-dic-no bunsetsu))
2059         (entry (wnn-bunsetsu-get-entry bunsetsu))
2060         (now (wnn-bunsetsu-get-right-now bunsetsu))
2061         (freq (wnn-bunsetsu-get-freq bunsetsu))
2062         (evaluation (wnn-bunsetsu-get-evaluation bunsetsu))
2063         (evaluation-dai (or (wnn-bunsetsu-get-dai-evaluation bunsetsu) "---"))
2064         (kangovect (wnn-bunsetsu-get-kangovect bunsetsu))
2065         hinsi dic)
2066     (setq hinshi (wnnrpc-hinshi-name (wnnenv-get-proc env) hinshi-no))
2067     (setq dic (if (>= dic-no 0)
2068                   (wnn-dict-name (car (wnnrpc-get-dictionary-info env dic-no)))
2069                 (egg-get-message 'wnn-pseud-bunsetsu)))
2070     (message "%s %s+%s(%s %s:%s Freq:%s%s) S:%s D:%s V:%s "
2071              converted yomi fuzokugo hinshi dic entry
2072              (if (= now 1) "*" " ") freq evaluation evaluation-dai kangovect)))
2073 \f
2074 ;;; not implemented yet (NIY)
2075 (defun wnn-delete-dictionary ()
2076   (dj-delete-dic XXX))
2077
2078 ;;; NIY, might never be implemented
2079 (defun wnn-server-inspect ())
2080
2081 ;;; NIY
2082 (defun wnn-get-conversion-parameter ()
2083   (js-get-parameter))
2084
2085 ;;; Dictionary management (word registration) is not implemented yet.
2086
2087 (defun wnn-find-dictionary-by-id (id dic-list)
2088   (catch 'return
2089     (while dic-list
2090       (let ((dic (car dic-list)))
2091         (if (= (wnndic-get-id dic) id)
2092             (throw 'return dic)
2093           (setq dic-list (cdr dic-list)))))))
2094
2095 (defun wnn-dict-name (dic-info)
2096   (let ((comment (wnndic-get-comment dic-info))
2097         (name (wnndic-get-dictname dic-info)))
2098     (cond ((null (string= comment "")) comment)
2099           ((wnn-client-file-p name) name)
2100           (t (file-name-nondirectory name)))))
2101
2102 (defun wnn-list-writable-dictionaries-byname (env)
2103   (let ((dic-list (wnn-get-dictionary-list-with-environment env))
2104         (w-id-list (wnnrpc-get-writable-dictionary-id-list env)))
2105     (cond ((numberp w-id-list)
2106            (egg-error "%s" (wnnrpc-get-error-message (- w-id-list))))
2107           ((null w-id-list)
2108            (egg-error 'wnn-no-writable-d))
2109           (t
2110            (delq nil
2111                  (mapcar (lambda (id)
2112                            (let ((dic (wnn-find-dictionary-by-id id dic-list)))
2113                              (and dic (cons (wnn-dict-name dic) dic))))
2114                          w-id-list))))))
2115
2116 (defun wnn-word-registration (backend kanji yomi)
2117   (let (env dic dic-id hinshi result)
2118     (if (or (null (eq (egg-get-language 0 kanji)
2119                       (wnn-backend-get-converted-language backend)))
2120             (next-single-property-change 0 'egg-lang kanji)
2121             (null (eq (egg-get-language 0 yomi)
2122                       (wnn-backend-get-source-language backend)))
2123             (next-single-property-change 0 'egg-lang yomi))
2124         (egg-error "word registration: invalid character")
2125       (setq env (wnn-get-environment backend)
2126             dic (wnn-dictionary-select env)
2127             dic-id (wnndic-get-id dic)
2128             hinshi (wnn-hinshi-select env dic-id)
2129             result (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi))
2130       (or (< result 0)
2131           (setq result (wnnrpc-add-word env dic-id yomi kanji "" result 0)))
2132       (if (>= result 0)
2133           (list hinshi (wnn-dict-name dic))
2134         (egg-error (wnnrpc-get-error-message (- result)))))))
2135
2136 (defun wnn-dictionary-select (env)
2137   (menudiag-select (list 'menu
2138                          (egg-get-message 'wnn-register-1)
2139                          (wnn-list-writable-dictionaries-byname env))))
2140
2141 (defun wnn-hinshi-select (env dic-id)
2142   (menudiag-select (wnn-make-hinshi-menu
2143                     env dic-id "/"
2144                     (egg-get-message 'wnn-register-2))))
2145
2146 (defun wnn-make-hinshi-menu (env dic-id hinshi prompt)
2147   (let ((hinshi-list (wnnrpc-get-hinshi-list env dic-id hinshi)))
2148     (if (numberp hinshi-list)
2149         (egg-error "%s" (wnnrpc-get-error-message (- hinshi-list)))
2150       (list 'menu
2151             (format (if (equal hinshi "/") "%s:" "%s[%s]:")
2152                     prompt
2153                     (substring hinshi 0 (1- (length hinshi))))
2154             (mapcar (lambda (h)
2155                       (if (= (aref h (1- (length h))) ?/)
2156                           (cons h (wnn-make-hinshi-menu env dic-id h prompt))
2157                         h))
2158                     hinshi-list)))))
2159
2160 ;;; setup
2161
2162 (load "egg/wnnrpc")
2163 (run-hooks 'wnn-load-hook)
2164
2165 ;;;###autoload
2166 (defun egg-activate-wnn (&rest arg)
2167   "Activate Wnn backend of Tamago 4."
2168   (apply 'egg-mode (append arg wnn-backend-alist)))
2169
2170 ;;; egg/wnn.el ends here.