[mcclim-cvs] CVS update: mcclim/Goatee/clim-area.lisp mcclim/Goatee/editing-stream.lisp

[Timothy Moore]

Update of /project/mcclim/cvsroot/mcclim/Goatee
In directory common-lisp.net:/tmp/cvs-serv16423/Goatee

Modified Files:
	clim-area.lisp editing-stream.lisp 
Log Message:

Fixed presentation highlighting to do the right thing in the
:SINGLE-BOX NIL case.

Fixed Goatee to not draw anything when drawing is not enabled for the
stream.

Changed input editing streams to never put activation gestures in the
input buffer. There is only one place to receive an activation
gesture: the end of the buffer. If the user types an activation
gesture, the insertion pointer is moved to the end of the buffer.

Fixed various problems with accepting-values. In particular, the
insertion pointer does not need to be left at the end of a field when
the user exits the dialog. Also, the behavior in the presence of
errors new: if an error occurs while the user is typing in an
accepting-values field, the bell is beeped and the insertion pointer
is positioned before the stream position where the error occured.

Date: Tue Feb 22 15:00:18 2005
Author: tmoore

Index: mcclim/Goatee/clim-area.lisp
diff -u mcclim/Goatee/clim-area.lisp:1.30 mcclim/Goatee/clim-area.lisp:1.31
--- mcclim/Goatee/clim-area.lisp:1.30	Fri Feb 11 11:03:07 2005
+++ mcclim/Goatee/clim-area.lisp	Tue Feb 22 15:00:18 2005
@@ -556,30 +556,31 @@
 			(line-text-width area line
 					 :end line-unchanged-from-end)
 			new-line-end)))
-	      (multiple-value-bind (x y)
-		  (output-record-position line)
-		;; Move unchanged text at the end of line, if needed
-		(when (and (not (eql line-unchanged-from-end new-line-size))
-			   (not (eql current-unchanged-left
-				     new-unchanged-left)))
-		  (copy-area medium
-			     (+ current-unchanged-left x)
-			     y
-			     (- line-end current-unchanged-left)
-			     (+ ascent descent)
-			     (+ new-unchanged-left x)
-			     y))
-		;; If the line is now shorter, erase the old end of line.
-		(erase-line line medium new-line-end line-end)
-		;; Erase the changed middle
-		(erase-line line medium start-width new-unchanged-left)
-		;; Draw the middle
-		(when (< line-unchanged-from-start line-unchanged-from-end)
-		  (draw-text* medium current-contents
-			      (+ x start-width) baseline
-			      :start line-unchanged-from-start
-			      :end line-unchanged-from-end
-			      :ink (foreground-ink line))))
+	      (when (stream-drawing-p stream)
+		(multiple-value-bind (x y)
+		    (output-record-position line)
+		  ;; Move unchanged text at the end of line, if needed
+		  (when (and (not (eql line-unchanged-from-end new-line-size))
+			     (not (eql current-unchanged-left
+				       new-unchanged-left)))
+		    (copy-area medium
+			       (+ current-unchanged-left x)
+			       y
+			       (- line-end current-unchanged-left)
+			       (+ ascent descent)
+			       (+ new-unchanged-left x)
+			       y))
+		  ;; If the line is now shorter, erase the old end of line.
+		  (erase-line line medium new-line-end line-end)
+		  ;; Erase the changed middle
+		  (erase-line line medium start-width new-unchanged-left)
+		  ;; Draw the middle
+		  (when (< line-unchanged-from-start line-unchanged-from-end)
+		    (draw-text* medium current-contents
+				(+ x start-width) baseline
+				:start line-unchanged-from-start
+				:end line-unchanged-from-end
+				:ink (foreground-ink line)))))
 	      ;; Old, wrong, bounding rectangle
 	      (with-bounding-rectangle* (old-min-x old-min-y old-max-x old-max-y)
 		  line


Index: mcclim/Goatee/editing-stream.lisp
diff -u mcclim/Goatee/editing-stream.lisp:1.20 mcclim/Goatee/editing-stream.lisp:1.21
--- mcclim/Goatee/editing-stream.lisp:1.20	Sun Oct 24 17:47:02 2004
+++ mcclim/Goatee/editing-stream.lisp	Tue Feb 22 15:00:18 2005
@@ -150,44 +150,54 @@
 				   gesture
 				   type)
   (declare (ignore type))
+  (when (activation-gesture-p gesture)
+    (setf (stream-insertion-pointer stream)
+	  (fill-pointer (stream-input-buffer stream)))
+    (set-editing-stream-insertion-pointer stream
+					  (stream-insertion-pointer stream))
+    (setf (climi::activation-gesture stream) gesture)
+    (rescan-if-necessary stream)
+    (return-from stream-process-gesture gesture))
   (let ((area (area stream))
 	(snapshot (snapshot stream)))
     (execute-gesture-command gesture area *simple-area-gesture-table*)
-  (make-input-editing-stream-snapshot snapshot area)
-  (let ((first-mismatch (mismatch (stream-input-buffer snapshot)
-				  (stream-input-buffer stream))))
-    (unwind-protect
-	 (cond ((null first-mismatch)
-		;; No change actually took place, event though IP may have
-		;; moved. 
-		nil)
-	       ((< first-mismatch (stream-scan-pointer stream))
-		(immediate-rescan stream))
-	       ((and (eql first-mismatch
-			  (1- (stream-insertion-pointer snapshot)))
-		     (eql (aref (stream-input-buffer snapshot) first-mismatch)
-			  gesture))
-		;; As best we can tell an insertion happened: one gesture was
-		;; entered it was inserted in the buffer.  There may be other
-		;; changes above IP, but we don't care.
-		gesture)
-	       (t
-		;; Other random changes, but we want to allow more editing
-		;; before scanning them.
-		nil))
-      (let ((snapshot-buffer (stream-input-buffer snapshot))
-	    (stream-buffer (stream-input-buffer stream)))
-	(setf (stream-insertion-pointer stream)
-	      (stream-insertion-pointer snapshot))
-	(when (< (car (array-dimensions stream-buffer))
-		 (fill-pointer snapshot-buffer))
-	  (adjust-array stream-buffer (fill-pointer snapshot-buffer)))
-	(setf (fill-pointer stream-buffer) (fill-pointer snapshot-buffer))
-	(when (and first-mismatch
-		   (>= (fill-pointer snapshot-buffer) first-mismatch))
-	  (replace stream-buffer snapshot-buffer
-		   :start1 first-mismatch
-		   :start2 first-mismatch)))))))
+    (make-input-editing-stream-snapshot snapshot area)
+    (let ((first-mismatch (mismatch (stream-input-buffer snapshot)
+				    (stream-input-buffer stream))))
+      (unwind-protect
+	   (cond ((null first-mismatch)
+		  ;; No change actually took place, event though IP may have
+		  ;; moved. 
+		  nil)
+		 ((< first-mismatch (stream-scan-pointer stream))
+		  ;; Throw out. Buffer is still updated by protect forms
+		  (immediate-rescan stream))
+		 ((and (eql first-mismatch
+			    (1- (stream-insertion-pointer snapshot)))
+		       (eql (aref (stream-input-buffer snapshot) first-mismatch)
+			    gesture))
+		  ;; As best we can tell an insertion happened: one gesture was
+		  ;; entered it was inserted in the buffer.  There may be other
+		  ;; changes above IP, but we don't care.
+		  gesture)
+		 (t
+		  ;; Other random changes, but we want to allow more editing
+		  ;; before scanning them.
+		  (queue-rescan stream)
+		  nil))
+	(let ((snapshot-buffer (stream-input-buffer snapshot))
+	      (stream-buffer (stream-input-buffer stream)))
+	  (setf (stream-insertion-pointer stream)
+		(stream-insertion-pointer snapshot))
+	  (when (< (car (array-dimensions stream-buffer))
+		   (fill-pointer snapshot-buffer))
+	    (adjust-array stream-buffer (fill-pointer snapshot-buffer)))
+	  (setf (fill-pointer stream-buffer) (fill-pointer snapshot-buffer))
+	  (when (and first-mismatch
+		     (>= (fill-pointer snapshot-buffer) first-mismatch))
+	    (replace stream-buffer snapshot-buffer
+		     :start1 first-mismatch
+		     :start2 first-mismatch)))))))
 
 (defun reposition-stream-cursor (stream)
   "Moves the cursor somewhere clear of Goatee's editing area."
@@ -243,6 +253,16 @@
 			   :format "Location line ~S pos ~S isn't in buffer ~S"
 			   :format-arguments (list line pos buffer)))
 		  (return (+ total-offset pos)))))
+
+(defgeneric set-editing-stream-insertion-pointer (stream pointer))
+
+(defmethod set-editing-stream-insertion-pointer
+    ((stream goatee-input-editing-mixin) pointer)
+  (let* ((area (area stream))
+	 (buffer (buffer area)))
+    (setf (point* buffer) (location*-offset buffer pointer))
+    (redisplay-area area)))
+
 
 (defun %replace-input (stream new-input start end buffer-start
 		       rescan rescan-supplied-p