;;; egg/wnn.el --- WNN Support (high level interface) in Egg ;;; Input Method Architecture ;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical ;; Laboratory, JAPAN. ;; Project Leader: Satoru Tomura ;; Author: NIIBE Yutaka ;; Maintainer: NIIBE Yutaka ;; This file will be part of GNU Emacs (in future). ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; Code: (defgroup wnn nil "Wnn interface for Tamagotchy" :group 'egg) (eval-when-compile (defmacro WNN-const (c) (cond ((eq c 'BUN_SENTOU) -1) ((eq c 'NO_EXIST) 1) ((eq c 'NO_MATCH) 10) ((eq c 'IMA_OFF) -4) ((eq c 'IMA_ON) -3) ((eq c 'HINDO_NOP) -2) ((eq c 'HINDO_INC) -3)))) (defconst wnn-conversion-backend [ wnn-init wnn-start-conversion wnn-get-bunsetsu-converted wnn-get-bunsetsu-source wnn-list-candidates wnn-get-number-of-candidates wnn-get-current-candidate-number wnn-get-all-candidates wnn-decide-candidate wnn-change-bunsetsu-length wnn-end-conversion wnn-fini ]) ;; ::= [ ] (defsubst wnnenv-create (proc env-id) (vector proc env-id nil)) (defsubst wnnenv-get-proc (env) (aref env 0)) (defsubst wnnenv-get-env-id (env) (aref env 1)) (defsubst wnnenv-get-daibunsetsu-info (env) (aref env 2)) (defsubst wnnenv-set-daibunsetsu-info (env d) (aset env 2 d)) ;; ::= [ ;; ;; ;; ;; ;; ;; ] ;; (defsubst wnn-bunsetsu-create (e end start jiritsugo-end dic-no entry freq right-now hinshi status status-backward kangovect evaluation) (vector e end start jiritsugo-end dic-no entry freq right-now hinshi status status-backward kangovect evaluation nil nil nil nil nil nil)) (defsubst wnn-bunsetsu-get-env (bunsetsu) (aref bunsetsu 0)) (defsubst wnn-bunsetsu-get-converted (bunsetsu) (aref bunsetsu 13)) (defsubst wnn-bunsetsu-set-converted (bunsetsu converted) (aset bunsetsu 13 converted)) (defsubst wnn-bunsetsu-get-hinshi (bunsetsu) (aref bunsetsu 8)) (defsubst wnn-bunsetsu-get-dic-no (bunsetsu) (aref bunsetsu 4)) (defsubst wnn-bunsetsu-get-entry (bunsetsu) (aref bunsetsu 5)) (defsubst wnn-bunsetsu-get-right-now (bunsetsu) (aref bunsetsu 7)) (defsubst wnn-bunsetsu-get-yomi (bunsetsu) (aref bunsetsu 14)) (defsubst wnn-bunsetsu-set-yomi (bunsetsu yomi) (aset bunsetsu 14 yomi)) (defsubst wnn-bunsetsu-get-fuzokugo (bunsetsu) (aref bunsetsu 15)) (defsubst wnn-bunsetsu-set-fuzokugo (bunsetsu fuzokugo) (aset bunsetsu 15 fuzokugo)) (defsubst wnn-bunsetsu-get-zenkouho (bunsetsu) (aref bunsetsu 16)) (defsubst wnn-bunsetsu-set-zenkouho (bunsetsu z) (aset bunsetsu 16 z)) (defsubst wnn-bunsetsu-get-freq-down (bunsetsu) (aref bunsetsu 17)) (defsubst wnn-bunsetsu-set-freq-down (bunsetsu d) (aset bunsetsu 17 d)) (defsubst wnn-bunsetsu-get-zenkouho-pos (bunsetsu) (aref bunsetsu 18)) (defsubst wnn-bunsetsu-set-zenkouho-pos (bunsetsu zp) (aset bunsetsu 18 zp)) (defcustom wnn-server "localhost" "Hostname of wnn server" :group 'wnn :type 'string) (defvar wnn-environment nil "Environment for WNN kana-kanji conversion") (defun wnn-init () ) (defun wnn-start-conversion (yomi) "Convert YOMI string to kanji, and enter conversion mode. Return the list of bunsetsu." (let* ((env (wnn-get-environment wnn-dictionary-specification)) (result (wnnrpc-renbunsetsu-conversion env yomi (WNN-const BUN_SENTOU) ""))) (wnnenv-set-daibunsetsu-info env (car result)) (cdr result))) (defun wnn-get-bunsetsu-converted (bunsetsu) (concat (wnn-bunsetsu-get-converted bunsetsu) (wnn-bunsetsu-get-fuzokugo bunsetsu))) ;; WNN-UNIQ-CANDIDATES ;; ;; Here, IMNSHO, WNN is broken. ;; WNN must/should return unique one. The word is representative ;; among possible words with same string literal. ;; ;; With no bunsetsu information to users, users have to chose ;; the word based on the string literal only. ;; How we could update frequency? ;; ;; We'll modify WNN in future. ;; ;; (defun wnn-uniq-candidates (bunsetsu bunsetsu-list) (let ((hash-table (make-vector 31 0)) ; XXX why 31? (l bunsetsu-list) (i 0) n sym0 result p b sym) (setq sym0 (intern (wnn-get-bunsetsu-converted bunsetsu) hash-table)) (while l (setq b (car l) l (cdr l) sym (intern (wnn-get-bunsetsu-converted b) hash-table)) (if (null (boundp sym)) ; new one (let ((bl (cons b nil))) (set sym b) (if (eq sym0 sym) (wnn-bunsetsu-set-zenkouho-pos bunsetsu (setq n i))) (if p (setq p (setcdr p bl)) (setq result (setq p bl))) (setq i (1+ i))))) (wnn-bunsetsu-set-zenkouho bunsetsu result) n)) (defun wnn-list-candidates (bunsetsu prev-bunsetsu) (let* ((candidates (wnn-bunsetsu-get-zenkouho bunsetsu)) (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu) (wnn-bunsetsu-get-fuzokugo bunsetsu))) (converted (concat (wnn-bunsetsu-get-converted bunsetsu) (wnn-bunsetsu-get-fuzokugo bunsetsu))) (env (wnn-bunsetsu-get-env bunsetsu)) prev-hinshi prev-fuzokugo) (if candidates ;; We have the candidates already. Return the current position. (wnn-bunsetsu-get-zenkouho-pos bunsetsu) (if (null prev-bunsetsu) (setq prev-hinshi -1 prev-fuzokugo "") (setq prev-hinshi (wnn-bunsetsu-get-hinshi prev-bunsetsu) prev-fuzokugo (wnn-bunsetsu-get-fuzokugo prev-bunsetsu))) (setq candidates (wnnrpc-get-bunsetsu-candidates env yomi prev-hinshi prev-fuzokugo)) (wnn-uniq-candidates bunsetsu candidates)))) (defun wnn-get-number-of-candidates (bunsetsu) (let ((l (wnn-bunsetsu-get-zenkouho bunsetsu))) (if l (length l) nil))) (defun wnn-get-current-candidate-number (bunsetsu) (wnn-bunsetsu-get-zenkouho-pos bunsetsu)) (defun wnn-get-all-candidates (bunsetsu) (let* ((l (wnn-bunsetsu-get-zenkouho bunsetsu)) (result (cons nil nil)) (r result)) (catch 'break (while t (let ((candidate (car l))) (setcar r (concat (wnn-bunsetsu-get-converted candidate) (wnn-bunsetsu-get-fuzokugo candidate))) (if (null (setq l (cdr l))) (throw 'break nil) (setq r (setcdr r (cons nil nil))))))) result)) (defun wnn-decide-candidate (bunsetsu candidate-pos) (let* ((candidate-list (wnn-bunsetsu-get-zenkouho bunsetsu)) (candidate (nth candidate-pos candidate-list))) (wnn-bunsetsu-set-zenkouho candidate candidate-list) (wnn-bunsetsu-set-zenkouho-pos candidate candidate-pos) candidate)) ;; ;; (defun wnn-change-bunsetsu-length (b0 b1 b2 len) (let ((yomi (concat (wnn-get-bunsetsu-source b1) (if b2 (wnn-get-bunsetsu-source b2)))) (env (wnn-bunsetsu-get-env b1)) yomi1 yomi2 prev-hinshi prev-fuzokugo bunsetsu1 bunsetsu2) (if (null b0) (setq prev-hinshi -1 prev-fuzokugo "") (setq prev-hinshi (wnn-bunsetsu-get-hinshi b0) prev-fuzokugo (wnn-bunsetsu-get-fuzokugo b0))) (save-match-data (string-match (concat "^\\(" (make-string len ?.) "\\)\\(.*$\\)") yomi) (setq yomi1 (match-string 1 yomi)) (setq yomi2 (match-string 2 yomi))) (setq bunsetsu1 (car (wnnrpc-tanbunsetsu-conversion env yomi1 prev-hinshi prev-fuzokugo))) ;; Only set once. (wnn-bunsetsu-set-freq-down bunsetsu1 (or (wnn-bunsetsu-get-freq-down b1) (if b2 (list b1 b2) (list b1)))) (if (< 0 (length yomi2)) ;; RENBUNSETSU? XXX (setq bunsetsu2 (car (wnnrpc-tanbunsetsu-conversion env yomi2 (wnn-bunsetsu-get-hinshi bunsetsu1) (wnn-bunsetsu-get-fuzokugo bunsetsu1)))) (setq bunsetsu2 nil)) (if bunsetsu2 (list bunsetsu1 bunsetsu2) (list bunsetsu1)))) (defun wnn-get-bunsetsu-source (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))) (defvar wnn-sticky-environment-flag nil "*Flag which specifies sticky environment.") (defun wnn-fini () ; XXX (if (null wnn-environment) nil (condition-case nil (progn (if wnn-sticky-environment-flag (wnnrpc-make-env-sticky wnn-environment) (wnnrpc-make-env-unsticky wnn-environment)) (wnnrpc-disconnect wnn-environment)) (error nil)) (let ((proc (wnnenv-get-proc wnn-environment))) (if (eq (process-status proc) 'open) (progn (wnnrpc-close proc) (kill-buffer (process-buffer proc)) (delete-process proc)))) (setq wnn-environment nil))) ;; XXX should be array (index: server) of {C,J,K}server (defconst wnn-jserver-port 22273) ;; (defun wnn-comm-sentinel (proc reason) ; assume it is close (kill-buffer (process-buffer proc)) (delete-process proc) (setq wnn-environment nil) (message "WNN: connection closed")) ;; (defun wnn-open (hostname language) "Establish the connection to WNN server. Return process object." ;; Specifying language (jserver/cserver/kserver), ;; open the session to WNN server, (let ((buf (generate-new-buffer " *WNN*")) proc result) (condition-case result (setq proc (open-network-stream "WNN" buf hostname wnn-jserver-port)) (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) (save-excursion (set-buffer buf) (erase-buffer) (buffer-disable-undo) (setq enable-multibyte-characters nil)) (setq result (wnnrpc-open proc (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 language msg)) proc))) (defvar wnn-dictionary-specification '([2 10 2 45 100 200 5 1 40 0 -100 200 -100 200 80 200 200] "pubdic/full.fzk" ["pubdic/kihon.dic" ("kihon.h") 5 nil t] ["pubdic/setsuji.dic" ("setsuji.h") 5 nil t] ["pubdic/koyuu.dic" ("koyuu.h") 1 nil t] ["pubdic/chimei.dic" ("chimei.h") 1 nil t] ["pubdic/jinmei.dic" ("jinmei.h") 1 nil t] ["pubdic/special.dic" ("special.h") 5 nil t] ["pubdic/computer.dic" ("computer.h") 5 nil t] ["pubdic/symbol.dic" ("symbol.h") 1 nil t] ["pubdic/tankan.dic" ("tankan.h") 1 nil t] ["pubdic/bio.dic" ("bio.h") 1 nil t] ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t] ["wnncons/tankan2.dic" ("tankan2.h") 1 nil t] ["wnncons/tankan3.dic" ("tankan3.h") 1 nil t] [("ud") nil 5 t t]) "") (defcustom wnn-usr-dic-dir (concat "usr/" (user-login-name)) "*Directory of user dictionary for Wnn." :group 'wnn :type 'string) (defun wnn-filename (p) "" (cond ((consp p) (concat wnn-usr-dic-dir "/" (car p))) (t p))) (defun wnn-open-file (proc env-id filename) "Open the file FILENAME on the environment ENV-ID on server process PROC. Return file descripter. NIL means NO-file. On failure, return negate-encoded error code." (if filename (wnnrpc-open-file proc env-id filename) nil)) (defun wnn-create-directory (proc env-id path) "Create directory to the path." (let ((dir (directory-file-name path)) create-list) (while (and dir (/= (wnnrpc-access proc env-id 0 dir) 0)) (setq create-list (cons dir create-list) dir (file-name-directory dir)) (if dir (setq dir (directory-file-name dir)))) (if (null create-list) t ; Already exist. ;; Only query once. (if (y-or-n-p (format "ディレクトリ(%s)が有りません。作りますか? " path)) (catch 'return (while create-list (let* ((dir (car create-list)) (ret (wnnrpc-mkdir proc env-id dir))) (if (< ret 0) (progn (message "ディレクトリ(%s)の作成に失敗しました" dir) (throw 'return nil)))) (setq create-list (cdr create-list))) ;; Success (message "ディレクトリ(%s)を作りました" path) t) ;; Failure nil)))) (defun wnn-open-dictionary (proc env-id dicname mode) (let ((dictionary (wnn-open-file proc env-id dicname))) (if (null dictionary) (throw 'wnn-set-dictionary-tag nil) (while (< dictionary 0) (let ((err-code (- dictionary))) (if (or (null mode) (/= err-code (WNN-const NO_EXIST))) (let ((msg (wnnrpc-get-error-message err-code))) (message "辞書ファイル(%s)がありません: %s" dicname msg) (throw 'wnn-set-dictionary-tag nil)) ; Failure ;; Try to create new one (if (and (y-or-n-p (format "辞書ファイル(%s)がありません。作りますか? " dicname)) (wnn-create-directory proc env-id (file-name-directory dicname)) (= (wnnrpc-create-dictionary proc env-id dicname) 0)) (progn (message "辞書ファイル(%s)を作りました" dicname) (setq dictionary (wnnrpc-open-file proc env-id dicname))) (throw 'wnn-set-dictionary-tag nil))))) dictionary))) (defun wnn-open-frequency (proc env-id freqname mode dic) (let ((frequency (wnn-open-file proc env-id freqname))) (if (null frequency) (setq frequency -1) (while (< frequency 0) (let ((err-code (- frequency))) (if (or (null mode) (/= err-code (WNN-const NO_EXIST))) (let ((msg (wnnrpc-get-error-message err-code))) (message "頻度ファイル(%s)がありません: %s" freqname msg) (throw 'wnn-set-dictionary-tag nil)) ; Failure ;; Try to create new one (if (and (y-or-n-p (format "頻度ファイル(%s)がありません。作りますか? " freqname)) (wnn-create-directory proc env-id (file-name-directory freqname)) (= (wnnrpc-create-frequency proc env-id freqname dic) 0)) (progn (message "頻度ファイル(%s)を作りました" freqname) (setq frequency (wnnrpc-open-file proc env-id freqname))) (throw 'wnn-set-dictionary-tag nil)))))) frequency)) ;; Using local file (uploading/downloading) is not supported yet. ;; Password is not supported (Password is questionable feature, anyway) (defun wnn-set-dictionary (proc env-id reverse-flag dic-spec) "" (catch 'wnn-set-dictionary-tag (let ((dicname (wnn-filename (aref dic-spec 0))) (freqname (wnn-filename (aref dic-spec 1))) (priority (aref dic-spec 2)) (dic-mode (aref dic-spec 3)) (freq-mode (aref dic-spec 4)) dictionary frequency) (setq dictionary (wnn-open-dictionary proc env-id dicname dic-mode)) (setq frequency (wnn-open-frequency proc env-id freqname freq-mode dictionary)) (wnn-set-dictionary-sub proc env-id reverse-flag dictionary frequency priority dic-mode freq-mode dicname freqname)))) (defun wnn-set-dictionary-sub (proc env-id reverse-flag dictionary frequency priority dic-mode freq-mode dicname freqname) (let ((trying t)) (while trying (let ((ret (wnnrpc-set-dictionary proc env-id reverse-flag dictionary frequency priority dic-mode freq-mode))) (if (< ret 0) (let ((err-code (- ret))) (if (or (null freq-mode) (/= err-code (WNN-const NO_MATCH))) (let ((msg (wnnrpc-get-error-message (- ret)))) (message "WNN: Error on setting dictionary (%s, %s): %s" dicname freqname msg) (setq trying nil)) ; done ;; No-match: Create new frequency and try it again (wnnrpc-discard-file proc env-id frequency) ; XXX: error? (setq frequency (wnn-query-del/create-frequency proc env-id freqname dictionary)))) ;; done sucessfully (setq trying nil)))))) (defun wnn-query-del/create-frequency (proc env-id freqname dictionary) (if (y-or-n-p (format "辞書と頻度(%s)の整合性がありません。作り直しますか? " freqname)) (progn (wnnrpc-remove-file proc freqname) ; XXX: error? (wnnrpc-create-frequency proc env-id freqname dictionary) ; XXX: error? (message "頻度ファイル(%s)を作りました" freqname) (wnnrpc-open-file proc env-id freqname)) ; XXX: error? -1)) (defun wnn-get-environment (dic-spec) "Return WNN Environemt. If none, create new environment. Take one argument DIC-SPEC for dictionary specification." (if wnn-environment wnn-environment (let ((username (user-login-name)) (proc (wnn-open wnn-server "ja_JP"))) (setq wnn-environment (wnn-create-environment proc username nil dic-spec))))) (defun wnn-create-environment (proc username reverse-flag spec) "" ;; Create new data structure: something like wnn_buf ;; Process, Environment-ID and Daibunsetsu-info. (let (env env-id parameters) (setq env-id (wnnrpc-connect proc username)) (if (< env-id 0) (let ((msg (wnnrpc-get-error-message (- env-id)))) (error "Can't connect new WNN environment: %s" msg))) (setq parameters (car spec)) (setq spec (cdr spec)) (let ((filename (wnn-filename (car spec))) fuzokugo-fid ret) (setq fuzokugo-fid (wnn-open-file proc env-id filename)) (if (null fuzokugo-fid) (setq fuzokugo-fid -1) (if (< fuzokugo-fid 0) (let ((msg (wnnrpc-get-error-message (- fuzokugo-fid)))) (message "WNN: Can't open fuzokugo file (%s): %s" filename msg) (setq fuzokugo-fid -1)))) (setq ret (wnnrpc-set-fuzokugo-file proc env-id fuzokugo-fid)) (if (< ret 0) (let ((msg (wnnrpc-get-error-message (- ret)))) (message "WNN: Error on setting fuzokugo (%s): %s" filename msg)))) (setq spec (cdr spec)) (while spec (let ((dic-spec (car spec))) (wnn-set-dictionary proc env-id reverse-flag dic-spec) (setq spec (cdr spec)))) (wnnrpc-set-conversion-parameters proc env-id parameters) (setq env (wnnenv-create proc env-id)) env)) (defun wnn-update-frequency (env bunsetsu-info-list) (let ((l bunsetsu-info-list)) (while l (let* ((b (car l)) (fd (wnn-bunsetsu-get-freq-down b)) (z (wnn-bunsetsu-get-zenkouho b))) (while fd (let* ((fdb (car fd)) (dic-no (wnn-bunsetsu-get-dic-no fdb)) (entry (wnn-bunsetsu-get-entry fdb))) (wnnrpc-set-frequency env dic-no entry (WNN-const IMA_OFF) (WNN-const HINDO_NOP)) (setq fd (cdr fd)))) (while z (let* ((zb (car z)) (right-now (wnn-bunsetsu-get-right-now zb)) (dic-no (wnn-bunsetsu-get-dic-no zb)) (entry (wnn-bunsetsu-get-entry zb))) (if (and (/= right-now 0) (/= dic-no -1)) (wnnrpc-set-frequency env dic-no entry (WNN-const IMA_OFF) (WNN-const HINDO_NOP))) (setq z (cdr z)))) (let ((dic-no (wnn-bunsetsu-get-dic-no b)) (entry (wnn-bunsetsu-get-entry b))) (if (/= dic-no -1) (wnnrpc-set-frequency env dic-no entry (WNN-const IMA_ON) (WNN-const HINDO_INC)))) (setq l (cdr l)))))) ;;; XXX Need alternative implementation ;(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))) (defun wnn-version (proc) "Return version number string of WNN server." (format "%x" (wnnrpc-version proc))) (defun wnn-dai-bunsetsu-p () (jl-dai-top )) (defun wnn-next-dai-bunsetsu-pos () XXX) ;;; not implemented yet (NIY) (defun wnn-delete-dictionary () (dj-delete-dic XXX)) ;;; NIY, might never be implemented (defun wnn-server-inspect ()) ;;; NIY (defun wnn-list-dictionaries () (jl-dic-list)) ;;; NIY (defun wnn-get-conversion-parameters () (js-get-parameters)) ;;; Dictionary management (word registration) is not implemented yet. ;; XXX: local file loaded into the server: Not supported yet ;(defun wnn-list-dictionaries (env) ; (wnnrpc-get-dictionary-list-with-environment env)) (defun wnn-find-dictionary-by-id (id dic-list) (catch 'return (while dic-list (let ((dic (car dic-list))) (if (= (wnndic-get-id dic) id) (throw 'return dic) (setq dic-list (cdr dic-list))))))) (defun wnn-dict-name (dic) (let ((name (wnndic-get-comment dic))) (if (string= name "") (file-name-nondirectory (wnndic-get-dictname dic)) name))) (defun wnn-list-writable-dictionaries-byname (env) (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env)) (w-id-list (wnnrpc-get-writable-dictionary-id-list env))) (mapcar (function (lambda (id) (let ((dic (wnn-find-dictionary-by-id id dic-list))) (cons (wnn-dict-name dic) dic)))) w-id-list))) (defun wnn-hinshi-list (env dic name) (let ((dic-number (wnndic-get-id dic))) (wnnrpc-get-hinshi-list env dic-number name))) (defun wnn-hinshi-number (env hinshi-name) (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi-name)) (defun wnn-add-word (env dic yomi kanji comment hinshi-id initial-freq) (let ((dic-number (wnndic-get-id dic))) (wnnrpc-add-word env dic-number yomi kanji comment hinshi-id initial-freq))) (provide 'egg/wnn) ;;; egg/wnn.el ends here.