Mercurial > hg > xemacs-beta

comparison lisp/egg/egg-sj3-client.el @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
17 ;; You should have received a copy of the GNU EMACS GENERAL 17 ;; You should have received a copy of the GNU EMACS GENERAL
18 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING. 18 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
19 ;; If not, write to the Free Software Foundation, 675 Mass 19 ;; If not, write to the Free Software Foundation, 675 Mass
20 ;; Ave, Cambridge, MA 02139, USA. 20 ;; Ave, Cambridge, MA 02139, USA.
21 21
22 ;;; Ported to XEmacs 2-December, 1997.
23
22 ;;; 24 ;;;
23 ;;; Mule - Sj3 server interface in elisp 25 ;;; Mule - Sj3 server interface in elisp
24 ;;; 26 ;;;
25 27
26 (provide 'sj3-client) 28 (provide 'egg-sj3-client)
27 29
28 ;;;; $B=$@5%a%b!(!((B 30 ;;;; $B=$@5%a%b!(!((B
29 31
30 ;;; Aug-4-94 by K.Ishii 32 ;;; Aug-4-94 by K.Ishii
31 ;;; Bug fixed in sj3-put-kata. 33 ;;; Bug fixed in sj3-put-kata.
66 ;;; 68 ;;;
67 ;;; sj3-server-henkan-next $B$G0l3gJQ49$HJ8@aJQ49$GBh0l8uJd$,0c$C$?>l9g(B 69 ;;; sj3-server-henkan-next $B$G0l3gJQ49$HJ8@aJQ49$GBh0l8uJd$,0c$C$?>l9g(B
68 ;;; $B$K5/$3$k%P%0$N=$@5(B($B$3$l$KH<$$J8@a3X=,(B sj3-server-b-study $B$N=$@5(B) 70 ;;; $B$K5/$3$k%P%0$N=$@5(B($B$3$l$KH<$$J8@a3X=,(B sj3-server-b-study $B$N=$@5(B)
69 71
70 ;;; 72 ;;;
71 ;;; Sj3 deamon command constants 73 ;;; Sj3 daemon command constants
72 ;;; 74 ;;;
73 75
74 (defconst SJ3_OPEN 1 "$BMxMQ<TEPO?(B") 76 (defconst SJ3_OPEN 1 "$BMxMQ<TEPO?(B")
75 (defconst SJ3_CLOSE 2 "$BMxMQ<T:o=|(B") 77 (defconst SJ3_CLOSE 2 "$BMxMQ<T:o=|(B")
76 ;;; 78 ;;;
135 137
136 (defvar sj3-stdy-size nil) 138 (defvar sj3-stdy-size nil)
137 (defvar sj3-user-dict-list nil) 139 (defvar sj3-user-dict-list nil)
138 (defvar sj3-sys-dict-list nil) 140 (defvar sj3-sys-dict-list nil)
139 (defvar sj3-yomi-llist nil) 141 (defvar sj3-yomi-llist nil)
142
140 ;;; 143 ;;;
141 ;;; Put data into buffer 144 ;;; Put data into buffer
142 ;;; 145 ;;;
143 146
144 (defun sj3-put-4byte (integer) 147 (defun sj3-put-4byte (integer)
150 (defun sj3-put-string (str) 153 (defun sj3-put-string (str)
151 (insert str 0)) 154 (insert str 0))
152 155
153 (defun sj3-put-string* (str) 156 (defun sj3-put-string* (str)
154 (let ((sstr (if (= *sj3-current-server-version* 2) 157 (let ((sstr (if (= *sj3-current-server-version* 2)
155 (code-convert-string str *internal* *euc-japan*) 158 (encode-coding-string str 'euc-japan)
156 (code-convert-string str *internal* *sjis*)))) 159 (encode-coding-string str 'sjis))))
157 (insert sstr 0))) 160 (insert sstr 0)))
158 161
159 ;;; 162 ;;;
160 ;;; Get data from buffer 163 ;;; Get data from buffer
161 ;;; 164 ;;;
221 (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed"))) 224 (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed")))
222 (setq c (1+ c))) 225 (setq c (1+ c)))
223 (setq str (buffer-substring point (1- (point)))) 226 (setq str (buffer-substring point (1- (point))))
224 (delete-region point (point)) 227 (delete-region point (point))
225 (insert (if (= *sj3-current-server-version* 2) 228 (insert (if (= *sj3-current-server-version* 2)
226 (code-convert-string str *euc-japan* *internal*) 229 (decode-coding-string str 'euc-japan)
227 (code-convert-string str *sjis* *internal*)) 0))) 230 (decode-coding-string str 'sjis)) 0)))
228 231
229 (defun sj3-get-stdy () 232 (defun sj3-get-stdy ()
230 (let ((c 0) (point (point))) 233 (let ((c 0) (point (point)))
231 (while (< (point-max) (+ point sj3-stdy-size)) 234 (while (< (point-max) (+ point sj3-stdy-size))
232 (accept-process-output) 235 (accept-process-output)
249 (defun sj3-command-reset () 252 (defun sj3-command-reset ()
250 (save-excursion 253 (save-excursion
251 (progn 254 (progn
252 ;;; for Mule 255 ;;; for Mule
253 (if (fboundp 'set-process-coding-system) 256 (if (fboundp 'set-process-coding-system)
254 (set-process-coding-system sj3-server-process *noconv* *noconv*)) 257 (set-process-coding-system sj3-server-process 'binary 'binary))
255 ;;; for Nemacs 3.0 and later 258 ;;; for Nemacs 3.0 and later
256 ;; (if (fboundp 'set-process-kanji-code) 259 ;; (if (fboundp 'set-process-kanji-code)
257 ;; (set-process-kanji-code sj3-server-process 0)) 260 ;; (set-process-kanji-code sj3-server-process 0))
258 (set-buffer sj3-command-buffer) 261 (set-buffer sj3-command-buffer)
259 (setq mc-flag nil) ;;; for Mule 262 ;; (setq mc-flag nil) ;;; for Mule
260 ;; (setq kanji-flag nil) 263 ;; (setq kanji-flag nil)
261 ;; (setq kanji-fileio-code 0) ;;; for Nemacs 2.1 264 ;; (setq kanji-fileio-code 0) ;;; for Nemacs 2.1
262 (buffer-disable-undo sj3-command-buffer) 265 (buffer-disable-undo sj3-command-buffer)
263 (erase-buffer) 266 (erase-buffer)
264 (setq sj3-command-tail-position (point-min)) 267 (setq sj3-command-tail-position (point-min))
347 350
348 (save-excursion 351 (save-excursion
349 ;;; for Mule 352 ;;; for Mule
350 (if (fboundp 'set-process-coding-system) 353 (if (fboundp 'set-process-coding-system)
351 (set-process-coding-system 354 (set-process-coding-system
352 sj3-server-process *noconv* *noconv*)) 355 sj3-server-process 'binary 'binary))
353 ;;; for Nemacs 3.0 356 ;;; for Nemacs 3.0
354 ;; (if (fboundp 'set-process-kanji-code) 357 ;; (if (fboundp 'set-process-kanji-code)
355 ;; (set-process-kanji-code sj3-server-process 0)) 358 ;; (set-process-kanji-code sj3-server-process 0))
356 (progn 359 (progn
357 (set-buffer sj3-server-buffer) 360 (set-buffer sj3-server-buffer)
358 (setq mc-flag nil) ;;; for Mule 361 ;; (setq mc-flag nil) ;;; for Mule
359 ;; (setq kanji-flag nil) 362 ;; (setq kanji-flag nil)
360 ;;; for Nemacs 2.1 363 ;;; for Nemacs 2.1
361 ;; (setq kanji-fileio-code 0) 364 ;; (setq kanji-fileio-code 0)
362 (buffer-disable-undo sj3-server-buffer) 365 (buffer-disable-undo sj3-server-buffer)
363 ) 366 )
364 (progn 367 (progn
365 (set-buffer sj3-result-buffer) 368 (set-buffer sj3-result-buffer)
366 (setq mc-flag nil) ;;; for Mule 369 ;; (setq mc-flag nil) ;;; for Mule
367 ;; (setq kanji-flag nil) 370 ;; (setq kanji-flag nil)
368 ;;; for Nemacs 2.1 371 ;;; for Nemacs 2.1
369 ;; (setq kanji-fileio-code 0) 372 ;; (setq kanji-fileio-code 0)
370 (buffer-disable-undo sj3-result-buffer)) 373 (buffer-disable-undo sj3-result-buffer))
371 (progn 374 (progn
372 (set-buffer sj3-command-buffer) 375 (set-buffer sj3-command-buffer)
373 (setq mc-flag nil) ;;; for Mule 376 ;; (setq mc-flag nil) ;;; for Mule
374 ;; (setq kanji-flag nil) 377 ;; (setq kanji-flag nil)
375 ;;; for Nemacs 2.1 378 ;;; for Nemacs 2.1
376 ;; (setq kanji-fileio-code 0) 379 ;; (setq kanji-fileio-code 0)
377 (buffer-disable-undo sj3-command-buffer) 380 (buffer-disable-undo sj3-command-buffer)
378 (erase-buffer) 381 (erase-buffer)
507 (if (not (sj3-server-active-p)) (sj3-connection-error) 510 (if (not (sj3-server-active-p)) (sj3-connection-error)
508 (let ((inhibit-quit t) mb-str) 511 (let ((inhibit-quit t) mb-str)
509 (save-excursion 512 (save-excursion
510 (setq sj3-henkan-string henkan-string) 513 (setq sj3-henkan-string henkan-string)
511 (if (= *sj3-current-server-version* 2) 514 (if (= *sj3-current-server-version* 2)
512 (setq mb-str (code-convert-string henkan-string *internal* *euc-japan*)) 515 (setq mb-str (encode-coding-string henkan-string 'euc-japan))
513 (setq mb-str (code-convert-string henkan-string *internal* *sjis*)) 516 (setq mb-str (encode-coding-string henkan-string 'sjis))
514 ) 517 )
515 (set-buffer sj3-result-buffer) 518 (set-buffer sj3-result-buffer)
516 (erase-buffer) 519 (erase-buffer)
517 (setq sj3-bunsetu-suu 0) 520 (setq sj3-bunsetu-suu 0)
518 (setq sj3-yomi-llist nil) 521 (setq sj3-yomi-llist nil)
538 (let ((startp (point)) 541 (let ((startp (point))
539 (ystr (substring mb-str yp (+ yp yl))) 542 (ystr (substring mb-str yp (+ yp yl)))
540 endp) 543 endp)
541 (setq yp (+ yp yl)) 544 (setq yp (+ yp yl))
542 (if (= *sj3-current-server-version* 2) 545 (if (= *sj3-current-server-version* 2)
543 (setq yl (length (code-convert-string ystr *euc-japan* *internal*))) 546 (setq yl (length (decode-coding-string ystr 'euc-japan)))
544 (setq yl (length (code-convert-string ystr *sjis* *internal*))) 547 (setq yl (length (decode-coding-string ystr 'sjis)))
545 ) 548 )
546 (sj3-get-stdy) ;;; skip study-data 549 (sj3-get-stdy) ;;; skip study-data
547 (sj3-get-convert-string) 550 (sj3-get-convert-string)
548 (setq endp (point)) 551 (setq endp (point))
549 (set-buffer sj3-result-buffer) 552 (set-buffer sj3-result-buffer)
758 t)))))))) 761 t))))))))
759 762
760 (defun sj3-server-henkan-kouho (str) 763 (defun sj3-server-henkan-kouho (str)
761 (if (not (sj3-server-active-p)) -1 764 (if (not (sj3-server-active-p)) -1
762 (let ((mb-str (if (= *sj3-current-server-version* 2) 765 (let ((mb-str (if (= *sj3-current-server-version* 2)
763 (code-convert-string str *internal* *euc-japan*) 766 (encode-coding-string str 'euc-japan)
764 (code-convert-string str *internal* *sjis*))) 767 (encode-coding-string str 'sjis)))
765 len kouho-suu) 768 len kouho-suu)
766 (setq len (length mb-str)) 769 (setq len (length mb-str))
767 (setq kouho-suu (sj3-server-henkan-kouho-suu len mb-str)) 770 (setq kouho-suu (sj3-server-henkan-kouho-suu len mb-str))
768 (if (<= kouho-suu 0) nil 771 (if (<= kouho-suu 0) nil
769 (if (= *sj3-current-server-version* 2) 772 (if (= *sj3-current-server-version* 2)
777 (if (not (= sj3-return-code 0)) -1)) 780 (if (not (= sj3-return-code 0)) -1))
778 kouho-suu))) 781 kouho-suu)))
779 782
780 (defun sj3-put-kata (str) 783 (defun sj3-put-kata (str)
781 (setq str (copy-sequence str)) 784 (setq str (copy-sequence str))
782 (let ((i 0) (len (length str))) 785 (let ((i 0) (len (length str)) ch)
783 (while (< i len) 786 (while (< i len)
784 (if (/= (aref str i) lc-jp) 787 (setq ch (aref str i))
785 (setq i (1+ i)) 788 (aset str i
786 (if (= (aref str (1+ i)) ?\244) 789 (if (and (/= ?$B!<(B ch)
787 (aset str (1+ i) ?\245)) 790 (string-match "\\cH" (char-to-string ch)))
788 (setq i (+ i 3))))) 791 (make-char (find-charset 'japanese-jisx0208) 37
789 (insert str 0)) 792 (char-octet ch 1))
793 ch))
794 (incf i))
795 (insert str 0)))
790 796
791 (defun sj3-server-henkan-kouho-suu (yomi-length yomi) 797 (defun sj3-server-henkan-kouho-suu (yomi-length yomi)
792 (if (not (sj3-server-active-p)) -1 798 (if (not (sj3-server-active-p)) -1
793 (save-excursion 799 (save-excursion
794 (if (= *sj3-current-server-version* 2) 800 (if (= *sj3-current-server-version* 2)
844 (skip-chars-forward "^\0") 850 (skip-chars-forward "^\0")
845 (setq ll (+ len (- (point) (+ p0 4)))) 851 (setq ll (+ len (- (point) (+ p0 4))))
846 (setq p1 (+ p0 (+ length 4))) 852 (setq p1 (+ p0 (+ length 4)))
847 (setq ystr (sj3-get-yomi yp1 ll)) 853 (setq ystr (sj3-get-yomi yp1 ll))
848 (setq mb-str (if (= *sj3-current-server-version* 2) 854 (setq mb-str (if (= *sj3-current-server-version* 2)
849 (code-convert-string ystr *internal* *euc-japan*) 855 (encode-coding-string ystr 'euc-japan)
850 (code-convert-string ystr *internal* *sjis*))) 856 (encode-coding-string ystr 'sjis)))
851 (setq i (sj3-server-henkan-kouho-suu 857 (setq i (sj3-server-henkan-kouho-suu
852 (length mb-str) mb-str)) 858 (length mb-str) mb-str))
853 (set-buffer sj3-result-buffer) 859 (set-buffer sj3-result-buffer)
854 (if (= i 0) (setq ystr (sj3-get-yomi yp1 len)) 860 (if (= i 0) (setq ystr (sj3-get-yomi yp1 len))
855 (delete-region p0 p1) 861 (delete-region p0 p1)
861 sj3-bunsetu-suu))))))) 867 sj3-bunsetu-suu)))))))
862 868
863 (defun sj3-put-tanconv (str) 869 (defun sj3-put-tanconv (str)
864 (let ((point (point)) len ksuu 870 (let ((point (point)) len ksuu
865 (mb-str (if (= *sj3-current-server-version* 2) 871 (mb-str (if (= *sj3-current-server-version* 2)
866 (code-convert-string str *internal* *euc-japan*) 872 (encode-coding-string str 'euc-japan)
867 (code-convert-string str *internal* *sjis*)))) 873 (encode-coding-string str 'sjis))))
868 (setq len (length mb-str)) 874 (setq len (length mb-str))
869 (setq ksuu (sj3-server-henkan-kouho-suu len mb-str)) 875 (setq ksuu (sj3-server-henkan-kouho-suu len mb-str))
870 (if (>= ksuu 0) 876 (if (>= ksuu 0)
871 (let (offset) 877 (let (offset)
872 (set-buffer sj3-result-buffer) 878 (set-buffer sj3-result-buffer)
919 (let ((i 0) (c offset)) 925 (let ((i 0) (c offset))
920 (while (< i bunsetu-length) 926 (while (< i bunsetu-length)
921 (let ((ch (substring sj3-henkan-string c (1+ c)))) 927 (let ((ch (substring sj3-henkan-string c (1+ c))))
922 (if (string= ch "\222");;lc-jp 928 (if (string= ch "\222");;lc-jp
923 (setq c (+ 3 c)) 929 (setq c (+ 3 c))
924 (setq c (1+ c))) 930 (setq c (1+ c)))
925 (setq i (1+ i)))) 931 (setq i (1+ i))))
926 (substring sj3-henkan-string offset c))) 932 (substring sj3-henkan-string offset c)))
927 933
928 (defun sj3-bunsetu-suu () sj3-bunsetu-suu) 934 (defun sj3-bunsetu-suu () sj3-bunsetu-suu)
929 935
992 (if (or (< bunsetu-no 0) 998 (if (or (< bunsetu-no 0)
993 (<= sj3-bunsetu-suu bunsetu-no)) 999 (<= sj3-bunsetu-suu bunsetu-no))
994 nil 1000 nil
995 (sj3-result-goto-bunsetu bunsetu-no) 1001 (sj3-result-goto-bunsetu bunsetu-no)
996 (sj3-skip-length) 1002 (sj3-skip-length)
997 (let ((c 0) ch) 1003 ;; (1- (- (point-max) (point))))))
998 (while (not (zerop (setq ch (following-char)))) 1004 (let ((c 0))
999 (if (= ch lc-jp) 1005 (while (not (char-equal (int-to-char 0) (char-after)))
1000 (forward-char 3) 1006 (forward-char 1)
1001 (forward-char 1)) 1007 (setq c (1+ c)))
1002 (setq c (1+ c))) 1008 c))))
1003 c))))
1004 1009
1005 (defun sj3-yomi-point (bunsetu-no) 1010 (defun sj3-yomi-point (bunsetu-no)
1006 (let ((i 0) (len 0) point length) 1011 (let ((i 0) (len 0) point length)
1007 (goto-char (point-min)) 1012 (goto-char (point-min))
1008 (while (< i bunsetu-no) 1013 (while (< i bunsetu-no)