egg-cnv.el

   1 ;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture
   2
   3 ;; Copyright (C) 1999,2000 PFU LIMITED
   4
   5 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   6 ;;         KATAYAMA Yoshio <kate@pfu.co.jp>
   7
   8 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
   9
  10 ;; Keywords: mule, multilingual, input method
  11
  12 ;; This file is part of EGG.
  13
  14 ;; EGG 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 version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; EGG 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 GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31
  32 ;;; Code:
  33
  34 (require 'egg-edep)
  35
  36 (defgroup egg-conv nil
  37   "Conversion backend Interface of Tamagotchy"
  38   :group 'egg)
  39
  40 (defcustom egg-conversion-wrap-select nil
  41   "*Candidate selection wraps around to first candidate, if non-NIL.
  42 Otherwise stop at the last candidate."
  43   :group 'egg-conv :type 'boolean)
  44
  45 (defcustom egg-conversion-auto-candidate-menu 0
  46   "*Automatically enter the candidate selectionmenu mode at N times
  47 next/previous-candidate, if positive number N."
  48   :group 'egg-conv :type 'integer)
  49
  50 (defcustom egg-conversion-fence-invisible nil
  51   "*Make fence marks invisible, if non-NIL."
  52   :group 'egg-conv :type 'boolean)
  53
  54 (defcustom egg-conversion-fence-open "|"
  55   "*String of conversion fence start mark. (should not be null string)"
  56   :group 'egg-conv :type '(string :valid-regexp ".+"))
  57
  58 (defcustom egg-conversion-fence-close "|"
  59   "*String of conversion fence end mark. (should not be null string)"
  60   :group 'egg-conv :type '(string :valid-regexp ".+"))
  61
  62 (defcustom egg-conversion-face nil
  63   "*Face (or alist of languages and faces) of text in conversion fences."
  64   :group 'egg-conv
  65   :type '(choice face
  66                  (repeat :tag "Language-Face alist"
  67                          (cons :tag "Language-Face"
  68                                (choice :tag "Language"
  69                                        (const Japanese)
  70                                        (const Chinese-GB)
  71                                        (const Chinese-CNS)
  72                                        (const Korean)
  73                                        (const :tag "Default" t)
  74                                        (symbol :tag "Other"))
  75                                face))))
  76
  77 (defcustom egg-conversion-major-separator " "
  78   "*Major clause seperator"
  79   :group 'egg-conv :type 'string)
  80
  81 (defcustom egg-conversion-minor-separator "-"
  82   "*Minor clause seperator"
  83   :group 'egg-conv :type 'string)
  84
  85 (defcustom egg-startup-file ".eggrc"
  86   "*Egg startup file name."
  87   :group 'egg-conv :type 'string)
  88
  89 (defcustom egg-startup-file-search-path '("~")
  90   "*List of directories to search for egg-startup-file (default .eggrc)."
  91   :group 'egg-conv :type '(repeat string))
  92
  93 (egg-add-message
  94  '((nil
  95     (no-rcfile     "no egg-startup-file on %S")
  96     (rcfile-error  "error occured in egg-startup-file")
  97     (candidate     "candidates:")
  98     (register-str  "Chinese character:")
  99     (register-yomi "word registration ``%s''  pronunciation:")
 100     (registered    "dictionary entry ``%s''(%s: %s) is registerd at %s"))
 101    (Japanese
 102     (no-rcfile     "%S \e$B>e$K\e(B egg-startup-file \e$B$,$"$j$^$;$s\e(B")
 103     (rcfile-error  "egg-startup-file \e$B$G%(%i!<$,$"$j$^$7$?\e(B")
 104     (candidate     "\e$B8uJd\e(B:")
 105     (register-str  "\e$B4A;z\e(B:")
 106     (register-yomi "\e$B<-=qEPO?!X\e(B%s\e$B!Y\e(B  \e$BFI$_\e(B:")
 107     (registered    "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B %s \e$B$KEPO?$7$^$7$?\e(B"))
 108    (Chinese-GB
 109     (no-rcfile     "\e$ATZ\e(B %S \e$AIOC;SP\e(B egg-startup-file")
 110     (rcfile-error  "\e$ATZ6AH!\e(B egg-startup-file \e$AJ1#,SP3v4m7"IzAK\e(B")
 111     (candidate     "\e$A:r29\e(B:")
 112     (register-str  "\e$A::WV\e(B:")
 113     (register-yomi "\e$A4G5d5GB<!:\e(B%s\e$A!;\e(B \e$A6A7(\e(B:")
 114     (registered    "\e$A4G5dOnD?!:\e(B%s\e$A!;\e(B(%s: %s)\e$ARQ1;5GB<5=\e(B %s \e$AVPAK\e(B"))
 115    (Chinese-CNS
 116     (no-rcfile     "\e$(GGc\e(B %S \e$(GD8JtH4\e(B egg-startup-file")
 117     (rcfile-error  "\e$(GGc{tL=\e(B egg-startup-file \e$(GUk!"H4Exrc`uFmD'\e(B")
 118     (register-str  "\e$(GiGGs\e(B:")
 119     (candidate     "\e$(GT7fP\e(B:")
 120     (register-yomi "\e$(Gy0L(`trg!Z\e(B%s\e$(G![\e(B  \e$(G{tNN\e(B:")
 121     (registered    "\e$(Gy0L(bzFx!Z\e(B%s\e$(G![\e(B(%s: %s)\e$(GDX]7`trgL/\e(B %s \e$(GDcD'\e(B"))
 122    (Korean
 123     (no-rcfile     "%S \e$(C?!\e(B egg-startup-file \e$(C@L\e(B \e$(C>x@>4O4Y\e(B")
 124     (rcfile-error  "egg-startup-file \e$(C?!\e(B \e$(C?!7/0!\e(B \e$(C9_;}G_@>4O4Y\e(B")
 125     (candidate     "\e$(CHD:8\e(B:")
 126     (register-str  "\e$(CGQ@Z\e(B:")
 127     (register-yomi "\e$(C;g@|5n7O!:\e(B%s\e$(C!;\e(B  \e$(C569}\e(B:")
 128     (registered    "\e$(C;g@|GW8q!:\e(B%s\e$(C!;\e(B(%s: %s)\e$(C@;\e(B %s\e$(C?!\e(B \e$(C5n7OG_@>4O4Y\e(B"))))
 129
 130 ;;
 131 ;; <backend-alist> ::= ( ( <language> ( <stage>... )... )... )
 132 ;; <stage> ::= ( <backend> <backend-for-reconvert>... )
 133 ;; <backend-for-reconvert> ::= <backend>
 134 ;; <backend> ::= symbol
 135 ;;
 136
 137 (defvar egg-conversion-backend-alist nil)
 138 (make-variable-buffer-local 'egg-conversion-backend-alist)
 139 (put 'egg-conversion-backend-alist 'permanent-local t)
 140
 141 (defun egg-set-conversion-backend (backend-alist &optional force)
 142   (let (pair lang backend-set)
 143     (while backend-alist
 144       (setq lang (caar backend-alist)
 145             backend-set (cdar backend-alist)
 146             backend-alist (cdr backend-alist)
 147             pair (assq lang egg-conversion-backend-alist))
 148       (cond
 149        ((null pair)
 150         (setq egg-conversion-backend-alist
 151               (cons (cons lang backend-set) egg-conversion-backend-alist)))
 152        (force
 153         (setcdr pair backend-set))))))
 154
 155 (defun egg-get-conversion-backend (language n use-default)
 156   (let (backend)
 157     (cond ((null n) (setq n 0))
 158           ((null (integerp n)) (setq n 1)))
 159     (setq backend (nth (1+ n) (assq language egg-conversion-backend-alist)))
 160     (if backend
 161         (and backend (cons 0 (mapcar 'copy-sequence backend)))
 162       (and use-default (cons 0 egg-default-conversion-backend)))))
 163
 164 (defsubst egg-default-conversion-backend-p (backend)
 165   (eq (cdr backend) egg-default-conversion-backend))
 166
 167 (defsubst egg-get-current-backend (backend)
 168   (car (nth (car backend) (cdr backend))))
 169
 170 (defsubst egg-get-reconvert-backend (backend &optional n)
 171   (cond ((null n) (setq n 0))
 172         ((null (integerp n)) (setq n 1)))
 173   (nth (1+ n) (nth (car backend) (cdr backend))))
 174
 175 (defmacro egg-bunsetsu-info () ''intangible)
 176
 177 (defsubst egg-get-bunsetsu-info (p &optional object)
 178   (get-text-property p (egg-bunsetsu-info) object))
 179
 180 (defsubst egg-get-backend (p &optional object)
 181   (get-text-property p 'egg-backend object))
 182
 183 (defsubst egg-get-language (p &optional object)
 184   (get-text-property p 'egg-lang object))
 185
 186 (defsubst egg-get-bunsetsu-last (p &optional object)
 187   (get-text-property p 'egg-bunsetsu-last object))
 188
 189 (defsubst egg-get-major-continue (p &optional object)
 190   (get-text-property p 'egg-major-continue object))
 191
 192 (defsubst egg-get-char-size (p &optional object)
 193   (get-text-property p 'egg-char-size object))
 194
 195 ;; <bunsetsu-info> ::= ( <backend> . <backend-dependent-info> )
 196
 197 (defsubst egg-bunsetsu-create (backend info)
 198   (cons backend info))
 199
 200 (defsubst egg-bunsetsu-get-backend (bunsetsu)
 201   (car bunsetsu))
 202 (defsubst egg-bunsetsu-set-backend (bunsetsu backend)
 203   (setcar bunsetsu backend))
 204
 205 (defsubst egg-bunsetsu-get-info (bunsetsu)
 206   (cdr bunsetsu))
 207 (defsubst egg-bunsetsu-set-info (bunsetsu info)
 208   (setcdr bunsetsu info))
 209
 210 (defvar egg-finalize-backend-list nil)
 211
 212 (defun egg-set-finalize-backend (func-list)
 213   (mapcar (lambda (func)
 214             (if (and func
 215                      (null (memq func egg-finalize-backend-list)))
 216                 (setq egg-finalize-backend-list
 217                       (cons func egg-finalize-backend-list))))
 218           func-list))
 219
 220 (defmacro egg-define-backend-functions (list)
 221   (cons 'progn
 222         (mapcar
 223          (lambda (def)
 224            (let* ((func (car def))
 225                   (args (nth 1 def))
 226                   (backend (car args)))
 227              (cond ((eq backend 'bunsetsu)
 228                     (setq backend `(egg-bunsetsu-get-backend ,backend)))
 229                    ((eq backend 'bunsetsu-list)
 230                     (setq backend `(egg-bunsetsu-get-backend (car ,backend)))))
 231              `(defun ,func ,args
 232                 (let ((func (get ,backend ',func)))
 233                   (and func
 234                        (funcall func ,@args))))))
 235          list)))
 236
 237 (egg-define-backend-functions
 238  ((egg-start-conversion (backend source-string context))
 239   (egg-get-bunsetsu-source (bunsetsu))
 240   (egg-get-bunsetsu-converted (bunsetsu))
 241   (egg-get-source-language (bunsetsu))
 242   (egg-get-converted-language (bunsetsu))
 243   (egg-major-bunsetsu-continue-p (bunsetsu))
 244   (egg-list-candidates (bunsetsu-list prev-b next-b major))
 245   (egg-decide-candidate (bunsetsu-list candidate-pos prev-b next-b))
 246   (egg-change-bunsetsu-length (bunsetsu-list prev-b next-b length major))
 247   (egg-bunsetsu-combinable-p (bunsetsu next-b))
 248   (egg-end-conversion (bunsetsu-list abort))
 249   (egg-word-inspection (bunsetsu))
 250   (egg-word-registration (backend source converted))))
 251
 252 (defun egg-finalize-backend ()
 253   (run-hooks 'egg-finalize-backend-list))
 254
 255 (setplist 'egg-conversion-backend-noconv
 256           '(egg-start-conversion          egg-start-conversion-noconv
 257             egg-get-bunsetsu-source       egg-get-bunsetsu-source-noconv
 258             egg-get-bunsetsu-converted    egg-get-bunsetsu-converted-noconv
 259             egg-get-source-language       egg-get-source-language-noconv
 260             egg-get-converted-language    egg-get-converted-language-noconv
 261             egg-end-conversion            egg-end-conversion-noconv))
 262
 263 (defun egg-start-conversion-noconv (backend yomi-string context)
 264   (let ((string (copy-sequence yomi-string))
 265         (language (egg-get-language 0 yomi-string)))
 266     (set-text-properties 0 (length string) nil string)
 267     (list (egg-bunsetsu-create backend (vector string language)))))
 268
 269 (defun egg-get-bunsetsu-source-noconv (bunsetsu)
 270   (aref (egg-bunsetsu-get-info bunsetsu) 0))
 271 (defun egg-get-bunsetsu-converted-noconv (bunsetsu)
 272   (aref (egg-bunsetsu-get-info bunsetsu) 0))
 273 (defun egg-get-source-language-noconv (bunsetsu)
 274   (aref (egg-bunsetsu-get-info bunsetsu) 1))
 275 (defun egg-get-converted-language-noconv (bunsetsu)
 276   (aref (egg-bunsetsu-get-info bunsetsu) 1))
 277 (defun egg-end-conversion-noconv (bunsetsu-list abort)
 278   nil)
 279
 280 (defconst egg-default-conversion-backend '((egg-conversion-backend-noconv)))
 281 \f
 282 (defun egg-convert-region (start end &optional context nth-backend)
 283   (interactive "r\ni\nP")
 284   (let ((source (buffer-substring start end))
 285         backend backend-source-list converted converted-list
 286         lang len s success abort)
 287     (if (>= start end)
 288         ;; nothing to do
 289         nil
 290       (delete-region start end)
 291       (let ((inhibit-read-only t))
 292         (its-define-select-keys egg-conversion-map)
 293         (goto-char start)
 294         (setq s (copy-sequence egg-conversion-fence-open)
 295               len (length s)
 296               start (+ start len)
 297               end (+ end len))
 298         (set-text-properties 0 len (list 'read-only t
 299                                          'egg-start t
 300                                          'egg-source source)
 301                              s)
 302         (if context
 303             (put-text-property 0 len 'egg-context context s))
 304         (if egg-conversion-fence-invisible
 305             (put-text-property 0 len 'invisible t s))
 306         (insert s)
 307         (setq s (copy-sequence egg-conversion-fence-close)
 308               len (length s))
 309         (set-text-properties 0 len '(read-only t rear-nonsticky t egg-end t) s)
 310         (if egg-conversion-fence-invisible
 311             (put-text-property 0 len 'invisible t s))
 312         (insert s)
 313         (goto-char start)
 314         (insert source)
 315         (goto-char start)
 316         (setq source (copy-sequence source))
 317         (egg-separate-languages source)
 318         (setq backend-source-list (egg-assign-backend source nth-backend))
 319         (while (and (null abort) backend-source-list)
 320           (setq backend (car (car backend-source-list))
 321                 lang (nth 1 (car backend-source-list))
 322                 source (nth 2 (car backend-source-list))
 323                 backend-source-list (cdr backend-source-list))
 324           (condition-case error
 325               (progn
 326                 (setq converted (egg-start-conversion
 327                                  (egg-get-current-backend backend)
 328                                  source context))
 329                 (if (null converted)
 330                     (egg-error "no conversion result"))
 331                 (setq converted-list (nconc converted-list
 332                                             (list (cons backend converted)))
 333                       context 'continued)
 334                 (or (egg-default-conversion-backend-p backend)
 335                     (setq success t)))
 336             ((egg-error quit)
 337              (cond
 338               ((null (or success
 339                          (delq t (mapcar (lambda (s)
 340                                            (egg-default-conversion-backend-p
 341                                             (cdr (car s))))
 342                                          backend-source-list))))
 343                (message "egg %s backend: %s"
 344                         (if (cdr lang) lang (car lang))
 345                         (nth (if (eq (car error) 'quit) 0 1) error))
 346                (ding)
 347                (setq abort t))
 348               ((condition-case err
 349                    (y-or-n-p
 350                     (format "egg %s backend %s: continue? "
 351                             lang (nth (if (eq (car error) 'quit) 0 1) error)))
 352                  ((error quit) nil))
 353                (setq backend (egg-get-conversion-backend nil 0 t)
 354                      converted (egg-start-conversion
 355                                 (egg-get-current-backend backend)
 356                                 source context)
 357                      converted-list (nconc converted-list
 358                                            (list (cons backend converted)))
 359                      context 'continued))
 360               (t
 361                (setq abort t))))))
 362         (delete-region start end)
 363         (while converted-list
 364           (egg-insert-bunsetsu-list (caar converted-list) (cdar converted-list)
 365                                     (or (null (cdr converted-list)) 'continue))
 366           (setq converted-list (cdr converted-list)))
 367         (goto-char start)
 368         (cond (abort
 369                (egg-abort-conversion))
 370               ((null success)
 371                (egg-exit-conversion)))))))
 372
 373 (defun egg-separate-languages (str &optional last-lang)
 374   (let (lang last-chinese
 375         (len (length str)) i j l)
 376     ;; 1st pass -- mark undefined Chinese part
 377     (if (or (eq last-lang 'Chinese-GB) (eq last-lang 'Chinese-CNS))
 378         (setq last-chinese last-lang))
 379     (setq i 0)
 380     (while (< i len)
 381       (setq j (egg-next-single-property-change i 'egg-lang str len))
 382       (if (null (egg-get-language i str))
 383           (progn
 384             (setq c (egg-string-to-char-at str i)
 385                   cset (char-charset c))
 386             (cond
 387              ((eq cset 'chinese-sisheng)
 388               (egg-string-match-charset 'chinese-sisheng str i)
 389               (setq l (match-end 0)
 390                     j (min j l)
 391                     lang 'Chinese))
 392              ((setq l (egg-chinese-syllable str i))
 393               (setq j (+ i l)
 394                     lang 'Chinese))
 395              ((eq cset 'ascii)
 396               (if (eq (string-match "[\0-\177\240-\377]+" str (1+ i)) (1+ i))
 397                   (setq j (match-end 0))
 398                 (setq j (1+ i)))
 399               (if (and (< j len)
 400                        (eq (char-charset (egg-string-to-char-at str j))
 401                            'chinese-sisheng))
 402                   (setq j (max (1+ i) (- j 6))))
 403               (setq lang nil))
 404              ((eq cset 'composition)
 405               (setq j (+ i (egg-char-bytes c))
 406                     lang (egg-charset-to-language
 407                           (char-charset
 408                            (car (decompose-composite-char c 'list))))))
 409              (t
 410               (egg-string-match-charset cset str i)
 411               (setq j (match-end 0)
 412                     lang (egg-charset-to-language cset))))
 413             (if lang
 414                 (put-text-property i j 'egg-lang lang str))))
 415       (setq i j))
 416     ;; 2nd pass -- set language property
 417     (setq i 0)
 418     (while (< i len)
 419       (setq lang (egg-get-language i str))
 420       (cond
 421        ((null lang)
 422         (setq lang (or last-lang
 423                        (egg-next-part-lang str i))))
 424        ((equal lang 'Chinese)
 425         (setq lang (or last-chinese
 426                        (egg-next-chinese-lang str i)))))
 427       (setq last-lang lang)
 428       (if (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
 429           (setq last-chinese lang))
 430       (setq j i
 431             i (egg-next-single-property-change i 'egg-lang str len))
 432       (set-text-properties j i (list 'egg-lang lang) str))))
 433
 434 ;;; Should think again the interface to language-info-alist
 435 (defun egg-charset-to-language (charset)
 436   (let ((list language-info-alist))
 437     (while (and list
 438                 (null (memq charset (assq 'charset (car list)))))
 439       (setq list (cdr list)))
 440     (if list
 441         (intern (car (car list))))))
 442
 443 (defun egg-next-part-lang (str pos)
 444   (let ((lang (get-text-property
 445                (egg-next-single-property-change pos 'egg-lang str (length str))
 446                'egg-lang str)))
 447     (if (eq lang 'Chinese)
 448         (egg-next-chinese-lang str pos)
 449       (or lang
 450           its-current-language
 451           egg-default-language))))
 452
 453 (defun egg-next-chinese-lang (str pos)
 454   (let ((len (length str)) lang)
 455     (while (and (< pos len) (null lang))
 456       (setq pos (egg-next-single-property-change pos 'egg-lang str len)
 457             lang (egg-get-language pos str))
 458       (if (null (or (eq lang 'Chinese-GB)
 459                     (eq lang 'Chinese-CNS)))
 460           (setq lang nil)))
 461     (cond
 462      (lang lang)
 463      ((eq its-current-language 'Chinese-GB)  'Chinese-GB)
 464      ((eq its-current-language 'Chinese-CNS) 'Chinese-CNS)
 465      ((eq egg-default-language 'Chinese-GB)  'Chinese-GB)
 466      ((eq egg-default-language 'Chinese-CNS) 'Chinese-CNS)
 467      (t 'Chinese-GB))))
 468
 469 ;;
 470 ;; return value ::= ( (<backend> ( <lang>... ) <source string> )... )
 471 ;;
 472 (defun egg-assign-backend (source n)
 473   (let ((len (length source))
 474         (i 0)
 475         j s lang backend retval)
 476     (while (< i len)
 477       (setq j (egg-next-single-property-change i 'egg-lang source len)
 478             s (substring source i j)
 479             lang (egg-get-language 0 s)
 480             backend (egg-get-conversion-backend lang n t))
 481       (set-text-properties 0 (- j i) (list 'egg-lang lang) s)
 482       (setq retval (nconc retval (list (list backend (list lang) s)))
 483             i j))
 484     (prog1
 485         retval
 486       (while retval
 487         (if (or (egg-default-conversion-backend-p (car (car retval)))
 488                 (null (equal (car (car retval)) (car (nth 1 retval)))))
 489             (setq retval (cdr retval))
 490           (nconc (nth 1 (car retval)) (nth 1 (nth 1 retval)))
 491           (setcar (nthcdr 2 (car retval))
 492                   (concat (nth 2 (car retval)) (nth 2 (nth 1 retval))))
 493           (setcdr retval (cddr retval)))))))
 494
 495 (defun egg-search-file (filename path)
 496   (let (file)
 497     (if (file-name-directory filename)
 498         (setq file (substitute-in-file-name (expand-file-name filename))
 499               file (and (file-readable-p file) file))
 500       (while (and (null file) path)
 501         (if (stringp (car path))
 502             (setq file (substitute-in-file-name
 503                         (expand-file-name filename (car path)))
 504                   file (and (file-exists-p file) file)))
 505         (setq path (cdr path)))
 506       file)))
 507
 508 (defvar egg-default-startup-file "eggrc"
 509   "Egg startup file name (system default)")
 510
 511 (defun egg-load-startup-file (backend lang)
 512   (let ((eggrc (or (egg-search-file egg-startup-file
 513                                     egg-startup-file-search-path)
 514                    (egg-search-file egg-default-startup-file load-path))))
 515     (if eggrc
 516         (condition-case error
 517             (let ((egg-backend-type backend) (egg-language lang))
 518               (load-file eggrc))
 519           (error
 520            (message "%s: %s" (car error)
 521                     (mapconcat (lambda (s) (format "%S" s)) (cdr error) ", "))
 522            (egg-error 'rcfile-error))
 523           (quit
 524            (egg-error 'rcfile-error)))
 525       (egg-error 'no-rcfile egg-startup-file-search-path))))
 526
 527 (defun egg-get-conversion-face (lang)
 528   (if (null (consp egg-conversion-face))
 529       egg-conversion-face
 530     (cdr (or (assq lang egg-conversion-face)
 531              (assq t egg-conversion-face)))))
 532 \f
 533 (defvar egg-conversion-map
 534   (let ((map (make-sparse-keymap))
 535         (i 33))
 536     (while (< i 127)
 537       (define-key map (vector i) 'egg-exit-conversion-unread-char)
 538       (setq i (1+ i)))
 539     (define-key map "\C-@"   'egg-decide-first-char)
 540     (define-key map [?\C-\ ] 'egg-decide-first-char)
 541     (define-key map "\C-a"   'egg-beginning-of-conversion-buffer)
 542     (define-key map "\C-b"   'egg-backward-bunsetsu)
 543     (define-key map "\C-c"   'egg-abort-conversion)
 544     (define-key map "\C-e"   'egg-end-of-conversion-buffer)
 545     (define-key map "\C-f"   'egg-forward-bunsetsu)
 546     (define-key map "\C-h"   'egg-help-command)
 547     (define-key map "\C-i"   'egg-shrink-bunsetsu-major)
 548     (define-key map "\C-k"   'egg-decide-before-point)
 549 ;;    (define-key map "\C-l"   'egg-exit-conversion)  ; Don't override C-L
 550     (define-key map "\C-m"   'egg-exit-conversion)
 551     (define-key map "\C-n"   'egg-next-candidate-major)
 552     (define-key map "\C-o"   'egg-enlarge-bunsetsu-major)
 553     (define-key map "\C-p"   'egg-previous-candidate-major)
 554     (define-key map "\C-r"   'egg-reconvert-bunsetsu)
 555     (define-key map "\C-t"   'egg-toroku-bunsetsu)
 556     (define-key map "\C-v"   'egg-inspect-bunsetsu)
 557     (define-key map "\M-i"   'egg-shrink-bunsetsu-minor)
 558     (define-key map "\M-n"   'egg-next-candidate-minor)
 559     (define-key map "\M-o"   'egg-enlarge-bunsetsu-minor)
 560     (define-key map "\M-p"   'egg-previous-candidate-minor)
 561     (define-key map "\M-r"   'egg-reconvert-bunsetsu-from-source)
 562     (define-key map "\M-s"   'egg-select-candidate-major)
 563     (define-key map "\M-v"   'egg-toggle-inspect-mode)
 564     (define-key map "\M-z"   'egg-select-candidate-minor)
 565     (define-key map "\e\C-s" 'egg-select-candidate-list-all-major)
 566     (define-key map "\e\C-z" 'egg-select-candidate-list-all-minor)
 567     (define-key map [return] 'egg-exit-conversion)
 568     (define-key map [right]  'egg-forward-bunsetsu)
 569     (define-key map [left]   'egg-backward-bunsetsu)
 570     (define-key map " "      'egg-next-candidate)
 571     (define-key map "/"      'egg-exit-conversion)
 572     ;;;(define-key map "\M-h"   'egg-hiragana)
 573     ;;;(define-key map "\M-k"   'egg-katakana)
 574     ;;;(define-key map "\M-<"   'egg-hankaku)
 575     ;;;(define-key map "\M->"   'egg-zenkaku)
 576     map)
 577   "Keymap for EGG Conversion mode.")
 578
 579 (fset 'egg-conversion-map egg-conversion-map)
 580
 581 (defun egg-exit-conversion-unread-char ()
 582   (interactive)
 583   (setq unread-command-events (list last-command-event)
 584         this-command 'egg-use-context)
 585   (setq egg-context (egg-exit-conversion)))
 586
 587 (defun egg-make-bunsetsu (backend bunsetsu last)
 588   (let* ((converted (copy-sequence (egg-get-bunsetsu-converted bunsetsu)))
 589          (language (egg-get-converted-language bunsetsu))
 590          (continue (and (null last) (egg-major-bunsetsu-continue-p bunsetsu)))
 591          (face (egg-get-conversion-face language))
 592          len len1)
 593     (setq len1 (length converted))
 594     (or (eq last t)
 595         (setq converted (concat converted
 596                                 (if continue
 597                                     egg-conversion-minor-separator
 598                                   egg-conversion-major-separator))))
 599     (setq len (length converted))
 600     (set-text-properties 0 len
 601                          (list 'read-only          t
 602                                (egg-bunsetsu-info) bunsetsu
 603                                'egg-backend        backend
 604                                'egg-lang           language
 605                                'egg-bunsetsu-last  last
 606                                'egg-major-continue continue
 607                                'local-map          'egg-conversion-map)
 608                          converted)
 609     (if face
 610         (egg-set-face 0 len1 face converted))
 611     converted))
 612
 613 (defun egg-insert-bunsetsu-list (backend bunsetsu-list &optional last)
 614   (let ((len (length bunsetsu-list)))
 615     (insert
 616      (mapconcat
 617       (lambda (b)
 618         (setq len (1- len))
 619         (egg-make-bunsetsu backend b (and (= len 0) last)))
 620       bunsetsu-list ""))))
 621
 622 (defun egg-beginning-of-conversion-buffer (n)
 623   (interactive "p")
 624   (cond
 625    ((<= n 0)
 626     (egg-end-of-conversion-buffer 1))
 627    ((null (get-text-property (1- (point)) 'egg-start))
 628     (goto-char (previous-single-property-change (point) 'egg-start)))))
 629
 630 (defun egg-end-of-conversion-buffer(n)
 631   (interactive "p")
 632   (cond
 633    ((<= n 0)
 634     (egg-beginning-of-conversion-buffer 1))
 635    (t
 636     (goto-char (next-single-property-change (point) 'egg-end))
 637     (backward-char))))
 638
 639 (defun egg-backward-bunsetsu (n)
 640   (interactive "p")
 641   (while (and (> n 0)
 642               (null (get-text-property (1- (point)) 'egg-start)))
 643     (backward-char)
 644     (setq n (1- n)))
 645   (if (> n 0)
 646       (signal 'beginning-of-buffer nil)))
 647
 648 (defun egg-forward-bunsetsu (n)
 649   (interactive "p")
 650   (while (and (>= n 0)
 651               (null (get-text-property (point) 'egg-end)))
 652     (forward-char)
 653     (setq n (1- n)))
 654   (backward-char)
 655   (if (>= n 0)
 656       (signal 'end-of-buffer nil)))
 657 \f
 658 (defun egg-get-bunsetsu-tail (b)
 659   (nth (1- (length b)) b))
 660
 661 (defun egg-previous-bunsetsu-point (p &optional n obj lim)
 662   (or n (setq n 1))
 663   (while (> n 0)
 664     (setq p (previous-single-property-change p (egg-bunsetsu-info) obj lim)
 665           n (1- n)))
 666   p)
 667
 668 (defun egg-next-bunsetsu-point (p &optional n obj lim)
 669   (or n (setq n 1))
 670   (while (> n 0)
 671     (setq p (egg-next-single-property-change p (egg-bunsetsu-info) obj lim)
 672           n (1- n)))
 673   p)
 674
 675 (defun egg-get-previous-bunsetsu (p)
 676   (and (null (egg-get-bunsetsu-last (1- p)))
 677        (egg-get-bunsetsu-info (1- p))))
 678
 679 (defun egg-get-previous-major-bunsetsu (p)
 680   (let ((p (point))
 681         (prev (egg-get-previous-bunsetsu p))
 682         bunsetsu)
 683     (while prev
 684       (setq bunsetsu (cons prev bunsetsu)
 685             p (egg-previous-bunsetsu-point p)
 686             prev (and (egg-get-major-continue (1- p))
 687                       (egg-get-bunsetsu-info (1- p)))))
 688     bunsetsu))
 689
 690 (defun egg-get-next-bunsetsu (p)
 691   (and (null (egg-get-bunsetsu-last p))
 692        (egg-get-bunsetsu-info (egg-next-bunsetsu-point p))))
 693
 694 (defun egg-get-major-bunsetsu (p)
 695   (let ((next (egg-get-bunsetsu-info p))
 696         bunsetsu)
 697     (while next
 698       (setq bunsetsu (cons next bunsetsu)
 699             p (egg-next-bunsetsu-point p)
 700             next (and (egg-get-major-continue (1- p))
 701                       (egg-get-bunsetsu-info p))))
 702     (nreverse bunsetsu)))
 703
 704 (defsubst egg-get-major-bunsetsu-source (list)
 705   (mapconcat (lambda (b) (egg-get-bunsetsu-source b)) list ""))
 706
 707 (defvar egg-inspect-mode nil
 708   "*Display clause information on candidate selection, if non-NIL.")
 709
 710 (defun egg-toggle-inspect-mode ()
 711   (interactive)
 712   (if (setq egg-inspect-mode (not egg-inspect-mode))
 713       (egg-inspect-bunsetsu t)))
 714
 715 (defun egg-inspect-bunsetsu (&optional quiet)
 716   (interactive)
 717   (or (egg-word-inspection (egg-get-bunsetsu-info (point)))
 718       quiet
 719       (beep)))
 720
 721 (defvar egg-candidate-selection-info nil)
 722 (make-variable-buffer-local 'egg-candidate-selection-info)
 723
 724 (defvar egg-candidate-selection-major t)
 725 (make-variable-buffer-local 'egg-candidate-selection-major)
 726
 727 (defsubst egg-set-candsel-info (b prev-b next-b major)
 728   (setq egg-candidate-selection-info (list b prev-b next-b major)))
 729
 730 (defsubst egg-candsel-last-bunsetsu () (car egg-candidate-selection-info))
 731 (defsubst egg-candsel-last-prev-b () (nth 1 egg-candidate-selection-info))
 732 (defsubst egg-candsel-last-next-b () (nth 2 egg-candidate-selection-info))
 733 (defsubst egg-candsel-last-major () (nth 3 egg-candidate-selection-info))
 734
 735 (defun egg-major-bunsetsu-head-p (head bunsetsu)
 736   (while (and head (eq (car head) (car bunsetsu)))
 737     (setq head (cdr head)
 738           bunsetsu (cdr bunsetsu)))
 739   (null head))
 740
 741 (defun egg-major-bunsetsu-tail-p (tail bunsetsu)
 742   (egg-major-bunsetsu-head-p
 743    tail (nthcdr (- (length bunsetsu) (length tail)) bunsetsu)))
 744
 745 (defun egg-get-candsel-target-major ()
 746   (let ((bunsetsu (egg-get-major-bunsetsu (point)))
 747         next-b prev-b next)
 748     (setq prev-b (egg-get-previous-major-bunsetsu (point))
 749           next (egg-next-bunsetsu-point (point) (length bunsetsu)))
 750     (cond
 751      ((and (egg-candsel-last-major)
 752            (egg-major-bunsetsu-tail-p (egg-candsel-last-prev-b) prev-b)
 753            (egg-major-bunsetsu-head-p (append (egg-candsel-last-bunsetsu)
 754                                               (egg-candsel-last-next-b))
 755                                       bunsetsu))
 756       (setq bunsetsu (egg-candsel-last-bunsetsu)
 757             prev-b (egg-candsel-last-prev-b)
 758             next-b (egg-candsel-last-next-b))
 759       (setq next (egg-next-bunsetsu-point (point) (length bunsetsu))))
 760      ((null (egg-get-bunsetsu-last (1- next)))
 761       (setq next-b (egg-get-major-bunsetsu next))))
 762     (setq egg-candidate-selection-major t)
 763     (list bunsetsu prev-b next-b next t)))
 764
 765 (defun egg-get-candsel-target-minor ()
 766   (let* ((bunsetsu (list (egg-get-bunsetsu-info (point))))
 767          (prev-b (egg-get-previous-bunsetsu (point)))
 768          (next-b (egg-get-next-bunsetsu (point))))
 769     (and prev-b (setq prev-b (list prev-b)))
 770     (and next-b (setq next-b (list next-b)))
 771     (setq egg-candidate-selection-major nil)
 772     (list bunsetsu prev-b next-b (egg-next-bunsetsu-point (point)) nil)))
 773
 774 (defun egg-insert-new-bunsetsu (b prev-b next-b next end)
 775   (let ((backend (egg-get-backend (point)))
 776         start last)
 777     (setq start (egg-previous-bunsetsu-point (point) (length prev-b)))
 778     (setq end (or end (egg-next-bunsetsu-point next (length next-b))))
 779     (setq last (egg-get-bunsetsu-last (1- end)))
 780     (delete-region start end)
 781     (egg-insert-bunsetsu-list backend (append prev-b (append b next-b)) last)
 782     (goto-char (egg-next-bunsetsu-point start (length prev-b)))
 783     (if egg-inspect-mode
 784         (egg-inspect-bunsetsu t))))
 785
 786 (defun egg-next-candidate (n)
 787   (interactive "p")
 788   (if egg-candidate-selection-major
 789       (egg-next-candidate-major n)
 790     (egg-next-candidate-minor n)))
 791
 792 (defun egg-next-candidate-major (n)
 793   (interactive "p")
 794   (apply 'egg-next-candidate-internal n (egg-get-candsel-target-major)))
 795
 796 (defun egg-next-candidate-minor (n)
 797   (interactive "p")
 798   (apply 'egg-next-candidate-internal n (egg-get-candsel-target-minor)))
 799
 800 (defun egg-previous-candidate (n)
 801   (interactive "p")
 802   (if egg-candidate-selection-major
 803       (egg-previous-candidate-major n)
 804     (egg-previous-candidate-minor n)))
 805
 806 (defun egg-previous-candidate-major (n)
 807   (interactive "p")
 808   (apply 'egg-next-candidate-internal (- n) (egg-get-candsel-target-major)))
 809
 810 (defun egg-previous-candidate-minor (n)
 811   (interactive "p")
 812   (apply 'egg-next-candidate-internal (- n) (egg-get-candsel-target-minor)))
 813
 814 (defvar egg-candidate-select-counter 1)
 815
 816 (defun egg-next-candidate-internal (n b prev-b next-b next major)
 817   (if (eq last-command (if major 'egg-candidate-major 'egg-candidate-minor))
 818       (setq egg-candidate-select-counter (1+ egg-candidate-select-counter))
 819     (setq egg-candidate-select-counter 1))
 820   (if (= egg-candidate-select-counter egg-conversion-auto-candidate-menu)
 821       (egg-select-candidate-internal nil b prev-b next-b next major)
 822     (setq this-command (if major 'egg-candidate-major 'egg-candidate-minor))
 823     (let ((inhibit-read-only t)
 824           candidates nitem i beep)
 825       (setq candidates (egg-list-candidates b prev-b next-b major))
 826       (if (null candidates)
 827           (setq beep t)
 828         (setq i (+ n (car candidates))
 829               nitem (length (cdr candidates)))
 830         (cond
 831          ((< i 0)                       ; go backward as if it is ring
 832           (while (< i 0)
 833             (setq i (+ i nitem))))
 834          ((< i nitem))                  ; OK
 835          (egg-conversion-wrap-select    ; go backward as if it is ring
 836           (while (>= i nitem)
 837             (setq i (- i nitem))))
 838          (t                             ; don't go forward
 839           (setq i (1- nitem)
 840                 beep t)))
 841         (setq b (egg-decide-candidate b i prev-b next-b)
 842               prev-b (nth 1 b)
 843               next-b (nth 2 b)
 844               b (car b))
 845         (egg-set-candsel-info b prev-b next-b major)
 846         (egg-insert-new-bunsetsu b prev-b next-b next nil))
 847       (if beep
 848           (ding)))))
 849
 850 (defun egg-numbering-item (list)
 851   (let ((n -1))
 852     (mapcar (lambda (item) (cons item (setq n (1+ n)))) list)))
 853
 854 (defun egg-select-candidate-major ()
 855   (interactive)
 856   (apply 'egg-select-candidate-internal nil (egg-get-candsel-target-major)))
 857
 858 (defun egg-select-candidate-minor ()
 859   (interactive)
 860   (apply 'egg-select-candidate-internal nil (egg-get-candsel-target-minor)))
 861
 862 (defun egg-select-candidate-list-all-major ()
 863   (interactive)
 864   (apply 'egg-select-candidate-internal t (egg-get-candsel-target-major)))
 865
 866 (defun egg-select-candidate-list-all-minor ()
 867   (interactive)
 868   (apply 'egg-select-candidate-internal t (egg-get-candsel-target-minor)))
 869
 870 (defun egg-select-candidate-internal (all b prev-b next-b next major)
 871   (let ((inhibit-read-only t)
 872         (prompt (egg-get-message 'candidate))
 873         candidates item-list new i)
 874     (setq candidates (egg-list-candidates b prev-b next-b major))
 875     (if (null candidates)
 876         (ding)
 877       (setq all (and all '(menudiag-list-all))
 878             item-list (egg-numbering-item (cdr candidates))
 879             i (menudiag-select (list 'menu prompt item-list)
 880                                (cons (nth (car candidates) item-list) all))
 881             new (egg-decide-candidate b i prev-b next-b)
 882             prev-b (nth 1 new)
 883             next-b (nth 2 new)
 884             new (car new))
 885       (egg-set-candsel-info new prev-b next-b major)
 886       (egg-insert-new-bunsetsu new prev-b next-b next nil))))
 887
 888 (defun egg-separate-characters (str)
 889   (let* ((v (egg-string-to-vector str))
 890          (len (length v))
 891          (i 0) (j 0) m n (nchar 0))
 892     (while (< i len)
 893       (if (setq n (egg-chinese-syllable str j))
 894           (setq m (egg-chars-in-period str j n))
 895         (setq m 1 n (egg-char-bytes (aref v i))))
 896       (put-text-property j (+ j n) 'egg-char-size n str)
 897       (setq nchar (1+ nchar) i (+ i m) j (+ j n)))
 898     nchar))
 899
 900 (defun egg-enlarge-bunsetsu-major (n)
 901   (interactive "p")
 902   (egg-enlarge-bunsetsu-internal n t))
 903
 904 (defun egg-enlarge-bunsetsu-minor (n)
 905   (interactive "p")
 906   (egg-enlarge-bunsetsu-internal n nil))
 907
 908 (defun egg-shrink-bunsetsu-major (n)
 909   (interactive "p")
 910   (egg-enlarge-bunsetsu-internal (- n) t))
 911
 912 (defun egg-shrink-bunsetsu-minor (n)
 913   (interactive "p")
 914   (egg-enlarge-bunsetsu-internal (- n) nil))
 915
 916 (defun egg-enlarge-bunsetsu-internal (n major)
 917   (let ((inhibit-read-only t)
 918         b prev-b next-b s1 s1len s2 s2len nchar i last next end beep)
 919     (if major
 920         (setq b (egg-get-major-bunsetsu (point))
 921               prev-b (egg-get-previous-major-bunsetsu (point)))
 922       (setq b (list (egg-get-bunsetsu-info (point)))
 923             prev-b (egg-get-previous-bunsetsu (point))
 924             prev-b (and prev-b (list prev-b))))
 925     (setq end (egg-next-bunsetsu-point (point) (length b))
 926           last (egg-get-bunsetsu-last (1- end)))
 927     (while (null last)
 928       (setq next-b (cons (egg-get-bunsetsu-info end) next-b)
 929             last (egg-get-bunsetsu-last end)
 930             end (egg-next-bunsetsu-point end)))
 931     (setq next-b (nreverse next-b)
 932           s1 (egg-get-major-bunsetsu-source b)
 933           s2 (concat s1 (egg-get-major-bunsetsu-source next-b))
 934           s1len (egg-separate-characters s1)
 935           s2len (egg-separate-characters s2)
 936           n (+ n s1len))
 937     (cond
 938      ((<= n 0)
 939       (setq beep t nchar (and (/= s1len 1) (egg-get-char-size 0 s1))))
 940      ((> n s2len)
 941       (setq beep t nchar (and (/= s2len 0) (length s2))))
 942      (t
 943       (setq nchar 0)
 944       (while (> n 0)
 945         (setq nchar (+ nchar (egg-get-char-size nchar s2))
 946               n (1- n)))))
 947     (if nchar
 948         (progn
 949           (setq next-b (nconc b next-b)
 950                 i (length (egg-get-bunsetsu-source (car next-b))))
 951           (while (< i nchar)
 952             (setq next-b (cdr next-b)
 953                   i (+ i (length (egg-get-bunsetsu-source (car next-b))))))
 954           (setq next-b (prog1 (cdr next-b) (setcdr next-b nil))
 955                 next (egg-next-bunsetsu-point (point) (length b))
 956                 b (egg-change-bunsetsu-length b prev-b next-b nchar major))
 957           (if (null b)
 958               (setq beep t)
 959             (setq prev-b (nth 1 b)
 960                   next-b (nth 2 b)
 961                   b (car b))
 962             (egg-insert-new-bunsetsu b prev-b next-b next (and next-b end)))))
 963     (if beep
 964         (ding))))
 965
 966 (defun egg-reconvert-bunsetsu (n)
 967   (interactive "P")
 968   (egg-reconvert-bunsetsu-internal n 'egg-get-bunsetsu-converted))
 969
 970 (defun egg-reconvert-bunsetsu-from-source (n)
 971   (interactive "P")
 972   (egg-reconvert-bunsetsu-internal n 'egg-get-bunsetsu-source))
 973
 974 (defun egg-reconvert-bunsetsu-internal (n func)
 975   (let* ((inhibit-read-only t)
 976          (backend (egg-get-backend (point)))
 977          (source (funcall func (egg-get-bunsetsu-info (point))))
 978          (reconv-backend (egg-get-reconvert-backend backend n))
 979          (p (point))
 980          (last (egg-get-bunsetsu-last (point)))
 981          new prev-b next-b)
 982     (if (or (null reconv-backend)
 983             (null (setq new (egg-start-conversion reconv-backend source nil))))
 984         (ding)
 985       (delete-region p (egg-next-bunsetsu-point p))
 986       (setq next-b (egg-get-bunsetsu-info (point)))
 987       (if (and (equal (egg-get-backend p) backend)
 988                (eq (egg-bunsetsu-get-backend next-b)
 989                    (egg-bunsetsu-get-backend (car new)))
 990                (egg-bunsetsu-combinable-p (egg-get-bunsetsu-tail new) next-b))
 991           (setq last nil)
 992         (setq last (or (eq last t) 'continue)))
 993       (egg-insert-bunsetsu-list backend new last)
 994       (goto-char p)
 995       (setq prev-b (egg-get-bunsetsu-info (1- p)))
 996       (if prev-b
 997           (progn
 998             (if (and (equal (egg-get-backend (1- p)) backend)
 999                      (eq (egg-bunsetsu-get-backend prev-b)
1000                          (egg-bunsetsu-get-backend (car new)))
1001                      (egg-bunsetsu-combinable-p prev-b (car new)))
1002                 (setq last nil)
1003               (setq last (or (eq last t) 'continue)))
1004             (setq backend (egg-get-backend (1- p)))
1005             (delete-region (egg-previous-bunsetsu-point p) p)
1006             (egg-insert-bunsetsu-list backend (list prev-b) last))))))
1007
1008 (defun egg-decide-before-point ()
1009   (interactive)
1010   (let* ((inhibit-read-only t)
1011          (start (if (get-text-property (1- (point)) 'egg-start)
1012                     (point)
1013                   (previous-single-property-change (point) 'egg-start)))
1014          (end (if (get-text-property (point) 'egg-end)
1015                   (point)
1016                 (next-single-property-change (point) 'egg-end)))
1017          (decided (buffer-substring start (point)))
1018          (undecided (buffer-substring (point) end))
1019          i len bunsetsu source context)
1020     (delete-region
1021      (previous-single-property-change start 'egg-start nil (point-min))
1022      (next-single-property-change end 'egg-end nil (point-max)))
1023     (setq i 0
1024           len (length decided))
1025     (while (< i len)
1026       (setq bunsetsu (nconc bunsetsu (list (egg-get-bunsetsu-info i decided)))
1027             i (egg-next-bunsetsu-point i 1 decided len))
1028       (if (or (= i len)
1029               (egg-get-bunsetsu-last (1- i) decided))
1030           (progn
1031             (apply 'insert (mapcar
1032                             (lambda (b) (egg-get-bunsetsu-converted b))
1033                             bunsetsu))
1034             (setq context (cons (cons (egg-bunsetsu-get-backend (car bunsetsu))
1035                                       (egg-end-conversion bunsetsu nil))
1036                                 context)
1037                   bunsetsu nil))))
1038     (setq len (length undecided))
1039     (if (= len 0)
1040         (progn
1041           (egg-do-auto-fill)
1042           (run-hooks 'input-method-after-insert-chunk-hook)
1043           context)
1044       (setq i 0)
1045       (while (< i len)
1046         (setq bunsetsu (egg-get-bunsetsu-info i undecided)
1047               source (cons (egg-get-bunsetsu-source bunsetsu)
1048                            source))
1049         (put-text-property 0 (length (car source))
1050                            'egg-lang
1051                            (egg-get-source-language bunsetsu)
1052                            (car source))
1053         (setq i (egg-next-bunsetsu-point i 1 undecided len)))
1054       (its-restart (apply 'concat (nreverse source)) t t context))))
1055
1056 (defun egg-decide-first-char ()
1057   (interactive)
1058   (let* ((inhibit-read-only t)
1059          (start (if (get-text-property (1- (point)) 'egg-start)
1060                     (point)
1061                   (previous-single-property-change (point) 'egg-start)))
1062          (end (if (get-text-property (point) 'egg-end)
1063                   (point)
1064                 (next-single-property-change (point) 'egg-end)))
1065          (bunsetsu (egg-get-bunsetsu-info start)))
1066     (delete-region
1067      (previous-single-property-change start 'egg-start nil (point-min))
1068      (next-single-property-change end 'egg-end nil (point-max)))
1069     (egg-end-conversion (list bunsetsu) nil)
1070     (insert (egg-string-to-char-at (egg-get-bunsetsu-converted bunsetsu) 0))))
1071
1072 (defun egg-exit-conversion ()
1073   (interactive)
1074   (if (egg-get-bunsetsu-info (point))
1075       (progn
1076         (goto-char (next-single-property-change (point) 'egg-end))
1077         (egg-decide-before-point))))
1078
1079 (defun egg-abort-conversion ()
1080   (interactive)
1081   (let ((inhibit-read-only t)
1082         source context)
1083     (goto-char (previous-single-property-change
1084                 (if (get-text-property (1- (point)) 'egg-start)
1085                     (point)
1086                   (previous-single-property-change (point) 'egg-start))
1087                 'egg-start nil (point-min)))
1088     (setq source (get-text-property (point) 'egg-source)
1089           context (get-text-property (point) 'egg-context))
1090     (delete-region (point) (next-single-property-change
1091                             (next-single-property-change (point) 'egg-end)
1092                             'egg-end nil (point-max)))
1093     (its-restart source nil nil context)))
1094
1095 (defun egg-toroku-bunsetsu ()
1096   (interactive)
1097   (let* ((p (point))
1098          (lang (egg-get-source-language (egg-get-bunsetsu-info p)))
1099          (egg-mode-hook (or (cdr (assq lang its-select-func-alist))
1100                             (cdr (assq lang its-select-func-default-alist))))
1101          (s "")
1102          bunsetsu str yomi last)
1103     (while (null last)
1104       (setq bunsetsu (egg-get-bunsetsu-info p)
1105             str (concat str (egg-get-bunsetsu-converted bunsetsu))
1106             yomi (concat yomi (egg-get-bunsetsu-source bunsetsu))
1107             last (egg-get-bunsetsu-last p)
1108             p (egg-next-bunsetsu-point p)))
1109     (while (equal s "")
1110       (setq s (read-multilingual-string (egg-get-message 'register-str)
1111                                         str egg-last-method-name))
1112       (and (equal s "") (ding)))
1113     (egg-toroku-string s nil yomi lang (egg-bunsetsu-get-backend bunsetsu))))
1114
1115 (defun egg-toroku-region (start end &optional nth-backend)
1116   (interactive "r\nP")
1117   (egg-toroku-string (buffer-substring start end) nil nil nil nil nth-backend))
1118
1119 (defun egg-toroku-string (str &optional yomi guess lang backend nth-backend)
1120   (let (egg-mode-hook result)
1121     (if (= (length str) 0)
1122         (egg-error "Egg word registration: null string"))
1123     (egg-separate-languages str lang)
1124     (setq lang (egg-get-language 0 str)
1125           egg-mode-hook (or (cdr (assq lang its-select-func-alist))
1126                             (cdr (assq lang its-select-func-default-alist))))
1127     (or yomi (setq yomi ""))
1128     (while (equal yomi "")
1129       (setq yomi (read-multilingual-string
1130                   (format (egg-get-message 'register-yomi) str)
1131                   guess egg-last-method-name))
1132       (and (equal yomi "") (ding)))
1133     (egg-separate-languages yomi lang)
1134     (if (null backend)
1135         (progn
1136           (setq backend (egg-assign-backend str nth-backend))
1137           (if (cdr backend)
1138               (egg-error "Egg word registration: cannot decide backend"))
1139           (setq backend (egg-get-current-backend (caar backend)))))
1140     (setq result (egg-word-registration backend str yomi))
1141     (if result
1142         (apply 'message (egg-get-message 'registered) str yomi result)
1143       (beep))))
1144 \f
1145 (defun egg-conversion-mode ()
1146   "\\{egg-conversion-map}"
1147   ;; dummy function to get docstring
1148   )
1149
1150 (defun egg-help-command ()
1151   "Display documentation for EGG Conversion mode."
1152   (interactive)
1153   (with-output-to-temp-buffer "*Help*"
1154     (princ "EGG Conversion mode:\n")
1155     (princ (documentation 'egg-conversion-mode))
1156     (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
1157
1158 (provide 'egg-cnv)
1159 ;;; egg-cnv.el ends here.