lisp/international/kkc.el

   1 ;;; kkc.el --- Kana Kanji converter    -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   5 ;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
   6 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   7 ;;   Registration Number H14PRO021
   8
   9 ;; Keywords: i18n, mule, multilingual, Japanese
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; These routines provide a simple and easy-to-use converter from
  29 ;; Kana-string to Kana-Kanji-mixed-string.  This converter (here after
  30 ;; KKC) uses a SKK dictionary to get information how to convert
  31 ;; Kana-string.  Since KKC can't be fully automated, we need an
  32 ;; interaction with a user to decide the correct conversion.   For
  33 ;; that, we provide KKC major mode.
  34
  35 ;;; Code:
  36
  37 (require 'ja-dic-utl)
  38
  39 (defvar kkc-input-method-title "\e$B4A\e(B"
  40   "String denoting KKC input method.
  41 This string is shown at mode line when users are in KKC mode.")
  42
  43 (defvar kkc-init-file-name (locate-user-emacs-file "kkcrc" ".kkcrc")
  44   "Name of a file which contains user's initial setup code for KKC.")
  45
  46 ;; A flag to control a file specified by `kkc-init-file-name'.
  47 ;; The value nil means the file is not yet consulted.
  48 ;; The value t means the file has already been consulted but there's
  49 ;; no need of updating it yet.
  50 ;; Any other value means that we must update the file before exiting Emacs.
  51 (defvar kkc-init-file-flag nil)
  52
  53 ;; Cash data for `kkc-lookup-key'.  This may be initialized by loading
  54 ;; a file specified by `kkc-init-file-name'.  If any elements are
  55 ;; modified, the data is written out to the file when exiting Emacs.
  56 (defvar kkc-lookup-cache nil)
  57
  58 ;; Tag symbol of `kkc-lookup-cache'.
  59 (defconst kkc-lookup-cache-tag 'kkc-lookup-cache-2)
  60
  61 (defun kkc-save-init-file ()
  62   "Save initial setup code for KKC to a file specified by `kkc-init-file-name'"
  63   (if (and kkc-init-file-flag
  64            (not (eq kkc-init-file-flag t)))
  65       (let ((coding-system-for-write 'iso-2022-7bit)
  66             (print-length nil))
  67         (write-region (format "(setq kkc-lookup-cache '%S)\n" kkc-lookup-cache)
  68                       nil
  69                       kkc-init-file-name))))
  70
  71 ;; Sequence of characters to be used for indexes for shown list.  The
  72 ;; Nth character is for the Nth conversion in the list currently shown.
  73 (defvar kkc-show-conversion-list-index-chars
  74   "1234567890")
  75
  76 (defun kkc-help ()
  77   "Show key bindings available while converting by KKC."
  78   (interactive)
  79   (with-output-to-temp-buffer "*Help*"
  80     (princ (substitute-command-keys "\\{kkc-keymap}"))))
  81
  82 (defvar kkc-keymap
  83   (let ((map (make-sparse-keymap))
  84         (len (length kkc-show-conversion-list-index-chars))
  85         (i 0))
  86     (while (< i len)
  87       (define-key map
  88         (char-to-string (aref kkc-show-conversion-list-index-chars i))
  89         'kkc-select-from-list)
  90       (setq i (1+ i)))
  91     (define-key map " " 'kkc-next)
  92     (define-key map "\r" 'kkc-terminate)
  93     (define-key map "\C-@" 'kkc-first-char-only)
  94     (define-key map "\C-n" 'kkc-next)
  95     (define-key map "\C-p" 'kkc-prev)
  96     (define-key map "\C-i" 'kkc-shorter)
  97     (define-key map "\C-o" 'kkc-longer)
  98     (define-key map "I" 'kkc-shorter-conversion)
  99     (define-key map "O" 'kkc-longer-phrase)
 100     (define-key map "\C-c" 'kkc-cancel)
 101     (define-key map "\C-?" 'kkc-cancel)
 102     (define-key map "\C-f" 'kkc-next-phrase)
 103     (define-key map "K" 'kkc-katakana)
 104     (define-key map "H" 'kkc-hiragana)
 105     (define-key map "l" 'kkc-show-conversion-list-or-next-group)
 106     (define-key map "L" 'kkc-show-conversion-list-or-prev-group)
 107     (define-key map [?\C- ] 'kkc-first-char-only)
 108     (define-key map [delete] 'kkc-cancel)
 109     (define-key map [return] 'kkc-terminate)
 110     (define-key map "\C-h" 'kkc-help)
 111     map)
 112   "Keymap for KKC (Kana Kanji Converter).")
 113
 114 ;;; Internal variables used in KKC.
 115
 116 ;; The current Kana string to be converted.
 117 (defvar kkc-original-kana nil)
 118
 119 ;; The current key sequence (vector of Kana characters) generated from
 120 ;; `kkc-original-kana'.
 121 (defvar kkc-current-key nil)
 122
 123 ;; List of the current conversions for `kkc-current-key'.
 124 (defvar kkc-current-conversions nil)
 125
 126 ;; Vector of the same length as `kkc-current-conversion'.  The first
 127 ;; element is a vector of:
 128 ;;      o index number of the first conversion shown previously,
 129 ;;      o index number of a conversion next of the last one shown previously,
 130 ;;      o the shown string itself.
 131 ;; The remaining elements are widths (including columns for index
 132 ;; numbers) of conversions stored in the same order as in
 133 ;; `kkc-current-conversion'.
 134 (defvar kkc-current-conversions-width nil)
 135
 136 (defcustom kkc-show-conversion-list-count 4
 137   "Count of successive `kkc-next' or `kkc-prev' to show conversion list.
 138 When you type SPC or C-p successively this count while using the input
 139 method `japanese', the conversion candidates are shown in the echo
 140 area while indicating the current selection by `<N>'."
 141   :group 'mule
 142   :type 'integer)
 143
 144 ;; Count of successive invocations of `kkc-next'.
 145 (defvar kkc-next-count nil)
 146
 147 ;; Count of successive invocations of `kkc-prev'.
 148 (defvar kkc-prev-count nil)
 149
 150 ;; Provided that `kkc-current-key' is [A B C D E F G H I], the current
 151 ;; conversion target is [A B C D E F], and the sequence of which
 152 ;; conversion is found is [A B C D]:
 153 ;;
 154 ;;                                A B C D E F G H I
 155 ;; kkc-overlay-head (black):     |<--------->|
 156 ;; kkc-overlay-tail (underline):         |<------->|
 157 ;; kkc-length-head:              |<--------->|
 158 ;; kkc-length-converted:         |<----->|
 159 ;;
 160 (defvar kkc-overlay-head nil)
 161 (defvar kkc-overlay-tail nil)
 162 (defvar kkc-length-head nil)
 163 (defvar kkc-length-converted nil)
 164
 165 ;; Cursor type (`box' or `bar') of the current frame.
 166 (defvar kkc-cursor-type nil)
 167
 168 ;; Lookup Japanese dictionary to set list of conversions in
 169 ;; kkc-current-conversions for key sequence kkc-current-key of length
 170 ;; LEN.  If no conversion is found in the dictionary, don't change
 171 ;; kkc-current-conversions and return nil.
 172 ;; Postfixes are handled only if POSTFIX is non-nil.
 173 (defun kkc-lookup-key (len &optional postfix prefer-noun)
 174   ;; At first, prepare cache data if any.
 175   (unless kkc-init-file-flag
 176     (setq kkc-init-file-flag t
 177           kkc-lookup-cache nil)
 178     (add-hook 'kill-emacs-hook 'kkc-save-init-file)
 179     (if (file-readable-p kkc-init-file-name)
 180         (condition-case nil
 181             (load-file kkc-init-file-name)
 182           (kkc-error "Invalid data in %s" kkc-init-file-name))))
 183   (or (and (nested-alist-p kkc-lookup-cache)
 184            (eq (car kkc-lookup-cache) kkc-lookup-cache-tag))
 185       (setq kkc-lookup-cache (list kkc-lookup-cache-tag)
 186             kkc-init-file-flag 'kkc-lookup-cache))
 187   (let ((entry (lookup-nested-alist kkc-current-key kkc-lookup-cache len 0 t)))
 188     (if (consp (car entry))
 189         (setq kkc-length-converted len
 190               kkc-current-conversions-width nil
 191               kkc-current-conversions (car entry))
 192       (setq entry (skkdic-lookup-key kkc-current-key len postfix prefer-noun))
 193       (if entry
 194           (progn
 195             (setq kkc-length-converted len
 196                   kkc-current-conversions-width nil
 197                   kkc-current-conversions (cons 1 entry))
 198             (if postfix
 199                 ;; Store this conversions in the cache.
 200                 (progn
 201                   (set-nested-alist kkc-current-key kkc-current-conversions
 202                                     kkc-lookup-cache kkc-length-converted)
 203                   (setq kkc-init-file-flag 'kkc-lookup-cache)))
 204             t)
 205         (if (= len 1)
 206             (setq kkc-length-converted 1
 207                   kkc-current-conversions-width nil
 208                   kkc-current-conversions (cons 0 nil)))))))
 209
 210 (define-error 'kkc-error nil)
 211 (defun kkc-error (&rest args)
 212   (signal 'kkc-error (apply 'format args)))
 213
 214 (defvar kkc-converting nil)
 215
 216 ;;;###autoload
 217 (defvar kkc-after-update-conversion-functions nil
 218   "Functions to run after a conversion is selected in `japanese' input method.
 219 With this input method, a user can select a proper conversion from
 220 candidate list.  Each time he changes the selection, functions in this
 221 list are called with two arguments; starting and ending buffer
 222 positions that contains the current selection.")
 223
 224 ;;;###autoload
 225 (defun kkc-region (from to)
 226   "Convert Kana string in the current region to Kanji-Kana mixed string.
 227 Users can select a desirable conversion interactively.
 228 When called from a program, expects two arguments,
 229 positions FROM and TO (integers or markers) specifying the target region.
 230 When it returns, the point is at the tail of the selected conversion,
 231 and the return value is the length of the conversion."
 232   (interactive "r")
 233   (setq kkc-original-kana (buffer-substring from to))
 234   (goto-char from)
 235
 236   ;; Setup overlays.
 237   (if (overlayp kkc-overlay-head)
 238       (move-overlay kkc-overlay-head from to)
 239     (setq kkc-overlay-head (make-overlay from to nil nil t))
 240     (overlay-put kkc-overlay-head 'face 'highlight))
 241   (if (overlayp kkc-overlay-tail)
 242       (move-overlay kkc-overlay-tail to to)
 243     (setq kkc-overlay-tail (make-overlay to to nil nil t))
 244     (overlay-put kkc-overlay-tail 'face 'underline))
 245
 246   (setq kkc-current-key (string-to-vector kkc-original-kana))
 247   (setq kkc-length-head (length kkc-current-key))
 248   (setq kkc-length-converted 0)
 249
 250   (unwind-protect
 251       ;; At first convert the region to the first candidate.
 252       (let ((current-input-method-title kkc-input-method-title)
 253             (input-method-function nil)
 254             (modified-p (buffer-modified-p))
 255             (first t))
 256         (while (not (kkc-lookup-key kkc-length-head nil first))
 257           (setq kkc-length-head (1- kkc-length-head)
 258                 first nil))
 259         (goto-char to)
 260         (kkc-update-conversion 'all)
 261         (setq kkc-next-count 1 kkc-prev-count 0)
 262         (if (and (>= kkc-next-count kkc-show-conversion-list-count)
 263                  (>= (length kkc-current-conversions) 3))
 264             (kkc-show-conversion-list-or-next-group))
 265
 266         ;; Then, ask users to select a desirable conversion.
 267         (force-mode-line-update)
 268         (setq kkc-converting t)
 269         ;; Hide "... loaded" message.
 270         (message nil)
 271         (while kkc-converting
 272           (set-buffer-modified-p modified-p)
 273           (let* ((overriding-terminal-local-map kkc-keymap)
 274                  (help-char nil)
 275                  (keyseq (read-key-sequence nil))
 276                  (cmd (lookup-key kkc-keymap keyseq)))
 277             (if (commandp cmd)
 278                 (condition-case err
 279                     (progn
 280                       (cond ((eq cmd 'kkc-next)
 281                              (setq kkc-next-count (1+ kkc-next-count)
 282                                    kkc-prev-count 0))
 283                             ((eq cmd 'kkc-prev)
 284                              (setq kkc-prev-count (1+ kkc-prev-count)
 285                                    kkc-next-count 0))
 286                             (t
 287                              (setq kkc-next-count 0 kkc-prev-count 0)))
 288                       (call-interactively cmd))
 289                   (kkc-error (message "%s" (cdr err)) (beep)))
 290               ;; KEYSEQ is not defined in KKC keymap.
 291               ;; Let's put the event back.
 292               (setq unread-input-method-events
 293                     (append (string-to-list (this-single-command-raw-keys))
 294                             unread-input-method-events))
 295               (kkc-terminate))))
 296
 297         (force-mode-line-update)
 298         (goto-char (overlay-end kkc-overlay-tail))
 299         (- (overlay-start kkc-overlay-head) from))
 300     (delete-overlay kkc-overlay-head)
 301     (delete-overlay kkc-overlay-tail)))
 302
 303 (defun kkc-terminate ()
 304   "Exit from KKC mode by fixing the current conversion."
 305   (interactive)
 306   (goto-char (overlay-end kkc-overlay-tail))
 307   (move-overlay kkc-overlay-head (point) (point))
 308   (setq kkc-converting nil))
 309
 310 (defun kkc-cancel ()
 311   "Exit from KKC mode by canceling any conversions."
 312   (interactive)
 313   (goto-char (overlay-start kkc-overlay-head))
 314   (delete-region (overlay-start kkc-overlay-head)
 315                  (overlay-end kkc-overlay-tail))
 316   (insert kkc-original-kana)
 317   (setq kkc-converting nil))
 318
 319 (defun kkc-first-char-only ()
 320   "Select only the first character currently converted."
 321   (interactive)
 322   (goto-char (overlay-start kkc-overlay-head))
 323   (forward-char 1)
 324   (delete-region (point) (overlay-end kkc-overlay-tail))
 325   (kkc-terminate))
 326
 327 (defun kkc-next ()
 328   "Select the next candidate of conversion."
 329   (interactive)
 330   (let ((idx (1+ (car kkc-current-conversions))))
 331     (if (< idx 0)
 332         (setq idx 1))
 333     (if (>= idx (length kkc-current-conversions))
 334         (setq idx 0))
 335     (setcar kkc-current-conversions idx)
 336     (if (> idx 1)
 337         (progn
 338           (set-nested-alist kkc-current-key kkc-current-conversions
 339                             kkc-lookup-cache kkc-length-converted)
 340           (setq kkc-init-file-flag 'kkc-lookup-cache)))
 341     (if (or kkc-current-conversions-width
 342             (>= kkc-next-count kkc-show-conversion-list-count))
 343         (kkc-show-conversion-list-update))
 344     (kkc-update-conversion)))
 345
 346 (defun kkc-prev ()
 347   "Select the previous candidate of conversion."
 348   (interactive)
 349   (let ((idx (1- (car kkc-current-conversions))))
 350     (if (< idx 0)
 351         (setq idx (1- (length kkc-current-conversions))))
 352     (setcar kkc-current-conversions idx)
 353     (if (> idx 1)
 354         (progn
 355           (set-nested-alist kkc-current-key kkc-current-conversions
 356                             kkc-lookup-cache kkc-length-converted)
 357           (setq kkc-init-file-flag 'kkc-lookup-cache)))
 358     (if (or kkc-current-conversions-width
 359             (>= kkc-prev-count kkc-show-conversion-list-count))
 360         (kkc-show-conversion-list-update))
 361     (kkc-update-conversion)))
 362
 363 (defun kkc-select-from-list ()
 364   "Select one candidate from the list currently shown in echo area."
 365   (interactive)
 366   (let (idx)
 367     (if kkc-current-conversions-width
 368         (let ((len (length kkc-show-conversion-list-index-chars))
 369               (maxlen (- (aref (aref kkc-current-conversions-width 0) 1)
 370                          (aref (aref kkc-current-conversions-width 0) 0)))
 371               (i 0))
 372           (if (> len maxlen)
 373               (setq len maxlen))
 374           (while (< i len)
 375             (if (= (aref kkc-show-conversion-list-index-chars i)
 376                    last-input-event)
 377                 (setq idx i i len)
 378               (setq i (1+ i))))))
 379     (if idx
 380         (progn
 381           (setcar kkc-current-conversions
 382                   (+ (aref (aref kkc-current-conversions-width 0) 0) idx))
 383           (kkc-show-conversion-list-update)
 384           (kkc-update-conversion))
 385       (setq unread-input-method-events
 386             (cons last-input-event unread-input-method-events))
 387       (kkc-terminate))))
 388
 389 (defun kkc-katakana ()
 390   "Convert to Katakana."
 391   (interactive)
 392   (setcar kkc-current-conversions -1)
 393   (kkc-update-conversion 'all))
 394
 395 (defun kkc-hiragana ()
 396   "Convert to hiragana."
 397   (interactive)
 398   (setcar kkc-current-conversions 0)
 399   (kkc-update-conversion))
 400
 401 (defun kkc-shorter ()
 402   "Make the Kana string to be converted shorter."
 403   (interactive)
 404   (if (<= kkc-length-head 1)
 405       (kkc-error "Can't be shorter"))
 406   (setq kkc-length-head (1- kkc-length-head))
 407   (if (> kkc-length-converted kkc-length-head)
 408       (let ((len kkc-length-head))
 409         (setq kkc-length-converted 0)
 410         (while (not (kkc-lookup-key len))
 411           (setq len (1- len)))))
 412   (kkc-update-conversion 'all))
 413
 414 (defun kkc-longer ()
 415   "Make the Kana string to be converted longer."
 416   (interactive)
 417   (if (>= kkc-length-head (length kkc-current-key))
 418       (kkc-error "Can't be longer"))
 419   (setq kkc-length-head (1+ kkc-length-head))
 420   ;; This time, try also entries with postfixes.
 421   (kkc-lookup-key kkc-length-head 'postfix)
 422   (kkc-update-conversion 'all))
 423
 424 (defun kkc-shorter-conversion ()
 425   "Make the Kana string to be converted shorter."
 426   (interactive)
 427   (if (<= kkc-length-converted 1)
 428       (kkc-error "Can't be shorter"))
 429   (let ((len (1- kkc-length-converted)))
 430     (setq kkc-length-converted 0)
 431     (while (not (kkc-lookup-key len))
 432       (setq len (1- len))))
 433   (kkc-update-conversion 'all))
 434
 435 (defun kkc-longer-phrase ()
 436   "Make the current phrase (BUNSETSU) longer without looking up dictionary."
 437   (interactive)
 438   (if (>= kkc-length-head (length kkc-current-key))
 439       (kkc-error "Can't be longer"))
 440   (setq kkc-length-head (1+ kkc-length-head))
 441   (kkc-update-conversion 'all))
 442
 443 (defun kkc-next-phrase ()
 444   "Fix the currently converted string and try to convert the remaining string."
 445   (interactive)
 446   (if (>= kkc-length-head (length kkc-current-key))
 447       (kkc-terminate)
 448     (setq kkc-length-head (- (length kkc-current-key) kkc-length-head))
 449     (goto-char (overlay-end kkc-overlay-head))
 450     (while (and (< (point) (overlay-end kkc-overlay-tail))
 451                 (looking-at "\\CH"))
 452       (goto-char (match-end 0))
 453       (setq kkc-length-head (1- kkc-length-head)))
 454     (if (= kkc-length-head 0)
 455         (kkc-terminate)
 456       (let ((newkey (make-vector kkc-length-head 0))
 457             (idx (- (length kkc-current-key) kkc-length-head))
 458             (len kkc-length-head)
 459             (i 0))
 460         ;; For the moment, (setq kkc-original-kana (concat newkey))
 461         ;; doesn't work.
 462         (setq kkc-original-kana "")
 463         (while (< i kkc-length-head)
 464           (aset newkey i (aref kkc-current-key (+ idx i)))
 465           (setq kkc-original-kana
 466                 (concat kkc-original-kana (char-to-string (aref newkey i))))
 467           (setq i (1+ i)))
 468         (setq kkc-current-key newkey)
 469         (setq kkc-length-converted 0)
 470         (while (and (not (kkc-lookup-key kkc-length-head nil
 471                                          (< kkc-length-head len)))
 472                     (> kkc-length-head 1))
 473           (setq kkc-length-head (1- kkc-length-head)))
 474         (let ((pos (point))
 475               (tail (overlay-end kkc-overlay-tail)))
 476           (move-overlay kkc-overlay-head pos tail)
 477           (move-overlay kkc-overlay-tail tail tail))
 478         (kkc-update-conversion 'all)))))
 479
 480 ;; We'll show users a list of available conversions in echo area with
 481 ;; index numbers so that users can select one conversion with the
 482 ;; number.
 483
 484 ;; Set `kkc-current-conversions-width'.
 485 (defun kkc-setup-current-conversions-width ()
 486   (let ((convs (cdr kkc-current-conversions))
 487         (len (length kkc-current-conversions))
 488         (idx 1))
 489     (setq kkc-current-conversions-width (make-vector len nil))
 490     ;; To tell `kkc-show-conversion-list-update' to generate
 491     ;; message from scratch.
 492     (aset kkc-current-conversions-width 0 (vector len -2 nil))
 493     ;; Fill the remaining slots.
 494     (while convs
 495       (aset kkc-current-conversions-width idx
 496             (+ (string-width (car convs)) 4))
 497       (setq convs (cdr convs)
 498             idx (1+ idx)))))
 499
 500 (defun kkc-show-conversion-list-or-next-group ()
 501   "Show list of available conversions in echo area with index numbers.
 502 If the list is already shown, show the next group of conversions,
 503 and change the current conversion to the first one in the group."
 504   (interactive)
 505   (if (< (length kkc-current-conversions) 3)
 506       (kkc-error "No alternative"))
 507   (if kkc-current-conversions-width
 508       (let ((next-idx (aref (aref kkc-current-conversions-width 0) 1)))
 509         (if (< next-idx (length kkc-current-conversions-width))
 510             (setcar kkc-current-conversions next-idx)
 511           (setcar kkc-current-conversions 1))
 512         (kkc-show-conversion-list-update)
 513         (kkc-update-conversion))
 514     (kkc-setup-current-conversions-width)
 515     (kkc-show-conversion-list-update)))
 516
 517 (defun kkc-show-conversion-list-or-prev-group ()
 518   "Show list of available conversions in echo area with index numbers.
 519 If the list is already shown, show the previous group of conversions,
 520 and change the current conversion to the last one in the group."
 521   (interactive)
 522   (if (< (length kkc-current-conversions) 3)
 523       (kkc-error "No alternative"))
 524   (if kkc-current-conversions-width
 525       (let ((this-idx (aref (aref kkc-current-conversions-width 0) 0)))
 526         (if (> this-idx 1)
 527             (setcar kkc-current-conversions (1- this-idx))
 528           (setcar kkc-current-conversions
 529                   (1- (length kkc-current-conversions-width))))
 530         (kkc-show-conversion-list-update)
 531         (kkc-update-conversion))
 532     (kkc-setup-current-conversions-width)
 533     (kkc-show-conversion-list-update)))
 534
 535 ;; Update the conversion list shown in echo area.
 536 (defun kkc-show-conversion-list-update ()
 537   (or kkc-current-conversions-width
 538       (kkc-setup-current-conversions-width))
 539   (let* ((current-idx (car kkc-current-conversions))
 540          (first-slot (aref kkc-current-conversions-width 0))
 541          (this-idx (aref first-slot 0))
 542          (next-idx (aref first-slot 1))
 543          (msg (aref first-slot 2)))
 544     (if (< current-idx this-idx)
 545         ;; The currently selected conversion is before the list shown
 546         ;; previously.  We must start calculation of message width
 547         ;; from the start again.
 548         (setq this-idx 1 msg nil)
 549       (if (>= current-idx next-idx)
 550           ;; The currently selected conversion is after the list shown
 551           ;; previously.  We start calculation of message width from
 552           ;; the conversion next of TO.
 553           (setq this-idx next-idx msg nil)))
 554     (if (not msg)
 555         (let ((len (length kkc-current-conversions))
 556               (max-width (window-width (minibuffer-window)))
 557               (width-table kkc-current-conversions-width)
 558               (width 0)
 559               (idx this-idx)
 560               (max-items (length kkc-show-conversion-list-index-chars))
 561               l)
 562           ;; Set THIS-IDX to the first index of conversion to be shown
 563           ;; in MSG, and reflect it in kkc-current-conversions-width.
 564           (while (<= idx current-idx)
 565             (if (and (<= (+ width (aref width-table idx)) max-width)
 566                      (< (- idx this-idx) max-items))
 567                 (setq width (+ width (aref width-table idx)))
 568               (setq this-idx idx width (aref width-table idx)))
 569             (setq idx (1+ idx)
 570                   l (cdr l)))
 571           (aset first-slot 0 this-idx)
 572           ;; Set NEXT-IDX to the next index of the last conversion
 573           ;; shown in MSG, and reflect it in
 574           ;; kkc-current-conversions-width.
 575           (while (and (< idx len)
 576                       (<= (+ width (aref width-table idx)) max-width)
 577                       (< (- idx this-idx) max-items))
 578             (setq width (+ width (aref width-table idx))
 579                   idx (1+ idx)
 580                   l (cdr l)))
 581           (aset first-slot 1 (setq next-idx idx))
 582           (setq l (nthcdr this-idx kkc-current-conversions))
 583           (setq msg (format " %c %s"
 584                             (aref kkc-show-conversion-list-index-chars 0)
 585                             (propertize (car l)
 586                                         'kkc-conversion-index this-idx))
 587                 idx (1+ this-idx)
 588                 l (cdr l))
 589           (while (< idx next-idx)
 590             (setq msg (format "%s  %c %s"
 591                               msg
 592                               (aref kkc-show-conversion-list-index-chars
 593                                     (- idx this-idx))
 594                               (propertize (car l)
 595                                           'kkc-conversion-index idx))
 596                   idx (1+ idx)
 597                   l (cdr l)))
 598           (aset first-slot 2 msg)))
 599
 600     ;; Highlight the current conversion.
 601     (if (> current-idx 0)
 602         (let ((pos 3)
 603               (limit (length msg)))
 604           (remove-text-properties 0 (length msg) '(face nil) msg)
 605           (while (not (eq (get-text-property pos 'kkc-conversion-index msg)
 606                           current-idx))
 607             (setq pos (next-single-property-change pos 'kkc-conversion-index
 608                                                    msg limit)))
 609           (put-text-property pos (next-single-property-change
 610                                   pos 'kkc-conversion-index msg limit)
 611                              'face 'highlight msg)))
 612     (let ((message-log-max nil))
 613       (message "%s" msg))))
 614
 615 ;; Update the conversion area with the latest conversion selected.
 616 ;; ALL if non nil means to update the whole area, else update only
 617 ;; inside quail-overlay-head.
 618
 619 (defun kkc-update-conversion (&optional all)
 620   (goto-char (overlay-start kkc-overlay-head))
 621   (cond ((= (car kkc-current-conversions) 0) ; Hiragana
 622          (let ((i 0))
 623            (while (< i kkc-length-converted)
 624              (insert (aref kkc-current-key i))
 625              (setq i (1+ i)))))
 626         ((= (car kkc-current-conversions) -1) ; Katakana
 627          (let ((i 0))
 628            (while (< i kkc-length-converted)
 629              (insert (japanese-katakana (aref kkc-current-key i)))
 630              (setq i (1+ i)))))
 631         (t
 632          (insert (nth (car kkc-current-conversions) kkc-current-conversions))))
 633   (delete-region (point) (overlay-start kkc-overlay-tail))
 634   (if all
 635       (let ((len (length kkc-current-key))
 636             (i kkc-length-converted))
 637         (delete-region (overlay-start kkc-overlay-tail)
 638                        (overlay-end kkc-overlay-head))
 639         (while (< i kkc-length-head)
 640           (if (= (car kkc-current-conversions) -1)
 641               (insert (japanese-katakana (aref kkc-current-key i)))
 642             (insert (aref kkc-current-key i)))
 643           (setq i (1+ i)))
 644         (let ((pos (point)))
 645           (while (< i len)
 646             (insert (aref kkc-current-key i))
 647             (setq i (1+ i)))
 648           (move-overlay kkc-overlay-head
 649                         (overlay-start kkc-overlay-head) pos)
 650           (delete-region (point) (overlay-end kkc-overlay-tail)))))
 651   (unwind-protect
 652       (run-hook-with-args 'kkc-after-update-conversion-functions
 653                           (overlay-start kkc-overlay-head)
 654                           (overlay-end kkc-overlay-head))
 655     (goto-char (overlay-end kkc-overlay-tail))))
 656
 657 ;;
 658 (provide 'kkc)
 659
 660 ;;; kkc.el ends here