[mcclim-cvs] CVS mcclim

ahefner ahefner at common-lisp.net
Sat Jul 1 21:00:31 UTC 2006


Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv5802

Modified Files:
	frames.lisp 
Log Message:
Fix command menus in frames with no interactor (or application-pane?)
by making read-frame-command handle the case :stream nil by calling
the simple event loop. Changed the default top level to call 
read-frame-command with a null stream rather than calling the simple
event loop directly.

Previously the command menu would throw a menu-item, but because the 
receiving code is in the :around method on read-frame-command (and
thus not executed), the menu selection was ignored.

Metaphorically, the "read a command" operation should be applicable
even when the textual command parser is not invoked.





--- /project/mcclim/cvsroot/mcclim/frames.lisp	2006/05/05 10:24:02	1.119
+++ /project/mcclim/cvsroot/mcclim/frames.lisp	2006/07/01 21:00:31	1.120
@@ -459,11 +459,10 @@
 	       (redisplay-frame-panes frame :force-p first-time)
 	       (setq first-time nil)
 	       (if query-io
-                 ;; We don't need to turn the cursor on here, as Goatee has its own
-                 ;; cursor which will appear. In fact, leaving it on causes much
-                 ;; bit flipping and slows command output somewhat. So, leave it
-                 ;; off by default, and hope this doesn't violate the spec.  
+                   ;; For frames with an interactor:
 		   (progn
+                     ;; Hide cursor, so we don't need to toggle it during
+                     ;; command output.
 		     (setf (cursor-visibility (stream-text-cursor *query-io*))
 			   nil)
 		     (when (and prompt interactorp)
@@ -480,7 +479,9 @@
 			 (execute-frame-command frame command))
 		       (when interactorp
 			 (fresh-line *query-io*))))
-		   (simple-event-loop)))
+                   ;; Frames without an interactor:
+                   (let ((command (read-frame-command frame :stream nil)))
+                     (when command (execute-frame-command frame command)))))
 	   (abort ()
 	     :report "Return to application command loop"
 	     (if interactorp
@@ -488,7 +489,7 @@
 		 (beep))))))))
 
 (defmethod read-frame-command :around ((frame application-frame)
-				       &key (stream *standard-input*))  
+				       &key (stream *standard-input*))
   (with-input-context ('menu-item)
       (object)
       (call-next-method)
@@ -510,7 +511,9 @@
   ;; If we do things as the spec says, command accelerators will
   ;; appear to not work, confusing new users.
   #+NIL (read-command (frame-command-table frame) :use-keystrokes nil :stream stream)
-  (read-command (frame-command-table frame) :use-keystrokes t :stream stream))
+  (if stream
+      (read-command (frame-command-table frame) :use-keystrokes t :stream stream)
+      (simple-event-loop frame)))
 
 (define-event-class execute-command-event (window-manager-event)
   ((sheet :initarg :sheet :reader event-sheet)
@@ -1297,10 +1300,10 @@
                                input-context)
   (frame-update-pointer-documentation frame input-context stream event))
 
-(defun simple-event-loop ()
+(defun simple-event-loop (&optional (frame *application-frame*))
   "An simple event loop for applications that want all events to be handled by
  handle-event methods"
-  (let ((queue (frame-event-queue *application-frame*)))
+  (let ((queue (frame-event-queue frame)))
     (loop for event = (event-queue-read queue)
        ;; EVENT-QUEUE-READ in single-process mode calls PROCESS-NEXT-EVENT itself.
        do (handle-event (event-sheet event) event))))




More information about the Mcclim-cvs mailing list