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