CLIM mail archive


Accepting values and Abort

I am using CLIM 1.1 on a Symbolics under Genera 8.1.1.

When i create a pop-up window using clim:accepting-values and clim:accept and the user chooses Abort, my program at large will abort and/or the process from which the window is run will stop (i.e., "Stopped" will show up in the mouse line).  I want Abort to cause the window to go away (and maybe print a message saying that the operation was aborted) but not to have any effect on other running processes or the rest of the program from which it is called.  

I have tried typing in examples from the CLIM 1.0 manual, but they don't seem to work properly either.  If i type in reset-clock from page 241 of the Symbolics manual and choose Abort, the string "~&Time not set" is not printed.  The fact that it doesn't print as expected may have something to do with my bigger problem.  The simple code from symbolics is essentially:

;; I just typed this in; it may not compile...
(defun reset-clock (stream)
   (multiple-value-bind (second minute hour day month)
      (declare (ignore second minute hour day))
      (format stream "Enter the time~%")
            (clim:accepting-values (stream)
                (setq month (clim:accept 'integer :stream stream
                                         :default month :prompt "Month"))
                (terpri stream)
                ;; ... more of the same ...
            (format t "~%New values: Month: ~D." month))
     (abort () (format t "~&Time not set"))))) ;; this never seems to execute!

Why might this not work and is there a fix?  Is it related to the abort 
problem in my code?  My code is included below (it will compile):

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: COMMON-LISP-USER; Base: 10 -*-

;; Here is a little test program to show what i mean...
(defun test-popup ()
  (general-popup :msg "Choose Abort")
  ;; nothing executes from here down...
  (format t "~%I asked you to choose ABORT") 
  (general-popup :msg "Choose Abort again" :resp-reqd t)
  (format t "~%I asked you to choose ABORT again")
  (format t "~%Exiting test....")

; FUNCTION NAME: general-popup
; PURPOSE:  Creates a pop-up dialog box with some or all of the following:
; (1) the message to the operator,
; (2) the source of the message,
; (3) a place for a response,
; -- If a response is required, The operator must provide one before the
; dialog window may be dismissed by choosing  OK.
; DATE CREATED: 9/9/92
;    Created by Robin Kladke on Wednesday the ninth of September, 1992; 3:25:28 pm
;    Note#1 (10/19/92): CLI 1.1 has a big that resets values within a dialog to
;    their default values when later values are modified.  This code assumes the
;    presence of the fix, currently contained in file
;    d:>rel-8-1>clim>patch>clim-27>accept-values-command-parser-fix.bin.newest
;   :source    - The source of the message; e.g., name of person, host machine, etc.
;   :dest-type - (Defaults to 'integer) Sympol representing type of destination id
;   :dest-reqd - t: a destination id must be provided
;   :destination - NIL: no destination is required
;   :msg       - A string message to convey information or clarify response required
;   :prompt    - (Defaults to "Enter a response") Prompt for response
;   :resp-type - (Defaults to 'string) Symbol representing type of response;
;                  may be simple type like 'integer or ranged list like '(integer 0 1)
;   :resp-reqd - t: a response must be provided
;                NIL: no response is required (only ACK by choosing OK)
;   :new-resp-reqd - (Defaults to 0) Should this message be responded to? 0=No, 1=Yes.
;   :default response - (defaults to NIL); must be same type as resp-type
;   :stream    - (Defaults to (clim:open-root-window :sheet)) The popup window; if
;               not specified, a window is dynamically created
; RETURN VALUES: (Multiple) The value of the response and the destination id

(defun general-popup (&key (header nil) (source nil)
		      (dest-type 'integer) (dest-reqd nil)
		      (destination nil) (msg nil)
		      (prompt "Enter a Message")
		      (resp-type 'string) (resp-reqd nil) (new-resp-reqd 0)
		      (response nil)
		      (stream (clim:open-root-window :sheet)))
  (let ((exit-boxes nil) (abort-msg nil) (dest-prompt nil))
    (cond (resp-reqd 
	   (setq exit-boxes '((:exit "<End> uses these values")
			      (:abort "<Abort> aborts out of the system!"
	   (setq abort-msg
		 (format nil "~A~A"
			 "~%Message MUST be acknowedged! Try again...")))
	   (setq exit-boxes '((:exit "<End> exits this window")
			      (:abort "<Abort> aborts out of the system!"
	   (setq abort-msg "")))

	(clim:accepting-values (stream
				 :own-window '(:right-margin 300 :bottom-margin 100)
				 :exit-boxes exit-boxes
				 :x-position 0
				 :y-position 0
	  (when header
	    (format stream "~A~%~%" header))
	  (when source
	    (format stream "~%Message Source: ~A~%" source))
	  (when msg
	    (format stream "~%Message: ~A~%~%" msg))

	  (cond (dest-reqd
		 (setq dest-prompt
		       (format nil "Enter a Destination ID"))
		 (setq destination (clim:accept dest-type
						:stream stream
						:prompt dest-prompt
						;; See NOTE#1 in header
						:default destination
						:provide-default t
		 (terpri stream)
		 (terpri stream))
		(t (setq destination t)))
	  (cond (resp-reqd 
		 (setq response (clim:accept resp-type
					     :stream stream
					     :prompt prompt
					     :default response
					     :provide-default t))
		 (terpri stream) (terpri stream)
		 (terpri stream)
		 (terpri stream)
		 (setq new-resp-reqd (clim:accept '(integer 0 1)
						  :stream stream
						  :prompt "Is acknowledgement required (0=No, 1=Yes)? "
						  :prompt-mode :raw
						  ;; See NOTE#1 in header
						  :default new-resp-reqd
						  :provide-default t
		 (terpri stream) (terpri stream)
		 (terpri stream) (terpri stream)
		 (terpri stream) (terpri stream)
		(t (setq response t)))
      (abort () (format t abort-msg)))

    ;; if the user doesn't respond by giving no answer, a null answer, or aborting,
    ;; pop the window up again
    (cond ((or (null response) (string-equal (princ-to-string response) "")
	   (multiple-value-setq  (response destination new-resp-reqd)
	       :header header
	       :source source :dest-type dest-type :dest-reqd dest-reqd
	       :destination destination :msg msg :prompt prompt :resp-type resp-type
	       :resp-reqd resp-reqd :new-resp-reqd new-resp-reqd
	       :response response :stream stream)))

    (values response destination new-resp-reqd)


I would expect function TEST-POPUP to run to completion, but the function aborts after choosing ABORT in the first popup.  Why?  Any advice would be appreciated.




Main Index | Thread Index