egg-cnv.el

   1 ;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture
   2
   3 ;; Copyright (C) 1997 Mule Project,
   4 ;; Powered by Electrotechnical Laboratory, JAPAN.
   5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   6
   7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
   8 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
   9 ;; Keywords: mule, multilingual, input method
  10
  11 ;; This file will be part of GNU Emacs (in future).
  12
  13 ;; GNU Emacs 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 ;; GNU Emacs 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., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30
  31 ;;; Code:
  32
  33 (defsubst egg-bunsetsu-info () 'intangible)
  34 ;;
  35
  36 (defvar egg-conversion-backend nil)
  37
  38 (defun egg-initialize-backend ()
  39   (funcall (aref egg-conversion-backend 0)))
  40
  41 (defun egg-start-conversion (yomi-string)
  42   (funcall (aref egg-conversion-backend 1) yomi-string))
  43 (defun egg-get-bunsetsu-converted (bunsetsu-info)
  44   (funcall (aref egg-conversion-backend 2) bunsetsu-info))
  45 (defun egg-get-bunsetsu-source (bunsetsu-info)
  46   (funcall (aref egg-conversion-backend 3) bunsetsu-info))
  47 (defun egg-list-candidates (bunsetsu-info prev-bunsetsu-info)
  48   (funcall (aref egg-conversion-backend 4) bunsetsu-info prev-bunsetsu-info))
  49 (defun egg-get-number-of-candidates (bunsetsu-info)
  50   (funcall (aref egg-conversion-backend 5) bunsetsu-info))
  51 (defun egg-get-current-candidate-number (bunsetsu-info)
  52   (funcall (aref egg-conversion-backend 6) bunsetsu-info))
  53 (defun egg-get-all-candidates (bunsetsu-info)
  54   (funcall (aref egg-conversion-backend 7) bunsetsu-info))
  55 (defun egg-decide-candidate (bunsetsu-info candidate-pos)
  56   (funcall (aref egg-conversion-backend 8) bunsetsu-info candidate-pos))
  57 (defun egg-change-bunsetsu-length (b0 b1 b2 len)
  58   (funcall (aref egg-conversion-backend 9) b0 b1 b2 len))
  59 (defun egg-end-conversion (bunsetsu-info-list)
  60   (funcall (aref egg-conversion-backend 10) bunsetsu-info-list))
  61
  62 (defun egg-finalize-backend ()
  63   (funcall (aref egg-conversion-backend 11)))
  64 \f
  65 (defvar egg-conversion-open "|")
  66 (defvar egg-conversion-close "|")
  67 (defvar egg-conversion-separator " ")
  68
  69 ;;
  70 (defun egg-convert-region (start end)
  71   (interactive "r")
  72   (let ((bunsetsu-info-list
  73          (egg-start-conversion (buffer-substring start end)))
  74         p)
  75     (delete-region start end)
  76     (setq p (point))
  77     (insert egg-conversion-open)
  78     (put-text-property p (point) 'egg-start t)
  79     (if egg-conversion-face
  80         (put-text-property p (point) 'invisible t))
  81     ;;
  82     (egg-insert-bunsetsu-list bunsetsu-info-list)
  83     ;;
  84     (setq p (point))
  85     (insert egg-conversion-close)
  86     (put-text-property p (point) 'egg-end t)
  87     (if egg-conversion-face
  88         (put-text-property p (point) 'invisible t))
  89     (goto-char (1+ start))))
  90
  91 (defvar egg-conversion-face nil)
  92 (defvar egg-conversion-map
  93   (let ((map (make-sparse-keymap))
  94         (i 33))
  95     (while (< i 127)
  96       (define-key map (vector i) 'egg-exit-conversion-unread-char)
  97       (setq i (1+ i)))
  98     (define-key map "\C-@" 'egg-decide-first-char)
  99     (define-key map [?\C-\ ] 'egg-decide-first-char)
 100     (define-key map "\C-a"   'egg-beginning-of-conversion-buffer)
 101     (define-key map "\C-b"   'egg-backward-bunsetsu)
 102     (define-key map "\C-e"   'egg-end-of-conversion-buffer)
 103     (define-key map "\C-f"   'egg-forward-bunsetsu)
 104     (define-key map "\C-h"   'egg-help-command)
 105     (define-key map "\C-i"   'egg-shrink-bunsetsu)
 106     (define-key map "\C-k"   'egg-decide-before-point)
 107 ;;    (define-key map "\C-l"   'egg-exit-conversion)  ; Don't override C-L
 108     (define-key map "\C-m"   'egg-exit-conversion)
 109     (define-key map "\C-n"   'egg-next-candidate)
 110     (define-key map "\C-o"   'egg-enlarge-bunsetsu)
 111     (define-key map "\C-p"   'egg-previous-candidate)
 112     (define-key map "\M-s"   'egg-select-candidate)
 113     (define-key map [return] 'egg-exit-conversion)
 114 ;;    (define-key map "\C-\\"  'egg-exit-mode-no-egg)
 115     (define-key map [right]  'egg-forward-bunsetsu)
 116     (define-key map [left]   'egg-backward-bunsetsu)
 117     (define-key map " "      'egg-next-candidate)
 118     (define-key map "/"      'egg-exit-conversion)
 119     map)
 120   "Keymap for EGG Conversion mode.")
 121
 122 (defun egg-exit-conversion-unread-char ()
 123   (interactive)
 124   (setq unread-command-events (list last-command-event))
 125   (egg-exit-conversion))
 126
 127 (defun egg-insert-bunsetsu (bunsetsu-info last)
 128   (let ((bunsetsu (egg-get-bunsetsu-converted bunsetsu-info))
 129         (p (point)))
 130     (insert bunsetsu)
 131     (if (not last)
 132         (insert egg-conversion-separator))
 133     (add-text-properties p (point)
 134                          (list 'face      egg-conversion-face
 135                                'local-map egg-conversion-map
 136                                (egg-bunsetsu-info) bunsetsu-info
 137                                'egg-bunsetsu-last last))))
 138
 139 (defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional contin)
 140   (let ((l bunsetsu-info-list)
 141         bunsetsu-info bunsetsu p)
 142     (while l
 143       (setq bunsetsu-info (car l)
 144             l (cdr l)
 145             p (point))
 146       (egg-insert-bunsetsu bunsetsu-info (and (null l) (null contin))))))
 147
 148 (defun egg-backward-bunsetsu (n)
 149   (interactive "p")
 150   (let (start)
 151     (while (and (null start) (> n 0))
 152       (backward-char)
 153       (if (setq start (get-text-property (point) 'egg-start))
 154           (forward-char)
 155         (setq n (1- n))))
 156     (if (> n 0)
 157         (signal 'beginning-of-buffer nil))))
 158
 159 (defun egg-forward-bunsetsu (n)
 160   (interactive "p")
 161   (let (end)
 162     (while (and (null end) (> n 0))
 163       (forward-char)
 164       (if (setq end (get-text-property (point) 'egg-end))
 165           (backward-char)
 166         (setq n (1- n))))
 167     (if (> n 0)
 168         (signal 'end-of-buffer nil))))
 169
 170 (defun egg-get-previous-bunsetsu (p)
 171   (if (get-text-property (1- p) 'egg-start)
 172       nil
 173     (get-text-property (- p 2) (egg-bunsetsu-info))))
 174
 175 (defun egg-shrink-bunsetsu (n)
 176   (interactive "p")
 177   (let* ((b0 (egg-get-previous-bunsetsu (point)))
 178          (b1 (get-text-property (point) (egg-bunsetsu-info)))
 179          (last (get-text-property (point) 'egg-bunsetsu-last))
 180          (slen (chars-in-string (egg-get-bunsetsu-source b1)))
 181          (newlen (- slen n))
 182          b2 bunsetsu-info-list beep)
 183     (if (< newlen 1)
 184         (setq beep t
 185               newlen 1))
 186     (if (not last)
 187         (let ((p2 (save-excursion (forward-char) (point))))
 188           (setq b2 (get-text-property p2 (egg-bunsetsu-info))
 189                 last (get-text-property p2 'egg-bunsetsu-last))))
 190     (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 newlen))
 191     (delete-region (point)
 192                    (progn (forward-char) (if b2 (forward-char)) (point)))
 193     (let ((p (point)))
 194       (egg-insert-bunsetsu-list bunsetsu-info-list (not last))
 195       (goto-char p))
 196     (if beep
 197         (ding))))
 198
 199 (defun egg-enlarge-bunsetsu (n)
 200   (interactive "p")
 201   (let* ((b0 (egg-get-previous-bunsetsu (point)))
 202          (b1 (get-text-property (point) (egg-bunsetsu-info)))
 203          (last (get-text-property (point) 'egg-bunsetsu-last))
 204          (slen (chars-in-string (egg-get-bunsetsu-source b1)))
 205          (newlen (+ slen n))
 206          b2 maxlen bunsetsu-info-list beep)
 207     (if (not last)
 208         (let ((p2 (save-excursion (forward-char) (point))))
 209           (setq b2 (get-text-property p2 (egg-bunsetsu-info))
 210                 last (get-text-property p2 'egg-bunsetsu-last))))
 211     (setq maxlen (+ slen
 212                     (if b2
 213                         (chars-in-string (egg-get-bunsetsu-source b2))
 214                       0)))
 215     (if (> newlen maxlen)
 216         (setq beep t
 217               newlen maxlen))
 218     (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 newlen))
 219     (delete-region (point)
 220                    (progn (forward-char) (if b2 (forward-char)) (point)))
 221     (let ((p (point)))
 222       (egg-insert-bunsetsu-list bunsetsu-info-list (not last))
 223       (goto-char p))
 224     (if beep
 225         (ding))))
 226
 227 (defun egg-next-candidate (n)
 228   (interactive "p")
 229   (let ((last (get-text-property (point) 'egg-bunsetsu-last))
 230         (b (get-text-property (point) (egg-bunsetsu-info)))
 231         new i max+ p beep)
 232     (setq max+ (egg-get-number-of-candidates b))
 233     (if (null max+)
 234         (let ((prev-b (egg-get-previous-bunsetsu (point))))
 235           (setq i (egg-list-candidates b prev-b)) ; there is a case I=/=0
 236           (if (or (> n 1) (< n 0))      ; with N=/=1, start with I
 237               (setq i (+ n i))          ; or else (N==1),
 238             (setq i (if (= i 0) 1 0)))  ;   I:=1 when I was 0, or else I:=0
 239           (setq max+ (egg-get-number-of-candidates b)))
 240       (setq i (egg-get-current-candidate-number b))
 241       (setq i (+ n i)))
 242     (if (< i 0)                         ; go backward as if it is ring
 243         (while (< i 0)
 244           (setq i (+ i max+))))
 245     (if (>= i max+)                     ; don't go forward
 246         (setq i (1- max+)
 247               beep t))
 248     (setq new (egg-decide-candidate b i))
 249     (setq p (point))
 250     (delete-region p (progn (forward-char) (point)))
 251     (egg-insert-bunsetsu new last)
 252     (goto-char p)
 253     (if beep
 254         (ding))))
 255
 256 (defun egg-previous-candidate (n)
 257   (interactive "p")
 258   (egg-next-candidate (- n)))
 259
 260 (defun egg-decide-bunsetsu (&optional end-marker)
 261   (let ((in-loop t)
 262         p bunsetsu-info-list bl)
 263     (setq p (point))
 264     (while in-loop
 265       (let ((bl1 (cons (get-text-property p (egg-bunsetsu-info)) nil)))
 266         (if bl
 267             (setq bl (setcdr bl bl1))
 268           (setq bunsetsu-info-list (setq bl bl1))))
 269       (forward-char)
 270       (remove-text-properties p (point) '(face nil
 271                                           intangible nil
 272                                           local-map nil
 273                                           egg-bunsetsu-last nil))
 274       (setq p (point))
 275       (if (or (and end-marker (= p end-marker))
 276               (get-text-property p 'egg-end))
 277           (setq in-loop nil)
 278         (setq p (1- p))
 279         (delete-region p (1+ p))))      ; Delete bunsetsu separator
 280     bunsetsu-info-list))
 281
 282 (defun egg-decide-before-point ()
 283   (interactive)
 284   (let ((m (make-marker))
 285         all start bunsetsu-list)
 286     (if (get-text-property (1- (point)) 'egg-start)
 287         (signal 'beginning-of-buffer nil)
 288       (setq start (1- (previous-single-property-change (point) 'egg-start))))
 289     (set-marker m (point))
 290     (goto-char start)
 291     ;; Delete open marker
 292     (delete-region start (1+ start))
 293     (setq bunsetsu-list (egg-decide-bunsetsu m))
 294     ;; delete separator
 295     (delete-region (1- (point)) (point))
 296     ;; insert open marker
 297     (insert egg-conversion-open)
 298     (put-text-property m (point) 'egg-start t)
 299     (if egg-conversion-face
 300         (put-text-property p (point) 'invisible t))
 301     (egg-end-conversion bunsetsu-list)
 302     (set-marker m nil)))
 303
 304 (defun egg-exit-conversion ()
 305   (interactive)
 306   (let (start bunsetsu-list)
 307     (if (get-text-property (1- (point)) 'egg-start)
 308         (setq start (1- (point)))
 309       (setq start (1- (previous-single-property-change (point) 'egg-start))))
 310     (goto-char start)
 311     ;; Delete open marker
 312     (delete-region start (1+ start))
 313     (setq bunsetsu-list (egg-decide-bunsetsu))
 314     ;; Delete close marker
 315     (delete-region (point) (1+ (point)))
 316     (egg-do-auto-fill)
 317     (egg-end-conversion bunsetsu-list)
 318     (run-hooks 'input-method-after-insert-chunk-hook)))
 319
 320 (defun egg-select-candidate ()
 321   (interactive)
 322   (let ((last (get-text-property (point) 'egg-bunsetsu-last))
 323         (b (get-text-property (point) (egg-bunsetsu-info)))
 324         (in-loop t)
 325         new i max+ p)
 326     (setq max+ (egg-get-number-of-candidates b))
 327     (if (null max+)
 328         (let ((prev-b (egg-get-previous-bunsetsu (point))))
 329           (setq i (egg-list-candidates b prev-b))
 330           (setq max+ (egg-get-number-of-candidates b)))
 331       (setq i (egg-get-current-candidate-number b)))
 332     (let* ((candidate-list (egg-get-all-candidates b))
 333            (l candidate-list)
 334            (candidate (menudiag-select (list 'menu "\e$B8uJd\e(B:" l) (list (nth i l)))))
 335       (setq i 0)
 336       (while in-loop
 337         (if (eq candidate (car l))
 338             (setq in-loop nil)
 339           (setq l (cdr l)
 340                 i (1+ i))))
 341       (setq new (egg-decide-candidate b i))
 342       (setq p (point))
 343       (delete-region p (progn (forward-char) (point)))
 344       (egg-insert-bunsetsu new last)
 345       (goto-char p))))
 346
 347 (provide 'egg-cnv)
 348 ;;; egg-cnv.el ends here.