egg/sj3.el

   1 ;;; egg/sj3.el --- SJ3 Support (high level interface) in Egg
   2 ;;;                Input Method Architecture
   3
   4 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
   5 ;;               2015 Hiroki Sato <hrs@allbsd.org>
   6
   7 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   8
   9 ;; Keywords: mule, multilingual, input method
  10
  11 ;; This file is part of EGG.
  12
  13 ;; EGG is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; EGG is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc.,
  26 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  27
  28 ;;; Commentary:
  29
  30
  31 ;;; Code:
  32
  33 (require 'egg)
  34 (require 'egg-edep)
  35
  36 (defgroup sj3 nil
  37   "SJ3 interface for Tamago-tsunagi."
  38   :group 'egg)
  39
  40 (defcustom sj3-hostname "localhost"
  41   "Hostname of SJ3 server"
  42   :group 'sj3 :type 'string)
  43
  44 (defcustom sj3-server-port 3086
  45   "Port number of SJ3 server"
  46   :group 'sj3 :type 'integer)
  47
  48
  49 (eval-when-compile
  50   (defmacro SJ3-const (c)
  51     (cond ((eq c 'FileNotExist) 35)
  52           )))
  53
  54 (egg-add-message
  55  '((Japanese
  56     (sj3-register-1 "\e$BEPO?<-=qL>\e(B:")
  57     (sj3-register-2 "\e$BIJ;lL>\e(B"))))
  58
  59 (defvar sj3-hinshi-menu
  60   '(("\e$BL>;l\e(B"       .
  61      (menu "\e$BIJ;l\e(B:\e$BL>;l\e(B:"
  62            (("\e$BL>;l\e(B"               . 1)
  63             ("\e$BL>;l\e(B(\e$B$*!D\e(B)"   . 2)
  64             ("\e$BL>;l\e(B(\e$B$4!D\e(B)"   . 3)
  65             ("\e$BL>;l\e(B(\e$B!DE*\e(B/\e$B2=\e(B)"  . 4)
  66             ("\e$BL>;l\e(B(\e$B$*!D$9$k\e(B)"       . 5)
  67             ("\e$BL>;l\e(B(\e$B!D$9$k\e(B)" . 6)
  68             ("\e$BL>;l\e(B(\e$B$4!D$9$k\e(B)"       . 7)
  69             ("\e$BL>;l\e(B(\e$B!D$J\e(B/\e$B$K\e(B)"  . 8)
  70             ("\e$BL>;l\e(B(\e$B$*!D$J\e(B/\e$B$K\e(B)"        . 9)
  71             ("\e$BL>;l\e(B(\e$B$4!D$J\e(B/\e$B$K\e(B)"        . 10)
  72             ("\e$BL>;l\e(B(\e$BI{;l\e(B)"   . 11))))
  73     ("\e$BBeL>;l\e(B"     . 12)
  74     ("\e$BID;z\e(B"       . 21)
  75     ("\e$BL>A0\e(B"       . 22)
  76     ("\e$BCOL>\e(B"       . 24)
  77     ("\e$B8)\e(B/\e$B6hL>\e(B"      . 25)
  78     ("\e$BF0;l\e(B"       .
  79      (menu "\e$BIJ;l\e(B:\e$BF0;l\e(B:"
  80            (("\e$B%5JQ8l44\e(B"           . 80)
  81             ("\e$B%6JQ8l44\e(B"           . 81)
  82             ("\e$B0lCJITJQ2=It\e(B"       . 90)
  83             ("\e$B%+9T8^CJ8l44\e(B"       . 91)
  84             ("\e$B%,9T8^CJ8l44\e(B"       . 92)
  85             ("\e$B%59T8^CJ8l44\e(B"       . 93)
  86             ("\e$B%?9T8^CJ8l44\e(B"       . 94)
  87             ("\e$B%J9T8^CJ8l44\e(B"       . 95)
  88             ("\e$B%P9T8^CJ8l44\e(B"       . 96)
  89             ("\e$B%^9T8^CJ8l44\e(B"       . 97)
  90             ("\e$B%i9T8^CJ8l44\e(B"       . 98)
  91             ("\e$B%o9T8^CJ8l44\e(B"       . 99))))
  92     ("\e$BO"BN;l\e(B"             . 26)
  93     ("\e$B@\B3;l\e(B"             . 27)
  94     ("\e$B=u?t;l\e(B"             . 29)
  95     ("\e$B?t;l\e(B"               . 30)
  96     ("\e$B@\F,8l\e(B"             . 31)
  97     ("\e$B@\Hx8l\e(B"             . 36)
  98     ("\e$BI{;l\e(B"               . 45)
  99     ("\e$BI{;l\e(B2"              . 46)
 100     ("\e$B7AMF;l8l44\e(B" . 60)
 101     ("\e$B7AMFF0;l8l44\e(B"       . 71)
 102     ("\e$BC14A;z\e(B"             . 189))
 103   "Menu data for a hinshi (a part of speech) selection.")
 104
 105 (defun sj3-hinshi-name (id &optional menu alist)
 106   "Return a hinshi (a part of speech) name corresponding to ID.
 107 If ID is nil, return a flattened alist from `sj3-hinshi-menu'.
 108 Don't specify the optional arguments in normal use."
 109   (let ((menu (or menu sj3-hinshi-menu)))
 110     (if (consp menu)
 111         (if (consp (cdr menu))
 112             (mapcar (lambda (elem)
 113                       (setq alist (sj3-hinshi-name nil elem alist)))
 114                     menu)
 115           (setq alist (nconc alist (list (cons (cdr menu) (car menu)))))))
 116     (if id
 117         (cdr (assq id alist))
 118       alist)))
 119
 120 (setplist 'sj3-conversion-backend
 121           '(egg-start-conversion          sj3-start-conversion
 122             egg-get-bunsetsu-source       sj3-get-bunsetsu-source
 123             egg-get-bunsetsu-converted    sj3-get-bunsetsu-converted
 124             egg-get-source-language       sj3-get-source-language
 125             egg-get-converted-language    sj3-get-converted-language
 126             egg-list-candidates           sj3-list-candidates
 127             egg-decide-candidate          sj3-decide-candidate
 128             egg-change-bunsetsu-length    sj3-change-bunsetsu-length
 129             egg-end-conversion            sj3-end-conversion
 130             egg-word-registration         sj3-word-registration))
 131
 132 (defconst sj3-backend-alist '((Japanese ((sj3-conversion-backend)))))
 133
 134 (egg-set-finalize-backend '(sj3-finalize-backend))
 135
 136 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
 137
 138 (defvar sj3-open-message)
 139
 140 (defun sj3-open (hostname)
 141   "Establish the connection to SJ3 server.  Return process object."
 142   (let* ((buf (generate-new-buffer " *SJ3*"))
 143          proc result)
 144     (condition-case err
 145         (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 146       ((error quit)
 147        (egg-error "failed to connect sj3 server")))
 148     (set-process-query-on-exit-flag proc nil)
 149     (set-process-coding-system proc 'binary 'binary)
 150     (set-marker-insertion-type (process-mark proc) t)
 151     (with-current-buffer buf
 152       (erase-buffer)
 153       (buffer-disable-undo)
 154       (set-buffer-multibyte nil))
 155     ;; Initialize dictionaries
 156     (setq sj3-sys-dict-list nil)
 157     (setq sj3-user-dict-list nil)
 158     (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 159     (if (< result 0)
 160         (let ((msg (sj3rpc-get-error-message (- result))))
 161           (delete-process proc)
 162           (kill-buffer buf)
 163           (egg-error "Can't open SJ3 session (%s): %s" hostname msg)))
 164     (setq result (sj3rpc-get-stdy-size proc))
 165     (if (< result 0)
 166         (let ((msg (sj3rpc-get-error-message (- result))))
 167           (delete-process proc)
 168           (kill-buffer buf)
 169           (egg-error "Can't get SJ3 STDYSIZE: %s"msg)))
 170     (setq sj3-stdy-size result)
 171     proc))
 172
 173 ;; (defun sj3-open (hostname-list)
 174 ;;   "Establish the connection to SJ3 server.  Return process object."
 175 ;;   (let* ((buf (generate-new-buffer " *SJ3*"))
 176 ;;       (msg-form "SJ3: connecting to sj3serv at %s...")
 177 ;;       hostname proc result msg)
 178 ;;     (with-current-buffer buf
 179 ;;       (erase-buffer)
 180 ;;       (buffer-disable-undo)
 181 ;;       (setq enable-multibyte-characters nil))
 182 ;;     (cond
 183 ;;      ((null hostname-list)
 184 ;;       (setq hostname-list '("localhost")))
 185 ;;      ((null (listp hostname-list))
 186 ;;       (setq hostname-list (list hostname-list))))
 187 ;;     (while (and hostname-list (null proc))
 188 ;;       (setq hostname (car hostname-list)
 189 ;;          hostname-list (cdr hostname-list))
 190 ;;       (message msg-form hostname)
 191 ;;       (sit-for 0)
 192 ;;       (condition-case result
 193 ;;        (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 194 ;;      (error nil))
 195 ;;       (if proc
 196 ;;        (progn
 197 ;;          (process-kill-without-query proc)
 198 ;;          (set-process-coding-system proc 'binary 'binary)
 199 ;;          (set-marker-insertion-type (process-mark proc) t)
 200 ;;          ;; Initialize dictionaries
 201 ;;          (setq sj3-sys-dict-list nil)
 202 ;;          (setq sj3-user-dict-list nil)
 203 ;;          (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 204 ;;          (if (< result 0)
 205 ;;              (progn
 206 ;;                (delete-process proc)
 207 ;;                (setq proc nil
 208 ;;                      msg (format "Can't open SJ3 session (%s): %s"
 209 ;;                                  hostname msg)))
 210 ;;            (setq result (sj3rpc-get-stdy-size proc))
 211 ;;            (if (< result 0)
 212 ;;                (progn
 213 ;;                  (delete-process proc)
 214 ;;                  (setq proc nil
 215 ;;                        msg (format "Can't get SJ3 STDYSIZE: %s"
 216 ;;                                    (sj3rpc-get-error-message (- result)))))
 217 ;;              (setq sj3-stdy-size result))))))
 218 ;;     (if proc
 219 ;;      (progn
 220 ;;        (setq sj3-open-message (format (concat msg-form "done") hostname))
 221 ;;        proc)
 222 ;;       (kill-buffer buf)
 223 ;;       (error "%s" (or msg "no sj3serv available")))))
 224
 225 ;; <env> ::= [ <proc> <dictionary-list> ]
 226 (defvar sj3-environment nil
 227   "Environment for SJ3 kana-kanji conversion")
 228
 229 (defsubst sj3env-get-proc (env)
 230   (aref env 0))
 231 (defsubst sj3env-get-dictionary-list (env)
 232   (aref env 1))
 233
 234 ;; <sj3-bunsetsu> ::=
 235 ;;  [ <env> <source> <converted> <rest> <stdy>
 236 ;;    <zenkouho> <zenkouho-pos> <zenkouho-converted>
 237 ;;    <kugiri-changed> ]
 238 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
 239   (egg-bunsetsu-create
 240    'sj3-conversion-backend
 241    (vector env source converted rest stdy nil nil nil nil nil)))
 242
 243 (defsubst sj3bunsetsu-get-env (b)
 244   (aref (egg-bunsetsu-get-info b) 0))
 245 (defsubst sj3bunsetsu-get-source (b)
 246   (aref (egg-bunsetsu-get-info b) 1))
 247 (defsubst sj3bunsetsu-get-converted (b)
 248   (aref (egg-bunsetsu-get-info b) 2))
 249 (defsubst sj3bunsetsu-get-rest (b)
 250   (aref (egg-bunsetsu-get-info b) 3))
 251 (defsubst sj3bunsetsu-get-stdy (b)
 252   (aref (egg-bunsetsu-get-info b) 4))
 253
 254 (defsubst sj3bunsetsu-get-zenkouho (b)
 255   (aref (egg-bunsetsu-get-info b) 5))
 256 (defsubst sj3bunsetsu-set-zenkouho (b z)
 257   (aset (egg-bunsetsu-get-info b) 5 z))
 258
 259 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
 260   (aref (egg-bunsetsu-get-info b) 6))
 261 (defsubst sj3bunsetsu-set-zenkouho-pos (b zp)
 262   (aset (egg-bunsetsu-get-info b) 6 zp))
 263
 264 (defsubst sj3bunsetsu-get-zenkouho-converted (b)
 265   (aref (egg-bunsetsu-get-info b) 7))
 266 (defsubst sj3bunsetsu-set-zenkouho-converted (b zc)
 267   (aset (egg-bunsetsu-get-info b) 7 zc))
 268
 269 (defsubst sj3bunsetsu-get-kugiri-changed (b)
 270   (aref (egg-bunsetsu-get-info b) 8))
 271 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
 272   (aset (egg-bunsetsu-get-info b) 8 s))
 273
 274 (defun sj3-get-bunsetsu-source (b)
 275   (sj3bunsetsu-get-source b))
 276
 277 (defun sj3-get-bunsetsu-converted (b)
 278   (concat (sj3bunsetsu-get-converted b) (sj3bunsetsu-get-rest b)))
 279
 280 (defun sj3-get-source-language (b) 'Japanese)
 281 (defun sj3-get-converted-language (b) 'Japanese)
 282 (defun sj3-get-bunsetsu-stdy (b) (sj3bunsetsu-get-stdy b))
 283
 284 (defvar sj3-dictionary-specification
 285   '(("study.dat")
 286     ["sj3main.dic" ""]
 287     [("private.dic") ""])
 288   "Dictionary specification of SJ3.")
 289
 290 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 291   "*Directory of user dictionary for SJ3.")
 292
 293 (defun sj3-filename (p)
 294   ""
 295   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 296         (t p)))
 297
 298 (defun sj3-get-environment ()
 299   "Return the backend of SJ3 environment."
 300   (if sj3-environment
 301       sj3-environment
 302     (let* ((proc (sj3-open sj3-hostname))
 303            (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
 304            (l (cdr sj3-dictionary-specification))
 305            dict-list)
 306       (sj3-open-freq-info proc freq-info-name)
 307       (while l
 308         (let ((dic (car l))
 309               dic-id)
 310           (setq dic-id
 311                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 312                                      (aref dic 1)))
 313           (if (< dic-id 0)
 314               (egg-error "Dame2")       ; XXX
 315             (setq dict-list (cons dic-id dict-list)
 316                   l (cdr l)))))
 317       (setq sj3-environment (vector proc dict-list)))))
 318
 319 (defun sj3-open-freq-info (proc name)
 320   (let ((trying t)
 321         ret)
 322     (while trying
 323       (setq ret (sj3rpc-open-stdy proc name))
 324       (if (= ret 0)
 325           (setq trying nil)
 326         (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 327         (if (/= ret (SJ3-const FileNotExist))
 328             (egg-error "Fatal1")        ; XXX
 329           (if (and (y-or-n-p
 330                     (format "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 331                             name))
 332                    (sj3rpc-make-directory proc
 333                                           (file-name-directory name))
 334                    ;; ignore error
 335                    (= (sj3rpc-make-stdy proc name) 0))
 336               (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 337             (egg-error "Fatal2")))))))  ; XXX
 338
 339 (defun sj3-open-dictionary (proc name passwd)
 340   (let ((trying t)
 341         ret)
 342     (while trying
 343       (setq ret (sj3rpc-open-dictionary proc name passwd))
 344       (if (>= ret 0)
 345           (setq trying nil)
 346         (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 347         (setq ret (- ret))              ; Get error code.
 348         (if (/= ret (SJ3-const FileNotExist))
 349             (egg-error "Fatal3 %d" ret) ; XXX
 350           (if (and (y-or-n-p
 351                     (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 352                             name))
 353                    (= (sj3rpc-make-dictionary proc name) 0))
 354               (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 355             (egg-error "Fatal4")))))    ; XXX
 356     ret))
 357
 358 (defun sj3-start-conversion (backend yomi &optional context)
 359   "Convert YOMI string to kanji, and enter conversion mode.
 360 Return the list of bunsetsu."
 361   (let ((env (sj3-get-environment)))
 362     (sj3rpc-begin env yomi)))
 363
 364 (defun sj3-end-conversion (bunsetsu-list abort)
 365   (if abort
 366       ()
 367     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 368           (l bunsetsu-list)
 369           bunsetsu stdy kugiri-changed)
 370       (while l
 371         (setq bunsetsu (car l))
 372         (setq l (cdr l))
 373         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 374         (if stdy
 375             (sj3rpc-bunsetsu-stdy env stdy))
 376         (if (and l
 377                  (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed
 378                                        bunsetsu)))
 379             (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
 380                   (yomi2 (sj3bunsetsu-get-source (car l))))
 381               (if (/= kugiri-changed (length yomi1))
 382                   (sj3rpc-kugiri-stdy env yomi1 yomi2
 383                                       (sj3bunsetsu-get-stdy (car l))))))))))
 384
 385 (defun sj3-list-candidates (bunsetsu prev-bunsetsu next-bunsetsu major)
 386   (setq bunsetsu (car bunsetsu))
 387   (if (sj3bunsetsu-get-zenkouho bunsetsu)
 388       (cons (sj3bunsetsu-get-zenkouho-pos bunsetsu)
 389             (sj3bunsetsu-get-zenkouho-converted bunsetsu))
 390     (let* ((env (sj3bunsetsu-get-env bunsetsu))
 391            (yomi (sj3bunsetsu-get-source bunsetsu))
 392            (z (sj3rpc-get-bunsetsu-candidates env yomi)))
 393       (sj3bunsetsu-set-zenkouho bunsetsu z)
 394       (cons (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
 395             (sj3bunsetsu-set-zenkouho-converted
 396              bunsetsu
 397              (mapcar 'sj3bunsetsu-get-converted z))))))
 398
 399 (defun sj3-decide-candidate (bunsetsu candidate-pos prev-b next-b)
 400   (setq bunsetsu (car bunsetsu))
 401   (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
 402          (candidate (nth candidate-pos candidate-list)))
 403     (sj3bunsetsu-set-zenkouho candidate candidate-list)
 404     (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
 405     (sj3bunsetsu-set-zenkouho-converted
 406      candidate (sj3bunsetsu-get-zenkouho-converted bunsetsu))
 407     (list (list candidate))))
 408
 409 (defun sj3-change-bunsetsu-length (bunsetsu prev-b next-b len major)
 410   (let ((yomi (mapconcat 'sj3bunsetsu-get-source bunsetsu nil))
 411         (env (sj3bunsetsu-get-env (car bunsetsu)))
 412         (old (car bunsetsu))
 413         new yomi1 yomi2)
 414     (setq yomi1 (substring yomi 0 len)
 415           yomi2 (substring yomi len))
 416     (setq new (sj3rpc-tanbunsetsu-conversion env yomi1))
 417     ;; Only set once (memory original length of the bunsetsu).
 418     (sj3bunsetsu-set-kugiri-changed new
 419                                     (or (sj3bunsetsu-get-kugiri-changed old)
 420                                         (length (sj3bunsetsu-get-source old))))
 421     (if (> (length yomi2) 0)
 422         (list (list new (sj3rpc-tanbunsetsu-conversion env yomi2)))
 423       (list (list new)))))
 424
 425 (defun sj3-finalize-backend ()
 426   (if sj3-environment
 427       (let ((proc (sj3env-get-proc sj3-environment))
 428             (dict-list (sj3env-get-dictionary-list sj3-environment))
 429             dict)
 430         (while dict-list
 431           (setq dict (car dict-list))
 432           (setq dict-list (cdr dict-list))
 433           (sj3rpc-close-dictionary proc dict)) ; XXX: check error
 434         (sj3rpc-close-stdy proc)
 435         (sj3rpc-close proc)
 436         (setq sj3-environment nil))))
 437
 438 ;;; word registration
 439
 440 (defun sj3-dictionary-select ()
 441   (menudiag-select (list 'menu
 442                          (egg-get-message 'sj3-register-1)
 443                          (aref (nth 2 sj3-dictionary-specification) 0))))
 444
 445 (defun sj3-hinshi-select ()
 446   (menudiag-select (list 'menu
 447                          (egg-get-message 'sj3-register-2)
 448                          sj3-hinshi-menu)))
 449
 450 (defun sj3-word-registration (backend kanji yomi)
 451   "Register a word KANJI with a pronunciation YOMI."
 452   (if (or (null (eq (egg-get-language 0 kanji)
 453                     (sj3-get-converted-language backend)))
 454           (next-single-property-change 0 'egg-lang kanji)
 455           (null (eq (egg-get-language 0 yomi)
 456                     (sj3-get-source-language backend)))
 457           (next-single-property-change 0 'egg-lang yomi))
 458       (egg-error "word registration: invalid character")
 459     (let* ((env (sj3-get-environment))
 460            (dic (sj3-dictionary-select))
 461            (hinshi-id (sj3-hinshi-select))
 462            (result (sj3rpc-add-word env
 463                                     (car (aref env 1))
 464                                     yomi kanji hinshi-id)))
 465       (if (>= result 0)
 466           (list (sj3-hinshi-name hinshi-id) dic)
 467         (egg-error (sj3rpc-get-error-message (- result)))))))
 468
 469 ;;; setup
 470
 471 (load "egg/sj3rpc")
 472 (run-hooks 'sj3-load-hook)
 473
 474 ;;;###autoload
 475 (defun egg-activate-sj3 (&rest arg)
 476   "Activate SJ3 backend of Tamago-tsunagi."
 477   (apply 'egg-mode (append arg sj3-backend-alist)))
 478
 479 ;;; egg/sj3.el ends here.