1 ;;; egg.el --- EGG Input Method Architecture
3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
5 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
6 ;; KATAYAMA Yoshio <kate@pfu.co.jp>
8 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
10 ;; Keywords: mule, multilingual, input method
12 ;; This file is part of EGG.
14 ;; EGG is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; EGG is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
36 (autoload 'egg-simple-input-method "egg-sim")
41 (defcustom egg-mode-preference t
42 "*Make Egg as modefull input method, if non-NIL."
43 :group 'egg :type 'boolean)
45 (defvar egg-default-language)
47 (defvar egg-last-method-name)
48 (make-variable-buffer-local 'egg-last-method-name)
49 (put 'egg-last-method-name 'permanent-local t)
51 (defvar egg-current-keymap nil)
52 (make-variable-buffer-local 'egg-current-keymap)
53 (put 'egg-current-keymap 'permanent-local t)
56 (defun egg-mode (&rest arg)
66 (egg-exit-conversion))
67 (setq describe-current-input-method-function nil)
68 (if (eq (current-local-map) egg-current-keymap)
69 (use-local-map (keymap-parent (current-local-map))))
70 (remove-hook 'input-method-activate-hook 'its-set-mode-line-title t)
71 (force-mode-line-update))
73 (if (null (string= (car arg) egg-last-method-name))
76 (setq egg-default-language its-current-language)))
77 (egg-set-conversion-backend (nthcdr 2 arg))
78 (egg-set-conversion-backend
79 (list (assq its-current-language (nthcdr 2 arg))) t)
80 (setq egg-last-method-name (car arg))
81 (setq egg-current-keymap (if egg-mode-preference
84 (use-local-map egg-current-keymap)
85 (setq inactivate-current-input-method-function 'egg-mode)
86 (setq describe-current-input-method-function 'egg-help)
87 (make-local-hook 'input-method-activate-hook)
88 (add-hook 'input-method-activate-hook 'its-set-mode-line-title nil t)
89 (if (eq (selected-window) (minibuffer-window))
90 (add-hook 'minibuffer-exit-hook 'egg-exit-from-minibuffer))
91 (run-hooks 'egg-mode-hook)))
93 (defun egg-exit-from-minibuffer ()
94 (inactivate-input-method)
95 (if (<= (minibuffer-depth) 1)
96 (remove-hook 'minibuffer-exit-hook 'egg-exit-from-minibuffer)))
98 (defun egg-modefull-map ()
99 "Generate modefull keymap for EGG mode."
100 (let ((map (make-sparse-keymap))
102 (define-key map "\C-^" 'egg-simple-input-method)
104 (define-key map (vector i) 'egg-self-insert-char)
106 (its-define-select-keys map)
107 (set-keymap-parent map (current-local-map))
110 (defun egg-modeless-map ()
111 "Generate modeless keymap for EGG mode."
112 (let ((map (make-sparse-keymap)))
113 (define-key map " " 'mlh-space-bar-backward-henkan)
114 (define-key map "\C-^" 'egg-simple-input-method)
115 (set-keymap-parent map (current-local-map))
118 (defvar egg-context nil)
120 (defun egg-self-insert-char ()
122 (its-start last-command-char (and (eq last-command 'egg-use-context)
125 (defvar egg-mark-list nil)
126 (defvar egg-suppress-marking nil)
128 (defun egg-set-face (beg eng face &optional object)
129 (put face 'face face)
130 (add-text-properties beg eng
133 'modification-hooks '(egg-mark-modification))
136 (defun egg-mark-modification (beg end)
137 (if (and (null egg-suppress-marking)
138 (or (get-text-property beg 'egg-face)
139 (setq beg (next-single-property-change beg 'egg-face)))
140 (or (get-text-property (1- end) 'egg-face)
141 (setq end (previous-single-property-change end 'egg-face)))
143 (let ((list egg-mark-list)
146 (add-hook 'post-command-hook 'egg-redraw-face t)
147 (setq list egg-mark-list)
148 (while (and list (< found 2))
149 (setq pair (car list)
153 b (marker-position mb)
154 e (marker-position me))
156 ;; no overwrapping -- SKIP
157 ((or (null (eq (marker-buffer mb) (current-buffer)))
158 (or (> beg e) (< end b))))
159 ;; completely included
160 ((and (>= beg b) (<= end e))
162 ;; partially overwrapping
166 (setq egg-mark-list (delete pair egg-mark-list)
172 (setq b (make-marker)
174 egg-mark-list (cons (cons b e) egg-mark-list))
176 (set-marker e end))))))
178 (defun egg-redraw-face ()
179 (let ((inhibit-read-only t)
180 (inhibit-point-motion-hooks t)
181 (egg-suppress-marking t)
183 (org-buffer (current-buffer))
186 (setq egg-mark-list nil)
187 (remove-hook 'post-command-hook 'egg-redraw-face)
189 (setq mb (car (car list))
192 (when (marker-buffer mb)
193 (set-buffer (marker-buffer mb))
194 (let ((before-change-functions nil) (after-change-functions nil))
198 (setq b (max mb (point-min))
199 e (min me (point-max)))
203 (if (null (get-text-property b 'egg-face))
204 (setq b (next-single-property-change b 'egg-face nil e)))
205 (setq p (next-single-property-change b 'egg-face nil e))
208 (remove-text-properties 0 (- p b) '(face))
210 (set-buffer org-buffer)
211 (goto-char org-point)))
213 (defvar egg-messages nil)
214 (defvar egg-message-language-alist nil)
216 (defun egg-get-message (message)
217 (let ((lang (or (cdr (assq egg-default-language egg-message-language-alist))
218 egg-default-language)))
219 (or (nth 1 (assq message (cdr (assq lang egg-messages))))
220 (nth 1 (assq message (cdr (assq nil egg-messages))))
221 (error "EGG internal error: no such message: %s (%s)"
222 message egg-default-language))))
224 (defun egg-add-message (list)
228 (or (setq msg-l (assq (car l) egg-messages))
229 (setq egg-messages (cons (list (car l)) egg-messages)
230 msg-l (car egg-messages)))
233 (setcdr msg-l (cons msg (delq (assq (car msg) msg-l) (cdr msg-l)))))
235 (setq list (cdr list)))))
237 (defun egg-set-message-language-alist (alist)
240 (setq egg-message-language-alist
241 (delq (assq (caar a) egg-message-language-alist)
242 egg-message-language-alist))
244 (setq egg-message-language-alist
245 (append alist egg-message-language-alist))))
247 (put 'egg-error 'error-conditions '(error egg-error))
248 (put 'egg-error 'error-message "EGG error")
250 (defun egg-error (message &rest args)
251 (if (symbolp message)
252 (setq message (egg-get-message message)))
253 (signal 'egg-error (list (apply 'format message args))))
256 ;;; auto fill controll
259 (defun egg-do-auto-fill ()
260 (if (and auto-fill-function (> (current-column) fill-column))
261 (let ((ocolumn (current-column)))
262 (funcall auto-fill-function)
263 (while (and (< fill-column (current-column))
264 (< (current-column) ocolumn))
265 (setq ocolumn (current-column))
266 (funcall auto-fill-function)))))
268 (eval-when (eval load)
275 (add-hook 'kill-emacs-hook 'egg-kill-emacs-function)
276 (defun egg-kill-emacs-function ()
277 (egg-finalize-backend))