kkc.el 24 KB

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