Sync up with egg-980627.
[elisp/egg.git] / egg / wnn.el
index 4ada308..1e8330d 100644 (file)
 ;;; 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)
 
 ;; 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 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)))
-
-(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))
 (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) "")))
@@ -358,29 +359,88 @@ Return the list of bunsetsu."
 (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
@@ -426,7 +486,6 @@ Return the list of bunsetsu."
       (setq hostname (car hostname-list)
            hostname-list (cdr hostname-list))
       (message msg-form server-type hostname)
-      (sit-for 0)
       (condition-case result
          (setq proc (open-network-stream (wnn-server-stream-name server-info)
                                          buf
@@ -476,7 +535,7 @@ Return the list of bunsetsu."
          ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
          ["pubdic/tankan.dic"    nil            1 nil nil]
          ["pubdic/bio.dic"       ("bio.h")      1 nil t]
-         ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
+;        ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
          ["wnncons/tankan2.dic"  nil            1 nil nil]
          ["wnncons/tankan3.dic"  nil            1 nil nil]
          [("ud")                 nil            5 t   t])
@@ -493,7 +552,7 @@ Return the list of bunsetsu."
          ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
          ["pubdic/tankan.dic"    nil            1 nil nil]
          ["pubdic/bio.dic"       ("bio.h")      1 nil t]
-         ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
+;        ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
          ["wnncons/tankan2.dic"  nil            1 nil nil]
          ["wnncons/tankan3.dic"  nil            1 nil nil]
          [("ud")                 nil            5 t   t]))
@@ -839,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."