[gsharp-cvs] CVS update: gsharp/esa.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv10388

Modified Files:
	esa.lisp 
Log Message:
Copy improvements to esa.lisp made by Dave Murray for Climacs.

Date: Mon Aug  8 02:22:08 2005
Author: rstrandh

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.3 gsharp/esa.lisp:1.4
--- gsharp/esa.lisp:1.3	Tue Aug  2 04:15:57 2005
+++ gsharp/esa.lisp	Mon Aug  8 02:22:07 2005
@@ -143,39 +143,65 @@
 	(t 
 	 (unread-gesture gesture :stream stream))))
 
+(define-gesture-name universal-argument :keyboard (#\u :control))
+
+(define-gesture-name meta-minus :keyboard (#\- :meta))
+
 (defun read-numeric-argument (&key (stream *standard-input*))
+  "Reads gestures returning two values: prefix-arg and whether prefix given.
+Accepts: EITHER C-u, optionally followed by other C-u's, optionally followed
+by a minus sign, optionally followed by decimal digits;
+OR An optional M-minus, optionally followed by M-decimal-digits.
+You cannot mix C-u and M-digits.
+C-u gives a numarg of 4. Additional C-u's multiply by 4 (e.g. C-u C-u C-u = 64).
+After C-u you can enter decimal digits, possibly preceded by a minus (but not
+a plus) sign. C-u 3 4 = 34, C-u - 3 4 = -34. Note that C-u 3 - prints 3 '-'s.
+M-1 M-2 = 12. M-- M-1 M-2 = -12. As a special case, C-u - and M-- = -1.
+In the absence of a prefix arg returns 1 (and nil)."
   (let ((gesture (esa-read-gesture)))
     (cond ((event-matches-gesture-name-p
-	    gesture
-	    `(:keyboard #\u ,(make-modifier-state :control)))
+	    gesture 'universal-argument)
 	   (let ((numarg 4))
 	     (loop for gesture = (esa-read-gesture)
 		   while (event-matches-gesture-name-p
-			  gesture
-			  `(:keyboard #\u ,(make-modifier-state :control)))
+			  gesture 'universal-argument)
 		   do (setf numarg (* 4 numarg))
 		   finally (esa-unread-gesture gesture stream))
-	     (let ((gesture (esa-read-gesture)))
+	     (let ((gesture (esa-read-gesture))
+		   (sign +1))
+	       (when (and (characterp gesture)
+			  (char= gesture #\-))
+		 (setf gesture (esa-read-gesture)
+		       sign -1))
 	       (cond ((and (characterp gesture)
 			   (digit-char-p gesture 10))
-		      (setf numarg (- (char-code gesture) (char-code #\0)))
+		      (setf numarg (digit-char-p gesture 10))
 		      (loop for gesture = (esa-read-gesture)
 			    while (and (characterp gesture)
 				       (digit-char-p gesture 10))
 			    do (setf numarg (+ (* 10 numarg)
-					       (- (char-code gesture) (char-code #\0))))
+					       (digit-char-p gesture 10)))
 			    finally (esa-unread-gesture gesture stream)
-				    (return (values numarg t))))
+				    (return (values (* numarg sign) t))))
 		     (t
 		      (esa-unread-gesture gesture stream)
-		      (values numarg t))))))
-	  ((meta-digit gesture)
-	   (let ((numarg (meta-digit gesture)))
+		      (values (if (minusp sign) -1 numarg) t))))))
+	  ((or (meta-digit gesture)
+	       (event-matches-gesture-name-p
+		gesture 'meta-minus))
+	   (let ((numarg 0)
+		 (sign +1))
+	     (cond ((meta-digit gesture)
+		    (setf numarg (meta-digit gesture)))
+		   (t (setf sign -1)))
 	     (loop for gesture = (esa-read-gesture)
 		   while (meta-digit gesture)
 		   do (setf numarg (+ (* 10 numarg) (meta-digit gesture)))
 		   finally (esa-unread-gesture gesture stream)
-			   (return (values numarg t)))))
+			   (return (values (if (and (= sign -1) (= numarg 0))
+					       -1
+					       (* sign numarg))
+					   t)))))
 	  (t (esa-unread-gesture gesture stream)
 	     (values 1 nil)))))