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