1 ;;; kkc.el --- Kana Kanji converter
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
6 ;; Keywords: mule, multilingual, Japanese, SKK
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; These routines provide a simple and easy-to-use converter from
28 ;; Kana-string to Kana-Kanji-mixed-string. This converter (here after
29 ;; KKC) uses a SKK dictionary to get information how to convert
30 ;; Kana-string. Since KKC can't be fully automated, we need an
31 ;; interaction with a user to decide the correct conversion. For
32 ;; that, we provide KKC major mode.
38 (defvar kkc-input-method-title "
\e$B4A
\e(B"
39 "String denoting KKC input method.
40 This string is shown at mode line when users are in KKC mode.")
42 (defvar kkc-init-file-name "~/.kkcrc"
43 "Name of a file which contains user's initial setup code for KKC.")
45 ;; A flag to control a file specified by `kkc-init-file-name'.
46 ;; The value nil means the file is not yet consulted.
47 ;; The value t means the file has already been consulted but there's
48 ;; no need of updating it yet.
49 ;; Any other value means that we must update the file before exiting Emacs.
50 (defvar kkc-init-file-flag nil)
52 ;; Cash data for `kkc-lookup-key'. This may be initialized by loading
53 ;; a file specified by `kkc-init-file-name'. If any elements are
54 ;; modified, the data is written out to the file when exiting Emacs.
55 (defvar kkc-lookup-cache '(kkc-lookup-cache))
57 (defun kkc-save-init-file ()
58 "Save initial setup code for KKC to a file specified by `kkc-init-file-name'"
59 (if (and kkc-init-file-flag
60 (not (eq kkc-init-file-flag t)))
61 (let ((coding-system-for-write 'iso-2022-7))
62 (write-region (format "(setq kkc-lookup-cache '%S)\n" kkc-lookup-cache)
64 kkc-init-file-name))))
66 ;; Sequence of characters to be used for indexes for shown list. The
67 ;; Nth character is for the Nth conversion in the list currently shown.
68 (defvar kkc-show-conversion-list-index-chars
69 "1234567890abcdefghijklmnopqrsuvwxyz")
72 (let ((map (make-keymap))
75 (define-key map (char-to-string i) 'undefined)
78 (define-key map (char-to-string i) 'kkc-non-kkc-command)
81 (let ((len (length kkc-show-conversion-list-index-chars)))
84 (char-to-string (aref kkc-show-conversion-list-index-chars i))
85 'kkc-select-from-list)
87 (define-key map " " 'kkc-next)
88 (define-key map (char-to-string help-char) 'help-command)
89 (define-key map "\r" 'kkc-terminate)
90 (define-key map "\C-@" 'kkc-first-char-only)
91 (define-key map "\C-n" 'kkc-next)
92 (define-key map "\C-p" 'kkc-prev)
93 (define-key map "\C-i" 'kkc-shorter)
94 (define-key map "\C-o" 'kkc-longer)
95 (define-key map "\C-c" 'kkc-cancel)
96 (define-key map "\C-?" 'kkc-cancel)
97 (define-key map "\C-f" 'kkc-next-phrase)
98 (define-key map "K" 'kkc-katakana)
99 (define-key map "H" 'kkc-hiragana)
100 (define-key map "l" 'kkc-show-conversion-list-or-next-group)
101 (define-key map "L" 'kkc-show-conversion-list-or-prev-group)
102 (define-key map [?\C-\ ] 'kkc-first-char-only)
103 (define-key map [delete] 'kkc-cancel)
104 (define-key map [return] 'kkc-terminate)
105 (append map '((t . kkc-non-kkc-command))))
106 "Keymap for KKC (Kana Kanji Conversion) mode.")
109 "Major mode for converting Kana string to Kanji-Kana mixed string.
112 (setq major-mode 'kkc-mode)
113 (setq mode-name "KKC")
114 (use-local-map kkc-mode-map)
115 (run-hooks 'kkc-mode-hook))
117 ;;; Internal variables used in KKC.
119 ;; The current Kana string to be converted.
120 (defvar kkc-original-kana nil)
122 ;; The current key sequence (vector of Kana characters) generated from
123 ;; `kkc-original-kana'.
124 (defvar kkc-current-key nil)
126 ;; List of the current conversions for `kkc-current-key'.
127 (defvar kkc-current-conversions nil)
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)
139 (defvar kkc-show-conversion-list-count 4
140 "Count of successive `kkc-next' or `kkc-prev' to show conversion list.")
142 ;; Provided that `kkc-current-key' is [A B C D E F G H I], the current
143 ;; conversion target is [A B C D E F], the sequence of which
144 ;; conversion is found is [A B C D]:
147 ;; kkc-overlay-head (black): |<--------->|
148 ;; kkc-overlay-tail (underline): |<------->|
149 ;; kkc-length-head: |<--------->|
150 ;; kkc-length-converted: |<----->|
152 (defvar kkc-overlay-head nil)
153 (defvar kkc-overlay-tail nil)
154 (defvar kkc-length-head nil)
155 (defvar kkc-length-converted nil)
157 ;; Cursor type (`box' or `bar') of the current frame.
158 (defvar kkc-cursor-type nil)
160 ;; Flag to tell if the current conversion is canceled. If non-nil,
161 ;; the value is a buffer position of the head of currently active
162 ;; conversion region.
163 (defvar kkc-canceled nil)
165 ;; Lookup SKK dictionary to set list of conversions in
166 ;; kkc-current-conversions for key sequence kkc-current-key of length
167 ;; LEN. If no conversion is found in the dictionary, don't change
168 ;; kkc-current-conversions and return nil.
169 ;; Postfixes are handled only if POSTFIX is non-nil.
170 (defun kkc-lookup-key (len &optional postfix)
171 ;; At first, prepare cache data if any.
172 (if (not kkc-init-file-flag)
174 (setq kkc-init-file-flag t)
175 (add-hook 'kill-emacs-hook 'kkc-save-init-file)
176 (if (file-readable-p kkc-init-file-name)
178 (load-file "~/.kkcrc")
179 (error (message "Invalid data in %s" kkc-init-file-name)
181 (let ((entry (lookup-nested-alist kkc-current-key kkc-lookup-cache len 0 t)))
182 (if (consp (car entry))
183 (setq kkc-length-converted len
184 kkc-current-conversions-width nil
185 kkc-current-conversions (car entry))
186 (setq entry (skkdic-lookup-key kkc-current-key len postfix))
189 (setq kkc-length-converted len
190 kkc-current-conversions-width nil
191 kkc-current-conversions (cons 1 entry))
193 ;; Store this conversions in the cache.
195 (set-nested-alist kkc-current-key kkc-current-conversions
196 kkc-lookup-cache kkc-length-converted)
197 (setq kkc-init-file-flag 'kkc-lookup-cache)))
200 (setq kkc-length-converted 1
201 kkc-current-conversions-width nil
202 kkc-current-conversions (cons 0 nil)))))))
205 (defun kkc-region (from to)
206 "Convert Kana string in the current region to Kanji-Kana mixed string.
207 After one candidate of conversion is shown in the region, users are
208 put in KKC major mode to select a desirable conversion."
210 (setq kkc-original-kana (buffer-substring from to))
214 (if (overlayp kkc-overlay-head)
215 (move-overlay kkc-overlay-head from to)
216 (setq kkc-overlay-head (make-overlay from to nil nil t))
217 (overlay-put kkc-overlay-head 'face 'highlight))
218 (if (overlayp kkc-overlay-tail)
219 (move-overlay kkc-overlay-tail to to)
220 (setq kkc-overlay-tail (make-overlay to to nil nil t))
221 (overlay-put kkc-overlay-tail 'face 'underline))
223 ;; After updating the conversion region with the first candidate of
224 ;; conversion, jump into a recursive editing environment with KKC
226 (let ((overriding-local-map nil)
227 (previous-local-map (current-local-map))
228 (minor-mode-alist nil)
229 (minor-mode-map-alist nil)
230 (current-input-method-title kkc-input-method-title)
231 major-mode mode-name)
234 (setq kkc-canceled nil)
235 (setq kkc-current-key (string-to-vector kkc-original-kana))
236 (setq kkc-length-head (length kkc-current-key))
237 (setq kkc-length-converted 0)
238 (while (not (kkc-lookup-key kkc-length-head))
239 (setq kkc-length-head (1- kkc-length-head)))
241 (kkc-update-conversion 'all)
244 (goto-char (overlay-end kkc-overlay-tail))
245 (delete-overlay kkc-overlay-head)
246 (delete-overlay kkc-overlay-tail)
247 (use-local-map previous-local-map)))
250 (defun kkc-terminate ()
251 "Exit from KKC mode by fixing the current conversion."
255 (defun kkc-non-kkc-command ()
256 "Exit from KKC mode by fixing the current conversion.
257 After that, handle the event which invoked this command."
259 (setq unread-command-events (list last-input-event))
263 "Exit from KKC mode by canceling any conversions."
265 (setq kkc-canceled (overlay-start kkc-overlay-head))
266 (goto-char kkc-canceled)
267 (delete-region (overlay-start kkc-overlay-head)
268 (overlay-end kkc-overlay-tail))
269 (insert kkc-original-kana)
272 (defun kkc-first-char-only ()
273 "Select only the first character currently converted."
275 (goto-char (overlay-start kkc-overlay-head))
277 (delete-region (point) (overlay-end kkc-overlay-tail))
280 ;; Count of successive invocations of `kkc-next'.
281 (defvar kkc-next-count nil)
284 "Select the next candidate of conversion."
286 (if (eq this-command last-command)
287 (setq kkc-next-count (1+ kkc-next-count))
288 (setq kkc-next-count 1))
289 (let ((idx (1+ (car kkc-current-conversions))))
292 (if (>= idx (length kkc-current-conversions))
294 (setcar kkc-current-conversions idx)
297 (set-nested-alist kkc-current-key kkc-current-conversions
298 kkc-lookup-cache kkc-length-converted)
299 (setq kkc-init-file-flag 'kkc-lookup-cache)))
300 (if (or kkc-current-conversions-width
301 (>= kkc-next-count kkc-show-conversion-list-count))
302 (kkc-show-conversion-list-update))
303 (kkc-update-conversion)))
305 ;; Count of successive invocations of `kkc-next'.
306 (defvar kkc-prev-count nil)
309 "Select the previous candidate of conversion."
311 (if (eq this-command last-command)
312 (setq kkc-prev-count (1+ kkc-prev-count))
313 (setq kkc-prev-count 1))
314 (let ((idx (1- (car kkc-current-conversions))))
316 (setq idx (1- (length kkc-current-conversions))))
317 (setcar kkc-current-conversions idx)
320 (set-nested-alist kkc-current-key kkc-current-conversions
321 kkc-lookup-cache kkc-length-converted)
322 (setq kkc-init-file-flag 'kkc-lookup-cache)))
323 (if (or kkc-current-conversions-width
324 (>= kkc-prev-count kkc-show-conversion-list-count))
325 (kkc-show-conversion-list-update))
326 (kkc-update-conversion)))
328 (defun kkc-select-from-list ()
329 "Select one candidate from the list currently shown in echo area."
332 (if kkc-current-conversions-width
333 (let ((len (length kkc-show-conversion-list-index-chars))
334 (maxlen (- (aref (aref kkc-current-conversions-width 0) 1)
335 (aref (aref kkc-current-conversions-width 0) 0)))
340 (if (= (aref kkc-show-conversion-list-index-chars i)
346 (setcar kkc-current-conversions
347 (+ (aref (aref kkc-current-conversions-width 0) 0) idx))
348 (kkc-show-conversion-list-update)
349 (kkc-update-conversion))
350 (setq unread-command-events (list last-input-event))
353 (defun kkc-katakana ()
354 "Convert to Katakana."
356 (setcar kkc-current-conversions -1)
357 (kkc-update-conversion 'all))
359 (defun kkc-hiragana ()
360 "Convert to hiragana."
362 (setcar kkc-current-conversions 0)
363 (kkc-update-conversion))
365 (defun kkc-shorter ()
366 "Make the Kana string to be converted shorter."
368 (if (<= kkc-length-head 1)
369 (error "Can't be shorter")
370 (setq kkc-length-head (1- kkc-length-head))
371 (if (> kkc-length-converted kkc-length-head)
372 (let ((len kkc-length-head))
373 (setq kkc-length-converted 0)
374 (while (not (kkc-lookup-key len))
375 (setq len (1- len)))))
376 (kkc-update-conversion 'all)))
379 "Make the Kana string to be converted longer."
381 (if (>= kkc-length-head (length kkc-current-key))
382 (error "Can't be longer")
383 (setq kkc-length-head (1+ kkc-length-head))
384 ;; This time, try also entries with postfixes.
385 (kkc-lookup-key kkc-length-head 'postfix)
386 (kkc-update-conversion 'all)))
388 (defun kkc-next-phrase ()
389 "Fix the currently converted string and try to convert the remaining string."
391 (if (>= kkc-length-head (length kkc-current-key))
393 (setq kkc-length-head (- (length kkc-current-key) kkc-length-head))
394 (goto-char (overlay-end kkc-overlay-head))
395 (while (and (< (point) (overlay-end kkc-overlay-tail))
397 (goto-char (match-end 0))
398 (setq kkc-length-head (1- kkc-length-head)))
399 (if (= kkc-length-head 0)
401 (let ((newkey (make-vector kkc-length-head 0))
402 (idx (- (length kkc-current-key) kkc-length-head))
404 ;; For the moment, (setq kkc-original-kana (concat newkey))
406 (setq kkc-original-kana "")
407 (while (< i kkc-length-head)
408 (aset newkey i (aref kkc-current-key (+ idx i)))
409 (setq kkc-original-kana
410 (concat kkc-original-kana (char-to-string (aref newkey i))))
412 (setq kkc-current-key newkey)
413 (setq kkc-length-converted 0)
414 (while (and (not (kkc-lookup-key kkc-length-head))
415 (> kkc-length-head 1))
416 (setq kkc-length-head (1- kkc-length-head)))
418 (tail (overlay-end kkc-overlay-tail)))
419 (move-overlay kkc-overlay-head pos tail)
420 (move-overlay kkc-overlay-tail tail tail))
421 (kkc-update-conversion 'all)))))
423 ;; We'll show users a list of available conversions in echo area with
424 ;; index numbers so that users can select one conversion with the
427 ;; Set `kkc-current-conversions-width'.
428 (defun kkc-setup-current-conversions-width ()
429 (let ((convs (cdr kkc-current-conversions))
430 (len (length kkc-current-conversions))
432 (setq kkc-current-conversions-width (make-vector len nil))
433 ;; To tell `kkc-show-conversion-list-update' to generate
434 ;; message from scratch.
435 (aset kkc-current-conversions-width 0 (vector len -2 nil))
436 ;; Fill the remaining slots.
438 (aset kkc-current-conversions-width idx
439 (+ (string-width (car convs)) 4))
440 (setq convs (cdr convs)
443 (defun kkc-show-conversion-list-or-next-group ()
444 "Show list of available conversions in echo area with index numbers.
445 If the list is already shown, show the next group of conversions,
446 and change the current conversion to the first one in the group."
448 (if (< (length kkc-current-conversions) 3)
449 (error "No alternative"))
450 (if kkc-current-conversions-width
451 (let ((next-idx (aref (aref kkc-current-conversions-width 0) 1)))
452 (if (< next-idx (length kkc-current-conversions-width))
453 (setcar kkc-current-conversions next-idx)
454 (setcar kkc-current-conversions 1))
455 (kkc-show-conversion-list-update)
456 (kkc-update-conversion))
457 (kkc-setup-current-conversions-width)
458 (kkc-show-conversion-list-update)))
460 (defun kkc-show-conversion-list-or-prev-group ()
461 "Show list of available conversions in echo area with index numbers.
462 If the list is already shown, show the previous group of conversions,
463 and change the current conversion to the last one in the group."
465 (if (< (length kkc-current-conversions) 3)
466 (error "No alternative"))
467 (if kkc-current-conversions-width
468 (let ((this-idx (aref (aref kkc-current-conversions-width 0) 0)))
470 (setcar kkc-current-conversions (1- this-idx))
471 (setcar kkc-current-conversions
472 (1- (length kkc-current-conversions-width))))
473 (kkc-show-conversion-list-update)
474 (kkc-update-conversion))
475 (kkc-setup-current-conversions-width)
476 (kkc-show-conversion-list-update)))
478 ;; Update the conversion list shown in echo area.
479 (defun kkc-show-conversion-list-update ()
480 (or kkc-current-conversions-width
481 (kkc-setup-current-conversions-width))
482 (let* ((current-idx (car kkc-current-conversions))
483 (first-slot (aref kkc-current-conversions-width 0))
484 (this-idx (aref first-slot 0))
485 (next-idx (aref first-slot 1))
486 (msg (aref first-slot 2)))
487 (if (< current-idx this-idx)
488 ;; The currently selected conversion is before the list shown
489 ;; previously. We must start calculation of message width
490 ;; from the start again.
491 (setq this-idx 1 msg nil)
492 (if (>= current-idx next-idx)
493 ;; The currently selected conversion is after the list shown
494 ;; previously. We start calculation of message width from
495 ;; the conversion next of TO.
496 (setq this-idx next-idx msg nil)
497 ;; The current conversion is in MSG. Just clear brackets
498 ;; around index number.
499 (if (string-match "<.>" msg)
501 (aset msg (match-beginning 0) ?\ )
502 (aset msg (1- (match-end 0)) ?\ )))))
504 (let ((len (length kkc-current-conversions))
505 (max-width (window-width (minibuffer-window)))
506 (width-table kkc-current-conversions-width)
510 (while (< idx current-idx)
511 (if (<= (+ width (aref width-table idx)) max-width)
512 (setq width (+ width (aref width-table idx)))
513 (setq this-idx idx width (aref width-table idx)))
516 (aset first-slot 0 this-idx)
517 (while (and (< idx len)
518 (<= (+ width (aref width-table idx)) max-width))
519 (setq width (+ width (aref width-table idx))
522 (aset first-slot 1 (setq next-idx idx))
523 (setq l (nthcdr this-idx kkc-current-conversions))
526 (while (< idx next-idx)
527 (setq msg (format "%s %c %s "
529 (aref kkc-show-conversion-list-index-chars
534 (aset first-slot 2 msg)))
535 (if (> current-idx 0)
537 ;; Highlight the current conversion by brackets.
538 (string-match (format " \\(%c\\) "
539 (aref kkc-show-conversion-list-index-chars
540 (- current-idx this-idx)))
542 (aset msg (match-beginning 0) ?<)
543 (aset msg (1- (match-end 0)) ?>)))
546 ;; Update the conversion area with the latest conversion selected.
547 ;; ALL if non nil means to update the whole area, else update only
548 ;; inside quail-overlay-head.
550 (defun kkc-update-conversion (&optional all)
551 (goto-char (overlay-start kkc-overlay-head))
552 (cond ((= (car kkc-current-conversions) 0) ; Hiragana
554 (while (< i kkc-length-converted)
555 (insert (aref kkc-current-key i))
557 ((= (car kkc-current-conversions) -1) ; Katakana
559 (while (< i kkc-length-converted)
560 (insert (japanese-katakana (aref kkc-current-key i)))
563 (insert (nth (car kkc-current-conversions) kkc-current-conversions))))
564 (delete-region (point) (overlay-start kkc-overlay-tail))
566 (let ((len (length kkc-current-key))
567 (i kkc-length-converted))
568 (delete-region (overlay-start kkc-overlay-tail)
569 (overlay-end kkc-overlay-head))
570 (while (< i kkc-length-head)
571 (if (= (car kkc-current-conversions) -1)
572 (insert (japanese-katakana (aref kkc-current-key i)))
573 (insert (aref kkc-current-key i)))
577 (insert (aref kkc-current-key i))
579 (move-overlay kkc-overlay-head
580 (overlay-start kkc-overlay-head) pos)
581 (delete-region (point) (overlay-end kkc-overlay-tail)))))
582 (goto-char (overlay-end kkc-overlay-tail)))