Index: dialog.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/dialog.lisp,v
retrieving revision 1.22
diff -u -r1.22 dialog.lisp
--- dialog.lisp	26 Aug 2005 00:32:56 -0000	1.22
+++ dialog.lisp	9 Jan 2006 09:58:42 -0000
@@ -93,7 +93,11 @@
    (accept-condition :accessor accept-condition :initarg :accept-condition
 		     :initform nil
 		     :documentation "Condition signalled, if any, during
-accept of this query")))
+accept of this query")
+   (serial :accessor query-serial :initform nil
+	   :documentation "Controls the sanity checking mechanism guarding 
+against illegal accepting-values use by matching it against the serial of 
+accepting-values-stream.")))
 
 (defclass accepting-values-record (standard-updating-output-record)
   ())
@@ -106,7 +110,11 @@
    (last-pass :accessor last-pass :initform nil
 	      :documentation "Flag that indicates the last pass through the
   body of ACCEPTING-VALUES, after the user has chosen to exit. This controls
-  when conditions will be signalled from calls to ACCEPT.")))
+  when conditions will be signalled from calls to ACCEPT.")
+   (serial :accessor stream-serial :initform 0
+	   :documentation "Sanity checking for illegal accepting-values use.
+  Any query object touched by stream-accept must have a serial that is smaller
+  than this value".)))
 
 (defmethod stream-default-view ((stream accepting-values-stream))
   +textual-dialog-view+)
@@ -136,6 +144,8 @@
 
 (defvar *accepting-values-stream* nil)
 
+(defvar *accepting-values-error-on-illegal-use* t)
+
 (defmacro with-stream-in-own-window ((&optional (stream '*query-io*)
                                                 &rest further-streams)
                                      (&optional label)
@@ -166,6 +176,8 @@
   (with-gensyms (accepting-values-continuation)
     (let ((return-form
            `(flet ((,accepting-values-continuation (,stream)
+		     (incf (stream-serial ,stream))
+		     nil
                      ,@body))
               (invoke-accepting-values ,stream
                                        #',accepting-values-continuation
@@ -255,6 +267,21 @@
       (format stream "Cancel"))
     (terpri stream)))
 
+;; If stream-accept encounters a query that already has the most
+;; recent serial in its query object, the user tried to use 'accept'
+;; with a non-unique query-identifier (or prompt if query-identifier
+;; is missing) in a single run of the accepting-values body.
+;; According to the CLIM spec, the result is unspecified behavior.
+;;
+;; McCLIM tries to do better and gives the user an ignorable error.
+
+(defun throw-incorrect-accepting-values-use ()
+  (when *accepting-values-error-on-illegal-use*
+    (with-simple-restart (abort "Ignore (output stream corruption may occur.")
+			 (error "Incorrect use of accepting-values. See CLIM~
+                                 specification, Chapter 26, :query-identifier."))
+    (setq *accepting-values-error-on-illegal-use* nil)))
+
 (defmethod stream-accept ((stream accepting-values-stream) type
 			  &rest rest-args
 			  &key
@@ -295,6 +322,12 @@
 				 :default-supplied-p default-supplied-p
 				 :value default))
       (setf (queries stream) (nconc (queries stream) (list query))))
+    ;; Check if we have already seen the stream-serial with respect to
+    ;; this query (see throw-incorrect-accepting-values-use)
+    (if (eq (stream-serial stream) (query-serial query))
+	(throw-incorrect-accepting-values-use)
+      (setf (query-serial query) (stream-serial stream)))
+
     (setf (accept-arguments query) rest-args)
     ;; If the program changes the default, that becomes the value.
     (unless (equal default (default query))