CLIM mail archive
[Prev][Next][Index][Thread]
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)
(get-decoded-time)
(declare (ignore second minute hour day))
(format stream "Enter the time~%")
(conditions:restart-case
(progn
(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
; MODIFICATION HISTORY:
; Created by Robin Kladke on Wednesday the ninth of September, 1992; 3:25:28 pm
; NOTES:
; 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
;-------------------------------------------------------------------------------
; CALLS:
; CALLED BY:
; PARAMETERS:
; :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
; GLOBALS:
; SIDE EFFECTS:
; PSEUDOCODE:
;-------------------------------------------------------------------------------
(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"
header
"~%Message MUST be acknowedged! Try again...")))
(t
(setq exit-boxes '((:exit "<End> exits this window")
(:abort "<Abort> aborts out of the system!"
)))
(setq abort-msg "")))
(conditions:restart-case
(progn
(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)
(general-popup
: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.
||#
0,,
Follow-Ups:
Main Index |
Thread Index