Modified Files:
[elisp/egg.git] / egg / wnn.el
index 96d7472..acd5bc6 100644 (file)
@@ -10,7 +10,7 @@
 ;;
 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
 
-;; This file will be part of EGG (in future).
+;; This file is part of EGG.
 
 ;; EGG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;;; Commentary:
 
 ;;; Code:
+
+(require 'egg-edep)
+
 (defgroup wnn nil
   "Wnn interface for Tamagotchy"
   :group 'egg)
 
-(defconst wnn-support-languages
-  '("Japanese" "Chinese-GB" "Chinese-CNS" "Korean"))
+(defconst wnn-support-languages '(Japanese Chinese-GB Chinese-CNS Korean))
 
 (eval-when-compile
   (defmacro WNN-const (c)
@@ -60,6 +62,7 @@
           wnn-decide-candidate
       wnn-change-bunsetsu-length
     wnn-end-conversion
+    wnn-start-reverse-conversion
 
     wnn-fini
  ])
 (defvar wnn-environments nil
   "Environment for WNN kana-kanji conversion")
 
-(defcustom wnn-jserver "localhost" "jserver host" :group 'wnn :type 'string)
-(defcustom wnn-cserver "localhost" "cserver host" :group 'wnn :type 'string)
-(defcustom wnn-tserver "localhost" "tserver host" :group 'wnn :type 'string)
-(defcustom wnn-kserver "localhost" "kserver host" :group 'wnn :type 'string)
+(defcustom wnn-jserver nil "jserver host list" :group 'wnn :type 'string)
+(defcustom wnn-cserver nil "cserver host list" :group 'wnn :type 'string)
+(defcustom wnn-tserver nil "tserver host list" :group 'wnn :type 'string)
+(defcustom wnn-kserver nil "kserver host list" :group 'wnn :type 'string)
+
+(defcustom wnn-jport 22273 "jserver port number" :group 'wnn :type 'integer)
+(defcustom wnn-cport 22289 "cserver port number" :group 'wnn :type 'integer)
+(defcustom wnn-tport 22321 "tserver port number" :group 'wnn :type 'integer)
+(defcustom wnn-kport 22305 "kserver port number" :group 'wnn :type 'integer)
 
 ;; The port number should be initialized from $WNNLIB/serverdefs by wnn-init
 (defconst wnn-server-info-list
-  ;; language      locale  server  port  stream coding-system hostname
-  '(("Japanese"    "ja_JP" jserver 22273 "Wnn"  fixed-euc-jp wnn-jserver)
-    ("Chinese-GB"  "zh_CN" cserver 22289 "cWnn" fixed-euc-cn wnn-cserver)
-    ("Chinese-CNS" "zh_TW" tserver 22321 "tWnn" fixed-euc-tw wnn-tserver)
-    ("Korean"      "ko_KR" kserver 22305 "kWnn" fixed-euc-kr wnn-kserver)))
-
-(defun wnn-get-server-info (lang)
-  (let (info)
-    (if (null lang)
-       (setq lang its-current-language))
-    (if (setq info (assoc lang wnn-server-info-list)) info
-      (assoc "Japanese" wnn-server-info-list))))
+  ;; language    locale  server  port     stream coding-system hostname
+  '((Japanese    "ja_JP" jserver wnn-jport "Wnn"  fixed-euc-jp wnn-jserver)
+    (Chinese-GB  "zh_CN" cserver wnn-cport "cWnn" fixed-euc-cn wnn-cserver)
+    (Chinese-CNS "zh_TW" tserver wnn-tport "tWnn" fixed-euc-tw wnn-tserver)
+    (Korean      "ko_KR" kserver wnn-kport "kWnn" fixed-euc-kr wnn-kserver)))
+
+(defsubst wnn-server-get-info (lang)
+  (assq (or lang its-current-language) wnn-server-info-list))
+
+(defsubst wnn-server-language (info)
+  (car info))
 
 (defsubst wnn-server-locale (info)
   (nth 1 info))
   (nth 2 info))
 
 (defsubst wnn-server-port (info)
-  (nth 3 info))
+  (symbol-value (nth 3 info)))
 
 (defsubst wnn-server-stream-name (info)
   (nth 4 info))
 (defun wnn-start-conversion (yomi &optional language dic-set reverse)
   "Convert YOMI string to kanji, and enter conversion mode.
 Return the list of bunsetsu."
-  (let* ((server-info (wnn-get-server-info language))
+  (let* ((server-info (wnn-server-get-info language))
         (env (wnn-get-environment server-info dic-set reverse))
         (result (wnnrpc-renbunsetsu-conversion env yomi
                                                (WNN-const BUN_SENTOU) "")))
     (wnnenv-set-daibunsetsu-info env (car result))
     (cdr result)))
 
+(defun wnn-start-reverse-conversion (yomi &optional language dic-set)
+  (wnn-start-conversion yomi language dic-set t))
+
 (defun wnn-get-bunsetsu-converted (bunsetsu)
   (concat (wnn-bunsetsu-get-converted bunsetsu)
          (wnn-bunsetsu-get-fuzokugo  bunsetsu)))
@@ -339,37 +349,98 @@ Return the list of bunsetsu."
   (concat (wnn-bunsetsu-get-yomi bunsetsu)
          (wnn-bunsetsu-get-fuzokugo bunsetsu)))
 
-(defun wnn-end-conversion (bunsetsu-info-list)
-  (let ((env (wnn-bunsetsu-get-env (car bunsetsu-info-list))))
-    (wnn-update-frequency env bunsetsu-info-list)
-    (wnnenv-set-daibunsetsu-info env nil)))
+(defun wnn-end-conversion (bunsetsu-info-list abort)
+  (if abort
+      ()
+    (let ((env (wnn-bunsetsu-get-env (car bunsetsu-info-list))))
+      (wnn-update-frequency env bunsetsu-info-list)
+      (wnnenv-set-daibunsetsu-info env nil))))
 
 (defvar wnn-sticky-environment-flag nil
   "*Flag which specifies sticky environment.")
 
-(defun wnn-fini (lang)                 ; XXX
-                                       ; tamago-971009 version
-                                       ; argument LANG is still dummy
-  (if wnn-environments
-      (let ((l wnn-environments))
-       (condition-case nil
-           (while l
-             (let ((env (car l)))
-               (if wnn-sticky-environment-flag
-                   (wnnrpc-make-env-sticky env)
-                 (wnnrpc-make-env-unsticky env))
-               (wnnrpc-disconnect env)
-               (setq l (cdr l))))
-         (error nil))
-       (setq l wnn-environments)
-       (while l
-         (let ((proc (wnnenv-get-proc (car l))))
-           (if (eq (process-status proc) 'open)
-               (progn
-                 (wnnrpc-close proc)
-                 (kill-buffer (process-buffer proc)))
-             (setq l (cdr l)))))
-       (setq wnn-environments nil))))
+(defmacro wnn-for-each-environment (lang env &rest body)
+  `(let* ((server-info (wnn-server-get-info ,lang))
+        (server-type (wnn-server-type server-info))
+        (env-list wnn-environments))
+    (if server-type
+       (while env-list
+         (let ((,env (car env-list)))
+           ,@body)
+         (setq env-list (cdr env-list))))))
+
+(defun wnn-fini (lang &optional save-only)
+  (let* ((server-info (wnn-server-get-info lang))
+        (server-type (wnn-server-type server-info))
+        (l wnn-environments)
+        new-env-list del-list env proc)
+    (if server-type
+       (progn
+         (message "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9\e(B"
+                  (wnn-server-stream-name server-info))
+         (while l
+           (setq env (car l))
+           (if (eq (wnnenv-get-server-type env) server-type)
+               (condition-case nil
+                   (progn
+                     (wnn-save-dictionaries env)
+                     (if (null save-only)
+                         (progn
+                           (setq del-list (nconc del-list (list env)))
+                           (if wnn-sticky-environment-flag
+                               (wnnrpc-make-env-sticky env)
+                             (wnnrpc-make-env-unsticky env))
+                           (wnnrpc-disconnect env))))
+                 (error nil))
+             (setq new-env-list (nconc new-env-list (list env))))
+           (setq l (cdr l)))
+         (message "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?\e(B"
+                  (wnn-server-stream-name server-info))
+         (if (null save-only)
+             (progn
+               (setq proc (and del-list (wnnenv-get-proc (car del-list))))
+               (if (and proc (eq (process-status proc) 'open))
+                   (progn
+                     (wnnrpc-close proc)
+                     (kill-buffer (process-buffer proc))))
+               (setq wnn-environments new-env-list)))))))
+
+(defun wnn-close (lang)
+  (interactive (list (wnn-read-active-lang)))
+  (or (listp lang)
+      (setq lang (list lang)))
+  (while lang
+    (wnn-fini (car lang))
+    (setq lang (cdr lang))))
+
+(defun wnn-dictionary-save (lang)
+  (interactive (list (wnn-read-active-lang)))
+  (or (listp lang)
+      (setq lang (list lang)))
+  (while lang
+    (wnn-fini (car lang) t)
+    (setq lang (cdr lang))))
+
+(defun wnn-read-active-lang ()
+  (let ((completion-ignore-case t)
+       (env wnn-environments)
+       langs server server-list)
+    (while env
+      (setq server (wnnenv-get-server-type (car env))
+           env (cdr env))
+      (if (null (member server server-list))
+         (setq server-list (cons server server-list))))
+    (setq langs (delete nil
+                       (mapcar (lambda (info)
+                                 (if (memq (wnn-server-type info) server-list)
+                                     (wnn-server-language info)))
+                               wnn-server-info-list)))
+    (if (<= (length langs) 1)
+       langs
+      (setq langs (cons (cons "All" langs)
+                       (mapcar (lambda (lang) (cons (symbol-name lang) lang))
+                               langs)))
+      (cdr (assoc (completing-read "language? " langs nil t) langs)))))
 \f
 ;;
 (defun wnn-comm-sentinel (proc reason) ; assume it is close
@@ -390,43 +461,64 @@ Return the list of bunsetsu."
              l (cdr l))))))
 
 ;;
+(defvar wnn-open-message)
+
 (defun wnn-open (server-info)
   "Establish the connection to WNN server.  Return process object."
   ;; Open the session to WNN server, 
   (let ((buf (generate-new-buffer (wnn-server-buffer-name server-info)))
-       (hostname (wnn-server-hostname server-info))
-       proc result)
-    (condition-case result
-       (setq proc (open-network-stream (wnn-server-stream-name server-info)
-                                       buf
-                                       hostname
-                                       (wnn-server-port server-info)))
-      (error (progn
-              (kill-buffer buf)
-              (signal (car result) (cdr result)))))
-    (process-kill-without-query proc)
-    (set-process-coding-system proc 'no-conversion 'no-conversion)
-    (set-process-sentinel proc 'wnn-comm-sentinel)
-    (set-marker-insertion-type (process-mark proc) t)
+       (server-type (wnn-server-type server-info))
+       (hostname-list (wnn-server-hostname server-info))
+       (msg-form "WNN: connecting to %S at %s...")
+       hostname proc result msg)
     (save-excursion
       (set-buffer buf)
       (erase-buffer)
       (buffer-disable-undo)
-      (setq enable-multibyte-characters nil
-           egg-fixed-euc (wnn-server-coding-system server-info)))
-    (setq result (wnnrpc-open proc
-                             (if (equal hostname "localhost")
-                                 "unix"
-                               (system-name))
-                             (user-login-name)))
-    (if (< result 0)
-       (let ((msg (wnnrpc-get-error-message (- result))))
-         (delete-process proc)
-         (kill-buffer buf)
-         (error "Can't open WNN session (%s %S): %s"
-                hostname
-                (wnn-server-type server-info) msg))
-      proc)))
+      (setq egg-fixed-euc (wnn-server-coding-system server-info))
+      (set-buffer-multibyte nil))
+    (cond
+     ((null hostname-list)
+      (setq hostname-list '("localhost")))
+     ((null (listp hostname-list))
+      (setq hostname-list (list hostname-list))))
+    (while (and hostname-list (null proc))
+      (setq hostname (car hostname-list)
+           hostname-list (cdr hostname-list))
+      (message msg-form server-type hostname)
+      (condition-case result
+         (setq proc (open-network-stream (wnn-server-stream-name server-info)
+                                         buf
+                                         hostname
+                                         (wnn-server-port server-info)))
+       (error nil))
+      (if proc
+         (progn
+           (process-kill-without-query proc)
+           (set-process-coding-system proc 'no-conversion 'no-conversion)
+           (set-process-sentinel proc 'wnn-comm-sentinel)
+           (set-marker-insertion-type (process-mark proc) t)
+           (setq result (wnnrpc-open proc
+                                     (if (equal hostname "localhost")
+                                         "unix"
+                                       (system-name))
+                                     (user-login-name)))
+           (if (< result 0)
+               (progn
+                 (delete-process proc)
+                 (setq proc nil
+                       msg (format "Can't open WNN session (%s %S): %s"
+                                   hostname
+                                   (wnn-server-type server-info)
+                                   msg)))))))
+    (if proc
+       (progn
+         (setq wnn-open-message (format (concat msg-form "done")
+                                        server-type
+                                        hostname))
+         proc)
+      (kill-buffer buf)
+      (error "%s" (or msg (format "no %S available" server-type))))))
 
 (defvar wnn-dictionary-specification-list
   '((jserver
@@ -722,6 +814,12 @@ REVERSE specifies reverse conversion, if non nil."
                 (eq (wnn-dic-spec-reverse s) reverse))
            (setq env e))
        (setq spec (cdr spec)))
+      (if (null env)
+         (error "WNN: environment for %S%s (%s) not found"
+                server-type
+                (if dic-set (format "(%S)" dic-set) "")
+                (if reverse 'reverse 'normal)))
+      (message "%s" wnn-open-message)
       env)))
 
 (defun wnn-create-environment (proc server-type spec)
@@ -800,14 +898,41 @@ REVERSE specifies reverse conversion, if non nil."
 ;(defun wnn-set-conversion-mode ()
 ;  (jl-set-environment))
 
-(defun wnn-save-dictionaries ()
-  (for-each-environment
-   js-dic-list
-   (while (< i count)
-     dic => id
-     js-file-write
-     hindo => id
-     js-file-write)))
+(defsubst wnn-dicinfo-entry (info) (aref info 0))
+(defsubst wnn-dicinfo-id (info freq) (aref info (+ 1 freq)))
+(defsubst wnn-dicinfo-mode (info freq) (aref info (+ 3 freq)))
+(defsubst wnn-dicinfo-enable (info) (aref info 5))
+(defsubst wnn-dicinfo-nice (info) (aref info 6))
+(defsubst wnn-dicinfo-reverse (info) (aref info 7))
+(defsubst wnn-dicinfo-comment (info) (aref info 8))
+(defsubst wnn-dicinfo-name (info freq) (aref info (+ 9 freq)))
+(defsubst wnn-dicinfo-passwd (info freq) (aref info (+ 11 freq)))
+(defsubst wnn-dicinfo-type (info) (aref info 13))
+(defsubst wnn-dicinfo-words (info) (aref info 14))
+(defsubst wnn-dicinfo-local (info freq) (aref info (+ 15 freq)))
+
+(defun wnn-save-dictionaries (env)
+  (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
+       (result 0) info freq)
+    (while (and dic-list
+               (>= result 0))
+      (setq info (car dic-list)
+           dic-list (cdr dic-list)
+           freq 0)
+      (while (<= freq 1)
+       (if (and (> (wnn-dicinfo-id info freq) 0)
+                (= (wnn-dicinfo-mode info freq) 0))
+           (if (= (wnn-dicinfo-local info freq) 1)
+               (setq result (wnnrpc-write-file env
+                                               (wnn-dicinfo-id info freq)
+                                               (wnn-dicinfo-name info freq)))
+             (message "WNN: remote dictionary (%s) not supported yet"
+                      (wnn-dicinfo-name info freq))
+             (ding)
+             (sit-for 1)))
+       (if (< result 0)
+           (wnnrpc-disconnect env))
+       (setq freq (1+ freq))))))
 
 (defun wnn-version (proc)
   "Return version number string of WNN server."
@@ -880,11 +1005,10 @@ REVERSE specifies reverse conversion, if non nil."
 (load "egg/wnnrpc")
 
 ;;;###autoload
-(defun egg-activate-wnn (&optional arg)
+(defun egg-activate-wnn (&rest arg)
   "Activate Wnn backend of Tamagotchy."
   (egg-set-support-languages wnn-support-languages)
   (egg-set-conversion-backend wnn-conversion-backend
-                             (list (nth 2 arg))
                              wnn-support-languages)
   (apply 'egg-mode arg))