diff lisp/egg/egg.el @ 142:1856695b1fa9 r20-2b5

Import from CVS: tag r20-2b5
author cvs
date Mon, 13 Aug 2007 09:33:18 +0200
parents 585fb297b004
children 25f70ba0133c
line wrap: on
line diff
--- a/lisp/egg/egg.el	Mon Aug 13 09:32:45 2007 +0200
+++ b/lisp/egg/egg.el	Mon Aug 13 09:33:18 2007 +0200
@@ -405,12 +405,13 @@
   (let ((event (make-event))
 	(ch nil))
     (next-command-event event)
-    (if (and (key-press-event-p event)
-	     (eq 0 (event-modifier-bits event)))
-	(setq ch (event-key event))
-      (if (eq 1 (event-modifier-bits event))
-	  (setq ch (int-to-char (- (char-to-int (event-key event)) 96)))
-	(setq unread-command-events (list event))))
+    (if (key-press-event-p event)
+	(if (eq 0 (event-modifier-bits event))
+	    (setq ch (event-key event))
+	  (if (eq 1 (event-modifier-bits event))
+	      (setq ch (int-to-char (- (char-to-int (event-key event)) 96)))
+	    (setq unread-command-events (list event))))
+      (setq unread-command-events (list event)))
     ch))
 
 (eval-when-compile (require 'egg-jsymbol))
@@ -599,9 +600,6 @@
 	(minibuffer (window-buffer (minibuffer-window)))
 	value)
     (save-window-excursion
-      (if (fboundp 'redirect-frame-focus)
-	  (redirect-frame-focus (selected-frame)
-				(window-frame (minibuffer-window))))
       (set-window-buffer (minibuffer-window) menubuffer)
       (select-window (minibuffer-window))
       (set-buffer menubuffer)
@@ -1628,15 +1626,19 @@
   (and (characterp ch) (<= ch 127)
        (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-backward-delete-char)))
     
+(defvar egg:fence-buffer nil "Buffer fence is active in")
+
 (defun fence-self-insert-command ()
   (interactive)
-  (let ((ch (event-to-character last-command-event)))
-    (cond((or (not egg:*input-mode*)
-	      (null (get-next-map its:*current-map* ch)))
-	  (insert ch))
-	 (t
-	  (insert ch)
-	  (its:translate-region (1- (point)) (point) t)))))
+  (if (not (eq (current-buffer) egg:fence-buffer))
+      nil	;; #### This is to bandaid a deep event-handling bug
+    (let ((ch (event-to-character last-command-event)))
+      (cond((or (not egg:*input-mode*)
+		(null (get-next-map its:*current-map* ch)))
+	    (insert ch))
+	   (t
+	    (insert ch)
+	    (its:translate-region (1- (point)) (point) t))))))
 
 ;;;
 ;;; its: completing-read system
@@ -2082,8 +2084,6 @@
 (make-variable-buffer-local 'egg:*in-fence-mode*)
 (set-default 'egg:*in-fence-mode* nil)
 
-(defvar egg:fence-buffer nil "Buffer fence is active in")
-
 ;;(load-library "its-dump/roma-kana")         ;;;(define-its-mode "roma-kana"        " a$B$"(B")
 ;;(load-library "its-dump/roma-kata")         ;;;(define-its-mode "roma-kata"        " a$B%"(B")
 ;;(load-library "its-dump/downcase")          ;;;(define-its-mode "downcase"         " a a")
@@ -2583,7 +2583,7 @@
   (set-marker egg:*region-end* egg:*region-start*)
   (egg:fence-face-on)
   (goto-char egg:*region-start*)
-  (add-hook 'pre-command-hook 'fence-pre-command-hook)
+  (add-hook 'post-command-hook 'fence-post-command-hook)
   )
 
 (defun henkan-fence-region-or-single-space ()
@@ -2645,7 +2645,7 @@
 
 (defun egg:exit-if-empty-region ()
   (if (= egg:*region-start* egg:*region-end*)
-      (fence-exit-mode)))
+      (fence-exit-internal)))
 
 (defun fence-delete-char ()
   (interactive)
@@ -2670,6 +2670,9 @@
 
 (defun fence-exit-mode ()
   (interactive)
+  (fence-exit-internal))
+
+(defun fence-exit-internal ()
   (delete-region (- egg:*region-start* (length egg:*fence-open*)) egg:*region-start*)
   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*fence-close*)))
   (egg:fence-face-off)
@@ -2692,7 +2695,7 @@
 (defun egg:quit-egg-mode ()
   ;;;(use-global-map egg:*global-map-backup*)
   (use-local-map egg:*local-map-backup*)
-  (remove-hook 'pre-command-hook 'fence-pre-command-hook)
+  (remove-hook 'post-command-hook 'fence-post-command-hook)
   (setq egg:*in-fence-mode* nil)
   (egg:mode-line-display)
   (if overwrite-mode
@@ -2715,25 +2718,18 @@
   )
 
 (defun fence-cancel-input ()
+  "Cancel all fence operations in the current buffer"
   (interactive)
+  (fence-kill-operation))
+
+(defun fence-kill-operation ()
+  "Internal method to remove fences"
   (delete-region egg:*region-start* egg:*region-end*)
-  (fence-exit-mode))
-
-(defun fence-mouse-protect ()
-  "Cancel entry in progress if mouse events occur."
-  (if egg:*in-fence-mode*
-      (save-excursion
-	(its:reset-input)
-	(fence-cancel-input))))
-
-(if (boundp 'mouse-track-cleanup-hook)
-    (add-hook 'mouse-track-cleanup-hook 'fence-mouse-protect))
-
-(defun fence-pre-command-hook ()
-  ;; cribbed off of isearch-mode
-  ;;
-  ;; For use as the value of `pre-command-hook' when fence is active.
-  ;; If the command about to be executed is not ours,
+  (fence-exit-internal))
+
+(defun fence-post-command-hook ()
+  ;; For use as the value of `post-command-hook' when fence is active.
+  ;; If we got out of the region specified by the fence,
   ;; kill the fence before that command is executed.
   ;;
   (cond ((not (eq (current-buffer) egg:fence-buffer))
@@ -2745,26 +2741,19 @@
 	 (save-excursion
 	   (set-buffer egg:fence-buffer)
 	   (its:reset-input)
-	   (fence-cancel-input)))
-	((not (and this-command
-		   (symbolp this-command)
-		   (get this-command 'egg-fence-command)))
-	 (its:reset-input)
-	 (fence-cancel-input))
-	(t
-	 (if (or (not (pos-visible-in-window-safe
-		       (marker-position egg:*region-start*)))
-		 (not (pos-visible-in-window-safe
-		       (marker-position egg:*region-end*))))
-	     (recenter))))
-  )
+	   (fence-kill-operation)))
+	((or (< (point) egg:*region-start*)
+	     (> (point) egg:*region-end*))
+	 (save-excursion
+	   (its:reset-input)
+	   (fence-kill-operation)))))
 
 (defun egg-lang-switch-callback ()
   "Do whatever processing is necessary when the language-environment changes."
   (if egg:*in-fence-mode*
       (progn
 	(its:reset-input)
-	(fence-cancel-input)))
+	(fence-kill-operation)))
   (let ((func (get current-language-environment 'set-egg-environ)))
     (if (not (null func))
       (funcall func)))
@@ -2823,119 +2812,6 @@
 (define-key fence-mode-map [right] 'fence-forward-char)
 (define-key fence-mode-map [left] 'fence-backward-char)
 
-(put 'fence-self-insert-command 'egg-fence-command t)
-(put 'fence-hiragana 'egg-fence-command t)
-(put 'fence-katakana 'egg-fence-command t)
-(put 'fence-hankaku 'egg-fence-command t)
-(put 'fence-zenkaku 'egg-fence-command t)
-(put 'its:select-hiragana 'egg-fence-command t)
-(put 'its:select-katakana 'egg-fence-command t)
-(put 'its:select-downcase 'egg-fence-command t)
-(put 'its:select-upcase 'egg-fence-command t)
-(put 'its:select-zenkaku-downcase 'egg-fence-command t)
-(put 'its:select-zenkaku-upcase 'egg-fence-command t)
-(put 'its:minibuffer-completion-help 'egg-fence-command t)
-(put 'henkan-fence-region-or-single-space 'egg-fence-command t)
-(put 'henkan-fence-region 'egg-fence-command t)
-(put 'fence-beginning-of-line 'egg-fence-command t)
-(put 'fence-backward-char 'egg-fence-command t)
-(put 'fence-cancel-input 'egg-fence-command t)
-(put 'fence-delete-char 'egg-fence-command t)
-(put 'fence-end-of-line 'egg-fence-command t)
-(put 'fence-forward-char 'egg-fence-command t)
-(put 'fence-cancel-input 'egg-fence-command t)
-(put 'fence-mode-help-command 'egg-fence-command t)
-(put 'fence-kill-line 'egg-fence-command t)
-(put 'fence-exit-mode 'egg-fence-command t)
-(put 'fence-exit-mode 'egg-fence-command t)
-(put 'fence-exit-mode 'egg-fence-command t)
-(put 'its:select-previous-mode 'egg-fence-command t)
-(put 'fence-transpose-chars 'egg-fence-command t)
-(put 'eval-expression 'egg-fence-command t)
-(put 'fence-toggle-egg-mode 'egg-fence-command t)
-(put 'jis-code-input 'egg-fence-command t)
-(put 'fence-backward-delete-char 'egg-fence-command t)
-(put 'fence-backward-delete-char 'egg-fence-command t)
-(put 'fence-backward-delete-char 'egg-fence-command t)
-(put 'fence-forward-char 'egg-fence-command t)
-(put 'fence-backward-char 'egg-fence-command t)
-(put 'hiragana-region 'egg-fence-command t)
-(put 'hiragana-paragraph 'egg-fence-command t)
-(put 'hiragana-sentance 'egg-fence-command t)
-(put 'katakana-region 'egg-fence-command t)
-(put 'katakana-paragraph 'egg-fence-command t)
-(put 'katakana-sentance 'egg-fence-command t)
-(put 'hankaku-region 'egg-fence-command t)
-(put 'hankaku-paragraph 'egg-fence-command t)
-(put 'hankaku-sentance 'egg-fence-command t)
-(put 'hankaku-word 'egg-fence-command t)
-(put 'zenkaku-region 'egg-fence-command t)
-(put 'zenkaku-paragraph 'egg-fence-command t)
-(put 'zenkaku-sentance 'egg-fence-command t)
-(put 'zenkaku-word 'egg-fence-command t)
-(put 'roma-kana-region 'egg-fence-command t)
-(put 'roma-kana-paragraph 'egg-fence-command t)
-(put 'roma-kana-sentance 'egg-fence-command t)
-(put 'roma-kana-word 'egg-fence-command t)
-(put 'roma-kanji-region 'egg-fence-command t)
-(put 'roma-kanji-paragraph 'egg-fence-command t)
-(put 'roma-kanji-sentance 'egg-fence-command t)
-(put 'roma-kanji-word 'egg-fence-command t)
-(put 'its:select-mode 'egg-fence-command t)
-(put 'its:select-mode-from-menu 'egg-fence-command t)
-(put 'its:next-mode 'egg-fence-command t)
-(put 'its:previous-mode 'egg-fence-command t)
-(put 'its:select-hiragana 'egg-fence-command t)
-(put 'its:select-katakana 'egg-fence-command t)
-(put 'its:select-downcase 'egg-fence-command t)
-(put 'its:select-upcase   'egg-fence-command t)
-(put 'its:select-zenkaku-downcase 'egg-fence-command t)
-(put 'its:select-zenkaku-upcase   'egg-fence-command t)
-(put 'its:select-mode-temporally 'egg-fence-command t)
-(put 'its:select-previous-mode 'egg-fence-command t)
-(put 'fence-toggle-egg-mode 'egg-fence-command t)
-(put 'fence-transpose-chars 'egg-fence-command t)
-(put 'henkan-region 'egg-fence-command t)
-(put 'henkan-paragraph 'egg-fence-command t)
-(put 'henkan-sentance 'egg-fence-command t)
-(put 'henkan-word 'egg-fence-command t)
-(put 'henkan-kakutei 'egg-fence-command t)
-(put 'gyaku-henkan-region 'egg-fence-command t)
-(put 'gyaku-henkan-sentance 'egg-fence-command t)
-(put 'gyaku-henkan-word 'egg-fence-command t)
-(put 'gyaku-henkan-kakutei 'egg-fence-command t)
-(put 'henkan-kakutei-first-char 'egg-fence-command t)
-(put 'henkan-kakutei-before-point 'egg-fence-command t)
-(put 'sai-henkan 'egg-fence-command t)
-(put 'henkan-forward-bunsetu 'egg-fence-command t)
-(put 'henkan-backward-bunsetu 'egg-fence-command t)
-(put 'henkan-first-bunsetu 'egg-fence-command t)
-(put 'henkan-last-bunsetu 'egg-fence-command t)
-(put 'henkan-hiragana 'egg-fence-command t)
-(put 'henkan-katakana 'egg-fence-command t)
-(put 'henkan-next-kouho 'egg-fence-command t)
-(put 'henkan-next-kouho-dai 'egg-fence-command t)
-(put 'henkan-next-kouho-sho 'egg-fence-command t)
-(put 'henkan-previous-kouho 'egg-fence-command t)
-(put 'henkan-previous-kouho-dai 'egg-fence-command t)
-(put 'henkan-previous-kouho-sho 'egg-fence-command t)
-(put 'henkan-bunsetu-chijime-dai 'egg-fence-command t)
-(put 'henkan-bunsetu-chijime-sho 'egg-fence-command t)
-(put 'henkan-bunsetu-nobasi-dai 'egg-fence-command t)
-(put 'henkan-bunsetu-nobasi-sho 'egg-fence-command t)
-(put 'henkan-saishou-bunsetu 'egg-fence-command t)
-(put 'henkan-saichou-bunsetu 'egg-fence-command t)
-(put 'henkan-quit 'egg-fence-command t)
-(put 'henkan-select-kouho-dai 'egg-fence-command t)
-(put 'henkan-select-kouho-sho 'egg-fence-command t)
-(put 'henkan-word-off 'egg-fence-command t)
-(put 'henkan-kakutei-and-self-insert 'egg-fence-command t)
-(put 'henkan-help-command 'egg-fence-command t)
-(put 'toroku-region 'egg-fence-command t)
-(put 'toroku-henkan-mode 'egg-fence-command t)
-(put 'recenter 'egg-fence-command t)
-
-
 ;;;----------------------------------------------------------------------
 ;;;
 ;;; Read hiragana from minibuffer
@@ -2995,6 +2871,37 @@
 (autoload 'busyu-input "egg-busyu" nil t)
 (autoload 'kakusuu-input "egg-busyu" nil t)
 
+;; put us into all existing buffer's modelines
+(if (not (featurep 'egg))
+    (mapc-internal
+     (lambda (buf) 
+       (save-excursion
+	 (set-buffer buf)
+	 (setq modeline-format (cons (list 'display-minibuffer-mode-in-minibuffer
+		 ;;; minibuffer mode in minibuffer
+					   (list 
+					    (list 'its:*previous-map* "<" "[")
+					    'mode-line-egg-mode
+					    (list 'its:*previous-map* ">" "]")
+					    )
+		       ;;;; minibuffer mode in mode line
+					   (list 
+					    (list 'minibuffer-window-selected
+						  (list 'display-minibuffer-mode
+							"m"
+							" ")
+						  " ")
+					    (list 'its:*previous-map* "<" "[")
+					    (list 'minibuffer-window-selected
+						  (list 'display-minibuffer-mode
+							'mode-line-egg-mode-in-minibuffer
+							'mode-line-egg-mode)
+						  'mode-line-egg-mode)
+					    (list 'its:*previous-map* ">" "]")
+					    ))
+				     modeline-format))))
+     (buffer-list)))
+
 (provide 'egg)
 
 ;; if set-lang-environment has already been called, call egg-lang-switch-callback