egg/wnn.el

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