X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=egg.el;h=474f59b719a4c578041ac821f775202dd163c9c3;hb=5aed272165474232c184fca0eea0615d0d24eb03;hp=c8403a00212e2c43d1bceb91a912dd550a5083e8;hpb=73cfac9422c79ee1a8577f2ed21ff83ac98ced3e;p=elisp%2Fegg.git diff --git a/egg.el b/egg.el index c8403a0..474f59b 100644 --- a/egg.el +++ b/egg.el @@ -9,7 +9,7 @@ ;; Maintainer: NIIBE Yutaka ;; Keywords: mule, multilingual, input method -;; This file will be part of GNU Emacs (in future). +;; This file is part of EGG. ;; EGG is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -29,14 +29,14 @@ ;;; Commentary: ;;; Code: +(require 'egg-edep) + (defvar egg-mode-preference t "Non-nil if modefull.") -(defvar egg-default-language "Japanese") +(defvar egg-default-language) (defvar egg-last-method-name) (make-variable-buffer-local 'egg-last-method-name) -(defvar egg-mode-line-title) -(make-variable-buffer-local 'egg-mode-line-title) ;;;###autoload (defun egg-mode (&rest arg) @@ -54,39 +54,33 @@ (egg-exit-conversion))) (setq describe-current-input-method-function nil) (setq current-input-method nil) - (let ((orig-local-map (keymap-parent (current-local-map)))) - (use-local-map orig-local-map)) - (run-hooks 'input-method-inactivate-hook)) + (use-local-map (keymap-parent (current-local-map))) + (remove-hook 'input-method-activate-hook 'its-set-mode-line-title t) + (force-mode-line-update)) ;; Turn on (if (null (string= (car arg) egg-last-method-name)) (progn (funcall (nth 1 arg)) - (setq egg-default-language its-current-language))) + (setq egg-default-language its-current-language))) (setq egg-last-method-name (car arg)) (use-local-map (if egg-mode-preference (egg-modefull-map) (egg-modeless-map))) (setq inactivate-current-input-method-function 'egg-mode) (setq describe-current-input-method-function 'egg-help) - (run-hooks 'input-method-activate-hook)) - (force-mode-line-update)) - -(defun egg-set-mode-line-title (title) - (setq egg-mode-line-title title) - (force-mode-line-update)) - -(defun egg-check-language (lang) - (if (null (member lang egg-support-languages)) - (error "%S is not supported" lang))) + (make-local-hook 'input-method-activate-hook) + (add-hook 'input-method-activate-hook 'its-set-mode-line-title nil t))) (defun egg-modefull-map () "Generate modefull keymap for EGG mode." (let ((map (make-sparse-keymap)) (i 33)) - (define-key map "\C-_" 'egg-jis-code-input) + ;; BAD BAD BAD it should be UNDO + ;; (define-key map "\C-_" 'egg-jis-code-input) (while (< i 127) (define-key map (vector i) 'egg-self-insert-char) (setq i (1+ i))) + (its-define-select-keys map) (set-keymap-parent map (current-local-map)) map)) @@ -102,6 +96,96 @@ (interactive) (its-start last-command-char)) +(defvar egg-mark-list nil) +(defvar egg-suppress-marking nil) + +(defun egg-set-face (beg eng face &optional object) + (put face 'face face) + (add-text-properties beg eng + (list 'category face + 'egg-face t + 'modification-hooks '(egg-mark-modification)) + object)) + +(defun egg-mark-modification (beg end) + (if (and (null egg-suppress-marking) + (or (get-text-property beg 'egg-face) + (setq beg (next-single-property-change beg 'egg-face))) + (or (get-text-property (1- end) 'egg-face) + (setq end (previous-single-property-change end 'egg-face))) + (< beg end)) + (let ((list egg-mark-list) + (found 0) + pair mb me b e) + (add-hook 'post-command-hook 'egg-redraw-face t) + (setq list egg-mark-list) + (while (and list (< found 2)) + (setq pair (car list) + list (cdr list) + mb (car pair) + me (cdr pair) + b (marker-position mb) + e (marker-position me)) + (cond + ;; no overwrapping -- SKIP + ((or (null (eq (marker-buffer mb) (current-buffer))) + (or (> beg e) (< end b)))) + ;; completely included + ((and (>= beg b) (<= end e)) + (setq found 3)) + ;; partially overwrapping + (t + (set-marker mb nil) + (set-marker me nil) + (setq egg-mark-list (delete pair egg-mark-list) + beg (min beg b) + end (max end e) + found (1+ found))))) + (if (< found 3) + (progn + (setq b (make-marker) + e (make-marker) + egg-mark-list (cons (cons b e) egg-mark-list)) + (set-marker b beg) + (set-marker e end)))))) + +(defun egg-redraw-face () + (let ((inhibit-read-only t) + (inhibit-point-motion-hooks t) + (egg-suppress-marking t) + (list egg-mark-list) + (org-buffer (current-buffer)) + (org-point (point)) + mb me b e p) + (setq egg-mark-list nil) + (remove-hook 'post-command-hook 'egg-redraw-face) + (while list + (setq mb (car (car list)) + me (cdr (car list)) + list (cdr list)) + (when (marker-buffer mb) + (set-buffer (marker-buffer mb)) + (let ((before-change-functions nil) (after-change-functions nil)) + (save-restriction + (widen) + (setq b (max mb (point-min)) + e (min me (point-max))) + (set-marker mb nil) + (set-marker me nil) + (while (< b e) + (if (null (get-text-property b 'egg-face)) + (setq b (next-single-property-change b 'egg-face nil e))) + (setq p (next-single-property-change b 'egg-face nil e)) + (when (< b p) + (goto-char b) + (setq str (buffer-substring b p)) + (delete-region b p) + (remove-text-properties 0 (- p b) '(face) str) + (insert str) + (setq b p))))))) + (set-buffer org-buffer) + (goto-char org-point))) + (defun egg-hinshi-select () (menudiag-select ; Should generate at initialization time '(menu "品詞名:" @@ -168,30 +252,11 @@ (require 'egg-mlh) (require 'egg-cnv) (require 'egg-com) -(require 'custom) +(require 'custom) ; Really? (defgroup egg nil "Tamagotchy --- EGG Versio 4.0") -;;(load-library "its/hira") -;;(setq-default its-current-map its-hira-map) - -;;(load-library "egg/wnn") -;;(load-library "egg/wnnrpc") -;;(setq egg-conversion-backend wnn-conversion-backend) - -;;(load-library "egg/sj3rpc") -;;(load-library "egg/sj3") -;;(setq egg-conversion-backend sj3-conversion-backend) - -(defvar egg-support-languages nil) - -(defun egg-set-support-languages (langs) - (while langs - (if (null (member (car langs) egg-support-languages)) - (setq egg-support-languages (cons (car langs) egg-support-languages))) - (setq langs (cdr langs)))) - (add-hook 'kill-emacs-hook 'egg-kill-emacs-function) (defun egg-kill-emacs-function () (egg-finalize-backend))