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