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