Index: /trunk/ccl/hemlock/src/cocoa-hemlock.lisp
===================================================================
--- /trunk/ccl/hemlock/src/cocoa-hemlock.lisp	(revision 673)
+++ /trunk/ccl/hemlock/src/cocoa-hemlock.lisp	(revision 674)
@@ -15,8 +15,26 @@
   (prefix-argument-supplied nil)
   frame
-  (function nil)
+  (event-mode-list nil)			; for extended modal
   )
 
 (defvar *current-command-info* nil)
+
+(defun push-event-mode-function (f)
+  (push f (command-interpreter-info-event-mode-list *current-command-info*))
+  f)
+
+(defun exit-event-mode ()
+  (setf (command-interpreter-info-event-mode-list *current-command-info*)
+	(cdr (command-interpreter-info-event-mode-list *current-command-info*))))
+
+(defun current-event-mode ()
+  (car (command-interpreter-info-event-mode-list *current-command-info*)))
+
+(defun add-one-shot-event-mode-function (f)
+  (push-event-mode-function #'(lambda (key)
+				(exit-event-mode)
+				(funcall f key))))
+
+
 
 (defun buffer-windows (buffer)
@@ -38,10 +56,5 @@
   #+not-yet
   (invoke-hook hemlock::set-window-hook new-window)
-  #+clx
-  (move-mark (window-point *current-window*)
-	     (buffer-point (window-buffer *current-window*)))
-  #+clx
-  (move-mark (buffer-point (window-buffer new-window))
-	     (window-point new-window))
+  (activate-hemlock-view new-window)
   (setq *current-window* new-window))
 
Index: /trunk/ccl/hemlock/src/command.lisp
===================================================================
--- /trunk/ccl/hemlock/src/command.lisp	(revision 673)
+++ /trunk/ccl/hemlock/src/command.lisp	(revision 674)
@@ -64,6 +64,6 @@
   With prefix argument, insert the character that many times."
   "Reads a key-event from *editor-input* and inserts it at the point."
-  (setf (hi::command-interpreter-info-function hi::*current-command-info*)
-	#'(lambda (key-event)
+  (hi::add-one-shot-event-mode-function
+   #'(lambda (key-event)
 	    (let* ((char (hemlock-ext:key-event-char key-event))
 		   (point (current-point)))
Index: /trunk/ccl/hemlock/src/interp.lisp
===================================================================
--- /trunk/ccl/hemlock/src/interp.lisp	(revision 673)
+++ /trunk/ccl/hemlock/src/interp.lisp	(revision 674)
@@ -428,5 +428,5 @@
 	 (cmd (command-interpreter-info-current-command info))
 	 (trans (command-interpreter-info-current-translation info))
-	 (func (command-interpreter-info-function info)))
+	 (func (current-event-mode)))
     (handler-bind
 	;; Bind this outside the invocation loop to save consing.
@@ -450,5 +450,4 @@
 		(write-char #\space *echo-area-stream*)))))
       (cond (func
-	     (setf (command-interpreter-info-function info) nil)
 	     (funcall func key-event))
 	     (t
@@ -493,4 +492,5 @@
 ;;;    Read commands from the terminal and execute them, forever.
 ;;;
+#+original
 (defun %command-loop ()
   (let  ((cmd *current-command*)
@@ -551,4 +551,8 @@
 	      (hash-table))))))))
 
+(defun %command-loop ()
+  (format t "~& in %command-loop: current buffer = ~s" (current-buffer)))
+
+
 
 ;;; EXIT-HEMLOCK  --  Public