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

Robert Strandh rstrandh at common-lisp.net
Wed Feb 23 06:13:11 UTC 2005


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

Modified Files:
	gui.lisp 
Log Message:
Fixed a problem introduced by a recent change to the command loop, where
the numeric argument flag was not replaced in commands.

Date: Wed Feb 23 07:13:09 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.121 climacs/gui.lisp:1.122
--- climacs/gui.lisp:1.121	Tue Feb 22 12:01:38 2005
+++ climacs/gui.lisp	Wed Feb 23 07:13:09 2005
@@ -285,20 +285,22 @@
 		    (object)
 		    (loop
 		       for gestures = '()
-		       for numarg = (read-numeric-argument :stream *standard-input*)
-		       do (loop (setf *current-gesture* (climacs-read-gesture))
-			     (setf gestures (nconc gestures (list *current-gesture*)))
-			     (let ((item (find-gestures gestures 'global-climacs-table)))
-			       (cond ((not item)
-				      (beep) (return))
-				     ((eq (command-menu-item-type item) :command)
-				      (let ((command (command-menu-item-value item)))
-					(unless (consp command)
-					  (setf command (list command)))
-					(setf command (substitute-numeric-argument-marker command numarg))
-					(do-command command)
-					(return)))
-				     (t nil))))
+		       do (multiple-value-bind (numarg numargp)
+			      (read-numeric-argument :stream *standard-input*)
+			    (loop (setf *current-gesture* (climacs-read-gesture))
+				  (setf gestures (nconc gestures (list *current-gesture*)))
+				  (let ((item (find-gestures gestures 'global-climacs-table)))
+				    (cond ((not item)
+					   (beep) (return))
+					  ((eq (command-menu-item-type item) :command)
+					   (let ((command (command-menu-item-value item)))
+					     (unless (consp command)
+					       (setf command (list command)))
+					     (setf command (substitute-numeric-argument-marker command numarg))
+					     (setf command (substitute-numeric-argument-p command numargp))
+					     (do-command command)
+					     (return)))
+					  (t nil)))))
 			 (update-climacs))
 		    (t
 		     (do-command object)




More information about the Climacs-cvs mailing list