Download
(eval-when-compile
(require 'cl))
(defvar eim-version "1.0")
(defvar eim-database nil
"All word is store here as a symbol")
(defvar eim-char-database nil
"it is used to map a character into its code.")
(defvar eim-packages nil
"A list of input methods.
An input method has these variables:
char-database, word-database, validate-function, invalid-functions,
handle-functions, keymap")
(defvar eim-current-package nil)
(defun eim-intern-word (code word &optional db)
"Add the WORD to the symbol in `eim-database' which name is CODE"
(or db (setq db eim-database))
(let* ((s (intern-soft code db))
(ws (symbol-value s)))
(set (intern code db) (add-to-list 'ws word))))
(defun eim-make-database (words)
"Set `eim-database'"
(dolist (word words)
(set (intern (car word) eim-database) (cdr word))))
(defun eim-make-char-database (chars)
"Set `eim-char-database'"
(dolist (char chars)
(let ((code (car char)))
(dolist (c (cdr char))
(set (intern c eim-char-database) code)))))
(defun eim-get (code &optional db)
"Get the symbol value whose name is CODE"
(or db (setq db eim-database))
(symbol-value (intern-soft code db)))
(defun eim-get-completion (prefix)
"Get all completions of the PREFIX in `eim-database'"
(all-completions prefix eim-database))
(defun eim-get-char-code (char &optional db)
"Get the code of the character CHAR"
(or db (setq db eim-char-database))
(symbol-value (intern-soft (char-to-string char) db)))
(defsubst eim-char-database ()
(nth 2 eim-current-package))
(defsubst eim-database ()
(nth 3 eim-current-package))
(defsubst eim-docstring ()
(nth 1 eim-current-package))
(defsubst eim-params ()
(nth 4 eim-current-package))
(defsubst eim-package-name ()
(nth 0 eim-current-package))
(defun eim-install-package (package docstr char-db word-db &optional params)
"Install the package to `eim-packages'"
(setq eim-char-database char-db
eim-database word-db)
(dolist (p params)
(set (car p) (cdr p)))
(add-to-list 'eim-packages (list package docstr char-db word-db params)))
(defun eim-uninstall-package (package-name)
(setq eim-packages (remove (assoc package-name eim-packages)
eim-packages)))
(defvar eim-start nil)
(defvar eim-end nil)
(defvar eim-activate nil)
(defvar eim-choices-string "")
(defvar eim-display-string "")
(defvar eim-current-string "")
(defvar eim-choices nil)
(defvar eim-completions nil)
(defvar eim-history-file nil)
(defvar eim-select-pos nil)
(defvar eim-overlay nil
"Overlay to display `eim-display-string'")
(defvar eim-curse-overlay nil
"Overlay to set keymap")
(defvar eim-stop-length 10000
"When input so much char, the current display string will insert, leaving the
last input character.")
(defvar eim-page-length 7
"The number of choice to display per page.")
(defvar eim-inactivate-hook nil)
(defvar eim-activate-hook nil)
(defvar eim-after-load-hook nil)
(defvar eim-invalid-function 'eim-punctuation-handle-function)
(defvar eim-handle-function 'eim-default-handle)
(defvar eim-validate-function (lambda (char)
(let ((c (string-to-char char)))
(and (> c 96) (< c 123)))))
(defvar eim-default-map nil)
(when (null eim-default-map)
(setq eim-default-map
(let ((map (make-sparse-keymap)))
(dotimes (i 10)
(define-key map (number-to-string i) 'eim-select))
(define-key map " " 'eim-select-current)
(define-key map "\C-m" 'eim-no-clear-select)
(define-key map "\C-n" 'eim-next-page)
(define-key map "\C-c" 'eim-clear-select)
(define-key map "\C-p" 'eim-prev-page)
(define-key map "\C-b" 'ignore)
(define-key map "\C-f" 'ignore)
(define-key map "\C-a" 'ignore)
(define-key map "\C-e" 'ignore)
map)))
(defvar eim-mode-map eim-default-map)
(defvar eim-default-setting `((eim-handle-function . eim-default-handle)
(eim-invalid-function . eim-punctuation-handle-function)
(eim-validate-function . eim-lower-case-letterp)
(eim-stop-length . 10000)
(eim-page-length . 7)
(eim-history-file . nil)
(eim-mode-map . ,eim-default-map))
"Default settings")
(defvar eim-punctuation-list
'(("{" . "『")
("|" . "÷")
("}" . "』")
("~" . "~")
("`" . "·")
("!" . "!")
("#" . "#")
("$" . "¥")
("%" . "%")
("&" . "※")
("(" . "(")
(")" . ")")
("*" . "×")
("+" . "+")
("," . ",")
("-" . "-")
("." . "。")
("/" . "、")
(":" . ":")
(";" . ";")
("<" . "《")
("=" . "=")
(">" . "》")
("?" . "?")
("@" . "◎")
("[" . "【")
("]" . "】")
("^" . "……")
("_" . "——")
))
(defvar eim-quote-punctuation '(("\"" nil "“" "”")
("'" nil "‘" "’")))
(defun eim-subseq (list from &optional to)
(butlast (nthcdr from list) (- (length list) to)))
(defun eim-mod (x y)
"like `mod', but when result is 0, return Y"
(let ((base (mod x y)))
(if (= base 0)
y
base)))
(defun eim-reset ()
(setq eim-start nil)
(setq eim-end nil)
(setq eim-activate nil)
(setq eim-choices-string "")
(setq eim-display-string "")
(setq eim-current-string "")
(setq eim-choices nil)
(setq eim-completions nil)
(setq eim-completion-pos 0)
(setq eim-select-pos 1)
(if (and eim-overlay (overlayp eim-overlay))
(delete-overlay eim-overlay))
(if (and eim-curse-overlay (overlayp eim-curse-overlay))
(delete-overlay eim-curse-overlay)))
(defun eim-inactivate ()
(interactive)
(run-hooks 'eim-inactivate-hook)
(remove-hook 'after-change-functions 'eim-after-change t))
(defun eim-use-package (package-name &rest libraries)
(interactive)
(make-local-variable 'eim-handle-function)
(make-local-variable 'eim-invalid-function)
(make-local-variable 'eim-validate-function)
(make-local-variable 'eim-stop-length)
(make-local-variable 'eim-page-length)
(make-local-variable 'eim-mode-map)
(make-local-variable 'eim-start)
(make-local-variable 'eim-end)
(make-local-variable 'eim-choices)
(make-local-variable 'eim-select-pos)
(make-local-variable 'eim-display-string)
(make-local-variable 'eim-choices-string)
(make-local-variable 'eim-current-string)
(make-local-variable 'eim-activate)
(make-local-variable 'eim-overlay)
(make-local-variable 'eim-curse-overlay)
(make-local-variable 'eim-completions)
(make-local-variable 'eim-inactivate-hook)
(make-local-variable 'eim-activate-hook)
(make-local-variable 'eim-current-package)
(make-local-variable 'inactivate-current-input-method-function)
(setq inactivate-current-input-method-function 'eim-inactivate)
(make-local-variable 'describe-current-input-method-function)
(setq describe-current-input-method-function 'eim-help)
(if (assoc package-name eim-packages)
(apply 'eim-install-package (assoc package-name eim-packages))
(load (car libraries))
(run-hooks eim-after-load-hook)
(eim-load-history))
(setq eim-current-package (assoc package-name eim-packages))
(let ((params (eim-params)))
(dolist (var eim-default-setting)
(if (not (assoc (car var) params))
(set (car var) (cdr var)))))
(eim-reset)
(add-hook 'after-change-functions 'eim-after-change nil t)
(run-hooks 'eim-activate-hook))
(defun eim-lower-case-letterp (char)
"Default `eim-validate-function'"
(let ((c (string-to-char char)))
(and (> c 96) (< c 123))))
(defun eim-punctuation-handle-function (start end)
"Handle punctuation"
(let ((c (buffer-substring-no-properties start end))
punc)
(when eim-activate
(eim-select-current)
(forward-char 1))
(cond ((setq punc (assoc c eim-punctuation-list))
(delete-backward-char 1)
(insert (cdr punc)))
((setq punc (assoc c eim-quote-punctuation))
(delete-backward-char 1)
(if (cadr punc)
(progn
(setcar (cdr punc) nil)
(insert (nth 3 punc)))
(setcar (cdr punc) t)
(insert (nth 2 punc))))
((string= c "\\")
(delete-backward-char 1)
(call-interactively 'eim-insert-ascii)))))
(defun eim-after-change (start end length)
(if (and (= (- end start) 1)
(= length 0))
(if eim-activate
(progn
(if (and (<= eim-start start) (<= end (1+ eim-end)))
(let ((char (buffer-substring-no-properties start end)))
(if (funcall eim-validate-function char)
(progn
(setq eim-end (1+ eim-end))
(funcall eim-handle-function))
(funcall eim-invalid-function start end)))
(eim-reset)))
(let ((char (buffer-substring-no-properties start end)))
(if (funcall eim-validate-function char)
(progn
(setq eim-activate t)
(setq eim-start start)
(setq eim-end end)
(funcall eim-handle-function))
(funcall eim-invalid-function start end))))
(when eim-activate
(if (and (= start end) (= length 1)
(<= eim-start start) (< end eim-end))
(progn
(setq eim-end (1- eim-end))
(funcall eim-handle-function))
(eim-reset)))))
(defun eim-update-display ()
"Show `eim-display-string' and `eim-choices-string'"
(if eim-curse-overlay (delete-overlay eim-curse-overlay))
(when (eobp)
(let (after-change-functions)
(insert (propertize " " 'eim-ime t))
(backward-char 1)))
(setq eim-curse-overlay (make-overlay (1- (point)) (1+ (point))))
(overlay-put eim-curse-overlay 'keymap eim-mode-map)
(if eim-overlay (delete-overlay eim-overlay))
(setq eim-overlay (make-overlay eim-start eim-end))
(overlay-put eim-overlay 'display eim-display-string)
(overlay-put eim-overlay 'face 'underline)
(message eim-choices-string))
(defun eim-help (&optional package)
"Show input method docstring"
(let ((docstr (concat "Input method: " (eim-package-name) "\n"
(eim-docstring) "\n\n"
(substitute-command-keys "\\{eim-mode-map}"))))
(with-current-buffer (help-buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(insert docstr)
(run-hooks 'temp-buffer-show-hook))
(display-buffer (current-buffer)))))
(defun eim-default-handle ()
"The default handle set `eim-choices-string' and `eim-display-string'.
When arrive the `eim-stop-length', insert current `eim-display-string', leaving
the last input character."
(let (str message-log-max)
(if (> (- eim-end eim-start) eim-stop-length)
(let (after-change-functions)
(goto-char eim-start)
(delete-region eim-start (1- eim-end))
(insert eim-display-string)
(setq eim-start (point))
(forward-char 1)
(setq eim-end (point))))
(setq eim-current-string (buffer-substring-no-properties eim-start eim-end))
(setq str eim-current-string)
(when (> (length str) 1)
(setq eim-completions (cdr (sort (all-completions str eim-database)
'string<)))
(setq eim-completion-pos 0))
(if (string< "" str)
(progn
(if (setq eim-choices (mapcar (lambda (w) (list w)) (eim-get str)))
(eim-update-pos (get (intern str eim-database) 'pos))
(if (and (> (length str) 1) eim-completions)
(setq eim-choices-string (format "%s[%s] " str (eim-next-char)))
(setq eim-choices-string (format "%s[]" str)))
(setq eim-display-string ""))
(eim-update-display))
(setq eim-display-string "")
(eim-select-current))))
(defun eim-next-char ()
"The possible next char in the `eim-completions'"
(let (chars
(len (length eim-current-string)))
(dolist (code eim-completions)
(if chars
(add-to-list 'chars (substring code len (1+ len)))
(setq chars (list (substring code len (1+ len))))))
(mapconcat 'identity (sort chars 'string<) "")))
(defun eim-update-pos (pos)
"Change `eim-display-string' and `eim-choices-string' to the
nth POS of `eim-choices'"
(let ((str (buffer-substring-no-properties eim-start eim-end))
(mes (eim-format-choice eim-choices pos)))
(when (string< "" mes)
(setq eim-choices-string (format "%s: %s" str mes)
eim-display-string (car (nth (1- eim-select-pos) eim-choices))))
(eim-update-display)))
(defun eim-format-choice (choices &optional pos)
"format the current choice to string"
(let ((len eim-page-length)
(mes "")
(i 1) base
newlist)
(or pos (setq pos 1))
(setq base (eim-mod pos len))
(setq newlist (eim-get-page pos))
(when newlist
(setq eim-select-pos pos)
(dolist (c newlist)
(let ((char (car c))
(code (if (cdr c)
(substring (cdr c) (length eim-current-string))
"")))
(setq mes (format "%s %d.%s%s" mes i
(if (= i base) (propertize char 'face 'underline) char)
code)
i (1+ i)))))
mes))
(defun eim-get-page (pos)
"get the page of the POS"
(let* ((whole (length eim-choices))
(len eim-page-length)
(last (+ (- pos (eim-mod pos len)) len))
(comp eim-completions)
(all (length comp))
code word)
(while (and (< whole last)
(< eim-completion-pos all))
(setq word (eim-get (setq code (nth eim-completion-pos comp)))
eim-completion-pos (1+ eim-completion-pos))
(mapcar (lambda (w)
(if (and (= (length w) 1)
(not (assoc w eim-choices)))
(add-to-list 'eim-choices (cons w code) t)))
word)
(setq whole (length eim-choices)))
(eim-subseq eim-choices (- last len) last)))
(defun eim-load-history ()
(when (and eim-history-file (file-exists-p eim-history-file))
(let ((buf (find-file-noselect eim-history-file))
s word)
(with-current-buffer buf
(goto-char (point-min))
(while (not (eobp))
(setq word (split-string (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
(if (setq s (intern-soft (car word) eim-database))
(put s 'pos (string-to-number (cadr word))))
(forward-line 1)))
(kill-buffer buf))))
(defun eim-save-history ()
(dolist (package eim-packages)
(apply 'eim-install-package package)
(when (and eim-history-file (file-exists-p eim-history-file))
(let ((buf (find-file-noselect eim-history-file)))
(message "Save history to %s..." eim-history-file)
(with-current-buffer buf
(erase-buffer)
(mapatoms (lambda (s)
(let ((pos (get s 'pos)))
(if pos
(insert (format "%s %d\n" (symbol-name s) pos)))))
eim-database)
(save-buffer)
(kill-buffer (current-buffer)))
(message "Save history to %s... done" eim-history-file)))))
(add-hook 'kill-emacs-hook 'eim-save-history)
(defun eim-insert-ascii ()
(interactive)
(let (after-change-functions)
(insert (read-from-minibuffer ""))))
(defun eim-select ()
(interactive)
(let ((index (- last-input-char 48)))
(setq eim-select-pos
(+ index
(* eim-page-length
(/ (1- eim-select-pos) eim-page-length))))
(eim-update-pos eim-select-pos)))
(defun eim-select-current ()
(interactive)
(let (after-change-functions
(str (buffer-substring-no-properties eim-start eim-end)))
(when eim-start
(goto-char eim-start)
(delete-region eim-start eim-end)
(if eim-overlay (delete-overlay eim-overlay))
(insert eim-display-string)
(if (and eim-history-file (string< "" str))
(put (intern-soft str eim-database) 'pos eim-select-pos)))
(when (get-char-property (point) 'eim-ime)
(delete-char 1))
(eim-reset)))
(defun eim-next-page (arg)
(interactive "p")
(let* ((len eim-page-length)
(pos eim-select-pos)
(newpos (+ pos (* len arg) 1))
newlist)
(setq pos (- newpos (eim-mod pos len)))
(if (> pos 0)
(eim-update-pos pos)
(message eim-choices-string))))
(defun eim-prev-page (arg)
(interactive "p")
(eim-next-page (- arg)))
(defun eim-clear-select ()
"Erase current input"
(interactive)
(let (after-change-functions)
(if eim-start
(delete-region eim-start eim-end))
(eim-reset)))
(defun eim-no-clear-select ()
"Insert current input"
(interactive)
(let (after-change-functions)
(when eim-start
(if eim-overlay (delete-overlay eim-overlay))
(if eim-curse-overlay (delete-overlay eim-curse-overlay)))
(eim-reset)))
(defun eim-reset-vars ()
(setq eim-validate-function (lambda (char)
(let ((c (string-to-char char)))
(and (> c 96) (< c 123)))))
(setq eim-invalid-function 'eim-punctuation-handle-function)
(setq eim-handle-function 'eim-default-handle)
(setq eim-mode-map eim-default-map))
(defvar eim-debug nil)
(defun eim-dprintf (fmt &rest args)
(if eim-debug
(apply 'message fmt args)))
(provide 'eim)