Mercurial > hg > xemacs-beta
diff lisp/egg/egg-wnn-client.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 09:02:59 +0200 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/egg/egg-wnn-client.el Mon Aug 13 09:02:59 2007 +0200 @@ -0,0 +1,1203 @@ +;; Wnn3 server interface for Egg +;; Coded by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp) + +;; This file is part of Egg on Mule (Multilingual Environment) + +;; Egg is distributed in the forms of patches to GNU +;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC +;; LICENSE which is distributed along with GNU Emacs by the +;; Free Software Foundation. + +;; Egg 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 EMACS GENERAL PUBLIC LICENSE for +;; more details. + +;; You should have received a copy of the GNU EMACS GENERAL +;; PUBLIC LICENSE along with Nemacs; see the file COPYING. +;; If not, write to the Free Software Foundation, 675 Mass +;; Ave, Cambridge, MA 02139, USA. + +;;; +;;; Nemacs - Wnn V3 server interface in elisp +;;; + +;;; 93.4.6 modified for Mule Ver.0.9.7.1 +;;; by T.Saneto <sanewo@pdp.crl.sony.co.jp> +;;; Bug in wnn-bunsetu-yomi-equal fixed. + +(provide 'wnn-client) + +;;; +;;; Wnn deamon command constants +;;; + +(defconst JD_OPEN_IN 9 "$BJQ49(B") ;;; V3.0 +(defconst JD_OPEN 1 "$BMxMQ<TEPO?(B") +(defconst JD_CLOSE 2 "$BMxMQ<T:o=|(B") +(defconst JD_BEGIN 3 "$BJQ493+;O(B") +(defconst JD_END 4 "$BIQEY99?7(B") +;;; +(defconst JD_NEXT 17 "$B<!8uJd(B") ;;; 0x11 +(defconst JD_RECONV 18 "$B:FJQ49!JJ8;zNsJQ99!K(B") ;;; 0x12 +(defconst JD_TANCONV 19 "$B:FJQ49!JJ8@a?-=L!K(B") ;;; 0x13 +;;; +(defconst JD_UDP 33 "") ;;; 0x21 +(defconst JD_UDCHG 34 "$BMxMQ<T<-=qJQ99(B") ;;; 0x22 +(defconst JD_FREQSV 35 "$B<-=qB`Hr(B") ;;; 0x23 +(defconst JD_DICADD 36 "$B<-=qDI2C(B") ;;; 0x24 +(defconst JD_DICDEL 37 "$B<-=q:o=|(B") ;;; 0x25 +(defconst JD_DICINFO 38 "$B<-=q>pJs(B") ;;; 0x26 +(defconst JD_DICSTAT 39 "") ;;; 0x27 V3.0 + +(defconst JD_WDEL 49 "$BC18l:o=|(B") ;;; 0x31 +(defconst JD_WSCH 50 "$BC18l8!:w(B") ;;; 0x32 +(defconst JD_WREG 51 "$BC18lEPO?(B") ;;; 0x33 +(defconst JD_WHDEL 52 "") ;;; 0x34 + +(defconst JD_SETEVF 65 "$BJQ49J}<0JQ99(B") ;;; 0x41 +(defconst JD_GETEVF 66 "$BJQ49J}<0>pJs(B") ;;; 0x42 + +(defconst JD_MKDIR 81 "") ;;; 0x51 V3.0 +(defconst JD_ACCESS 82 "") ;;; 0x52 V3.0 +(defconst JD_WHO 83 "$BMxMQ<T0lMw(B") ;;; 0x53 V3.0 +(defconst JD_VERSION 84 "") ;;; 0x54 V3.0 + + +(defvar wnn-server-buffer nil "Buffer associated with Wnn server process.") + +(defvar wnn-server-process nil "Wnn Kana Kanji hankan process.") + +(defvar wnn-command-tail-position nil) +(defvar wnn-command-buffer nil) + +(defvar wnn-result-buffer nil) +(defvar wnn-henkan-string nil) +(defvar wnn-bunsetu-suu nil) + +(defvar wnn-return-code nil) +(defvar wnn-error-code nil) + +;;; +;;; Put data into buffer +;;; + +(defun wnn-put-4byte (integer) + (insert (if (<= 0 integer) 0 255) + (logand 255 (lsh integer -16)) + (logand 255 (lsh integer -8)) + (logand 255 integer))) + +(defun wnn-put-string (str) + (insert str 0)) + +(defun wnn-put-string* (str) + (let ((size (length str)) + (i 0)) + (while (< i size) + (if (<= 128 (aref str i)) + (progn (insert (aref str i) (aref str (1+ i))) + (setq i (+ i 2))) + (progn (insert 0 (aref str i)) + (setq i (1+ i)))))) + (insert 0 0)) + +(defun wnn-put-bit-position (pos) + (if (< pos 24) (wnn-put-4byte (lsh 1 pos)) + (insert (lsh 1 (- pos 24)) 0 0 0))) + +;;; +;;; Get data from buffer +;;; + +(defun wnn-get-4byte () + + (let ((c 0) (point (point))) + ;;;(goto-char (point-min)) + (while (< (point-max) (+ point 4)) + (accept-process-output) + (if (= c 10) (error "Count exceed.")) + (setq c (1+ c))) + (goto-char point)) + + (let ((point (point))) + (if (not (or (and (= (char-after point) 0) + (< (char-after (+ point 1)) 128)) + (and (= (char-after point) 255) + (<= 128 (char-after (+ point 1)))))) + (error "wnn-get-4byte: integer range overflow.")) + (prog1 + (logior + (lsh (char-after point) 24) + (lsh (char-after (+ point 1)) 16) + (lsh (char-after (+ point 2)) 8) + (lsh (char-after (+ point 3)) 0)) + (goto-char (+ (point) 4))))) + +(defun wnn-peek-4byte () + + (let ((c 0) (point (point))) + ;;;(goto-char (point-min)) + (while (< (point-max) (+ point 4)) + (accept-process-output) + (if (= c 10) (error "Count exceed.")) + (setq c (1+ c))) + (goto-char point)) + + (let ((point (point))) + (if (not (or (and (= (char-after point) 0) + (< (char-after (+ point 1)) 128)) + (and (= (char-after point) 255) + (<= 128 (char-after (+ point 1)))))) + (error "wnn-get-4byte: integer range overflow.")) + (prog1 + (logior + (lsh (char-after point) 24) + (lsh (char-after (+ point 1)) 16) + (lsh (char-after (+ point 2)) 8) + (lsh (char-after (+ point 3)) 0))))) + + +(defun wnn-get-bit-positions () + + (let ((c 0) (point (point))) + ;;;(goto-char (point-min)) + (while (< (point-max) (+ point 4)) + (accept-process-output) + (if (= c 10) (error "Count exceed.")) + (setq c (1+ c))) + (goto-char point)) + + (let* ((point (point)) + (left (+ (lsh (char-after point) 8) + (char-after (+ point 1)))) + (right (+ (lsh (char-after (+ point 2)) 8) + (char-after (+ point 3)))) + (result)) + (forward-char 4) + (let ((i 0)) + (while (< 0 right) + (if (zerop (logand 1 right)) nil + (setq result (cons i result))) + (setq right (lsh right -1)) + (setq i (1+ i))) + (setq i 16) + (while (< 0 left) + (if (zerop (logand 1 left)) nil + (setq result (cons i result))) + (setq left (lsh left -1)) + (setq i (1+ i)))) + (if (= (length result) 1) + (car result) + (nreverse result)))) + +(defun wnn-get-string () + (let ((point (point))) + (skip-chars-forward "^\0") + (let ((c 0)) + (while (not (= (following-char) 0)) + (forward-char -1) + (accept-process-output) + (if (= c 10) (error "Count exceed")) + (setq c (1+ c)) + (skip-chars-forward "^\0"))) + (prog1 + (buffer-substring point (point)) + (forward-char 1)))) + +(defun wnn-get-string* () + (let ((point (point))) + (let ((c 0)) + (while (not (search-forward "\0\0" nil t)) + (accept-process-output) + (goto-char point) + (if (= c 10) (error "Count exceed")) + (setq c (1+ c)))) + (goto-char point) + (if (= (following-char) 0) (delete-char 1) + (forward-char 1)) + (while (< 0 (following-char)) + (forward-char 1) + (if (= (following-char) 0) (delete-char 1) + (forward-char 1))) + (prog1 + (buffer-substring point (point)) + (forward-char 1)))) + +;;; +;;; Wnn Server Command Primitives +;;; + +(defun wnn-command-start (command) + (set-buffer wnn-command-buffer) + (goto-char (point-min)) + (if (not (= (point-max) (+ wnn-command-tail-position 1024))) + (error "wnn command start error")) + (delete-region (point-min) wnn-command-tail-position) + (wnn-put-4byte command)) + +(defun wnn-command-reset () + (save-excursion + (progn + ;;; for Nemacs 3.0 and later + (if (fboundp 'set-process-kanji-code) + (set-process-kanji-code wnn-server-process 0)) + (set-buffer wnn-command-buffer) + (setq kanji-flag nil) + (setq kanji-fileio-code 0) ;;; for Nemacs 2.1 + (buffer-flush-undo wnn-command-buffer) + (erase-buffer) + (setq wnn-command-tail-position (point-min)) + (let ((max 1024) (i 0)) + (while (< i max) + (insert 0) + (setq i (1+ i))))))) + +(defun wnn-command-end () + (set-buffer wnn-server-buffer) + (erase-buffer) + (set-buffer wnn-command-buffer) + (setq wnn-command-tail-position (point)) + (process-send-region wnn-server-process (point-min) + (+ (point-min) (lsh (1+ (lsh (- (point) (point-min)) -10)) 10))) + ) + +;;; +;;; Wnn Server Reply primitives +;;; + +(defun wnn-get-result () + (set-buffer wnn-server-buffer) + (condition-case () + (accept-process-output wnn-server-process) + (error nil)) + (goto-char (point-min))) + +(defun wnn-get-return-code () + (setq wnn-return-code (wnn-get-4byte)) + (setq wnn-error-code (if (= wnn-return-code -1) + (wnn-error-symbol (wnn-get-4byte)) + nil)) + (if wnn-error-code nil + wnn-return-code)) + +;;; +;;; Wnn Server Interface: wnn-server-open +;;; + +(defvar *wnn-server-max-kana-string-length* 1000) +(defvar *wnn-server-max-bunsetu-suu* 1000) + +(defvar *wnn-service-name* "wnn") + +(defun wnn-server-open (server-host-name login-name) + (if (wnn-server-active-p) t + (let ((kana_len *wnn-server-max-kana-string-length*) + (klist_len *wnn-server-max-bunsetu-suu*) + (jserver_name + (if (or (null server-host-name) + (equal server-host-name "") + (equal server-host-name "unix")) + (system-name) + server-host-name)) + (user_name + (if (or (null login-name) (equal login-name "")) + (user-login-name) + login-name)) + (host_name (system-name))) + (setq wnn-server-process + (condition-case var + (open-network-stream "Wnn V3" " [Wnn V3 Output Buffer] " + jserver_name *wnn-service-name* ) + (error + (cond((string-match "Unknown host" (car (cdr var))) + (setq wnn-error-code (list ':WNN_UNKNOWN_HOST + jserver_name))) + ((string-match "Unknown service" (car (cdr var))) + (setq wnn-error-code (list ':WNN_UNKNOWN_SERVICE + *wnn-service-name*))) + (t ;;; "Host ... not respoding" + (setq wnn-error-code ':WNN_SOCK_OPEN_FAIL))) + nil))) + (if (null wnn-server-process) nil + (setq wnn-server-buffer (get-buffer " [Wnn V3 Output Buffer] ")) + (setq wnn-command-buffer (get-buffer-create " [Wnn V3 Command Buffer] ")) + (setq wnn-result-buffer (get-buffer-create " [Wnn V3 Result Buffer] ")) + + (save-excursion + ;;; for Nemacs 3.0 + (if (fboundp 'set-process-kanji-code) + (set-process-kanji-code wnn-server-process 0)) + (progn + (set-buffer wnn-server-buffer) + (setq kanji-flag nil) + ;;; for Nemacs 2.1 + (setq kanji-fileio-code 0) + (buffer-flush-undo wnn-server-buffer) + ) + (progn + (set-buffer wnn-result-buffer) + (setq kanji-flag nil) + ;;; for Nemacs 2.1 + (setq kanji-fileio-code 0) + (buffer-flush-undo wnn-result-buffer)) + (progn + (set-buffer wnn-command-buffer) + (setq kanji-flag nil) + ;;; for Nemacs 2.1 + (setq kanji-fileio-code 0) + (buffer-flush-undo wnn-command-buffer) + (erase-buffer) + (setq wnn-command-tail-position (point-min)) + (let ((max 1024) (i 0)) + (while (< i max) + (insert 0) + (setq i (1+ i))))) + (wnn-command-start JD_OPEN_IN) + (wnn-put-4byte kana_len) + (wnn-put-4byte klist_len) + (wnn-put-string user_name) + (wnn-put-string host_name) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code)))))) + +(defun wnn-server-active-p () + (and wnn-server-process + (eq (process-status wnn-server-process) 'open))) + +(defun wnn-connection-error () + (setq wnn-error-code ':wnn-no-connection) + (setq wnn-return-code -1) + nil) + +(defun wnn-zero-arg-command (op) + (if (wnn-server-active-p) + (save-excursion + (wnn-command-start op) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code)) + (wnn-connection-error))) + +(defun wnn-server-close () + (wnn-zero-arg-command JD_CLOSE)) + +(or (fboundp 'si:kill-emacs) + (fset 'si:kill-emacs (symbol-function 'kill-emacs))) + +(defun kill-emacs (&optional arg) + (interactive "P") + (if (wnn-server-active-p) + (progn + (wnn-server-dict-save) + (message "Wnn$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?!#(B") (sit-for 0) + (wnn-server-close))) + (si:kill-emacs arg)) + +(or (fboundp 'si:do-auto-save) + (fset 'si:do-auto-save (symbol-function 'do-auto-save))) + +(defvar *wnn-do-auto-save-dict* nil) + +(defun do-auto-save (&optional nomsg) + (interactive) + (if (and *wnn-do-auto-save-dict* + (wnn-server-dict-save)) + (progn + (wnn-serve-dict-save) + (message "Wnn$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?!#(B") + (sit-for 1))) + (si:do-auto-save nomsg)) + +;;; Wnn Result Buffer's layout: +;;; +;;; { length:4 kana 0 kouhoSuu:4 kouhoNo:4 +;;; {jihoNo:4 serialNo:4 jirituGo 0 fuzokuGo 0 } ... +;;; } +;;; 0 0 0 0 + +(defun wnn-skip-length () + (goto-char (+ (point) 4))) + +(defun wnn-skip-4byte () + (goto-char (+ (point) 4))) + +(defun wnn-skip-yomi () + (skip-chars-forward "^\0") (forward-char 1)) + +(defun wnn-skip-kouho () + (goto-char (+ (point) 8)) + (skip-chars-forward "^\0") (forward-char 1) + (skip-chars-forward "^\0") (forward-char 1) + ) + +(defun wnn-forward-char (n) + (let ((i 1)) + (while (<= i n) + (if (<= 128 (following-char)) + (forward-char 2) + (forward-char 1)) + (setq i (1+ i))))) + +;;; +;;; entry function +;;; +(defun wnn-server-henkan-begin (henkan-string) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (setq wnn-henkan-string henkan-string) + (set-buffer wnn-result-buffer) + (erase-buffer) + (setq wnn-bunsetu-suu 0) + (goto-char (point-min)) + (wnn-command-start JD_BEGIN) + (wnn-put-string* henkan-string) + (wnn-command-end) + (wnn-get-result) + (wnn-henkan-recieve))))) + +;;; +;;; entry function +;;; +(defun wnn-server-henkan-quit () t) + +;;; +;;; entry function +;;; +(defun wnn-server-henkan-end (bunsetu-no) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (let (length jisho-no serial-no kouho-no p0) + (wnn-command-start JD_END) + (set-buffer wnn-result-buffer) + (goto-char (point-min)) + (let ((max (if (and (integerp bunsetu-no) + (<= 0 bunsetu-no) + (<= bunsetu-no wnn-bunsetu-suu)) + bunsetu-no + wnn-bunsetu-suu)) + (i 0)) + (while (< i max) + (setq length (wnn-get-4byte)) + (setq p0 (point)) + (wnn-skip-yomi) + (wnn-skip-4byte) ;;; kouho suu + (setq kouho-no (wnn-get-4byte)) + (let ((j 0)) + (while (< j kouho-no) + (wnn-skip-kouho) + (setq j (1+ j)))) + (setq jisho-no (wnn-get-4byte)) + (setq serial-no (wnn-get-4byte)) + (goto-char (+ p0 length)) + (set-buffer wnn-command-buffer) + (insert 0 ) + (wnn-put-4byte jisho-no) + (wnn-put-4byte serial-no) + (set-buffer wnn-result-buffer) + (setq i (1+ i))))) + (set-buffer wnn-command-buffer) + (insert 255) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun wnn-result-goto-bunsetu (bunsetu-no) + (goto-char (point-min)) + (let (length (i 0)) + (while (< i bunsetu-no) + (setq length (wnn-get-4byte)) + (goto-char (+ (point) length)) + (setq i (1+ i))))) + +;;; +;;; entry function +;;; +(defun wnn-server-henkan-kakutei (bunsetu-no jikouho-no) + (cond((not (wnn-server-active-p)) (wnn-connection-error)) + ((or (< bunsetu-no 0) (<= wnn-bunsetu-suu bunsetu-no)) + nil) + (t + (let ((inhibit-quit t)) + (save-excursion + (set-buffer wnn-result-buffer) + (let (kouho-suu) + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + (setq kouho-suu (wnn-get-4byte)) + (if (or (< jikouho-no 0) (<= kouho-suu jikouho-no)) nil + (delete-char 4) (wnn-put-4byte jikouho-no) + t))))))) + +;;; +;;; entry function +;;; +(defun wnn-server-henkan-next (bunsetu-no) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (let (p0 p1 kouho-suu length yomi0 yomi1) + (set-buffer wnn-result-buffer) + (wnn-result-goto-bunsetu bunsetu-no) + (setq length (wnn-get-4byte)) + (setq p0 (point)) + (setq p1 (+ p0 length)) + (setq yomi0 (point)) + (wnn-skip-yomi) + (setq yomi1 (point)) + (setq kouho-suu (wnn-peek-4byte)) + (cond((< 1 kouho-suu) t) + (t + (wnn-command-start JD_NEXT) + (wnn-put-4byte bunsetu-no) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code) + (if (= wnn-return-code -1) wnn-return-code + (let (jl jisho-no serial-no kanji) + (set-buffer wnn-result-buffer) + (delete-region (point) p1) + (wnn-put-4byte wnn-return-code) + (wnn-put-4byte 0) ;;; current jikouho number + (set-buffer wnn-server-buffer) + (while (not (= (setq jl (wnn-get-4byte)) -1)) + (setq jisho-no (wnn-get-4byte) + serial-no (wnn-get-4byte) + kanji (wnn-get-string*)) + (set-buffer wnn-result-buffer) + (wnn-put-4byte jisho-no) + (wnn-put-4byte serial-no) + (insert kanji 0) + (let ((p1 (point)) fuzoku) + (goto-char yomi0) + (wnn-forward-char jl) + (setq fuzoku (point)) + (goto-char p1) + (insert-buffer-substring wnn-result-buffer fuzoku yomi1)) + (set-buffer wnn-server-buffer)) + (set-buffer wnn-result-buffer) + (setq length (- (point) p0)) + (goto-char p0) (delete-char -4) + (wnn-put-4byte length)) + t)))))))) + +(defun jd_reconv (bunsetu-no new-kana) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (if (= bunsetu-no 0) (jd_begin kana) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_RECONV) + (wnn-put-4byte bunsetu-no) + (wnn-put-string* new-kana) + (wnn-command-end) + (wnn-get-result) + (wnn-henkan-recieve bunsetu-no)))))) + +;;; +;;; entry function +;;; +(defun wnn-server-bunsetu-henkou (bunsetu-no bunsetu-length) + (cond((not (wnn-server-active-p)) (wnn-connection-error)) + ((or (< bunsetu-no 0) (<= wnn-bunsetu-suu bunsetu-no)) + nil) + (t + (let ((inhibit-quit t)) + (save-excursion + (set-buffer wnn-result-buffer) + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-command-start JD_TANCONV) + (wnn-put-4byte bunsetu-no) + (wnn-put-4byte bunsetu-length) + (wnn-command-end) + (wnn-get-result) + (setq wnn-bunsetu-suu bunsetu-no) + (wnn-henkan-recieve)))))) + +(defun wnn-henkan-recieve () + (wnn-get-return-code) + (if (= wnn-return-code -1) nil + (let (p0 p1 length s-ichi jl fl jisho-no serial-no kanji fuzokugo) + (setq wnn-bunsetu-suu (+ wnn-bunsetu-suu wnn-return-code)) + (if (zerop wnn-return-code) nil + (setq s-ichi (wnn-peek-4byte)) + (set-buffer wnn-result-buffer) + (delete-region (point) (point-max)) + (setq p0 (point)) + (insert wnn-henkan-string 0 0 0 0) + (goto-char p0) + (wnn-forward-char s-ichi) + (delete-region p0 (point)) + (set-buffer wnn-server-buffer) + (while (not (= (setq s-ichi (wnn-get-4byte)) -1)) + (setq jl (wnn-get-4byte) + fl (wnn-get-4byte) + jisho-no (wnn-get-4byte) + serial-no (wnn-get-4byte) + kanji (wnn-get-string*)) + (set-buffer wnn-result-buffer) + (setq p0 (point)) + (wnn-forward-char jl) + (setq p1 (point)) + (wnn-forward-char fl) + (setq fuzokugo (buffer-substring p1 (point))) + (insert 0) ;;; yomi + (wnn-put-4byte 1) ;;; kouho suu + (wnn-put-4byte 0) ;;; current kouho number + (wnn-put-4byte jisho-no) + (wnn-put-4byte serial-no) + (insert kanji 0 fuzokugo 0) + (setq length (- (point) p0)) + (goto-char p0) (wnn-put-4byte length) + (goto-char (+ (point) length)) + (set-buffer wnn-server-buffer))))) + wnn-return-code) + +(defun wnn-bunsetu-suu () wnn-bunsetu-suu) + +(defun wnn-bunsetu-kanji (bunsetu-no &optional buffer) + (let ((savebuffer (current-buffer))) + (unwind-protect + (progn + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + + (wnn-skip-4byte) ;;; kouho-suu + (let ((i 0) (max (wnn-get-4byte))) + (while (< i max) + (wnn-skip-kouho) + (setq i (1+ i)))) + + (let ( p1 p2 p3 ) + (goto-char (+ (point) 4 4)) + (setq p1 (point)) + (skip-chars-forward "^\0") (setq p2 (point)) + (forward-char 1) (skip-chars-forward "^\0") + (setq p3 (point)) + (if (null buffer) + (concat (buffer-substring p1 p2) (buffer-substring (1+ p2) p3)) + (set-buffer buffer) + (insert-buffer-substring wnn-result-buffer p1 p2) + (insert-buffer-substring wnn-result-buffer (1+ p2) p3) + nil)))) + (set-buffer savebuffer)))) + +(defun wnn-bunsetu-kanji-length (bunsetu-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + + (wnn-skip-4byte) ;;; kouho-suu + (let ((i 0) (max (wnn-get-4byte))) + (while (< i max) + (wnn-skip-kouho) + (setq i (1+ i)))) + + (let ( p1 p3 ) + (goto-char (+ (point) 4 4)) + (setq p1 (point)) + (skip-chars-forward "^\0")(forward-char 1) (skip-chars-forward "^\0") + (setq p3 (point)) + (- p3 p1 1))))) + +(defun wnn-bunsetu-yomi-moji-suu (bunsetu-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (let ((c 0) ch) + (while (not (zerop (setq ch (following-char)))) + (if (<= 128 ch) (forward-char 2) + (forward-char 1)) + (setq c (1+ c))) + c)))) + +(defun wnn-bunsetu-yomi (bunsetu-no &optional buffer) + (let ((savebuff (current-buffer))) + (unwind-protect + (progn + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (let (p1 p2 ) + (setq p1 (point)) + (skip-chars-forward "^\0") + (if (null buffer ) (buffer-substring p1 (point)) + (setq p2 (point)) + (set-buffer buffer) + (insert-buffer-substring wnn-result-buffer p1 p2) + t)))) + (set-buffer savebuff)))) + +(defun wnn-bunsetu-yomi-equal (bunsetu-no yomi) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (looking-at yomi)))) ; 93.4.6 by T.Saneto + +(defun wnn-bunsetu-kouho-suu (bunsetu-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + (wnn-get-4byte)))) + +(defun wnn-bunsetu-kouho-list (bunsetu-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + (let ((max (wnn-get-4byte)) (i 0) (result nil) p0 p1) + (wnn-skip-4byte) ;;; current kouhou number + (while (< i max) + (wnn-skip-4byte) (wnn-skip-4byte) + (setq p0 (point)) + (skip-chars-forward "^\0") + (setq p1 (point)) + (forward-char 1) + (skip-chars-forward "^\0") + (setq result + (cons (concat (buffer-substring p0 p1) + (buffer-substring (1+ p1) (point))) + result)) + (forward-char 1) + (setq i (1+ i))) + (nreverse result))))) + +(defun wnn-bunsetu-kouho-number (bunsetu-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (wnn-skip-yomi) + (wnn-skip-4byte) + (wnn-get-4byte))) + ) + +(defun wnn-bunsetu-kouho-kanji (bunsetu-no kouho-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) (wnn-skip-yomi) + (let ((kouho-suu (wnn-get-4byte))) + (if (or (< kouho-no 0) (<= kouho-suu kouho-no)) + nil + (wnn-skip-4byte) ;;; current kouho number + (let ((i 0)) + (while (< i kouho-no) + (wnn-skip-kouho) + (setq i (1+ i)))) + (let ( p1 p2 p3 ) + (goto-char (+ (point) 4 4)) + (setq p1 (point)) + (skip-chars-forward "^\0") (setq p2 (point)) + (forward-char 1) (skip-chars-forward "^\0") + (setq p3 (point)) + (concat (buffer-substring p1 p2) (buffer-substring (1+ p2) p3)))))))) + +(defun wnn-bunsetu-kouho-inspect (bunsetu-no kouho-no) + (save-excursion + (set-buffer wnn-result-buffer) + (if (or (< bunsetu-no 0) + (<= wnn-bunsetu-suu bunsetu-no)) + nil + (let (p0 p1 kouho-suu jiritugo fuzokugo yomi jishono serial ) + (wnn-result-goto-bunsetu bunsetu-no) + (wnn-skip-length) + (setq p0 (point)) + (wnn-skip-yomi) + (setq p1 (1- (point))) + (setq kouho-suu (wnn-get-4byte)) + (if (or (< kouho-no 0) (<= kouho-suu kouho-no)) + nil + (wnn-skip-4byte) ;;; current kouho number + (let ((i 0)) + (while (< i kouho-no) + (wnn-skip-kouho) + (setq i (1+ i)))) + (setq jishono (wnn-get-4byte)) + (setq serial (wnn-get-4byte)) + (setq jiritugo (wnn-get-string)) + (setq fuzokugo (wnn-get-string)) + (goto-char p1) + (if (not (equal "" fuzokugo)) (search-backward fuzokugo p0)) + (setq yomi (buffer-substring p0 (point))) + (list jiritugo fuzokugo yomi jishono serial)))))) + +(defun wnn-simple-command (op arg) + (if (wnn-server-active-p) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start op) + (wnn-put-4byte arg) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))) + (wnn-connection-error))) + +(defun jd_udp (dict-no) + (wnn-simpale-command JD_UDP dict-no)) + +(defun wnn-server-set-current-dict (dict-no) + (wnn-simple-command JD_UDCHG dict-no)) + +(defun wnn-server-dict-save () + (wnn-zero-arg-command JD_FREQSV)) + +(defun wnn-server-use-dict (dict-file-name hindo-file-name priority readonly-flag) + (if (not (wnn-server-active-p))(wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_DICADD) + (wnn-put-string dict-file-name) + (wnn-put-string hindo-file-name) + (wnn-put-4byte priority) + (wnn-put-4byte (if readonly-flag 1 0)) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun jd_dicdel (dict-no) + (wnn-simple-command JD_DICDEL dict-no)) + +(defun jd_dicinfo () + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_DICINFO) + (wnn-command-end) + (wnn-get-result) + (let ((dic-no 0) (result nil)) + (while (not (= (setq dic-no (wnn-get-4byte)) -1)) + (setq result + (cons (list + dic-no + (wnn-get-4byte) ;;; ttl_hindo + (wnn-get-4byte) ;;; dic_type + (wnn-get-4byte) ;;; udp + (wnn-get-4byte) ;;; dic_size + (wnn-get-4byte) ;;; prioritry + (wnn-get-4byte) ;;; readonly no:0 yes:1 + (wnn-get-string) ;;; dic_name + (wnn-get-string) ;;; hindo_name + ) + result)) + (nreverse result))))))) + +(defun jd_dicstat (file-name) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_DICSTAT) + (wnn-put-string file-name) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun wnn-server-dict-delete (serial-no yomi) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_WDEL) + (wnn-put-4byte serial-no) + (wnn-put-string* yomi) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun wnn-server-dict-info (yomi) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_WSCH) + (wnn-put-string* yomi) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code) + (if (= wnn-return-code -1) nil + (let ((hindo 0) bunpo jisho serial kanji (result nil)) + (while (not (= (setq hindo (wnn-get-4byte)) -1)) + (setq bunpo (wnn-get-bit-positions)) + (setq jisho (wnn-get-4byte)) + (setq serial (wnn-get-4byte)) + (setq kanji (wnn-get-string*)) + (setq result + (if (integerp bunpo) + (cons (list kanji bunpo hindo jisho serial) + result) + (append + (mapcar (function (lambda (x) + (list kanji x hindo jisho serial))) + bunpo) + result)))) + (nreverse result))))))) + +(defun wnn-server-dict-add (kanji yomi bunpo) + (if (not (wnn-server-active-p))(wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_WREG) + (wnn-put-bit-position bunpo) + (wnn-put-4byte 129) ;;; 0x81 hindo always 1 with imatukattayo bit.(jl.c) + (wnn-put-string* kanji) + (wnn-put-string* yomi) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun jd_whdel (serial-no yomi bunpo) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_WHDEL) + (wnn-put-4byte serial-no) + (wnn-put-string* yomi) + (wnn-put-4byte bunpo) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun jd_setevf (bunsetu-su p1 p2 p3 p4 p5) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_SETEVF) + (wnn-put-4byte bunsetu-su) + (wnn-put-4byte p1) + (wnn-put-4byte p2) + (wnn-put-4byte p3) + (wnn-put-4byte p4) + (wnn-put-4byte p5) + (wnn-put-4byte 0);; p6 + (wnn-put-4byte 0);; p7 + (wnn-put-4byte 0);; p8 + (wnn-put-4byte 0);; p9 + (wnn-put-4byte 0);; p10 + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun jd_getevf () + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_GETEVF) + (wnn-command-end) + (wnn-get-result) + (prog1 + (list + (wnn-get-4byte) ;;; bunsetu-su + (wnn-get-4byte) ;;; p1 + (wnn-get-4byte) ;;; p2 + (wnn-get-4byte) ;;; p3 + (wnn-get-4byte) ;;; p4 + (wnn-get-4byte) ;;; p5 + ) + (wnn-get-4byte);; p6 + (wnn-get-4byte);; p7 + (wnn-get-4byte);; p8 + (wnn-get-4byte);; p9 + (wnn-get-4byte);; p10 + ))))) + +(defun wnn-server-make-directory (dir-name) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_MKDIR) + (wnn-put-string dir-name) + (wnn-command-end) + (wnn-get-result) + (wnn-get-return-code))))) + +(defun wnn-server-file-access (file-name access-mode) + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_ACCESS) + (wnn-put-4byte access-mode) + (wnn-put-string file-name) + (wnn-command-end) + (wnn-get-result) + (setq wnn-return-code (wnn-get-4byte)) + (setq wnn-error-code nil) + wnn-return-code)))) + +(defun jd_who () + (if (not (wnn-server-active-p)) (wnn-connection-error) + (let ((inhibit-quit t)) + (save-excursion + (wnn-command-start JD_WHO) + (wnn-command-end) + (wnn-get-result) + (let ( number user host result) + (while (not (= (setq number (wnn-get-4byte)) -1)) + (setq result + (cons + (list number (wnn-get-string) (wnn-get-string)) + result))) + (nreverse result)))))) + +(defun jd_version () + (wnn-zero-arg-command JD_VERSION)) + +(defconst *wnn-error-alist* + '( + (1 :WNN_NO_EXIST + "$B%U%!%$%k$,B8:_$7$^$;$s!#(B") + (2 :WNN_NOT_USERDICT + "$B@5$7$$%f!<%6!<<-=q$G$O$"$j$^$;$s!#(B") + (3 :WNN_MALLOC_ERR + "$B%a%b%j(Balloc$B$G<:GT$7$^$7$?!#(B") + (4 :WNN_NOT_SYSTEM + "$B@5$7$$%7%9%F%`<-=q$G$O$"$j$^$;$s!#(B") + (5 :WNN_NOT_A_DICT + "$B@5$7$$<-=q$G$O$"$j$^$;$s!#(B") + (6 :WNN_FILE_NO_SPECIFIED + "$B%U%!%$%kL>$,;XDj$5$l$F$$$^$;$s!#(B") + (8 :WNN_HINDO_FILE_NOT_SPECIFIED + "$B%7%9%F%`<-=q$KBP$7$F!"IQEY%U%!%$%k$N;XDj$,$"$j$^$;$s!#(B") + (9 :WNN_JISHOTABLE_FULL + "$B<-=q%F!<%V%k$,0lGU$G$9!#(B") + (10 :WNN_HINDO_NO_MATCH + "$BIQEY%U%!%$%k$,!";XDj$5$l$?<-=q$NIQEY%U%!%$%k$G$O$"$j$^$;$s!#(B") + (11 :WNN_PARAMR + "$B%U%!%$%k$NFI$_9~$_8"8B$,$"$j$^$;$s!#(B") + (12 :WNN_HJT_FULL + "$B%0%m!<%P%kIQEY%F!<%V%k$,0lGU$G$9!#(B") + (13 :WNN_JT_FULL + "$B%0%m!<%P%k<-=q%F!<%V%k$,0lGU$G$9!#(B") + (15 :WNN_PARAMW + "$B%U%!%$%k$KBP$9$k=q$-9~$_8"8B$,$"$j$^$;$s!#(B") + (16 :WNN_OPENF_ERR + "$B%U%!%$%k$,%*!<%W%s$G$-$^$;$s!#(B") +;;; $B<-=q:o=|4X78$N%(%i!<(B + (20 :WNN_DICT_NOT_USED + "$B$=$NHV9f$N<-=q$O!";H$o$l$F$$$^$;$s!#(B") +;;; $B%f!<%6!<<-=qJQ994X78$N%(%i!<(B +;;; +;;;WNN_DICT_NOT_USED +;;; + (21 :WNN_NOT_A_USERDICT + "$B;XDj$5$l$F<-=q$O!"%f!<%6!<<-=q$G$O$"$j$^$;$s!#(B") + (22 :WNN_READONLY + "$B%j!<%I%*%s%j!<$N<-=q$O!"%+%l%s%H%f!<%6!<<-=q$K$O$G$-$^$;$s!#(B") +;;; $B<-=q%;!<%V4X78$N%(%i!<(B +;;; +;;; WNN_PARAMW +;;; WNN_OPENF_ERR +;;; $BJQ49;~$N%(%i!<(B +;;; jishobiki.c + (30 :WNN_JMT_FULL + "$B<-=q%F!<%V%k$,$"$U$l$F$$$^$9!#(B ") + + (31 :WNN_LONG_MOJIRETSU + "$BJQ49$7$h$&$H$9$kJ8;zNs$,D92a$.$^$9!#(B") + (32 :WNN_WKAREA_FULL + "$BIUB08l2r@ONN0h$,ITB-$7$F$$$^$9!#(B") + (33 :WNN_KAREA_FULL + "$B2r@ONN0h$,ITB-$7$F$$$^$9!#(B") + +;;; $BC18lEPO?;~$N%(%i!<(B + (40 :WNN_YOMI_LONG + "$BFI$_$,D92a$.$^$9!#(B") + (41 :WNN_KANJI_LONG + "$B4A;z$,D92a$.$^$9!#(B") + (42 :WNN_BAD_YOMI + "$BFI$_$KITE,Ev$JJ8;z$,4^$^$l$F$$$^$9!#(B") + (43 :WNN_NO_YOMI + "$BFI$_$ND9$5$,(B0$B$G$9!#(B") + (44 :WNN_NO_CURRENT + "$B%+%l%s%H<-=q$,B8:_$7$^$;$s!#(B") + (45 :WNN_RDONLY + "$B%j!<%I%*%s%j!<$N<-=q$KEPO?$7$h$&$H$7$^$7$?!#(B") + +;;; $BC18l:o=|;~!"IJ;l:o=|;~$N%(%i!<(B +;;; +;;;WNN_NO_CURRENT +;;;WNN_RDONLY +;;; + (50 :WNN_WORD_NO_EXIST + "$B;XDj$5$l$?C18l$,B8:_$7$^$;$s!#(B") + +;;; $B<!8uJd;~$N%(%i!<(B + (55 :WNN_JIKOUHO_TOO_MANY + "$B<!8uJd$N%(%s%H%j!<$N8D?t$,$*$*2a$.$^$9!#(B") + +;;; $B=i4|2=$N;~$N%(%i!<(B + (60 :WNN_MALLOC_INITIALIZE + "$B%a%b%j(Balloc$B$G<:GT$7$^$7$?!#(B") + +;;; $BC18l8!:w;~$N%(%i!<(B +;;; +;;;WNN_BAD_YOMI +;;;WNN_JMT_FULL +;;; + + (68 :WNN_SOME_ERROR + " $B2?$+$N%(%i!<$,5/$3$j$^$7$?!#(B") + (69 :WNN_SONOTA + "$B%P%0$,H/@8$7$F$$$kLOMM$G$9!#(B") + (70 :WNN_JSERVER_DEAD + "$B%5!<%P$,;`$s$G$$$^$9!#(B") + (71 :WNN_ALLOC_FAIL + "jd_begin$B$G(Balloc$B$K<:GT(B") + (72 :WNN_SOCK_OPEN_FAIL + "jd_begin$B$G(Bsocket$B$N(Bopen$B$K<:GT(B") + + (73 :WNN_RCV_SPACE_OVER + "$B<u?.%9%Z!<%9$+$i%G!<%?$,$O$_$@$7$?(B") + (74 :WNN_MINUS_MOJIRETSU + "$BJ8;zNs$ND9$5$N;XDj$,Ii$G$"$k(B") +;;; V3.0 + (80 :WNN_MKDIR_FAIL + " $B%G%#%l%/%H%j$r:n$jB;$J$C$?(B ") + (81 :WNN_BAD_USER + " $B%f!<%6L>$,$J$$(B ") + (82 :WNN_BAD_HOST + " $B%[%9%HL>$,$J$$(B ") + )) + +(defun wnn-error-symbol (code) + (let ((pair (assoc code *wnn-error-alist*))) + (if (null pair) + (list ':wnn-unknown-error-code code) + (car (cdr pair)))))