egg/wnn.el

   1 ;;; egg/wnn.el --- WNN Support (high level interface) in Egg
   2 ;;;                Input Method Architecture
   3
   4 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
   5 ;; Laboratory, JAPAN.
   6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   7
   8 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
   9 ;;         KATAYAMA Yoshio <kate@pfu.co.jp> ; Korean, Chinese support.
  10 ;;
  11 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
  12
  13 ;; This file is part of EGG.
  14
  15 ;; EGG is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; EGG is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;;; Code:
  33 (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 abort)
 352   (if abort
 353       ()
 354     (let ((env (wnn-bunsetsu-get-env (car bunsetsu-info-list))))
 355       (wnn-update-frequency env bunsetsu-info-list)
 356       (wnnenv-set-daibunsetsu-info env nil))))
 357
 358 (defvar wnn-sticky-environment-flag nil
 359   "*Flag which specifies sticky environment.")
 360
 361 (defun wnn-fini (lang)                  ; XXX
 362                                         ; tamago-971009 version
 363                                         ; argument LANG is still dummy
 364   (if wnn-environments
 365       (let ((l wnn-environments))
 366         (condition-case nil
 367             (while l
 368               (let ((env (car l)))
 369                 (if wnn-sticky-environment-flag
 370                     (wnnrpc-make-env-sticky env)
 371                   (wnnrpc-make-env-unsticky env))
 372                 (wnnrpc-disconnect env)
 373                 (setq l (cdr l))))
 374           (error nil))
 375         (setq l wnn-environments)
 376         (while l
 377           (let ((proc (wnnenv-get-proc (car l))))
 378             (if (eq (process-status proc) 'open)
 379                 (progn
 380                   (wnnrpc-close proc)
 381                   (kill-buffer (process-buffer proc)))
 382               (setq l (cdr l)))))
 383         (setq wnn-environments nil))))
 384 \f
 385 ;;
 386 (defun wnn-comm-sentinel (proc reason)  ; assume it is close
 387                                         ; tamago-971009 version
 388   (let ((l wnn-environments)
 389         env l1)
 390     (kill-buffer (process-buffer proc))
 391     ;; delete env from the list.
 392     (while l
 393       (setq env (car l))
 394       (if (eq proc (wnnenv-get-proc env))
 395           (progn
 396             (if l1
 397                 (setcdr l1 (cdr l))
 398               (setq wnn-environments (cdr l)))
 399             (setq l (cdr l)))
 400         (setq l1 l
 401               l (cdr l))))))
 402
 403 ;;
 404 (defvar wnn-open-message)
 405
 406 (defun wnn-open (server-info)
 407   "Establish the connection to WNN server.  Return process object."
 408   ;; Open the session to WNN server,
 409   (let ((buf (generate-new-buffer (wnn-server-buffer-name server-info)))
 410         (server-type (wnn-server-type server-info))
 411         (hostname-list (wnn-server-hostname server-info))
 412         (msg-form "WNN: connecting to %S at %s...")
 413         hostname proc result msg)
 414     (save-excursion
 415       (set-buffer buf)
 416       (erase-buffer)
 417       (buffer-disable-undo)
 418       (setq egg-fixed-euc (wnn-server-coding-system server-info))
 419       (set-buffer-multibyte nil))
 420     (cond
 421      ((null hostname-list)
 422       (setq hostname-list '("localhost")))
 423      ((null (listp hostname-list))
 424       (setq hostname-list (list hostname-list))))
 425     (while (and hostname-list (null proc))
 426       (setq hostname (car hostname-list)
 427             hostname-list (cdr hostname-list))
 428       (message msg-form server-type hostname)
 429       (sit-for 0)
 430       (condition-case result
 431           (setq proc (open-network-stream (wnn-server-stream-name server-info)
 432                                           buf
 433                                           hostname
 434                                           (wnn-server-port server-info)))
 435         (error nil))
 436       (if proc
 437           (progn
 438             (process-kill-without-query proc)
 439             (set-process-coding-system proc 'no-conversion 'no-conversion)
 440             (set-process-sentinel proc 'wnn-comm-sentinel)
 441             (set-marker-insertion-type (process-mark proc) t)
 442             (setq result (wnnrpc-open proc
 443                                       (if (equal hostname "localhost")
 444                                           "unix"
 445                                         (system-name))
 446                                       (user-login-name)))
 447             (if (< result 0)
 448                 (progn
 449                   (delete-process proc)
 450                   (setq proc nil
 451                         msg (format "Can't open WNN session (%s %S): %s"
 452                                     hostname
 453                                     (wnn-server-type server-info)
 454                                     msg)))))))
 455     (if proc
 456         (progn
 457           (setq wnn-open-message (format (concat msg-form "done")
 458                                          server-type
 459                                          hostname))
 460           proc)
 461       (kill-buffer buf)
 462       (error "%s" (or msg (format "no %S available" server-type))))))
 463
 464 (defvar wnn-dictionary-specification-list
 465   '((jserver
 466      (nil nil ""
 467           [2 10 2 45 100 200 5 1 40 -100 200 -100 200 80 200 200 200]
 468           "pubdic/full.fzk"
 469           ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
 470           ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
 471           ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
 472           ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
 473           ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
 474           ["pubdic/special.dic"   ("special.h")  5 nil t]
 475           ["pubdic/computer.dic"  ("computer.h") 5 nil t]
 476           ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
 477           ["pubdic/tankan.dic"    nil            1 nil nil]
 478           ["pubdic/bio.dic"       ("bio.h")      1 nil t]
 479           ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
 480           ["wnncons/tankan2.dic"  nil            1 nil nil]
 481           ["wnncons/tankan3.dic"  nil            1 nil nil]
 482           [("ud")                 nil            5 t   t])
 483      (nil t "R"
 484           [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
 485           "pubdic/full.fzk"
 486           ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
 487           ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
 488           ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
 489           ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
 490           ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
 491           ["pubdic/special.dic"   ("special.h")  5 nil t]
 492           ["pubdic/computer.dic"  ("computer.h") 5 nil t]
 493           ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
 494           ["pubdic/tankan.dic"    nil            1 nil nil]
 495           ["pubdic/bio.dic"       ("bio.h")      1 nil t]
 496           ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
 497           ["wnncons/tankan2.dic"  nil            1 nil nil]
 498           ["wnncons/tankan3.dic"  nil            1 nil nil]
 499           [("ud")                 nil            5 t   t]))
 500     (cserver
 501      (Q   nil "Q"
 502           nil
 503           "sys/full.con"
 504           ["sys/QianMa.dic"       nil            1 nil nil])
 505      (W   nil "W"
 506           nil
 507           "sys/full.con"
 508           ["sys/WuBi.dic"         nil            1 nil nil])
 509      (nil nil "PZ"
 510           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
 511           "sys/full.con"
 512           ["sys/level_1.dic"      ("level_1.h")  4 nil t]
 513           ["sys/level_2.dic"      ("level_2.h")  1 nil t]
 514           ["sys/basic.dic"        ("basic.h")    7 nil t]
 515           ["sys/computer.dic"     ("computer.h") 4 nil t]
 516           ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
 517           [("ud")                 nil            5 t   t])
 518      (Q   t "QR"
 519           nil
 520           "sys/full.conR"
 521           ["sys/QianMa.dic"       nil            1 nil nil])
 522      (W   t "WR"
 523           nil
 524           "sys/full.conR"
 525           ["sys/WuBi.dic"         nil            1 nil nil])
 526      (nil t "PZR"
 527           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
 528           "sys/full.conR"
 529           ["sys/level_1.dic"      ("level_1.h")  4 nil t]
 530           ["sys/level_2.dic"      ("level_2.h")  1 nil t]
 531           ["sys/basic.dic"        ("basic.h")    7 nil t]
 532           ["sys/computer.dic"     ("computer.h") 4 nil t]
 533           ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
 534           [("ud")                 nil            5 t   t]))
 535     (tserver
 536      (nil nil ""
 537           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
 538           "sys/full.con"
 539           ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
 540           ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
 541           [("ud")                 nil            5 t   t])
 542      (nil t "R"
 543           [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
 544           "sys/full.conR"
 545           ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
 546           ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
 547           [("ud")                 nil            5 t   t]))
 548     (kserver
 549      (nil nil ""
 550           [2 5 2 45 200 80 5 1 40 0 400 -100 400 80 200 2 200]
 551           "sys/full.fzk"
 552           ["sys/hword.dic"        ("hword.h")    5 nil t]
 553           ["sys/single.dic"       ("single.h")   1 nil t]
 554           [("ud")                 nil            2 t   t])
 555      (nil t "R"
 556           [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
 557           "sys/full.fzk"
 558           ["sys/hword.dic"        ("hword.h")    5 nil t]
 559           ["sys/single.dic"       ("single.h")   1 nil t]
 560           [("ud")                 nil            2 t   t]))))
 561
 562 (defsubst wnn-get-dic-spec (server)
 563   (cdr (assoc server wnn-dictionary-specification-list)))
 564
 565 (defsubst wnn-dic-spec-dic-set (spec)
 566   (nth 0 spec))
 567
 568 (defsubst wnn-dic-spec-reverse (spec)
 569   (nth 1 spec))
 570
 571 (defsubst wnn-dic-spec-name (spec)
 572   (nth 2 spec))
 573
 574 (defsubst wnn-dic-spec-param (spec)
 575   (nth 3 spec))
 576
 577 (defsubst wnn-dic-spec-fuzokugo (spec)
 578   (nth 4 spec))
 579
 580 (defsubst wnn-dic-spec-dic-list (spec)
 581   (nthcdr 5 spec))
 582
 583
 584 (defcustom wnn-usr-dic-dir (concat "usr/" (user-login-name))
 585   "*Directory of user dictionary for Wnn."
 586   :group 'wnn
 587   :type 'string)
 588
 589 (defun wnn-filename (p)
 590   ""
 591   (cond ((consp p) (concat wnn-usr-dic-dir "/" (car p)))
 592         (t p)))
 593
 594 (defun wnn-open-file (proc env-id filename)
 595   "Open the file FILENAME on the environment ENV-ID on server process PROC.
 596 Return file descripter.  NIL means NO-file.
 597 On failure, return negate-encoded error code."
 598   (if filename
 599       (wnnrpc-open-file proc env-id filename)
 600     nil))
 601
 602 (defun wnn-create-directory (proc env-id path)
 603   "Create directory to the path."
 604   (let ((dir (directory-file-name path))
 605         create-list)
 606     (while (and dir (/= (wnnrpc-access proc env-id 0 dir) 0))
 607       (setq create-list (cons dir create-list)
 608             dir (file-name-directory dir))
 609       (if dir
 610           (setq dir (directory-file-name dir))))
 611     (if (null create-list)
 612         t                               ; Already exist.
 613       ;; Only query once.
 614       (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))
 615           (catch 'return
 616             (while create-list
 617               (let* ((dir (car create-list))
 618                      (ret (wnnrpc-mkdir proc env-id dir)))
 619                 (if (< ret 0)
 620                     (progn
 621                       (message "\e$B%G%#%l%/%H%j\e(B(%s)\e$B$N:n@.$K<:GT$7$^$7$?\e(B" dir)
 622                       (throw 'return nil))))
 623               (setq create-list (cdr create-list)))
 624             ;; Success
 625             (message "\e$B%G%#%l%/%H%j\e(B(%s)\e$B$r:n$j$^$7$?\e(B" path)
 626             t)
 627         ;; Failure
 628         nil))))
 629
 630 (defun wnn-open-dictionary (proc env-id dicname mode)
 631   (let ((dictionary (wnn-open-file proc env-id dicname)))
 632     (if (null dictionary)
 633         (throw 'wnn-set-dictionary-tag nil)
 634       (while (< dictionary 0)
 635         (let ((err-code (- dictionary)))
 636           (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
 637               (let ((msg (wnnrpc-get-error-message err-code)))
 638                 (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B: %s" dicname msg)
 639                 (throw 'wnn-set-dictionary-tag nil)) ; Failure
 640             ;; Try to create new one
 641             (if (and (y-or-n-p
 642                       (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 643                               dicname))
 644                      (wnn-create-directory proc env-id
 645                                            (file-name-directory dicname))
 646                      (= (wnnrpc-create-dictionary proc env-id dicname) 0))
 647                 (progn
 648                   (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" dicname)
 649                   (setq dictionary
 650                         (wnnrpc-open-file proc env-id dicname)))
 651               (throw 'wnn-set-dictionary-tag nil)))))
 652       dictionary)))
 653
 654 (defun wnn-open-frequency (proc env-id freqname mode dic)
 655   (let ((frequency (wnn-open-file proc env-id freqname)))
 656     (if (null frequency)
 657         (setq frequency -1)
 658       (while (< frequency 0)
 659         (let ((err-code (- frequency)))
 660           (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
 661               (let ((msg (wnnrpc-get-error-message err-code)))
 662                 (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B: %s" freqname msg)
 663                 (throw 'wnn-set-dictionary-tag nil)) ; Failure
 664             ;; Try to create new one
 665             (if (and (y-or-n-p
 666                       (format "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 667                               freqname))
 668                      (wnn-create-directory proc env-id
 669                                            (file-name-directory freqname))
 670                      (= (wnnrpc-create-frequency proc env-id freqname dic) 0))
 671                 (progn
 672                   (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" freqname)
 673                   (setq frequency
 674                         (wnnrpc-open-file proc env-id freqname)))
 675               (throw 'wnn-set-dictionary-tag nil))))))
 676       frequency))
 677
 678 ;; Using local file (uploading/downloading) is not supported yet.
 679 ;; Password is not supported (Password is questionable feature, anyway)
 680 (defun wnn-set-dictionary (proc env-id reverse-flag dic-spec)
 681   ""
 682   (catch 'wnn-set-dictionary-tag
 683     (let ((dicname (wnn-filename (aref dic-spec 0)))
 684           (freqname (wnn-filename (aref dic-spec 1)))
 685           (priority  (aref dic-spec 2))
 686           (dic-mode  (aref dic-spec 3))
 687           (freq-mode (aref dic-spec 4))
 688           dictionary frequency)
 689       (setq dictionary (wnn-open-dictionary proc env-id dicname dic-mode))
 690       (setq frequency
 691             (wnn-open-frequency proc env-id freqname freq-mode dictionary))
 692       (wnn-set-dictionary-sub proc env-id reverse-flag
 693                               dictionary frequency priority dic-mode
 694                               freq-mode dicname freqname))))
 695
 696 (defun wnn-set-dictionary-sub (proc env-id reverse-flag
 697                                dictionary frequency priority dic-mode
 698                                freq-mode dicname freqname)
 699   (let ((trying t))
 700     (while trying
 701       (let ((ret (wnnrpc-set-dictionary proc env-id reverse-flag
 702                                         dictionary frequency
 703                                         priority dic-mode freq-mode)))
 704         (if (< ret 0)
 705             (let ((err-code (- ret)))
 706               (if (or (null freq-mode) (/= err-code (WNN-const NO_MATCH)))
 707                   (let ((msg (wnnrpc-get-error-message (- ret))))
 708                     (message "WNN: Error on setting dictionary (%s, %s): %s"
 709                              dicname freqname msg)
 710                     (setq trying nil))  ; done
 711                 ;; No-match: Create new frequency and try it again
 712                 (wnnrpc-discard-file proc env-id frequency) ; XXX: error?
 713                 (setq frequency
 714                       (wnn-query-del/create-frequency proc env-id freqname
 715                                                       dictionary))))
 716           ;; done sucessfully
 717           (setq trying nil))))))
 718
 719 (defun wnn-query-del/create-frequency (proc env-id freqname dictionary)
 720   (if (y-or-n-p
 721        (format "\e$B<-=q$HIQEY\e(B(%s)\e$B$N@09g@-$,$"$j$^$;$s!#:n$jD>$7$^$9$+\e(B? "
 722                freqname))
 723       (progn
 724         (wnnrpc-remove-file proc freqname) ; XXX: error?
 725         (wnnrpc-create-frequency proc env-id freqname dictionary) ; XXX: error?
 726         (message "\e$BIQEY%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" freqname)
 727         (wnnrpc-open-file proc env-id freqname)) ; XXX: error?
 728     -1))
 729
 730 (defun wnn-get-environment (server-info &optional dic-set reverse)
 731   "Return WNN Environemt for the conversion server specified
 732 by SERVER-INFO.  If none, create new environment.  Optional
 733 argument DIC-SET specifies dictionary set.  Optional argument
 734 REVERSE specifies reverse conversion, if non nil."
 735   (let ((server-type (wnn-server-type server-info))
 736         (env wnn-environments)
 737         proc spec e s)
 738     (setq reverse (null (null reverse)))
 739     (if (catch 'found
 740           (while env
 741             (setq e (car env))
 742             (if (and (eq (wnnenv-get-server-type e) server-type)
 743                      (eq (wnnenv-get-dictionary-set e) dic-set)
 744                      (eq (wnnenv-get-reverse-flag e) reverse))
 745                 (throw 'found t))
 746             (setq env (cdr env))))
 747         e
 748       (setq proc (wnn-open server-info)
 749             spec (wnn-get-dic-spec server-type))
 750       (while spec
 751         (setq s (car spec)
 752               e (wnn-create-environment proc server-type s)
 753               wnn-environments (cons e wnn-environments))
 754         (if (and (eq (wnn-dic-spec-dic-set s) dic-set)
 755                  (eq (wnn-dic-spec-reverse s) reverse))
 756             (setq env e))
 757         (setq spec (cdr spec)))
 758       (if (null env)
 759           (error "WNN: environment for %S%s (%s) not found"
 760                  server-type
 761                  (if dic-set (format "(%S)" dic-set) "")
 762                  (if reverse 'reverse 'normal)))
 763       (message "%s" wnn-open-message)
 764       env)))
 765
 766 (defun wnn-create-environment (proc server-type spec)
 767   ""
 768   ;; Create new data structure: something like wnn_buf
 769   ;; Process, Environment-ID and Daibunsetsu-info.
 770   (let (env-id parameters filename fuzokugo-fid ret dic-set reverse)
 771     (setq env-id (wnnrpc-connect proc (wnn-make-env-name spec)))
 772     (if (< env-id 0)
 773         (error "Can't connect new WNN environment: %s"
 774                (wnnrpc-get-error-message (- env-id))))
 775     (setq dic-set (wnn-dic-spec-dic-set spec)
 776           reverse (wnn-dic-spec-reverse spec)
 777           parameters (wnn-dic-spec-param spec)
 778           filename (wnn-filename (wnn-dic-spec-fuzokugo spec))
 779           fuzokugo-fid (wnn-open-file proc env-id filename))
 780     (if (null fuzokugo-fid)
 781         (setq fuzokugo-fid -1)
 782       (if (< fuzokugo-fid 0)
 783           (progn
 784             (message "WNN: Can't open fuzokugo file (%s): %s"
 785                      filename
 786                      (wnnrpc-get-error-message (- fuzokugo-fid)))
 787             (setq fuzokugo-fid -1))))
 788     (setq ret (wnnrpc-set-fuzokugo-file proc env-id fuzokugo-fid))
 789     (if (< ret 0)
 790         (let ((msg (wnnrpc-get-error-message (- ret))))
 791           (message "WNN: Error on setting fuzokugo (%s): %s" filename msg)))
 792     (setq spec (wnn-dic-spec-dic-list spec))
 793     (while spec
 794       (wnn-set-dictionary proc env-id reverse (car spec))
 795       (setq spec (cdr spec)))
 796     (if parameters
 797         (wnnrpc-set-conversion-parameters proc env-id parameters))
 798     (wnnenv-create proc env-id server-type dic-set reverse)))
 799
 800 (defvar wnn-user-name nil)
 801
 802 (defun wnn-make-env-name (spec)
 803   (or wnn-user-name
 804       (setq wnn-user-name (getenv "WNNUSER"))
 805       (setq wnn-user-name (user-login-name)))
 806   (concat wnn-user-name (wnn-dic-spec-name spec)))
 807
 808 (defun wnn-update-frequency (env bunsetsu-info-list)
 809   (let ((l bunsetsu-info-list))
 810     (while l
 811       (let* ((b (car l))
 812              (fd (wnn-bunsetsu-get-freq-down b))
 813              (z (wnn-bunsetsu-get-zenkouho b)))
 814         (while fd
 815           (let* ((fdb (car fd))
 816                  (dic-no (wnn-bunsetsu-get-dic-no fdb))
 817                  (entry (wnn-bunsetsu-get-entry fdb)))
 818             (wnnrpc-set-frequency env dic-no entry
 819                                   (WNN-const IMA_OFF) (WNN-const HINDO_NOP))
 820             (setq fd (cdr fd))))
 821         (while z
 822           (let* ((zb (car z))
 823                  (right-now (wnn-bunsetsu-get-right-now zb))
 824                  (dic-no (wnn-bunsetsu-get-dic-no zb))
 825                  (entry (wnn-bunsetsu-get-entry zb)))
 826             (if (and (/= right-now 0) (/= dic-no -1))
 827                 (wnnrpc-set-frequency env dic-no entry (WNN-const IMA_OFF)
 828                                       (WNN-const HINDO_NOP)))
 829             (setq z (cdr z))))
 830         (let ((dic-no (wnn-bunsetsu-get-dic-no b))
 831               (entry (wnn-bunsetsu-get-entry b)))
 832           (if (/= dic-no -1)
 833               (wnnrpc-set-frequency env dic-no entry
 834                                     (WNN-const IMA_ON)
 835                                     (WNN-const HINDO_INC))))
 836         (setq l (cdr l))))))
 837 \f
 838 ;;; XXX Need alternative implementation
 839 ;(defun wnn-set-conversion-mode ()
 840 ;  (jl-set-environment))
 841
 842 (defun wnn-save-dictionaries ()
 843   (for-each-environment
 844    js-dic-list
 845    (while (< i count)
 846      dic => id
 847      js-file-write
 848      hindo => id
 849      js-file-write)))
 850
 851 (defun wnn-version (proc)
 852   "Return version number string of WNN server."
 853   (format "%x" (wnnrpc-version proc)))
 854
 855 (defun wnn-dai-bunsetsu-p ()
 856   (jl-dai-top ))
 857
 858 (defun wnn-next-dai-bunsetsu-pos ()
 859   XXX)
 860 \f
 861 ;;; not implemented yet (NIY)
 862 (defun wnn-delete-dictionary ()
 863   (dj-delete-dic XXX))
 864
 865 ;;; NIY, might never be implemented
 866 (defun wnn-server-inspect ())
 867
 868 ;;; NIY
 869 (defun wnn-list-dictionaries ()
 870   (jl-dic-list))
 871
 872 ;;; NIY
 873 (defun wnn-get-conversion-parameters ()
 874   (js-get-parameters))
 875
 876 ;;; Dictionary management (word registration) is not implemented yet.
 877
 878 ;; XXX: local file loaded into the server: Not supported yet
 879 ;(defun wnn-list-dictionaries (env)
 880 ;  (wnnrpc-get-dictionary-list-with-environment env))
 881
 882 (defun wnn-find-dictionary-by-id (id dic-list)
 883   (catch 'return
 884     (while dic-list
 885       (let ((dic (car dic-list)))
 886         (if (= (wnndic-get-id dic) id)
 887             (throw 'return dic)
 888           (setq dic-list (cdr dic-list)))))))
 889
 890 (defun wnn-dict-name (dic)
 891   (let ((name (wnndic-get-comment dic)))
 892     (if (string= name "")
 893         (file-name-nondirectory (wnndic-get-dictname dic))
 894       name)))
 895
 896 (defun wnn-list-writable-dictionaries-byname (env)
 897   (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
 898         (w-id-list (wnnrpc-get-writable-dictionary-id-list env)))
 899     (mapcar (function (lambda (id)
 900                         (let ((dic (wnn-find-dictionary-by-id id dic-list)))
 901                           (cons (wnn-dict-name dic) dic))))
 902             w-id-list)))
 903
 904 (defun wnn-hinshi-list (env dic name)
 905   (let ((dic-number (wnndic-get-id dic)))
 906     (wnnrpc-get-hinshi-list env dic-number name)))
 907
 908 (defun wnn-hinshi-number (env hinshi-name)
 909   (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi-name))
 910
 911 (defun wnn-add-word (env dic yomi kanji comment hinshi-id initial-freq)
 912   (let ((dic-number (wnndic-get-id dic)))
 913     (wnnrpc-add-word env dic-number yomi kanji comment
 914                      hinshi-id initial-freq)))
 915
 916 ;;; setup
 917
 918 (require 'egg)
 919 (load "egg/wnnrpc")
 920
 921 ;;;###autoload
 922 (defun egg-activate-wnn (&rest arg)
 923   "Activate Wnn backend of Tamagotchy."
 924   (egg-set-support-languages wnn-support-languages)
 925   (egg-set-conversion-backend wnn-conversion-backend
 926                               wnn-support-languages)
 927   (apply 'egg-mode arg))
 928
 929 ;;; egg/wnn.el ends here.