cgit.sxemacs.org Git - packages/blob - mule-packages/egg-its/egg-sj3-client.el

   1 ;; Sj3 server interface for Egg
   2 ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp)
   3
   4 ;; This file is part of Egg on Mule (Multilingual Environment)
   5
   6 ;; Egg is distributed in the forms of patches to GNU
   7 ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
   8 ;; LICENSE which is distributed along with GNU Emacs by the
   9 ;; Free Software Foundation.
  10
  11 ;; Egg is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied
  13 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  14 ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  15 ;; more details.
  16
  17 ;; You should have received a copy of the GNU EMACS GENERAL
  18 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  19 ;; If not, write to the Free Software Foundation, 675 Mass
  20 ;; Ave, Cambridge, MA 02139, USA.
  21
  22 ;;; Ported to XEmacs 2-December, 1997.
  23
  24 ;;;
  25 ;;; Mule - Sj3 server interface in elisp
  26 ;;;
  27
  28 (provide 'egg-sj3-client)
  29
  30 ;;;;  \e$B=$@5%a%b!(!(\e(B
  31
  32 ;;;   Aug-4-94 by K.Ishii
  33 ;;;   Bug fixed in sj3-put-kata.
  34
  35 ;;;   Apr-6-94 by N.Tanaka
  36 ;;;   Add version 2(japanese EUC) protocol
  37
  38 ;;;   Jun-16-93 by H.Shirasaki <sirasaki@rd.ecip.osaka-u.ac.jp>
  39 ;;;   In sj3-bunsetu-yomi-equal, typo fixed.
  40
  41 ;;;   Apr-6-93 by T.Saneto <sanewo@pdp.crl.sony.co.jp>
  42 ;;;   Bug fixed in sj3-bunsetu-yomi-equal.
  43
  44 ;;;   Mar-19-93 by K.Ishii
  45 ;;;   Changed sj3-server-dict-info for edit-dict
  46
  47 ;;;   Aug-6-92 by K.Ishii
  48 ;;;   \e$BF|K\8lH=Dj$K\e(B lc-jp \e$B$r;H$&$h$&$KJQ99\e(B
  49
  50 ;;;   Jul-30-92 by K.Ishii
  51 ;;;   \e$BD9$$J8>O$rJQ49$9$k$H$-$K5/$3$k\e(B "Args out of range" \e$B%(%i!<$N=$@5\e(B
  52 ;;;   \e$BEPO?$7$?F0;l$N:o=|$,$G$-$k$h$&$K\e(B sj3-server-dict-info \e$B$N=$@5\e(B
  53 ;;;   sj3serv \e$B$KEO$9%W%m%0%i%`L>$NJQ99\e(B
  54
  55 ;;;   Jun-2-92 by K.Ishii
  56 ;;;   Mule \e$BMQ$KJQ99\e(B
  57
  58 ;;;   Dec-12-91 by K.Ishii
  59 ;;;   \e$BJ8@a3X=,$,$&$^$/$G$-$J$$$3$H$,$"$k$?$a!"\e(Bsj3-result-buffer \e$B$rJQ99\e(B
  60 ;;;
  61 ;;;   sj3-get-stdy \e$B$G\e(B "Count exceed." \e$B%(%i!<$rNI$/5/$3$9$N$G:o=|\e(B
  62
  63 ;;;   Nov-26-91 by K.Ishii
  64 ;;;   sj3-server-open \e$B$G\e(B host_name \e$B$H\e(B user_name \e$B$rEO$9=gHV$N=$@5\e(B
  65 ;;;
  66 ;;;   sj3-server-henkan-next \e$B$r<B9T$7$F$h$/5/$3$k\e(B "Count exceed." \e$B$H$$$&\e(B
  67 ;;;   \e$B%P%0$N=$@5\e(B
  68 ;;;
  69 ;;;   sj3-server-henkan-next \e$B$G0l3gJQ49$HJ8@aJQ49$GBh0l8uJd$,0c$C$?>l9g\e(B
  70 ;;;   \e$B$K5/$3$k%P%0$N=$@5\e(B(\e$B$3$l$KH<$$J8@a3X=,\e(B sj3-server-b-study \e$B$N=$@5\e(B)
  71
  72 ;;;
  73 ;;;  Sj3 daemon command constants
  74 ;;;
  75
  76 (defconst SJ3_OPEN          1  "\e$BMxMQ<TEPO?\e(B")
  77 (defconst SJ3_CLOSE         2  "\e$BMxMQ<T:o=|\e(B")
  78 ;;;
  79 (defconst SJ3_DICADD       11 "\e$B<-=qDI2C\e(B")
  80 (defconst SJ3_DICDEL       12 "\e$B<-=q:o=|\e(B")
  81 ;;;
  82 (defconst SJ3_OPENSTDY     21  "\e$B3X=,%U%!%$%k%*!<%W%s\e(B")
  83 (defconst SJ3_CLOSESTDY    22  "\e$B3X=,%U%!%$%k%/%m!<%:\e(B")
  84 (defconst SJ3_STDYSIZE     23  "")
  85 ;;;
  86 (defconst SJ3_LOCK         31 "\e$B<-=q%m%C%/\e(B")
  87 (defconst SJ3_UNLOCK       32 "\e$B<-=q%"%s%m%C%/\e(B")
  88 ;;;
  89 (defconst SJ3_BEGIN        41 "\e$BJQ493+;O\e(B")
  90 (defconst SJ3_BEGIN_EUC   111 "\e$BJQ493+;O\e(B")
  91 ;;;
  92 (defconst SJ3_TANCONV      51 "\e$B:FJQ49!JJ8@a?-=L!K\e(B")
  93 (defconst SJ3_TANCONV_EUC 112 "\e$B:FJQ49!JJ8@a?-=L!K\e(B")
  94 (defconst SJ3_KOUHO        54 "\e$B8uJd\e(B")
  95 (defconst SJ3_KOUHO_EUC   115 "\e$B8uJd\e(B")
  96 (defconst SJ3_KOUHOSU      55 "\e$B8uJd?t\e(B")
  97 (defconst SJ3_KOUHOSU_EUC 116 "\e$B8uJd?t\e(B")
  98 ;;;
  99 (defconst SJ3_STDY         61 "\e$BJ8@a3X=,\e(B")
 100 (defconst SJ3_END          62 "\e$BJ8@aD93X=,\e(B")
 101 (defconst SJ3_END_EUC     117 "\e$BJ8@aD93X=,\e(B")
 102 ;;;
 103 (defconst SJ3_WREG         71 "\e$BC18lEPO?\e(B")
 104 (defconst SJ3_WREG_EUC    118 "\e$BC18lEPO?\e(B")
 105 (defconst SJ3_WDEL         72 "\e$BC18l:o=|\e(B")
 106 (defconst SJ3_WDEL_EUC    119 "\e$BC18l:o=|\e(B")
 107 ;;;
 108 (defconst SJ3_MKDIC        81 "")
 109 (defconst SJ3_MKSTDY       82 "")
 110 (defconst SJ3_MKDIR        83 "")
 111 (defconst SJ3_ACCESS       84 "")
 112 ;;;
 113 (defconst SJ3_WSCH         91 "\e$BC18l8!:w\e(B")
 114 (defconst SJ3_WSCH_EUC    120 "\e$BC18l8!:w\e(B")
 115 (defconst SJ3_WNSCH        92 "")
 116 (defconst SJ3_WNSCH_EUC   121 "")
 117 ;;;
 118 (defconst SJ3_VERSION     103 "")
 119
 120 ;;;  Sj3 server version error
 121 (defconst SJ3_DifferentVersion 11 "")
 122 (defvar *sj3-current-server-version* nil)
 123
 124 (defvar sj3-server-buffer nil  "Buffer associated with Sj3 server process.")
 125
 126 (defvar sj3-server-process nil  "Sj3 Kana Kanji hankan process.")
 127
 128 (defvar sj3-command-tail-position nil)
 129 (defvar sj3-command-buffer nil)
 130
 131 (defvar sj3-result-buffer nil)
 132 (defvar sj3-henkan-string nil)
 133 (defvar sj3-bunsetu-suu   nil)
 134
 135 (defvar sj3-return-code nil)
 136 (defvar sj3-error-code nil)
 137
 138 (defvar sj3-stdy-size nil)
 139 (defvar sj3-user-dict-list nil)
 140 (defvar sj3-sys-dict-list nil)
 141 (defvar sj3-yomi-llist nil)
 142
 143 ;;;
 144 ;;;  Put data into buffer
 145 ;;;
 146
 147 (defun sj3-put-4byte (integer)
 148   (insert (logand 255 (ash integer -24))
 149           (logand 255 (ash integer -16))
 150           (logand 255 (ash integer -8))
 151           (logand 255 (ash integer 0)) ))
 152
 153 (defun sj3-put-string (str)
 154   (insert str 0))
 155
 156 (defun sj3-put-string* (str)
 157   (let ((sstr (if (= *sj3-current-server-version* 2)
 158                   (encode-coding-string str 'euc-japan)
 159                 (encode-coding-string str 'shift_jis))))
 160     (insert sstr 0)))
 161
 162 ;;;
 163 ;;; Get data from buffer
 164 ;;;
 165
 166 (defun sj3-get-4byte ()
 167
 168   (let ((c 0) (point (point)))
 169     ;;;(goto-char (point-min))
 170     (while (< (point-max) (+ point 4))
 171       (accept-process-output)
 172       ;;(if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed.")))
 173       (setq c (1+ c)))
 174     (goto-char point))
 175
 176   (let ((point (point)))
 177     (if (not (or (and (= (char-after point) 0)
 178                       (< (char-after (+ point 1)) 128))
 179                  (and (= (char-after point) 255)
 180                       (<= 128 (char-after (+ point 1))))))
 181         (error "sj3-get-4byte: integer range overflow."))
 182     (prog1
 183         (logior
 184          (lsh (char-after point)       24)
 185          (lsh (char-after (+ point 1)) 16)
 186          (lsh (char-after (+ point 2))  8)
 187          (lsh (char-after (+ point 3))  0))
 188       (goto-char (+ (point) 4)))))
 189
 190 (defun sj3-get-byte ()
 191   (let ((c 0) (point (point)))
 192     (while (< (point-max) (1+ point))
 193       (accept-process-output)
 194       ;;(if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed.")))
 195       (setq c (1+ c)))
 196     (goto-char point)
 197     (prog1
 198         (lsh (char-after point) 0)
 199       (forward-char 1))))
 200
 201 (defun sj3-get-string ()
 202   (let ((point (point)))
 203     (skip-chars-forward "^\0")
 204     (let ((c 0))
 205       (while (eobp)
 206         (accept-process-output)
 207         ;;(if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed")))
 208         (setq c (1+ c))
 209         (skip-chars-forward "^\0")))
 210     (prog1
 211         (buffer-substring point (point))
 212       (forward-char 1))))
 213
 214 (defun sj3-get-string* ()
 215   (let ((point (point)))
 216     (sj3-get-convert-string)
 217     (buffer-substring point (1- (point)))))
 218
 219 (defun sj3-get-convert-string ()
 220   (let ((point (point)) (c 0) str)
 221     (while (not (search-forward "\0" nil t))
 222       (accept-process-output)
 223       (goto-char point)
 224       ;;(if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed")))
 225       (setq c (1+ c)))
 226     (setq str (buffer-substring point (1- (point))))
 227     (delete-region point (point))
 228     (insert (if (= *sj3-current-server-version* 2)
 229                 (decode-coding-string str 'euc-japan)
 230               (decode-coding-string str 'shift_jis)) 0)))
 231
 232 (defun sj3-get-stdy ()
 233   (let ((c 0) (point (point)))
 234     (while (< (point-max) (+ point sj3-stdy-size))
 235       (accept-process-output)
 236       ;;(if (>= c 10) (progn (sit-for 0) (setq c 0))) ;;; delete error
 237       (setq c (1+ c)))
 238     (goto-char (+ point sj3-stdy-size))))
 239
 240 ;;;
 241 ;;; Sj3 Server Command Primitives
 242 ;;;
 243
 244 (defun sj3-command-start (command)
 245   (set-buffer sj3-command-buffer)
 246   (goto-char (point-min))
 247   (if (not (= (point-max) (+ sj3-command-tail-position 1024)))
 248       (error "sj3 command start error"))
 249   (delete-region (point-min) sj3-command-tail-position)
 250   (sj3-put-4byte command))
 251
 252 (defun sj3-command-reset ()
 253   (save-excursion
 254     (progn
 255       ;;; for Mule
 256       (if (fboundp 'set-process-coding-system)
 257           (set-process-coding-system sj3-server-process 'binary 'binary))
 258       ;;; for Nemacs 3.0 and later
 259 ;;      (if (fboundp 'set-process-kanji-code)
 260 ;;         (set-process-kanji-code sj3-server-process 0))
 261       (set-buffer sj3-command-buffer)
 262       ;; (setq mc-flag nil)   ;;; for Mule
 263 ;;      (setq kanji-flag nil)
 264 ;;      (setq kanji-fileio-code 0)   ;;; for Nemacs 2.1
 265       (buffer-disable-undo sj3-command-buffer)
 266       (erase-buffer)
 267       (setq sj3-command-tail-position (point-min))
 268       (let ((max 1024) (i 0))
 269         (while (< i max)
 270           (insert 0)
 271           (setq i (1+ i)))))))
 272
 273 (defun sj3-command-end ()
 274   (set-buffer sj3-server-buffer)
 275   (erase-buffer)
 276   (set-buffer sj3-command-buffer)
 277   (setq sj3-command-tail-position (point))
 278 ;;  (process-send-region sj3-server-process (point-min)
 279 ;;             (+ (point-min) (lsh (1+ (lsh (- (point) (point-min)) -10)) 10)))
 280   (process-send-region sj3-server-process (point-min) (1+ (point)))
 281   )
 282
 283 ;;;
 284 ;;; Sj3 Server Reply primitives
 285 ;;;
 286
 287 (defun sj3-get-result ()
 288   (set-buffer sj3-server-buffer)
 289   (condition-case ()
 290       (let ((focus-follows-mouse t))
 291         (accept-process-output sj3-server-process))
 292     (error nil))
 293   (goto-char (point-min)))
 294
 295 (defun sj3-get-return-code ()
 296   (setq sj3-return-code (sj3-get-4byte))
 297   (setq sj3-error-code  (if (= sj3-return-code 0) nil
 298                           (sj3-error-symbol sj3-return-code)))
 299   (if sj3-error-code nil
 300     sj3-return-code))
 301
 302 ;;;
 303 ;;; Sj3 Server Interface:  sj3-server-open
 304 ;;;
 305
 306 ;(defvar *sj3-server-max-kana-string-length* 1000)
 307 ;(defvar *sj3-server-max-bunsetu-suu* 1000)
 308
 309 (defvar *sj3-server-version* 2)
 310 (setq *sj3-server-version* 2)
 311 (defvar *sj3-program-name* "sj3-egg-m")
 312 (defvar *sj3-service-name* "sj3")
 313
 314 (defun sj3-server-open (server-host-name login-name)
 315   (if (sj3-server-active-p) t
 316      (let ((server_version *sj3-server-version*)
 317            (sj3serv_name
 318            (if (or (null  server-host-name)
 319                    (equal server-host-name "")
 320                    (equal server-host-name "unix"))
 321                (system-name)
 322              server-host-name))
 323           (user_name
 324            (if (or (null login-name) (equal login-name ""))
 325                (user-login-name)
 326              login-name))
 327           (host_name (system-name))
 328           (program_name
 329            (format "%d.%s"
 330                   (string-to-int (substring (make-temp-name "") 1 6))
 331                   *sj3-program-name*)))
 332       (setq sj3-server-process
 333             (condition-case var
 334                 (open-network-stream "Sj3" " [Sj3 Output Buffer] "
 335                                      sj3serv_name *sj3-service-name* )
 336               (error
 337                 (cond((string-match "Unknown host" (car (cdr var)))
 338                       (setq sj3-error-code (list ':SJ3_UNKNOWN_HOST
 339                                                  sj3serv_name)))
 340                      ((string-match "Unknown service" (car (cdr var)))
 341                       (setq sj3-error-code (list ':SJ3_UNKNOWN_SERVICE
 342                                                  *sj3-service-name*)))
 343                      (t ;;; "Host ... not respoding"
 344                       (setq sj3-error-code ':SJ3_SOCK_OPEN_FAIL)))
 345                      nil)))
 346       (if (null sj3-server-process) nil
 347         (process-kill-without-query sj3-server-process)
 348         (setq sj3-server-buffer (get-buffer " [Sj3 Output Buffer] "))
 349         (setq sj3-command-buffer (get-buffer-create " [Sj3 Command Buffer] "))
 350         (setq sj3-result-buffer (get-buffer-create " [Sj3 Result Buffer] "))
 351
 352         (save-excursion
 353           ;;; for Mule
 354           (if (fboundp 'set-process-coding-system)
 355               (set-process-coding-system
 356                sj3-server-process 'binary 'binary))
 357           ;;; for Nemacs 3.0
 358 ;;        (if (fboundp 'set-process-kanji-code)
 359 ;;            (set-process-kanji-code sj3-server-process 0))
 360           (progn
 361             (set-buffer sj3-server-buffer)
 362 ;;          (setq mc-flag nil)   ;;; for Mule
 363 ;;          (setq kanji-flag nil)
 364             ;;; for Nemacs 2.1
 365 ;;          (setq kanji-fileio-code 0)
 366             (buffer-disable-undo sj3-server-buffer)
 367             )
 368           (progn
 369             (set-buffer sj3-result-buffer)
 370             ;; (setq mc-flag nil)   ;;; for Mule
 371 ;;          (setq kanji-flag nil)
 372             ;;; for Nemacs 2.1
 373 ;;          (setq kanji-fileio-code 0)
 374             (buffer-disable-undo sj3-result-buffer))
 375           (progn
 376             (set-buffer sj3-command-buffer)
 377 ;;          (setq mc-flag nil)   ;;; for Mule
 378 ;;          (setq kanji-flag nil)
 379             ;;; for Nemacs 2.1
 380 ;;          (setq kanji-fileio-code 0)
 381             (buffer-disable-undo sj3-command-buffer)
 382             (erase-buffer)
 383             (setq sj3-command-tail-position (point-min))
 384             (let ((max 1024) (i 0))
 385               (while (< i max)
 386                 (insert 0)
 387                 (setq i (1+ i)))))
 388           (sj3-clear-dict-list)
 389           (sj3-command-start SJ3_OPEN)
 390           (sj3-put-4byte server_version)
 391           (sj3-put-string host_name)
 392           (sj3-put-string user_name)
 393           (sj3-put-string program_name)
 394           (sj3-command-end)
 395           (sj3-get-result)
 396           (sj3-get-return-code)
 397           (if (= sj3-return-code SJ3_DifferentVersion)
 398               (progn (sj3-command-start SJ3_OPEN)
 399                      (sj3-put-4byte 1)
 400                      (sj3-put-string host_name)
 401                      (sj3-put-string user_name)
 402                      (sj3-put-string program_name)
 403                      (sj3-command-end)
 404                      (sj3-get-result)
 405                      (sj3-get-return-code)
 406                      (if (not (= sj3-return-code 0))
 407                          (sj3-connection-error)
 408                        nil)
 409                      )
 410             nil)
 411           (if (or (= sj3-return-code 0) (> -1 sj3-return-code))
 412               (progn  (setq *sj3-current-server-version* 1)
 413                       (if (not (= sj3-return-code 0))
 414                           (setq *sj3-current-server-version* (- 0 sj3-return-code))
 415                         nil)
 416                       (sj3-get-stdy-size)
 417                       )
 418             nil)
 419           )))))
 420
 421 (defun sj3-server-active-p ()
 422   (and sj3-server-process
 423        (eq (process-status sj3-server-process) 'open)))
 424
 425 (defun sj3-connection-error ()
 426   (setq sj3-error-code ':sj3-no-connection)
 427   (setq sj3-return-code -1)
 428   nil)
 429
 430 (defun sj3-zero-arg-command (op)
 431   (if (sj3-server-active-p)
 432       (progn
 433         (sj3-command-start op)
 434         (sj3-command-end)
 435         (sj3-get-result)
 436         (sj3-get-return-code))
 437     (sj3-connection-error)))
 438
 439 (defun sj3-server-close ()
 440   (let (dict-no)
 441     (while (and (sj3-server-active-p) (setq dict-no (car sj3-sys-dict-list)))
 442       (sj3-server-close-dict dict-no)
 443       (setq sj3-sys-dict-list (cdr sj3-sys-dict-list)))
 444     (while (and (sj3-server-active-p) (setq dict-no (car sj3-user-dict-list)))
 445       (sj3-server-close-dict dict-no)
 446       (setq sj3-user-dict-list (cdr sj3-user-dict-list)))
 447     (sj3-clear-dict-list))
 448   (sj3-server-close-stdy)
 449   (sj3-zero-arg-command SJ3_CLOSE)
 450   (if (sj3-server-active-p)
 451       (delete-process sj3-server-process))
 452   (if sj3-server-buffer
 453       (kill-buffer sj3-server-buffer))
 454   (if sj3-command-buffer
 455       (kill-buffer sj3-command-buffer))
 456   (if sj3-result-buffer
 457       (kill-buffer sj3-result-buffer))
 458   (setq sj3-server-process nil)
 459   (setq sj3-server-buffer nil)
 460   (setq sj3-command-buffer nil)
 461   (setq sj3-result-buffer nil))
 462
 463 (defun sj3-clear-dict-list ()
 464   (setq sj3-sys-dict-list nil)
 465   (setq sj3-user-dict-list nil))
 466
 467 (or (fboundp 'si:kill-emacs)
 468     (fset 'si:kill-emacs (symbol-function 'kill-emacs)))
 469
 470 (defun kill-emacs (&optional arg)
 471   (interactive "P")
 472   (if (sj3-server-active-p)
 473       (progn
 474         (sj3-server-close)))
 475   (si:kill-emacs arg))
 476
 477 (defun sj3-get-stdy-size ()
 478   (sj3-zero-arg-command SJ3_STDYSIZE)
 479   (if (not (= sj3-return-code 0)) nil
 480       (setq sj3-stdy-size (sj3-get-4byte))))
 481
 482 (defun sj3-put-stdy-dmy ()
 483   (let ((i 0))
 484     (while (< i sj3-stdy-size)
 485       (insert 0)
 486       (setq i (1+ i)))))
 487
 488 ;;; Sj3 Result Buffer's layout:
 489 ;;;
 490 ;;; { length:4  kana 0 kouhoSuu:4 kouhoNo:4
 491 ;;;   {studyData kanji 0 } ...
 492 ;;; }
 493 ;;;   0 0 0 0
 494
 495 (defun sj3-skip-length ()
 496   (goto-char (+ (point) 4)))
 497
 498 (defun sj3-skip-4byte ()
 499   (goto-char (+ (point) 4)))
 500
 501 (defun sj3-skip-yomi ()
 502   (skip-chars-forward "^\0") (forward-char 1))
 503
 504 (defun sj3-skip-stdy ()
 505   (goto-char (+ (point) sj3-stdy-size)))
 506
 507 ;;;
 508 ;;; entry function
 509 ;;;
 510 (defun sj3-server-henkan-begin (henkan-string)
 511   (if (not (sj3-server-active-p)) (sj3-connection-error)
 512     (let ((inhibit-quit t) mb-str)
 513       (save-excursion
 514         (setq sj3-henkan-string henkan-string)
 515         (if (= *sj3-current-server-version* 2)
 516             (setq mb-str (encode-coding-string henkan-string 'euc-japan))
 517             (setq mb-str (encode-coding-string henkan-string 'shift_jis))
 518         )
 519         (set-buffer sj3-result-buffer)
 520         (erase-buffer)
 521         (setq sj3-bunsetu-suu 0)
 522         (setq sj3-yomi-llist nil)
 523         (goto-char (point-min))
 524         (if (= *sj3-current-server-version* 2)
 525             (sj3-command-start SJ3_BEGIN_EUC)
 526           (sj3-command-start SJ3_BEGIN)
 527         )
 528         (sj3-put-string mb-str)
 529         (sj3-command-end)
 530         (sj3-get-result)
 531         (sj3-get-return-code)
 532         (if (not (= sj3-return-code 0)) nil
 533           (let ((yp 0) p0 yl offset)
 534             (sj3-get-4byte)
 535             (set-buffer sj3-result-buffer)
 536             (delete-region (point) (point-max))
 537             (setq p0 (point))
 538             (insert sj3-henkan-string 0 0 0 0)
 539             (goto-char p0)
 540             (set-buffer sj3-server-buffer)
 541             (while (> (setq yl (sj3-get-byte)) 0)
 542               (let ((startp (point))
 543                     (ystr (substring mb-str yp (+ yp yl)))
 544                     endp)
 545                 (setq yp (+ yp yl))
 546                 (if (= *sj3-current-server-version* 2)
 547                     (setq yl (length (decode-coding-string ystr 'euc-japan)))
 548                   (setq yl (length (decode-coding-string ystr 'shift_jis)))
 549                 )
 550                 (sj3-get-stdy) ;;; skip study-data
 551                 (sj3-get-convert-string)
 552                 (setq endp (point))
 553                 (set-buffer sj3-result-buffer)
 554                 (setq p0 (point))
 555                 (forward-char yl)
 556                 (setq sj3-yomi-llist (append sj3-yomi-llist (list yl)))
 557                 (insert 0)  ;;; yomi
 558                 (sj3-put-4byte 1) ;;; kouho suu
 559                 (sj3-put-4byte 0) ;;; current kouho number
 560                 (insert-buffer-substring sj3-server-buffer startp endp)
 561                                   ;;; insert study data and kanji strings
 562                 (setq offset (- (point) p0))
 563                 (goto-char p0) (sj3-put-4byte offset)
 564                 (goto-char (+ (point) offset))
 565                 (setq sj3-return-code (1+ sj3-return-code))
 566                 (set-buffer sj3-server-buffer)))
 567             (setq sj3-bunsetu-suu sj3-return-code)))))))
 568 ;;;
 569 ;;; entry function
 570 ;;;
 571 (defun sj3-server-henkan-quit () t)
 572
 573 (defun sj3-get-yomi-suu-org ()
 574   (if (setq sj3-yomi-llist (cdr sj3-yomi-llist))
 575       (car sj3-yomi-llist)
 576     0))
 577
 578 ;;;
 579 ;;; entry function
 580 ;;;
 581 (defun sj3-server-henkan-end (bunsetu-no)
 582   (if (not (sj3-server-active-p)) (sj3-connection-error)
 583     (let ((inhibit-quit t))
 584       (save-excursion
 585         (let (length ystr len kouho-no kouho-suu p0 (ylist nil))
 586           (set-buffer sj3-result-buffer)
 587           (goto-char (point-min))
 588           (let ((max (if (and (integerp bunsetu-no)
 589                               (<= 0 bunsetu-no)
 590                               (<= bunsetu-no sj3-bunsetu-suu))
 591                          bunsetu-no
 592                        sj3-bunsetu-suu))
 593                 (i 0))
 594             (while (< i max)
 595               (setq length (sj3-get-4byte))
 596               (setq p0 (point))
 597               (setq ystr (sj3-get-string))
 598               (setq len (1- (- (point) p0)))
 599               (setq kouho-suu (sj3-get-4byte)) ;;; kouho suu
 600               (setq kouho-no (sj3-get-4byte))
 601               (if (and (> kouho-no 0)
 602                        (< kouho-no (- kouho-suu 2))
 603                        (> kouho-suu 3))
 604                   (sj3-server-b-study kouho-no))
 605               (setq ylist (cons (list len ystr kouho-suu (point)) ylist))
 606               (goto-char (+ p0 length))
 607               (setq i (1+ i)))
 608             (setq ylist (nreverse ylist))
 609             (setq i 1)
 610             (let ((yp 0) (op 0) (ydata (car ylist)) (ol (car sj3-yomi-llist)))
 611               (while (< i max)
 612                 (let ((yl (nth 0 ydata)))
 613                   (setq ylist (cdr ylist))
 614                   (if (and (= yp op) (= yl ol))
 615                       (let ((pp (+ yp yl)))
 616                         (setq yp pp)
 617                         (setq op pp)
 618                         (setq ydata (car ylist))
 619                         (setq ol (sj3-get-yomi-suu-org)))
 620                     (let ((str (nth 1 ydata))
 621                           (ent (nth 2 ydata)))
 622                       (setq ydata (car ylist))
 623                       (setq yp (+ yp yl))
 624                       (while (< op yp)
 625                         (setq op (+ op ol))
 626                         (setq ol (sj3-get-yomi-suu-org)))
 627                       (if (or (= ent 2) (= (nth 2 ydata) 2)) nil
 628                         (let ((sub (- op yp)) (yl1 (nth 0 ydata)))
 629                           (set-buffer sj3-result-buffer)
 630                           (goto-char (nth 3 ydata))
 631                           (sj3-server-cl-study str (nth 1 ydata))
 632                           (if (and (not (= sub yl1)) (not (= sub (- yl1 ol))))
 633                               nil
 634                             (setq i (1+ i))
 635                             (setq ylist (cdr ylist))
 636                             (setq ydata (car ylist))
 637                             (if (= sub yl1) nil
 638                               (setq op (+ op ol))
 639                               (setq ol (sj3-get-yomi-suu-org))))))))
 640                       (setq i (1+ i))))
 641             (if (or (null ydata) (= (nth 0 ydata) ol) (= (nth 2 ydata) 2))
 642                 sj3-return-code
 643               (goto-char (nth 3 ydata))
 644               (sj3-server-cl-study (nth 1 ydata) "")))))))))
 645
 646 (defun sj3-server-cl-study (str1 str2)
 647   (if (not (sj3-server-active-p)) (sj3-connection-error)
 648     (save-excursion
 649       (if (= *sj3-current-server-version* 2)
 650           (sj3-command-start SJ3_END_EUC)
 651         (sj3-command-start SJ3_END))
 652       (sj3-put-string* str1)
 653       (sj3-put-string* str2)
 654       (if (string= str2 "") (sj3-put-stdy-dmy)
 655         (let (p0)
 656           (set-buffer sj3-result-buffer)
 657           (setq p0 (point))
 658           (set-buffer sj3-command-buffer)
 659           (insert-buffer-substring sj3-result-buffer p0 (+ p0 sj3-stdy-size))))
 660       (sj3-command-end)
 661       (sj3-get-result)
 662       (sj3-get-return-code))))
 663
 664 (defun sj3-server-b-study (no)
 665   (if (not (sj3-server-active-p)) (sj3-connection-error)
 666     (save-excursion
 667       (let ((i 0) p0)
 668         (set-buffer sj3-result-buffer)
 669         (while (< i no)
 670           (sj3-skip-stdy)
 671           (sj3-skip-yomi)
 672           (setq i (1+ i)))
 673         (setq p0 (point))
 674         (sj3-command-start SJ3_STDY)
 675         (insert-buffer-substring sj3-result-buffer p0 (+ p0 sj3-stdy-size))
 676         (sj3-command-end)
 677         (sj3-get-result)
 678         (sj3-get-return-code)))))
 679
 680 (defun sj3-result-goto-bunsetu (bunsetu-no)
 681   (goto-char (point-min))
 682   (let (length (i 0))
 683     (while (< i bunsetu-no)
 684       (setq length (sj3-get-4byte))
 685       (goto-char (+ (point) length))
 686       (setq i (1+ i)))))
 687
 688 ;;;
 689 ;;; entry function
 690 ;;;
 691 (defun sj3-server-henkan-kakutei (bunsetu-no jikouho-no)
 692   (cond((not (sj3-server-active-p)) (sj3-connection-error))
 693        ((or (< bunsetu-no 0) (<= sj3-bunsetu-suu bunsetu-no))
 694         nil)
 695        (t
 696         (let ((inhibit-quit t))
 697           (save-excursion
 698             (set-buffer sj3-result-buffer)
 699             (let (kouho-suu)
 700               (sj3-result-goto-bunsetu bunsetu-no)
 701               (sj3-skip-length)
 702               (sj3-skip-yomi)
 703               (setq kouho-suu (sj3-get-4byte))
 704               (if (or (< jikouho-no 0) (<= kouho-suu jikouho-no)) nil
 705                 (delete-char 4) (sj3-put-4byte jikouho-no)
 706                 t)))))))
 707
 708 ;;;
 709 ;;; entry function
 710 ;;;
 711 (defun sj3-server-henkan-next (bunsetu-no)
 712   (if (not (sj3-server-active-p)) (sj3-connection-error)
 713     (let ((inhibit-quit t))
 714       (save-excursion
 715         (let (p0 p1 kouho-suu length ystr)
 716           (set-buffer sj3-result-buffer)
 717           (sj3-result-goto-bunsetu bunsetu-no)
 718           (sj3-skip-length)
 719           (setq p0 (point))
 720           (setq ystr (sj3-get-string))
 721           (setq p1 (point))
 722           (setq kouho-suu (sj3-get-4byte))
 723           (if (> kouho-suu 1) t
 724             (let ((ksuu (sj3-server-henkan-kouho ystr)) (startp 0) endp)
 725               (if (< ksuu 0) sj3-return-code
 726                 (let (kanji)
 727                   (set-buffer sj3-result-buffer)
 728                   (sj3-skip-4byte)
 729                   (sj3-skip-stdy)
 730                   (setq kanji (sj3-get-string))
 731                   (if (> ksuu 1)
 732                       (let ((i 1))
 733                         (set-buffer sj3-server-buffer)
 734                         (sj3-get-4byte)
 735                         (setq startp (point))
 736                         (sj3-get-stdy)
 737                         (let ((kkanji (sj3-get-string*)))
 738                           (if (equal kanji kkanji)
 739                               (setq startp (point))
 740                             (setq ksuu (1+ ksuu))
 741                             (setq i (1+ i))))
 742                         (while (< i ksuu)
 743                           (sj3-get-4byte)
 744                           (delete-char -4)
 745                           (sj3-get-stdy)
 746                           (sj3-get-convert-string)
 747                           (setq i (1+ i)))
 748                         (setq endp (point))))
 749                   (set-buffer sj3-result-buffer)
 750                   (if (> startp 0)
 751                       (insert-buffer-substring sj3-server-buffer startp endp))
 752                   (sj3-put-kata ystr)
 753                   (insert ystr 0)
 754                   (setq length (- (point) p0))
 755                   (goto-char p1)
 756                   (delete-char 4)
 757                   (if (<= ksuu 0)(sj3-put-4byte 3) ;;;
 758                     (sj3-put-4byte (+ ksuu 2)))    ;;; put kouho-suu
 759                   (goto-char p0)
 760                   (delete-char -4)
 761                   (sj3-put-4byte length))
 762                 t))))))))
 763
 764 (defun sj3-server-henkan-kouho (str)
 765   (if (not (sj3-server-active-p)) -1
 766     (let ((mb-str (if (= *sj3-current-server-version* 2)
 767                       (encode-coding-string str 'euc-japan)
 768                     (encode-coding-string str 'shift_jis)))
 769           len kouho-suu)
 770       (setq len (length mb-str))
 771       (setq kouho-suu (sj3-server-henkan-kouho-suu len mb-str))
 772       (if (<= kouho-suu 0) nil
 773         (if (= *sj3-current-server-version* 2)
 774             (sj3-command-start SJ3_KOUHO_EUC)
 775           (sj3-command-start SJ3_KOUHO))
 776         (sj3-put-4byte len)
 777         (sj3-put-string mb-str)
 778         (sj3-command-end)
 779         (sj3-get-result)
 780         (sj3-get-return-code)
 781         (if (not (= sj3-return-code 0)) -1))
 782       kouho-suu)))
 783
 784 (defun sj3-put-kata (str)
 785   (setq str (copy-sequence str))
 786   (let ((i 0) (len (length str)) ch)
 787     (while (< i len)
 788       (setq ch (aref str i))
 789       (aset str i
 790             (if (and (/= ?\e$B!<\e(B ch)
 791                      (string-match "\\cH" (char-to-string ch)))
 792                 (make-char (find-charset 'japanese-jisx0208) 37
 793                            (nth 2 (split-char ch)))
 794               ch))
 795       (incf i))
 796     (insert str 0)))
 797
 798 (defun sj3-server-henkan-kouho-suu (yomi-length yomi)
 799   (if (not (sj3-server-active-p)) -1
 800     (save-excursion
 801       (if (= *sj3-current-server-version* 2)
 802           (sj3-command-start SJ3_KOUHOSU_EUC)
 803         (sj3-command-start SJ3_KOUHOSU))
 804       (sj3-put-4byte yomi-length)
 805       (sj3-put-string yomi)
 806       (sj3-command-end)
 807       (sj3-get-result)
 808       (sj3-get-return-code)
 809       (if (not (= sj3-return-code 0)) -1
 810         (sj3-get-4byte)))))
 811
 812 ;;;
 813 ;;; entry function
 814 ;;;
 815 (defun sj3-server-bunsetu-henkou (bunsetu-no bunsetu-length)
 816   (cond((not (sj3-server-active-p)) (sj3-connection-error))
 817        ((or (< bunsetu-no 0) (<= sj3-bunsetu-suu bunsetu-no))
 818         nil)
 819        (t
 820         (let ((inhibit-quit t))
 821           (save-excursion
 822             (let (yp0 p0 p1 str len1 len2 bunsetu-suu (bno bunsetu-no))
 823               (set-buffer sj3-result-buffer)
 824               (setq yp0 (sj3-yomi-point bunsetu-no))
 825               (setq p0 (point))
 826               (setq str (sj3-get-yomi* yp0 bunsetu-length))
 827               (setq len1 (length str))
 828               (setq bunsetu-suu sj3-bunsetu-suu)
 829               (let (point length)
 830                 (setq len2 len1)
 831                 (while (and (< bno sj3-bunsetu-suu) (> len2 0))
 832                   (setq length (sj3-get-4byte))
 833                   (setq point (point))
 834                   (skip-chars-forward "^\0")
 835                   (setq len2 (- len2 (- (point) point)))
 836                   (goto-char (+ point length))
 837                   (setq bno (1+ bno))))
 838               (setq p1 (point))
 839               (delete-region p0 p1)
 840               (setq sj3-bunsetu-suu (- sj3-bunsetu-suu (- bno bunsetu-no)))
 841               (if (= (sj3-put-tanconv str) 0)
 842                   (if (not (= len2 0))
 843                       (let ((len (- 0 len2)) (yp1 (+ yp0 len1))
 844                             ystr mb-str)
 845                         (if (or (> bno (1+ bunsetu-no)) (= bno bunsetu-suu))
 846                             (setq ystr (sj3-get-yomi yp1 len))
 847                           (let (ll length i)
 848                             (set-buffer sj3-result-buffer)
 849                             (setq p0 (point))
 850                             (setq length (sj3-get-4byte))
 851                             (skip-chars-forward "^\0")
 852                             (setq ll (+ len (- (point) (+ p0 4))))
 853                             (setq p1 (+ p0 (+ length 4)))
 854                             (setq ystr (sj3-get-yomi yp1 ll))
 855                             (setq mb-str (if (= *sj3-current-server-version* 2)
 856                                              (encode-coding-string ystr 'euc-japan)
 857                                            (encode-coding-string ystr 'shift_jis)))
 858                             (setq i (sj3-server-henkan-kouho-suu
 859                                      (length mb-str) mb-str))
 860                             (set-buffer sj3-result-buffer)
 861                             (if (= i 0) (setq ystr (sj3-get-yomi yp1 len))
 862                               (delete-region p0 p1)
 863                               (setq sj3-bunsetu-suu (1- sj3-bunsetu-suu))
 864                               (setq len ll))
 865                             (goto-char p0)))
 866                         (sj3-put-tanconv ystr))))
 867               (if (= sj3-return-code -1) nil
 868                 sj3-bunsetu-suu)))))))
 869
 870 (defun sj3-put-tanconv (str)
 871   (let ((point (point)) len ksuu
 872         (mb-str (if (= *sj3-current-server-version* 2)
 873                     (encode-coding-string str 'euc-japan)
 874                   (encode-coding-string str 'shift_jis))))
 875     (setq len (length mb-str))
 876     (setq ksuu (sj3-server-henkan-kouho-suu len mb-str))
 877     (if (>= ksuu 0)
 878         (let (offset)
 879           (set-buffer sj3-result-buffer)
 880           (insert str 0)
 881           (if (or (= ksuu 0)
 882                   (not (sj3-server-tanconv len mb-str)))
 883               (put-kata-and-hira str)
 884             (let (p0 p1)
 885               (set-buffer sj3-result-buffer)
 886               (sj3-put-4byte 1)
 887               (sj3-put-4byte 0)
 888               (set-buffer sj3-server-buffer)
 889               (sj3-get-4byte)
 890               (setq p0 (point))
 891               (sj3-get-stdy)
 892               (sj3-get-convert-string)
 893               (setq p1 (point))
 894               (set-buffer sj3-result-buffer)
 895               (insert-buffer-substring sj3-server-buffer p0 p1)))
 896           (set-buffer sj3-result-buffer)
 897           (setq offset (- (point) point))
 898           (goto-char point) (sj3-put-4byte offset)
 899           (goto-char (+ (point) offset))
 900           (setq sj3-bunsetu-suu (1+ sj3-bunsetu-suu))))
 901     sj3-return-code))
 902
 903 (defun sj3-server-tanconv (len str)
 904   (if (not (sj3-server-active-p)) (sj3-connection-error)
 905     (let ((inhibit-quit t))
 906       (if (= *sj3-current-server-version* 2)
 907           (sj3-command-start SJ3_TANCONV_EUC)
 908         (sj3-command-start SJ3_TANCONV))
 909       (sj3-put-4byte len)
 910       (sj3-put-string str)
 911       (sj3-command-end)
 912       (sj3-get-result)
 913       (sj3-get-return-code))))
 914
 915 (defun put-kata-and-hira (str)
 916   (sj3-put-4byte 2)
 917   (sj3-put-4byte 0)
 918   (sj3-put-stdy-dmy)
 919   (sj3-put-kata str)
 920   (insert str 0))
 921
 922 (defun sj3-get-yomi (offset length)
 923   (substring sj3-henkan-string offset (+ offset length)))
 924
 925 (defun sj3-get-yomi* (offset bunsetu-length)
 926   (let ((i 0) (c offset))
 927     (while (< i bunsetu-length)
 928         (let ((ch (substring sj3-henkan-string c (1+ c))))
 929           (if (string= ch "\222");;lc-jp
 930               (setq c (+ 3 c))
 931           (setq c (1+ c)))
 932           (setq i (1+ i))))
 933     (substring sj3-henkan-string offset c)))
 934
 935 (defun sj3-bunsetu-suu () sj3-bunsetu-suu)
 936
 937 (defun sj3-bunsetu-kanji (bunsetu-no &optional buffer)
 938   (let ((savebuffer (current-buffer)))
 939     (unwind-protect
 940         (progn
 941           (set-buffer sj3-result-buffer)
 942           (if (or (< bunsetu-no 0)
 943                   (<= sj3-bunsetu-suu bunsetu-no))
 944               nil
 945             (sj3-result-goto-bunsetu bunsetu-no)
 946             (sj3-skip-length)
 947             (sj3-skip-yomi)
 948
 949             (let ((i 0)
 950                   (rksuu (- (sj3-get-4byte) 2)) ;;; real kouho-suu
 951                   (max (sj3-get-4byte)))       ;;; kouho-number
 952               (sj3-skip-stdy)
 953               (while (< i max)
 954                 (sj3-skip-yomi)
 955                 (setq i (1+ i))
 956                 (if (< i rksuu)
 957                     (sj3-skip-stdy))))
 958
 959             (let ( p1 p2 )
 960               (setq p1 (point))
 961               (skip-chars-forward "^\0") (setq p2 (point))
 962               (forward-char 1)
 963               (if (null buffer)
 964                   (concat (buffer-substring p1 p2))
 965                 (set-buffer buffer)
 966                 (insert-buffer-substring sj3-result-buffer p1 p2)
 967                 nil))))
 968       (set-buffer savebuffer))))
 969
 970 (defun sj3-bunsetu-kanji-length (bunsetu-no)
 971   (save-excursion
 972     (set-buffer sj3-result-buffer)
 973     (if (or (< bunsetu-no 0)
 974             (<= sj3-bunsetu-suu bunsetu-no))
 975         nil
 976       (sj3-result-goto-bunsetu bunsetu-no)
 977       (sj3-skip-length)
 978       (sj3-skip-yomi)
 979
 980       (let ((i 0)
 981             (rksuu (- (sj3-get-4byte) 2)) ;;; real kouho-suu
 982             (max (sj3-get-4byte)))        ;;; kouho-number
 983         (sj3-skip-stdy)
 984         (while (< i max)
 985           (sj3-skip-yomi)
 986           (setq i (1+ i))
 987           (if (< i rksuu)
 988               (sj3-skip-stdy))))
 989
 990       (let ( p1 p3 )
 991         (setq p1 (point))
 992         (skip-chars-forward "^\0")
 993         (setq p3 (point))
 994         (- p3 p1)))))
 995
 996 (defun sj3-bunsetu-yomi-moji-suu (bunsetu-no)
 997   (save-excursion
 998     (set-buffer sj3-result-buffer)
 999     (if (or (<  bunsetu-no 0)
1000             (<= sj3-bunsetu-suu bunsetu-no))
1001         nil
1002       (sj3-result-goto-bunsetu bunsetu-no)
1003       (sj3-skip-length)
1004 ;;      (1- (- (point-max) (point))))))
1005       (let ((c 0))
1006         (while (not (char-equal (int-to-char 0) (char-after)))
1007           (forward-char 1)
1008           (setq c (1+ c)))
1009         c))))
1010
1011 (defun sj3-yomi-point (bunsetu-no)
1012   (let ((i 0) (len 0) point length)
1013     (goto-char (point-min))
1014     (while (< i bunsetu-no)
1015       (setq length (sj3-get-4byte))
1016       (setq point (point))
1017       (skip-chars-forward "^\0")
1018       (setq len (+ len (- (point) point)))
1019       (goto-char (+ point length))
1020       (setq i (1+ i)))
1021       len))
1022
1023 (defun sj3-bunsetu-yomi (bunsetu-no &optional buffer)
1024   (let ((savebuff (current-buffer)))
1025     (unwind-protect
1026         (progn
1027           (set-buffer sj3-result-buffer)
1028           (if (or (<  bunsetu-no 0)
1029                   (<= sj3-bunsetu-suu bunsetu-no))
1030               nil
1031             (sj3-result-goto-bunsetu bunsetu-no)
1032             (sj3-skip-length)
1033             (let (p1 p2 )
1034               (setq p1 (point))
1035               (skip-chars-forward "^\0")
1036               (if (null buffer ) (buffer-substring p1 (point))
1037                 (setq p2 (point))
1038                 (set-buffer buffer)
1039                 (insert-buffer-substring sj3-result-buffer p1 p2)
1040                 t))))
1041       (set-buffer savebuff))))
1042
1043 (defun sj3-bunsetu-yomi-equal (bunsetu-no yomi)
1044   (save-excursion
1045     (set-buffer sj3-result-buffer)
1046       (if (or (<  bunsetu-no 0)
1047             (<= sj3-bunsetu-suu bunsetu-no))
1048         nil
1049       (sj3-result-goto-bunsetu bunsetu-no)
1050       (sj3-skip-length)
1051       (looking-at (regexp-quote yomi))))) ;93.4.6 by T.Saneto
1052
1053 (defun sj3-bunsetu-kouho-suu (bunsetu-no)
1054   (save-excursion
1055     (set-buffer sj3-result-buffer)
1056     (if (or (<  bunsetu-no 0)
1057             (<= sj3-bunsetu-suu bunsetu-no))
1058         nil
1059       (sj3-result-goto-bunsetu bunsetu-no)
1060       (sj3-skip-length)
1061       (sj3-skip-yomi)
1062       (sj3-get-4byte))))
1063
1064 (defun sj3-bunsetu-kouho-list (bunsetu-no)
1065   (save-excursion
1066     (set-buffer sj3-result-buffer)
1067     (if (or (<  bunsetu-no 0)
1068             (<= sj3-bunsetu-suu bunsetu-no))
1069         nil
1070       (sj3-result-goto-bunsetu bunsetu-no)
1071       (sj3-skip-length)
1072       (sj3-skip-yomi)
1073       (let ((max (sj3-get-4byte)) (i 0) (result nil) p0)
1074         (sj3-skip-4byte) ;;; current kouhou number
1075         (sj3-skip-stdy)
1076         (while (< i max)
1077           (setq p0 (point))
1078           (skip-chars-forward "^\0")
1079           (setq result
1080                 (cons (concat (buffer-substring p0 (point)))
1081                       result))
1082           (forward-char 1)
1083           (setq i (1+ i))
1084           (if (< i (- max 2))
1085               (sj3-skip-stdy)))
1086         (nreverse result)))))
1087
1088 (defun sj3-bunsetu-kouho-number (bunsetu-no)
1089   (save-excursion
1090     (set-buffer sj3-result-buffer)
1091     (if (or (<  bunsetu-no 0)
1092             (<= sj3-bunsetu-suu bunsetu-no))
1093         nil
1094       (sj3-result-goto-bunsetu bunsetu-no)
1095       (sj3-skip-length)
1096       (sj3-skip-yomi)
1097       (sj3-skip-4byte)
1098       (sj3-get-4byte)))
1099   )
1100
1101 (defun sj3-simple-command (op arg)
1102   (if (sj3-server-active-p)
1103       (let ((inhibit-quit t))
1104         (progn
1105           (sj3-command-start op)
1106           (sj3-put-4byte arg)
1107           (sj3-command-end)
1108           (sj3-get-result)
1109           (sj3-get-return-code)))
1110     (sj3-connection-error)))
1111
1112 (defun sj3-server-open-dict (dict-file-name password)
1113   (if (not (sj3-server-active-p))(sj3-connection-error)
1114     (let ((inhibit-quit t))
1115       (save-excursion
1116         (sj3-command-start SJ3_DICADD)
1117         (sj3-put-string dict-file-name)
1118         (if (stringp password)
1119             (sj3-put-string password)
1120           (sj3-put-string 0))
1121         (sj3-command-end)
1122         (sj3-get-result)
1123         (sj3-get-return-code)
1124         (if (not (= sj3-return-code 0)) nil
1125           (let ((dict-no (sj3-get-4byte)))
1126             (if (stringp password)
1127                 (setq sj3-user-dict-list
1128                       (append sj3-user-dict-list (list dict-no)))
1129               (setq sj3-sys-dict-list
1130                     (append sj3-sys-dict-list (list dict-no))))
1131             dict-no))))))
1132
1133 (defun sj3-server-close-dict (dict-no)
1134   (if (not (sj3-server-active-p))(sj3-connection-error)
1135     (let ((inhibit-quit t))
1136       (save-excursion
1137         (sj3-command-start SJ3_DICDEL)
1138         (sj3-put-4byte dict-no)
1139         (sj3-command-end)
1140         (sj3-get-result)
1141         (sj3-get-return-code)))))
1142
1143 (defun sj3-server-make-dict (dict-file-name)
1144   (if (not (sj3-server-active-p))(sj3-connection-error)
1145     (let ((inhibit-quit t))
1146       (save-excursion
1147         (sj3-command-start SJ3_MKDIC)
1148         (sj3-put-string dict-file-name)
1149         (sj3-put-4byte 2048)  ;;; Index length
1150         (sj3-put-4byte 2048)  ;;; Length
1151         (sj3-put-4byte 256)   ;;; Number
1152         (sj3-command-end)
1153         (sj3-get-result)
1154         (sj3-get-return-code)))))
1155
1156 (defun sj3-server-open-stdy (stdy-file-name)
1157   (if (not (sj3-server-active-p))(sj3-connection-error)
1158     (let ((inhibit-quit t))
1159       (save-excursion
1160         (sj3-command-start SJ3_OPENSTDY)
1161         (sj3-put-string stdy-file-name)
1162         (sj3-put-string 0)
1163         (sj3-command-end)
1164         (sj3-get-result)
1165         (sj3-get-return-code)))))
1166
1167 (defun sj3-server-close-stdy ()
1168   (sj3-zero-arg-command SJ3_CLOSESTDY))
1169
1170 (defun sj3-server-make-stdy (stdy-file-name)
1171   (if (not (sj3-server-active-p))(sj3-connection-error)
1172     (let ((inhibit-quit t))
1173       (save-excursion
1174         (sj3-command-start SJ3_MKSTDY)
1175         (sj3-put-string stdy-file-name)
1176         (sj3-put-4byte 2048)  ;;; Number
1177         (sj3-put-4byte 1)     ;;; Step
1178         (sj3-put-4byte 2048)  ;;; Length
1179         (sj3-command-end)
1180         (sj3-get-result)
1181         (sj3-get-return-code)))))
1182
1183 (defun sj3-server-dict-add (dictno kanji yomi bunpo)
1184   (if (not (sj3-server-active-p))(sj3-connection-error)
1185     (let ((inhibit-quit t))
1186       (save-excursion
1187         (if (= *sj3-current-server-version* 2)
1188             (sj3-command-start SJ3_WREG_EUC)
1189           (sj3-command-start SJ3_WREG))
1190         (sj3-put-4byte dictno)
1191         (sj3-put-string* yomi)
1192         (sj3-put-string* kanji)
1193         (sj3-put-4byte bunpo)
1194         (sj3-command-end)
1195         (sj3-get-result)
1196         (sj3-get-return-code)))))
1197
1198 (defun sj3-server-dict-delete (dictno kanji yomi bunpo)
1199   (if (not (sj3-server-active-p)) (sj3-connection-error)
1200     (let ((inhibit-quit t))
1201       (save-excursion
1202         (if (= *sj3-current-server-version* 2)
1203             (sj3-command-start SJ3_WDEL_EUC)
1204           (sj3-command-start SJ3_WDEL))
1205         (sj3-put-4byte dictno)
1206         (sj3-put-string* yomi)
1207         (sj3-put-string* kanji)
1208         (sj3-put-4byte bunpo)
1209         (sj3-command-end)
1210         (sj3-get-result)
1211         (sj3-get-return-code)))))
1212
1213 (defun sj3-server-dict-info (dict-no)
1214   (if (not (sj3-server-active-p)) (sj3-connection-error)
1215     (let ((inhibit-quit t))
1216       (save-excursion
1217         (let ((result nil))
1218           (set-buffer sj3-server-buffer)
1219           (if (= *sj3-current-server-version* 2)
1220               (sj3-simple-command SJ3_WSCH_EUC dict-no)
1221             (sj3-simple-command SJ3_WSCH dict-no))
1222           (while (= sj3-return-code 0)
1223             ;;; (sj3-get-4byte)
1224             (setq result (cons (list (sj3-get-string*)
1225                                     (sj3-get-string*) (sj3-get-4byte)) result))
1226             (if (= *sj3-current-server-version* 2)
1227                 (sj3-simple-command SJ3_WNSCH_EUC dict-no)
1228               (sj3-simple-command SJ3_WNSCH dict-no)))
1229           (if (= sj3-return-code 111)
1230               (setq sj3-error-code nil))
1231           (nreverse result))))))
1232
1233 (defun sj3-server-make-directory (dir-name)
1234   (if (not (sj3-server-active-p)) (sj3-connection-error)
1235     (let ((inhibit-quit t))
1236       (save-excursion
1237         (sj3-command-start SJ3_MKDIR)
1238         (sj3-put-string dir-name)
1239         (sj3-command-end)
1240         (sj3-get-result)
1241         (sj3-get-return-code)))))
1242
1243 (defun sj3-server-file-access (file-name access-mode)
1244   (if (not (sj3-server-active-p)) (sj3-connection-error)
1245     (let ((inhibit-quit t))
1246       (save-excursion
1247         (sj3-command-start SJ3_ACCESS)
1248         (sj3-put-string file-name)
1249         (sj3-put-4byte access-mode)
1250         (sj3-command-end)
1251         (sj3-get-result)
1252         (setq sj3-error-code nil)
1253         (sj3-get-4byte)))))
1254
1255 (defun sj3_lock ()
1256   (sj3-zero-arg-command SJ3_LOCK))
1257
1258 (defun sj3_unlock ()
1259   (sj3-zero-arg-command SJ3_UNLOCK))
1260
1261 (defun sj3_version ()
1262   (sj3-zero-arg-command SJ3_VERSION))
1263
1264 (defconst *sj3-error-alist*
1265   '(
1266     (1 :SJ3_SERVER_DEAD
1267        "\e$B%5!<%P$,;`$s$G$$$^$9!#\e(B")
1268     (2 :SJ3_SOCK_OPEN_FAIL
1269        "socket\e$B$N\e(Bopen\e$B$K<:GT$7$^$7$?!#\e(B")
1270     (6 :SJ3_ALLOC_FAIL
1271        "\e$B%a%b%j\e(Balloc\e$B$G<:GT$7$^$7$?!#\e(B")
1272     (7 :SJ3_ILLEGAL_COMMAND
1273        "\e$B%3%^%s%I$,4V0c$C$F$$$k\e(B")
1274     (12 :SJ3_BAD_HOST
1275         " \e$B%[%9%HL>$,$J$$\e(B ")
1276     (13 :SJ3_BAD_USER
1277         " \e$B%f!<%6L>$,$J$$\e(B ")
1278     (31 :SJ3_NOT_A_DICT
1279         "\e$B@5$7$$<-=q$G$O$"$j$^$;$s!#\e(B")
1280     (35 :SJ3_NO_EXIST
1281         "\e$B%U%!%$%k$,B8:_$7$^$;$s!#\e(B")
1282     (37 :SJ3_OPENF_ERR
1283         "\e$B%U%!%$%k$,%*!<%W%s$G$-$^$;$s!#\e(B")
1284     (39 :SJ3_PARAMR
1285         "\e$B%U%!%$%k$NFI$_9~$_8"8B$,$"$j$^$;$s!#\e(B")
1286     (40 :SJ3_PARAMW
1287         "\e$B%U%!%$%k$N=q$-9~$_8"8B$,$"$j$^$;$s!#\e(B")
1288     (71 :SJ3_NOT_A_USERDICT
1289         "\e$B;XDj$5$l$F<-=q$O!"%f!<%6!<<-=q$G$O$"$j$^$;$s!#\e(B")
1290     (72 :SJ3_RDONLY
1291         "\e$B%j!<%I%*%s%j!<$N<-=q$KEPO?$7$h$&$H$7$^$7$?!#\e(B")
1292     (74 :SJ3_BAD_YOMI
1293         "\e$BFI$_$KITE,Ev$JJ8;z$,4^$^$l$F$$$^$9!#\e(B")
1294     (75 :SJ3_BAD_KANJI
1295         "\e$B4A;z$KITE,Ev$JJ8;z$,4^$^$l$F$$$^$9!#\e(B")
1296     (76 :SJ3_BAD_HINSHI
1297         "\e$B;XDj$5$l$?IJ;lHV9f$,$"$j$^$;$s!#\e(B")
1298     (82 :SJ3_WORD_ALREADY_EXIST
1299         "\e$B;XDj$5$l$?C18l$O$9$G$KB8:_$7$F$$$^$9!#\e(B")
1300     (84 :SJ3_JISHOTABLE_FULL
1301         "\e$B<-=q%F!<%V%k$,0lGU$G$9!#\e(B")
1302     (92 :SJ3_WORD_NO_EXIST
1303         "\e$B;XDj$5$l$?C18l$,B8:_$7$^$;$s!#\e(B")
1304     (102 :SJ3_MKDIR_FAIL
1305         " \e$B%G%#%l%/%H%j$r:n$jB;$J$C$?\e(B ")
1306     ))
1307
1308 (defun sj3-error-symbol (code)
1309   (let ((pair (assoc code *sj3-error-alist*)))
1310     (if (null pair)
1311         (list ':sj3-unknown-error-code code)
1312       (car (cdr pair)))))
1313