[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Problem with dw:accepting-values



I wrote:
>My problem is that I switch sometimes to another application using the
>select-key while I am in accepting-values.  If I am not in the middle
>of typing a new number, everything is fine, accepting-values is
>aborted.  Otherwise, if I come back to my application,
>accepting-values is still active but the window is not exposed.  

Since I got no responses, I solved the problem on my own.  I patched
one method (changes in uppercase).  This solves the problems with
temporary windows, non-temporary windows have still an unexpected
behavior.

Andreas Girgensohn
andreasg@boulder.colorado.edu

;;; from SYS:DYNAMIC-WINDOWS;ACCEPT-VALUES.LISP.224

DW::
(defmethod (accept-values-top-level accept-values) (&key temporary-p
							 initially-select-query-identifier
							 continuation resynchronize-every-pass
							 queries-are-independent
						    &allow-other-keys)
  (setq redisplay-necessary t)
  (let ((*presentation-more-break-input-context* nil)
	(*accept-help* nil)
	(resynchronize-this-pass nil))
    (tv:with-blinker-visibility (stream nil)
      (catch 'accept-values-return
	(unwind-protect
	    (loop
	      ;; I wonder whether we could manage to get this to be the redisplay-function for
	      ;; the choices pane?
	      (when (and redisplay-necessary
			 (or resynchronize-every-pass resynchronize-this-pass))
		(letf (((accept-values-stream-state stream) :resynchronizing))
		  (funcall continuation stream))
		(setq resynchronize-this-pass nil))
	      (accept-values-choices-redisplay queries-are-independent)
	      (cond (initially-select-query-identifier
		     (read-new-value stream
				     (find-query stream initially-select-query-identifier))
		     (setq redisplay-necessary t)
		     (setq initially-select-query-identifier nil))
		    (t
		     (setq resynchronize-this-pass
			   (catch 'accept-values-resynchronize
			     (LET ((STATUS (AND TEMPORARY-P :EXPOSED)))
			       (multiple-value-bind (command arguments kind)
				   (read-program-command self
							 :stream real-stream
							 :echo-stream #'ignore
							 :status STATUS
							 :notification nil)
				 (case kind
				   (:status (signal 'abort))
				   (otherwise
				     (when command
				       (MULTIPLE-VALUE-BIND (RESULT KIND)
					   (CATCH 'ACCEPT-VALUES-STATUS
					     (WITH-INPUT-EDITING-OPTIONS-IF
						 STATUS
						 ((:INPUT-WAIT NIL
						   #'(LAMBDA (STREAM STATUS)
						       (SI:READ-CHARACTER-WINDOW-STATUS
							 STREAM STATUS))
						   REAL-STREAM STATUS)
						  (:INPUT-WAIT-HANDLER
						    #'(LAMBDA (STREAM STATUS)
							(WHEN (SI:READ-CHARACTER-WINDOW-STATUS
								STREAM STATUS)
							  (THROW 'ACCEPT-VALUES-STATUS
							    (VALUES NIL :STATUS))))
						    REAL-STREAM STATUS))
					       (apply command arguments)))
					 (WHEN (EQ KIND :STATUS)
					   (SIGNAL 'ABORT))
					 RESULT)))))))))))
	  (clear-accept-values-stream-cursor-highlighting stream))))))