-;;; 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))))
;; Sequence of characters to be used for indexes for shown list. The
;; Nth character is for the Nth conversion in the list currently shown.
(defvar kkc-show-conversion-list-index-chars
- "1234567890abcdefghijklmnopqrsuvwxyz")
+ "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-mode-map
- (let ((map (make-keymap))
+(defvar kkc-keymap
+ (let ((map (make-sparse-keymap))
+ (len (length kkc-show-conversion-list-index-chars))
(i 0))
- (while (< i 128)
- (define-key map (char-to-string i) 'kkc-non-kkc-command)
+ (while (< i len)
+ (define-key map
+ (char-to-string (aref kkc-show-conversion-list-index-chars i))
+ 'kkc-select-from-list)
(setq i (1+ i)))
- (setq i 0)
- (let ((len (length kkc-show-conversion-list-index-chars)))
- (while (< i len)
- (define-key map
- (char-to-string (aref kkc-show-conversion-list-index-chars i))
- 'kkc-select-from-list)
- (setq i (1+ i))))
(define-key map " " 'kkc-next)
- (define-key map (char-to-string help-char) 'help-command)
(define-key map "\r" 'kkc-terminate)
(define-key map "\C-@" 'kkc-first-char-only)
(define-key map "\C-n" 'kkc-next)
(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 "H" 'kkc-hiragana)
(define-key map "l" 'kkc-show-conversion-list-or-next-group)
(define-key map "L" 'kkc-show-conversion-list-or-prev-group)
- (define-key map [?\C-\ ] 'kkc-first-char-only)
+ (define-key map [?\C- ] 'kkc-first-char-only)
(define-key map [delete] 'kkc-cancel)
(define-key map [return] 'kkc-terminate)
- (let ((meta-map (make-sparse-keymap)))
- (define-key map (char-to-string meta-prefix-char) meta-map)
- (define-key map [escape] meta-map))
- (define-key map (vector meta-prefix-char t) 'kkc-non-kkc-command)
- ;; At last, define default key binding.
- (define-key map [t] 'kkc-non-kkc-command)
+ (define-key map "\C-h" 'kkc-help)
map)
- "Keymap for KKC (Kana Kanji Conversion) mode.")
-
-(defun kkc-mode ()
- "Major mode for converting Kana string to Kanji-Kana mixed string.
-Commands:
-\\{kkc-mode-map}"
- (setq major-mode 'kkc-mode)
- (setq mode-name "KKC")
- (use-local-map kkc-mode-map)
- (run-hooks 'kkc-mode-hook))
+ "Keymap for KKC (Kana Kanji Converter).")
;;; Internal variables used in KKC.
;; `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], the sequence of which
+;; conversion target is [A B C D E F], and the sequence of which
;; conversion is found is [A B C D]:
;;
;; A B C D E F G H I
;; Cursor type (`box' or `bar') of the current frame.
(defvar kkc-cursor-type nil)
-;; Flag to tell if the current conversion is canceled. If non-nil,
-;; the value is a buffer position of the head of currently active
-;; conversion region.
-(defvar kkc-canceled 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
-(defun kkc-region (from to &optional kkc-mode-exit-function)
+(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.
-After one candidate of conversion is shown in the region, users are
-put in KKC major mode to select a desirable conversion.
-Optional arg KKC-MODE-EXIT-FUNCTION if non-nil is called on exiting KKC mode."
+Users can select a desirable conversion interactively.
+When called from a program, expects two arguments,
+positions FROM and TO (integers or markers) specifying the target region.
+When it returns, the point is at the tail of the selected conversion,
+and the return value is the length of the conversion."
(interactive "r")
(setq kkc-original-kana (buffer-substring from to))
(goto-char from)
(setq kkc-overlay-tail (make-overlay to to nil nil t))
(overlay-put kkc-overlay-tail 'face 'underline))
- ;; After updating the conversion region with the first candidate of
- ;; conversion, jump into a recursive editing environment with KKC
- ;; mode.
- (let ((overriding-local-map nil)
- (previous-local-map (current-local-map))
- (minor-mode-alist nil)
- (minor-mode-map-alist nil)
- (current-input-method-title kkc-input-method-title)
- major-mode mode-name)
- (unwind-protect
- (let (len)
- (setq kkc-canceled nil)
- (setq kkc-current-key (string-to-vector kkc-original-kana))
- (setq kkc-length-head (length kkc-current-key))
- (setq len kkc-length-head)
- (setq kkc-length-converted 0)
- (while (not (kkc-lookup-key kkc-length-head nil
- (< kkc-length-head len)))
- (setq kkc-length-head (1- kkc-length-head)))
- (goto-char to)
- (kkc-update-conversion 'all)
- (kkc-mode)
- (recursive-edit))
- (goto-char (overlay-end kkc-overlay-tail))
- (delete-overlay kkc-overlay-head)
- (delete-overlay kkc-overlay-tail)
- (use-local-map previous-local-map)
- (if (and kkc-mode-exit-function
- (fboundp kkc-mode-exit-function))
- (funcall kkc-mode-exit-function (if kkc-canceled
- (cons kkc-canceled (point))))))))
+ (setq kkc-current-key (string-to-vector kkc-original-kana))
+ (setq kkc-length-head (length kkc-current-key))
+ (setq kkc-length-converted 0)
+
+ (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)
- (throw 'exit nil))
-
-(defun kkc-non-kkc-command ()
- "Exit from KKC mode by fixing the current conversion.
-After that, handle the event which invoked this command."
- (interactive)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events (append keylist unread-command-events)))
- (kkc-terminate))
+ (goto-char (overlay-end kkc-overlay-tail))
+ (move-overlay kkc-overlay-head (point) (point))
+ (setq kkc-converting nil))
(defun kkc-cancel ()
"Exit from KKC mode by canceling any conversions."
(interactive)
- (setq kkc-canceled (overlay-start kkc-overlay-head))
- (goto-char kkc-canceled)
+ (goto-char (overlay-start kkc-overlay-head))
(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))))
(setq len maxlen))
(while (< i len)
(if (= (aref kkc-show-conversion-list-index-chars i)
- last-input-char)
+ last-input-event)
(setq idx i i len)
(setq i (1+ i))))))
(if idx
(+ (aref (aref kkc-current-conversions-width 0) 0) idx))
(kkc-show-conversion-list-update)
(kkc-update-conversion))
- (setq unread-command-events (list last-input-event))
+ (setq unread-input-method-events
+ (cons last-input-event unread-input-method-events))
(kkc-terminate))))
(defun kkc-katakana ()
"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
HCoop / bpt / emacs.git / blobdiff