[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv28103

Modified Files:
	gui.lisp 
Log Message:
moved do-command and update-climacs out of climacs-top-level

Date: Sun Jul 17 14:31:55 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.152 climacs/gui.lisp:1.153
--- climacs/gui.lisp:1.152	Sun Jul 17 12:24:15 2005
+++ climacs/gui.lisp	Sun Jul 17 14:31:55 2005
@@ -115,8 +115,8 @@
   (setf (message *standard-input*)
 	(apply #'format nil format-string format-args)))
 
-(defmacro current-window () ; shouldn't this be an inlined function? --amb
-  `(car (windows *application-frame*)))
+(defun current-window ()
+  (car (windows *application-frame*)))
 
 (defmethod execute-frame-command :around ((frame climacs) command)
   (declare (ignore command))
@@ -280,6 +280,21 @@
     (no-such-operation ()
       (beep) (display-message "Operation unavailable for syntax"))))  
 
+(defun do-command (frame command)
+  (execute-frame-command frame command)
+  (setf (previous-command *standard-output*)
+	(if (consp command)
+	    (car command)
+	    command)))
+	     
+(defun update-climacs (frame)
+  (let ((buffer (buffer (current-window))))
+    (when (modified-p buffer)
+      (setf (needs-saving buffer) t)))
+  (when (null (remaining-keys *application-frame*))
+    (setf (executingp *application-frame*) nil)
+    (redisplay-frame-panes frame)))
+
 (defun climacs-top-level (frame &key
                           command-parser command-unparser
                           partial-command-parser prompt)
@@ -292,19 +307,7 @@
 	  (*print-pretty* nil)
 	  (*abort-gestures* '((:keyboard #\g 512))))
       (redisplay-frame-panes frame :force-p t)
-      (flet ((do-command (command)
-	       (execute-frame-command frame command)
-	       (setf (previous-command *standard-output*)
-		     (if (consp command)
-			 (car command)
-			 command)))
-	     (update-climacs ()
-	       (let ((buffer (buffer (current-window))))
-		 (when (modified-p buffer)
-		   (setf (needs-saving buffer) t)))
-	       (when (null (remaining-keys *application-frame*))
-		 (setf (executingp *application-frame*) nil)
-		 (redisplay-frame-panes frame))))
+      (flet ()
 	(flet ((process-gestures ()
 		 (loop
 		  for gestures = '()
@@ -324,10 +327,10 @@
 				 (setf command (list command)))
 			       (setf command (substitute-numeric-argument-marker command numarg))
 			       (setf command (substitute-numeric-argument-p command numargp))
-			       (do-command command)
+			       (do-command frame command)
 			       (return)))
 			    (t nil)))))
-		  do (update-climacs))))
+		  do (update-climacs frame))))
 	  (loop
 	   for maybe-error = t
 	   do (restart-case
@@ -338,12 +341,12 @@
 			    (object)
 		            (process-gestures)
 			  (t
-			   (do-command object)
+			   (do-command frame object)
 			   (setq maybe-error nil)))
 		      (abort-gesture () (display-message "Quit")))
 		    (when maybe-error
 		      (beep))
-		    (update-climacs))
+		    (update-climacs frame))
 		(return-to-climacs () nil))))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)