-;;; kkc.el --- Kana Kanji converter
+;;; kkc.el --- Kana Kanji converter -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
-;; Keywords: mule, multilingual, Japanese, SKK
+;; Keywords: mule, multilingual, Japanese
;; This file is part of GNU Emacs.
;;; Code:
-(require 'skkdic-utl)
+(require 'ja-dic-utl)
(defvar kkc-input-method-title "\e$B4A\e(B"
"String denoting KKC input method.
;; Cash data for `kkc-lookup-key'. This may be initialized by loading
;; a file specified by `kkc-init-file-name'. If any elements are
;; modified, the data is written out to the file when exiting Emacs.
-(defvar kkc-lookup-cache '(kkc-lookup-cache))
+(defvar kkc-lookup-cache nil)
+
+;; Tag symbol of `kkc-lookup-cache'.
+(defconst kkc-lookup-cache-tag 'kkc-lookup-cache-2)
(defun kkc-save-init-file ()
"Save initial setup code for KKC to a file specified by `kkc-init-file-name'"
(if (and kkc-init-file-flag
(not (eq kkc-init-file-flag t)))
- (let ((coding-system-for-write 'iso-2022-7bit))
+ (let ((coding-system-for-write 'iso-2022-7bit)
+ (print-length nil))
(write-region (format "(setq kkc-lookup-cache '%S)\n" kkc-lookup-cache)
nil
kkc-init-file-name))))
(defvar kkc-show-conversion-list-index-chars
"1234567890")
+(defun kkc-help ()
+ "Show key bindings available while converting by KKC."
+ (interactive)
+ (with-output-to-temp-buffer "*Help*"
+ (princ (substitute-command-keys "\\{kkc-keymap}"))))
+
(defvar kkc-keymap
- (let ((map (make-keymap))
+ (let ((map (make-sparse-keymap))
(len (length kkc-show-conversion-list-index-chars))
(i 0))
(while (< i len)
(define-key map "\C-p" 'kkc-prev)
(define-key map "\C-i" 'kkc-shorter)
(define-key map "\C-o" 'kkc-longer)
+ (define-key map "I" 'kkc-shorter-conversion)
+ (define-key map "O" 'kkc-longer-phrase)
(define-key map "\C-c" 'kkc-cancel)
(define-key map "\C-?" 'kkc-cancel)
(define-key map "\C-f" 'kkc-next-phrase)
(define-key map [?\C- ] 'kkc-first-char-only)
(define-key map [delete] 'kkc-cancel)
(define-key map [return] 'kkc-terminate)
+ (define-key map "\C-h" 'kkc-help)
map)
"Keymap for KKC (Kana Kanji Converter).")
;; `kkc-current-conversion'.
(defvar kkc-current-conversions-width nil)
-(defvar kkc-show-conversion-list-count 4
- "Count of successive `kkc-next' or `kkc-prev' to show conversion list.")
+(defcustom kkc-show-conversion-list-count 4
+ "*Count of successive `kkc-next' or `kkc-prev' to show conversion list.
+When you type SPC or C-p successively this count while using the input
+method `japanese', the conversion candidates are shown in the echo
+area while indicating the current selection by `<N>'."
+ :group 'mule
+ :type 'integer)
+
+;; Count of successive invocations of `kkc-next'.
+(defvar kkc-next-count nil)
+
+;; Count of successive invocations of `kkc-prev'.
+(defvar kkc-prev-count nil)
;; Provided that `kkc-current-key' is [A B C D E F G H I], the current
;; conversion target is [A B C D E F], and the sequence of which
;; Cursor type (`box' or `bar') of the current frame.
(defvar kkc-cursor-type nil)
-;; Lookup SKK dictionary to set list of conversions in
+;; Lookup Japanese dictionary to set list of conversions in
;; kkc-current-conversions for key sequence kkc-current-key of length
;; LEN. If no conversion is found in the dictionary, don't change
;; kkc-current-conversions and return nil.
-;; Postfixes are handled only if POSTFIX is non-nil.
+;; Postfixes are handled only if POSTFIX is non-nil.
(defun kkc-lookup-key (len &optional postfix prefer-noun)
;; At first, prepare cache data if any.
- (if (not kkc-init-file-flag)
- (progn
- (setq kkc-init-file-flag t)
- (add-hook 'kill-emacs-hook 'kkc-save-init-file)
- (if (file-readable-p kkc-init-file-name)
- (condition-case nil
- (load-file "~/.kkcrc")
- (error (message "Invalid data in %s" kkc-init-file-name)
- (ding))))))
+ (unless kkc-init-file-flag
+ (setq kkc-init-file-flag t
+ kkc-lookup-cache nil)
+ (add-hook 'kill-emacs-hook 'kkc-save-init-file)
+ (if (file-readable-p kkc-init-file-name)
+ (condition-case nil
+ (load-file kkc-init-file-name)
+ (kkc-error "Invalid data in %s" kkc-init-file-name))))
+ (or (and (nested-alist-p kkc-lookup-cache)
+ (eq (car kkc-lookup-cache) kkc-lookup-cache-tag))
+ (setq kkc-lookup-cache (list kkc-lookup-cache-tag)
+ kkc-init-file-flag 'kkc-lookup-cache))
(let ((entry (lookup-nested-alist kkc-current-key kkc-lookup-cache len 0 t)))
(if (consp (car entry))
(setq kkc-length-converted len
kkc-current-conversions-width nil
kkc-current-conversions (cons 0 nil)))))))
+(put 'kkc-error 'error-conditions '(kkc-error error))
+(defun kkc-error (&rest args)
+ (signal 'kkc-error (apply 'format args)))
+
(defvar kkc-converting nil)
+;;;###autoload
+(defvar kkc-after-update-conversion-functions nil
+ "Functions to run after a conversion is selected in `japanese' input method.
+With this input method, a user can select a proper conversion from
+candidate list. Each time he changes the selection, functions in this
+list are called with two arguments; starting and ending buffer
+positions that contains the current selection.")
+
;;;###autoload
(defun kkc-region (from to)
"Convert Kana string in the current region to Kanji-Kana mixed string.
(setq kkc-length-head (length kkc-current-key))
(setq kkc-length-converted 0)
- ;; At first convert the region to the first candidate.
- (let ((first t))
- (while (not (kkc-lookup-key kkc-length-head nil first))
- (setq kkc-length-head (1- kkc-length-head)
- first nil))
- (goto-char to)
- (kkc-update-conversion 'all))
-
- ;; Then, ask users to selecte a desirable conversoin.
- (let ((current-input-method-title kkc-input-method-title)
- (input-method-function nil))
- (force-mode-line-update)
- (setq kkc-converting t)
- (while kkc-converting
- (let* ((echo-keystrokes 0)
- (keyseq (read-key-sequence nil))
- (cmd (lookup-key kkc-keymap keyseq)))
- (if (commandp cmd)
- (condition-case err
- (call-interactively cmd)
- (kkc-error (message "%s" (cdr err)) (beep)))
- ;; KEYSEQ is not defined in KKC keymap.
- ;; Let's put the event back.
- (setq unread-input-method-events
- (append (string-to-list keyseq) unread-input-method-events))
- (setq kkc-converting nil)))))
-
- (force-mode-line-update)
- (goto-char (overlay-end kkc-overlay-tail))
- (prog1 (- (point) from)
+ (unwind-protect
+ ;; At first convert the region to the first candidate.
+ (let ((current-input-method-title kkc-input-method-title)
+ (input-method-function nil)
+ (modified-p (buffer-modified-p))
+ (first t))
+ (while (not (kkc-lookup-key kkc-length-head nil first))
+ (setq kkc-length-head (1- kkc-length-head)
+ first nil))
+ (goto-char to)
+ (kkc-update-conversion 'all)
+ (setq kkc-next-count 1 kkc-prev-count 0)
+ (if (and (>= kkc-next-count kkc-show-conversion-list-count)
+ (>= (length kkc-current-conversions) 3))
+ (kkc-show-conversion-list-or-next-group))
+
+ ;; Then, ask users to select a desirable conversion.
+ (force-mode-line-update)
+ (setq kkc-converting t)
+ ;; Hide "... loaded" message.
+ (message nil)
+ (while kkc-converting
+ (set-buffer-modified-p modified-p)
+ (let* ((overriding-terminal-local-map kkc-keymap)
+ (help-char nil)
+ (keyseq (read-key-sequence nil))
+ (cmd (lookup-key kkc-keymap keyseq)))
+ (if (commandp cmd)
+ (condition-case err
+ (progn
+ (cond ((eq cmd 'kkc-next)
+ (setq kkc-next-count (1+ kkc-next-count)
+ kkc-prev-count 0))
+ ((eq cmd 'kkc-prev)
+ (setq kkc-prev-count (1+ kkc-prev-count)
+ kkc-next-count 0))
+ (t
+ (setq kkc-next-count 0 kkc-prev-count 0)))
+ (call-interactively cmd))
+ (kkc-error (message "%s" (cdr err)) (beep)))
+ ;; KEYSEQ is not defined in KKC keymap.
+ ;; Let's put the event back.
+ (setq unread-input-method-events
+ (append (string-to-list keyseq)
+ unread-input-method-events))
+ (kkc-terminate))))
+
+ (force-mode-line-update)
+ (goto-char (overlay-end kkc-overlay-tail))
+ (- (overlay-start kkc-overlay-head) from))
(delete-overlay kkc-overlay-head)
(delete-overlay kkc-overlay-tail)))
(defun kkc-terminate ()
"Exit from KKC mode by fixing the current conversion."
(interactive)
+ (goto-char (overlay-end kkc-overlay-tail))
+ (move-overlay kkc-overlay-head (point) (point))
(setq kkc-converting nil))
(defun kkc-cancel ()
(delete-region (overlay-start kkc-overlay-head)
(overlay-end kkc-overlay-tail))
(insert kkc-original-kana)
- (kkc-terminate))
+ (setq kkc-converting nil))
(defun kkc-first-char-only ()
"Select only the first character currently converted."
(delete-region (point) (overlay-end kkc-overlay-tail))
(kkc-terminate))
-;; Count of successive invocations of `kkc-next'.
-(defvar kkc-next-count nil)
-
(defun kkc-next ()
"Select the next candidate of conversion."
(interactive)
- (if (eq this-command last-command)
- (setq kkc-next-count (1+ kkc-next-count))
- (setq kkc-next-count 1))
(let ((idx (1+ (car kkc-current-conversions))))
(if (< idx 0)
(setq idx 1))
(kkc-show-conversion-list-update))
(kkc-update-conversion)))
-;; Count of successive invocations of `kkc-next'.
-(defvar kkc-prev-count nil)
-
(defun kkc-prev ()
"Select the previous candidate of conversion."
(interactive)
- (if (eq this-command last-command)
- (setq kkc-prev-count (1+ kkc-prev-count))
- (setq kkc-prev-count 1))
(let ((idx (1- (car kkc-current-conversions))))
(if (< idx 0)
(setq idx (1- (length kkc-current-conversions))))
"Make the Kana string to be converted shorter."
(interactive)
(if (<= kkc-length-head 1)
- (error "Can't be shorter")
- (setq kkc-length-head (1- kkc-length-head))
- (if (> kkc-length-converted kkc-length-head)
- (let ((len kkc-length-head))
- (setq kkc-length-converted 0)
- (while (not (kkc-lookup-key len))
- (setq len (1- len)))))
- (kkc-update-conversion 'all)))
+ (kkc-error "Can't be shorter"))
+ (setq kkc-length-head (1- kkc-length-head))
+ (if (> kkc-length-converted kkc-length-head)
+ (let ((len kkc-length-head))
+ (setq kkc-length-converted 0)
+ (while (not (kkc-lookup-key len))
+ (setq len (1- len)))))
+ (kkc-update-conversion 'all))
(defun kkc-longer ()
"Make the Kana string to be converted longer."
(interactive)
(if (>= kkc-length-head (length kkc-current-key))
- (error "Can't be longer")
- (setq kkc-length-head (1+ kkc-length-head))
- ;; This time, try also entries with postfixes.
- (kkc-lookup-key kkc-length-head 'postfix)
- (kkc-update-conversion 'all)))
+ (kkc-error "Can't be longer"))
+ (setq kkc-length-head (1+ kkc-length-head))
+ ;; This time, try also entries with postfixes.
+ (kkc-lookup-key kkc-length-head 'postfix)
+ (kkc-update-conversion 'all))
+
+(defun kkc-shorter-conversion ()
+ "Make the Kana string to be converted shorter."
+ (interactive)
+ (if (<= kkc-length-converted 1)
+ (kkc-error "Can't be shorter"))
+ (let ((len (1- kkc-length-converted)))
+ (setq kkc-length-converted 0)
+ (while (not (kkc-lookup-key len))
+ (setq len (1- len))))
+ (kkc-update-conversion 'all))
+
+(defun kkc-longer-phrase ()
+ "Make the current phrase (BUNSETSU) longer without looking up dictionary."
+ (interactive)
+ (if (>= kkc-length-head (length kkc-current-key))
+ (kkc-error "Can't be longer"))
+ (setq kkc-length-head (1+ kkc-length-head))
+ (kkc-update-conversion 'all))
(defun kkc-next-phrase ()
"Fix the currently converted string and try to convert the remaining string."
and change the current conversion to the first one in the group."
(interactive)
(if (< (length kkc-current-conversions) 3)
- (error "No alternative"))
+ (kkc-error "No alternative"))
(if kkc-current-conversions-width
(let ((next-idx (aref (aref kkc-current-conversions-width 0) 1)))
(if (< next-idx (length kkc-current-conversions-width))
and change the current conversion to the last one in the group."
(interactive)
(if (< (length kkc-current-conversions) 3)
- (error "No alternative"))
+ (kkc-error "No alternative"))
(if kkc-current-conversions-width
(let ((this-idx (aref (aref kkc-current-conversions-width 0) 0)))
(if (> this-idx 1)
;; The currently selected conversion is after the list shown
;; previously. We start calculation of message width from
;; the conversion next of TO.
- (setq this-idx next-idx msg nil)
- ;; The current conversion is in MSG. Just clear brackets
- ;; around index number.
- (if (string-match "<.>" msg)
- (progn
- (aset msg (match-beginning 0) ?\ )
- (aset msg (1- (match-end 0)) ?\ )))))
+ (setq this-idx next-idx msg nil)))
(if (not msg)
(let ((len (length kkc-current-conversions))
(max-width (window-width (minibuffer-window)))
(width-table kkc-current-conversions-width)
(width 0)
(idx this-idx)
+ (max-items (length kkc-show-conversion-list-index-chars))
l)
- (while (< idx current-idx)
- (if (<= (+ width (aref width-table idx)) max-width)
+ ;; Set THIS-IDX to the first index of conversion to be shown
+ ;; in MSG, and reflect it in kkc-current-conversions-width.
+ (while (<= idx current-idx)
+ (if (and (<= (+ width (aref width-table idx)) max-width)
+ (< (- idx this-idx) max-items))
(setq width (+ width (aref width-table idx)))
(setq this-idx idx width (aref width-table idx)))
(setq idx (1+ idx)
l (cdr l)))
(aset first-slot 0 this-idx)
+ ;; Set NEXT-IDX to the next index of the last conversion
+ ;; shown in MSG, and reflect it in
+ ;; kkc-current-conversions-width.
(while (and (< idx len)
- (<= (+ width (aref width-table idx)) max-width))
+ (<= (+ width (aref width-table idx)) max-width)
+ (< (- idx this-idx) max-items))
(setq width (+ width (aref width-table idx))
idx (1+ idx)
l (cdr l)))
(aset first-slot 1 (setq next-idx idx))
(setq l (nthcdr this-idx kkc-current-conversions))
- (setq msg "")
- (setq idx this-idx)
+ (setq msg (format " %c %s"
+ (aref kkc-show-conversion-list-index-chars 0)
+ (propertize (car l)
+ 'kkc-conversion-index this-idx))
+ idx (1+ this-idx)
+ l (cdr l))
(while (< idx next-idx)
- (setq msg (format "%s %c %s "
+ (setq msg (format "%s %c %s"
msg
(aref kkc-show-conversion-list-index-chars
(- idx this-idx))
- (car l)))
- (setq idx (1+ idx)
+ (propertize (car l)
+ 'kkc-conversion-index idx))
+ idx (1+ idx)
l (cdr l)))
(aset first-slot 2 msg)))
+
+ ;; Highlight the current conversion.
(if (> current-idx 0)
- (progn
- ;; Highlight the current conversion by brackets.
- (string-match (format " \\(%c\\) "
- (aref kkc-show-conversion-list-index-chars
- (- current-idx this-idx)))
- msg)
- (aset msg (match-beginning 0) ?<)
- (aset msg (1- (match-end 0)) ?>)))
- (message "%s" msg)))
+ (let ((pos 3)
+ (limit (length msg)))
+ (remove-text-properties 0 (length msg) '(face nil) msg)
+ (while (not (eq (get-text-property pos 'kkc-conversion-index msg)
+ current-idx))
+ (setq pos (next-single-property-change pos 'kkc-conversion-index
+ msg limit)))
+ (put-text-property pos (next-single-property-change
+ pos 'kkc-conversion-index msg limit)
+ 'face 'highlight msg)))
+ (let ((message-log-max nil))
+ (message "%s" msg))))
;; Update the conversion area with the latest conversion selected.
;; ALL if non nil means to update the whole area, else update only
(move-overlay kkc-overlay-head
(overlay-start kkc-overlay-head) pos)
(delete-region (point) (overlay-end kkc-overlay-tail)))))
- (goto-char (overlay-end kkc-overlay-tail)))
+ (unwind-protect
+ (run-hook-with-args 'kkc-after-update-conversion-functions
+ (overlay-start kkc-overlay-head)
+ (overlay-end kkc-overlay-head))
+ (goto-char (overlay-end kkc-overlay-tail))))
;;
(provide 'kkc)
-;; kkc.el ends here
+;;; arch-tag: 3cbfd56e-74e6-4f60-bb46-ba7c2d366fbf
+;;; kkc.el ends here