cgit.sxemacs.org Git - packages/blob - mule-packages/skk/skk-server.el

   1 ;;; skk-server.el --- SKK \e$B%5!<%P!<$N$?$a$N%W%m%0%i%`\e(B
   2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996,
   3 ;;               1997, 1998, 1999
   4 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
   5
   6 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
   7 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
   8 ;; Version: $Id: skk-server.el,v 1.2 2000-07-10 04:34:01 yoshiki Exp $
   9 ;; Keywords: japanese
  10 ;; Last Modified: $Date: 2000-07-10 04:34:01 $
  11
  12 ;; This file is part of SKK.
  13
  14 ;; SKK is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either versions 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; SKK is distributed in the hope that it will be useful
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with SKK, see the file COPYING.  If not, write to the Free
  26 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  27 ;; MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30 ;;
  31 ;;; Code:
  32 (eval-when-compile (require 'skk))
  33 (require 'skk-foreword)
  34
  35 ;;;###autoload
  36 (defgroup skk-server nil "SKK server related customization."
  37   :prefix "skk-server-"
  38   :group 'skk )
  39
  40 ;; user variables.
  41 (defcustom skk-server-host (getenv "SKKSERVER")
  42   "*SKK \e$B<-=q%5!<%P!<$rAv$i$;$F$$$k%[%9%HL>!#\e(B"
  43   :type 'string
  44   :group 'skk-server )
  45
  46 (defcustom skk-server-prog (getenv "SKKSERV")
  47   "*SKK \e$B<-=q%5!<%P!<%W%m%0%i%`L>!#%U%k%Q%9$G=q$/!#\e(B"
  48   :type 'file
  49   :group 'skk-server )
  50
  51 (defcustom skk-server-jisyo (getenv "SKK_JISYO")
  52   "*SKK \e$B<-=q%5!<%P!<%W%m%0%i%`$KEO$9<-=qL>!#%U%k%Q%9$G=q$/!#\e(B"
  53   :type 'file
  54   :group 'skk-server )
  55
  56 (defcustom skk-server-portnum nil
  57   "*Non-nil \e$B$G$"$l$P!"$=$NCM$r\e(B port number \e$B$H$7$F\e(B skkserv \e$B$H\e(B TCP \e$B@\B3$9$k!#\e(B
  58 /etc/services \e$B$rD>@\=q$-49$($k8"8B$,$J$$%f!<%6!<$N$?$a$NJQ?t!#\e(B"
  59   :type '(choice integer (const nil))
  60   :group 'skk-server )
  61
  62 ;;(defvar skk-server-debug nil
  63 ;;  "*Non-nil \e$B$G$"$l$P!"<-=q%5!<%P!<%W%m%0%i%`$r%G%#%P%C%0%b!<%I$G5/F0$9$k!#\e(B
  64 ;;\e$B%G%#%P%C%0!&%b!<%I$G\e(B skkserv \e$B$rAv$i$;$k$H!"$=$N$^$^\e(B foreground \e$B$GAv$j!"%a%C%;!<\e(B
  65 ;;\e$B%8$r=PNO$9$k!#%-!<%\!<%I$+$i3d$j$3$_$r$+$1$k$3$H$b$G$-$k!#\e(B" )
  66
  67 (defcustom skk-servers-list nil
  68   "*\e$B<-=q%5!<%P!<Kh$N>pJs%j%9%H!#\e(B
  69
  70 \e$BJ#?t$N%[%9%H$GF0$$$F$$$k%5!<%P$K%"%/%;%9$G$-$k>l9g$K$O!"0J2<$N$h$&$K%j%9%H$N\e(B
  71 \e$B3FMWAG$K=g$K%[%9%HL>!"%U%k%Q%9$G$N\e(B SKK \e$B%5!<%P!<L>!"\e(BSKK \e$B%5!<%P!<$KEO$9<-=qL>!"\e(B
  72 SKK \e$B%5!<%P!<$,;HMQ$9$k%]!<%HHV9f$r=q$-!"@_Dj$r$9$k$3$H$,$G$-$k!#\e(B
  73
  74    \(setq skk-servers-list
  75          '\(\(\"host1\" \"/path/to/skkserv\" \"/path/to/SKK-JISYO.L\" 1178\)
  76            \(\"host2\" \"/path/to/skkserv\"\) \)\)
  77
  78 \e$B$3$N>l9g!":G=i$K;XDj$7$?%5!<%P$K%"%/%;%9$G$-$J$/$J$k$H!"<+F0E*$K=g<!%j%9%H$K$"\e(B
  79 \e$B$k;D$j$N%5!<%P$K%"%/%;%9$9$k$h$&$K$J$k!#\e(B
  80 \e$B%5!<%P!<$N%G%#%U%)%k%H$N<-=q$*$h$S%]!<%HHV9f$r;HMQ$9$k>l9g$O\e(B nil \e$B$r;XDj$9$k$+!"\e(B
  81 \e$B2?$b=q$+$J$$$GNI$$!#\e(B
  82
  83 \e$B$J$*!"%f!<%6!<<+?H$K<B9T8"8B$N$J$$%5!<%P!<$r;XDj$9$k>l9g$O!"\e(B
  84
  85    \(setq skk-servers-list '\(\(\"host1\"\) \(\"host2\"\)\)\)
  86
  87 \e$B$N$h$&$K!"%[%9%HL>$@$1$r=q$/$3$H$,$G$-$k!#>e5-$N@_DjNc$G$O!"\e(Bhost1, host2 \e$B$K$*\e(B
  88 \e$B$1$k\e(B skkserv \e$B%5!<%S%9$N\e(B TCP \e$B@\B3$N3+;O$N$_;n$_!"%5!<%P!<$N5/F0$O;n$_$J$$!#\e(B"
  89   :type '(repeat
  90           (list (string :tag "Hostname")
  91                 (choice :tag "Server" file (const nil))
  92                 (choice :tag "Dictionary" file (const nil))
  93                 (choice :tag "Port number" integer (const nil)) ))
  94   :group 'skk-server )
  95
  96 (defcustom skk-server-report-response nil
  97   "*Non-nil \e$B$G$"$l$P!"JQ49;~%5!<%P!<$NAw=P$9$kJ8;z$r<u$1<h$k$^$G$K\e(B accept-process-output \e$B$r2?2s<B9T$7$?$+$rJs9p$9$k!#\e(B"
  98   :type 'boolean
  99   :group 'skk-server )
 100
 101 (defcustom skk-server-remote-shell-program
 102   (or (getenv "REMOTESHELL")
 103       (and (boundp 'remote-shell-program) remote-shell-program)
 104       (cond
 105        ((eq system-type 'berkeley-unix)
 106         (if (file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh" "/usr/bin/rsh") )
 107        ((eq system-type 'usg-unix-v)
 108         (if (file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh" "/bin/rsh"))
 109        ((eq system-type 'hpux) "/usr/bin/remsh")
 110        ((eq system-type 'EWS-UX/V) "/usr/ucb/remsh")
 111        ((eq system-type 'pcux) "/usr/bin/rcmd")
 112        (t "rsh") ))
 113   "*\e$B%j%b!<%H%7%'%k$N%W%m%0%i%`L>!#\e(B"
 114   :type 'file
 115   :group 'skk-server )
 116
 117 (defcustom skk-server-load-hook nil
 118   "*skk-server.el \e$B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#\e(B"
 119   :type 'hook
 120   :group 'skk-server )
 121
 122 ;; internal constants and variables.
 123 (defconst skk-network-open-status 'open)
 124 (defconst skkserv-working-buffer " *skkserv*")
 125 (defvar skkserv-process nil)
 126
 127 (defun skk-server-version ()
 128   (interactive)
 129   (if (interactive-p)
 130       (message (skk-server-version))
 131     (let (status)
 132       (if (not (or skk-server-host skk-servers-list))
 133           (skk-error "Lack of host information of SKK server"
 134                      "SKK \e$B%5!<%P!<$N%[%9%H>pJs$,$"$j$^$;$s\e(B" ))
 135       (setq status (process-status "skkservd"))
 136       (or (eq status skk-network-open-status) (setq status (skk-open-server)))
 137       (if (eq status skk-network-open-status)
 138           (let (v)
 139             (save-match-data
 140               (with-current-buffer skkserv-working-buffer
 141                 (erase-buffer)
 142                 ;; \e$B%5!<%P!<%P!<%8%g%s$rF@$k!#\e(B
 143                 (process-send-string "skkservd" "2")
 144                 (while (eq (buffer-size) 0)
 145                   (accept-process-output) )
 146                 (setq v (buffer-string))
 147                 (erase-buffer)
 148                 ;; \e$B%[%9%HL>$rF@$k!#\e(B
 149                 (process-send-string "skkservd" "3")
 150                 (while (eq (buffer-size) 0)
 151                   (accept-process-output) )
 152                 (goto-char (point-min))
 153                 (format
 154                  (concat "SKK SERVER version %s"
 155                          (if skk-japanese-message-and-error
 156                              "(\e$B%[%9%HL>\e(B %s)"
 157                            "running on HOST %s" ))
 158                  v (prog1 (buffer-string) (erase-buffer)) ))))))))
 159
 160 (defun skk-search-server (file limit &optional nomsg)
 161   ;; SKK \e$B<-=q%U%)!<%^%C%H$N\e(B FILE \e$B$G\e(B SKK \e$B%5!<%P!<$r;HMQ$7$F\e(B skk-henkan-key \e$B$r%-!<\e(B
 162   ;; \e$B$K$7$F8!:w$r9T$&!#\e(B
 163   ;; SKK \e$B%5!<%P!<$,;HMQ$G$-$J$$$H$-$O!"\e(BFILE \e$B$r%P%C%U%!$KFI$_9~$s$G%5!<%A$r9T\e(B
 164   ;; \e$B$&!#\e(B
 165   ;; LIMIT \e$B$H\e(B NOMSG \e$B$O\e(B SKK \e$B%5!<%P!<$r;HMQ$7$J$$$H$-$N$_;H$&!#\e(B
 166   ;; \e$B8!:w%j!<%8%g%s$,\e(B LIMIT \e$B0J2<$K$J$k$^$G%P%$%J%j%5!<%A$r9T$$!"$=$N8e%j%K%"\e(B
 167   ;; \e$B%5!<%A$r9T$&!#\e(B
 168   ;; LIMIT \e$B$,\e(B 0 \e$B$G$"$l$P!"%j%K%"%5!<%A$N$_$r9T$&!#\e(B
 169   ;; \e$B<-=q$,%=!<%H$5$l$F$$$J$$$N$G$"$l$P!"\e(BLIMIT \e$B$r\e(B 0 \e$B$9$kI,MW$,$"$k!#\e(B
 170   ;; \e$B%*%W%7%g%J%k0z?t$N\e(B NOMSG \e$B$,\e(B non-nil \e$B$G$"$l$P\e(B skk-get-jisyo-buffer \e$B$N%a%C\e(B
 171   ;; \e$B%;!<%8$r=PNO$7$J$$$h$&$K$9$k!#\e(B
 172   (if (or skk-server-host skk-servers-list)
 173       (skk-search-server-subr file limit)
 174     (skk-search-jisyo-file file limit nomsg) ))
 175
 176 (defun skk-search-server-subr (file limit)
 177   ;; skk-search-server \e$B$N%5%V%k!<%A%s!#\e(B
 178   (let ((key
 179          (if skk-use-numeric-conversion
 180              (skk-num-compute-henkan-key skk-henkan-key)
 181            skk-henkan-key))
 182         ;; \e$B%P%C%U%!%m!<%+%kCM$N<u$1EO$7$N$?$a!"JLL>$N0l;~JQ?t$K<h$k!#\e(B
 183         (okurigana (or skk-henkan-okurigana skk-okuri-char))
 184         (status (process-status "skkservd")) )
 185     (or (eq status skk-network-open-status) (setq status (skk-open-server)))
 186     (if (eq status skk-network-open-status)
 187         (with-current-buffer skkserv-working-buffer
 188           (let ((cont t) (count 0)
 189                 l )
 190             (erase-buffer)
 191             (process-send-string "skkservd" (concat "1" key " "))
 192             (while (and cont (eq (process-status "skkservd")
 193                                  skk-network-open-status ))
 194               (accept-process-output)
 195               (setq count (1+ count))
 196               (if (> (buffer-size) 0)
 197                   (if (eq (char-after 1) ?1) ;?1
 198                       ;; found key successfully, so check if a whole line
 199                       ;; is received.
 200                       (if (eq (char-after (1- (point-max))) ?\n) ;?\n
 201                           (setq cont nil) )
 202                     ;; not found or error, so exit
 203                     (setq cont nil) )))
 204             (goto-char (point-min))
 205             (if skk-server-report-response
 206                 (skk-message "%d \e$B2s\e(B SKK \e$B%5!<%P!<$N1~EzBT$A$r$7$^$7$?\e(B"
 207                              "Waited for server response %d times" count ))
 208             (if (eq (following-char) ?1) ;?1
 209                 (progn
 210                   (forward-char 2)
 211                   (setq l (skk-compute-henkan-lists okurigana))
 212                   (if l
 213                       (cond ((and okurigana skk-henkan-okuri-strictly)
 214                              ;; \e$BAw$j2>L>$,F10l$N%(%s%H%j$N$_$rJV$9!#\e(B
 215                              (nth 2 l) )
 216                             ((and okurigana skk-henkan-strict-okuri-precedence)
 217                              (skk-nunion (nth 2 l) (car l)) )
 218                             (t (car l)) ))))))
 219       ;; server is not active, so search file instead
 220       (skk-search-jisyo-file file limit) )))
 221
 222 (defun skk-open-server ()
 223   ;; SKK \e$B%5!<%P!<$H@\B3$9$k!#%5!<%P!<%W%m%;%9$N\e(B status \e$B$rJV$9!#\e(B
 224   (let (status code proc)
 225     (if (or (skk-open-network-stream) (skk-open-server-1))
 226         (progn
 227           (setq status (process-status "skkservd"))
 228           (if (eq status skk-network-open-status)
 229               (progn
 230                 (setq code (cdr (assoc "euc" skk-coding-system-alist))
 231                       proc (get-process "skkservd") )
 232                 (cond ((eq skk-emacs-type 'xemacs)
 233                        (set-process-input-coding-system proc code)
 234                        (set-process-output-coding-system proc code) )
 235                       (t
 236                        (set-process-coding-system proc code code) ))))))
 237     status ))
 238
 239 (defun skk-open-server-1 ()
 240   ;; skk-open-server \e$B$N%5%V%k!<%A%s!#\e(B
 241   ;; skkserv \e$B%5!<%S%9$r%*!<%W%s$G$-$?$i\e(B t \e$B$rJV$9!#\e(B
 242   ;; skkserv \e$B$O0z?t$K<-=q$,;XDj$5$l$F$$$J$1$l$P!"\e(BDEFAULT_JISYO \e$B$r;2>H$9$k!#\e(B
 243   (if (null skk-servers-list)
 244       (progn
 245         ;; Emacs \e$B5/F08e$K4D6-JQ?t$r@_Dj$7$?>l9g!#\e(B
 246         (if (not skk-server-host)
 247             (setq skk-server-host (getenv "SKKSERVER")) )
 248         (if (not skk-server-prog)
 249             (setq skk-server-prog (getenv "SKKSERV")) )
 250         (if (not skk-server-jisyo)
 251             (setq skk-server-jisyo (getenv "SKK_JISYO")) )
 252         (if skk-server-host
 253             (setq skk-servers-list (list (list skk-server-host
 254                                                skk-server-prog
 255                                                skk-server-jisyo
 256                                                skk-server-portnum )))
 257           (setq skk-server-prog nil) )))
 258   (while (and (not (eq (process-status "skkservd") skk-network-open-status))
 259               skk-servers-list )
 260     (let ((elt (car skk-servers-list))
 261           arg )
 262       (setq skk-server-host (car elt)
 263             skk-server-prog (nth 1 elt)
 264             skk-server-jisyo (nth 2 elt)
 265             skk-server-portnum (nth 3 elt)
 266             skk-servers-list (cdr skk-servers-list) )
 267       ;; skkserv \e$B$N5/F0%*%W%7%g%s$O2<5-$NDL$j!#\e(B
 268       ;;     skkserv [-d] [-p NNNN] [JISHO]
 269       ;;     `-d'     \e$B%G%#%P%C%0!&%b!<%I\e(B
 270       ;;     `-p NNNN'     \e$BDL?.MQ$N%]!<%HHV9f$H$7$F\e(BNNNN\e$B$r;H$&\e(B.
 271       ;;     `~/JISYO'     ~/JISYO\e$B$r<-=q$H$7$FMxMQ\e(B.
 272       (if skk-server-jisyo
 273           (setq arg (list skk-server-jisyo))
 274         ;; skkserv \e$B$O0z?t$K<-=q$,;XDj$5$l$F$$$J$1$l$P!"\e(BDEFAULT_JISYO \e$B$r\e(B
 275         ;; \e$B;2>H$9$k!#\e(B
 276         )
 277       ;;(if skk-server-debug
 278       ;;    (setq arg (cons "-d" arg)) )
 279       (if (and skk-server-portnum (not (= skk-server-portnum 1178)))
 280           (setq arg
 281                 (nconc (list "-p" (number-to-string skk-server-portnum)) arg) ))
 282       (if (and skk-server-host (not (skk-open-network-stream))
 283                skk-server-prog )
 284           ;; skk-startup-server \e$B$G%5!<%P!<$r5/F0$9$k$K$O!"\e(Bskk-server-host \e$B$H\e(B
 285           ;; skk-server-prog \e$B$,@_Dj$5$l$F$$$k$3$H$,I,MW!#\e(B
 286           (skk-startup-server arg) )))
 287   (if (not (eq (process-status "skkservd") skk-network-open-status))
 288       ;; reset SKK-SERVER-HOST so as not to use server in this session
 289       (setq skk-server-host nil
 290             skk-server-prog nil
 291             skk-servers-list nil )
 292     t ))
 293
 294 (defun skk-open-network-stream ()
 295   ;; skk-server-host \e$B$K$*$1$k\e(B skkserv \e$B%5!<%S%9$N\e(B TCP \e$B@\B3$r%*!<%W%s$7!"%W%m%;\e(B
 296   ;; \e$B%9$rJV$9!#\e(B
 297   (condition-case nil
 298       (progn
 299         (setq skkserv-process
 300               (open-network-stream "skkservd" skkserv-working-buffer
 301                                    skk-server-host
 302                                    (or skk-server-portnum "skkserv") ))
 303         (process-kill-without-query skkserv-process) )
 304     (error nil) ))
 305
 306 (defun skk-startup-server (arg)
 307   ;; skkserv \e$B$r5/F0$G$-$?$i\e(B t \e$B$rJV$9!#\e(B
 308   (let (
 309         ;;(msgbuff (get-buffer-create " *skkserv-msg*"))
 310         (count 7) )
 311     (while (> count 0)
 312       (skk-message
 313        "%s \e$B$N\e(B SKK \e$B%5!<%P!<$,5/F0$7$F$$$^$;$s!#5/F0$7$^$9\e(B%s"
 314        "SKK SERVER on %s is not active, I will activate it%s"
 315        skk-server-host (make-string count ?.) )
 316       (if (or (string= skk-server-host (system-name))
 317               (string= skk-server-host "localhost"))
 318           ;; server host is local machine
 319           (apply 'call-process skk-server-prog nil
 320                  ;;msgbuff
 321                  0 nil arg)
 322         (apply 'call-process
 323                skk-server-remote-shell-program nil
 324                ;; 0 \e$B$K$7$F%5%V%W%m%;%9$N=*N;$rBT$C$F$O$$$1$J$$M}M3$,$"$k!)\e(B
 325                ;; \e$B$J$1$l$P\e(B msgbuf \e$B$K%(%i!<=PNO$r<h$C$?J}$,7z@_E*$G$O!)\e(B  \e$B$^$?$=\e(B
 326                ;; \e$B$N>l9g$O$3$N\e(B while \e$B%k!<%W<+?H$,$$$i$J$$!)\e(B
 327                ;; msgbuff
 328                0 nil skk-server-host skk-server-prog arg ))
 329       (sit-for 3)
 330       (if (and (skk-open-network-stream)
 331                (eq (process-status "skkservd") skk-network-open-status) )
 332           (setq count 0)
 333         (setq count (1- count)) ))
 334     (if (eq (process-status "skkservd") skk-network-open-status)
 335         (progn
 336           (skk-message "\e$B%[%9%H\e(B %s \e$B$N\e(B SKK \e$B%5!<%P!<$,5/F0$7$^$7$?\e(B"
 337                        "SKK SERVER on %s is active now"
 338                        skk-server-host )
 339           (sit-for 1) ; return t
 340           t ) ; \e$B$G$bG0$N$?$a\e(B
 341       (skk-message "%s \e$B$N\e(B SKK \e$B%5!<%P!<$r5/F0$9$k$3$H$,$G$-$^$;$s$G$7$?\e(B"
 342                    "Could not activate SKK SERVER on %s"
 343                    skk-server-host )
 344       (sit-for 1)
 345       (ding) ;return nil
 346       nil ))) ; \e$B$G$bG0$N$?$a\e(B
 347
 348 ;;;###autoload
 349 (defun skk-adjust-search-prog-list-for-server-search (&optional non-del)
 350   ;; skk-server-host \e$B$b$7$/$O\e(B skk-servers-list \e$B$,\e(B nil \e$B$G$"$l$P!"\e(B
 351   ;; skk-search-prog-list \e$B$+$i\e(B skk-search-server \e$B$r\e(B car \e$B$K;}$D%j%9%H$r>C$9!#\e(B
 352   ;; non-nil \e$B$G$"$l$P!"2C$($k!#\e(B
 353   (if (or skk-server-host skk-servers-list)
 354       (if (null (assq 'skk-search-server skk-search-prog-list))
 355           ;; skk-search-prog-list \e$B$,\e(B nil \e$B$H$$$&$3$H$O$^$:$J$$$@$m$&$,!"G0$N$?\e(B
 356           ;; \e$B$a!"\e(Bsetq \e$B$7$F$*$/!#\e(B
 357           (setq skk-search-prog-list
 358                 ;; \e$BKvHx$KIU$1$k!#KvHx$K$O\e(B (skk-okuri-search) \e$B$r;}$C$F$-$?$$?M\e(B
 359                 ;; \e$B$b$$$k$+$b!#%*%W%7%g%s$GIU$1$k>l=j$rJQ99$9$k$h$&$K$7$?J}$,\e(B
 360                 ;; \e$BNI$$!)\e(B
 361                 (nconc skk-search-prog-list
 362                        (list
 363                         '(skk-search-server skk-aux-large-jisyo 10000) ))))
 364     (if (not non-del)
 365         (remove-alist 'skk-search-prog-list 'skk-search-server) )))
 366
 367 (defun skk-disconnect-server ()
 368   ;; \e$B%5!<%P!<$r@Z$jN%$9!#\e(B
 369   (if (and skk-server-host
 370            (eq (process-status "skkservd") skk-network-open-status) )
 371       (progn
 372         (process-send-string "skkservd" "0") ; disconnect server
 373         (accept-process-output (get-process "skkservd")) )))
 374
 375 ;;(add-hook 'skk-mode-hook 'skk-adjust-search-prog-list-for-server-search)
 376 (add-hook 'skk-before-kill-emacs-hook 'skk-disconnect-server)
 377
 378 (run-hooks 'skk-server-load-hook)
 379
 380 (provide 'skk-server)
 381 ;;; skk-server.el ends here