CLIM mail archive
[Prev][Next][Index][Thread]

re: Accepting values and commands


Scott,

I tried the CLIM 1.1 bug fix for the dialog problem, but see no difference.  I compiled and loaded the code then called the following
general popup window routine.  The values are still reset to their
defaults when previous values are changed.  Ideas?

--Robin

----Begin Code----

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

;-------------------------------------------------------------------------------
; 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: self (recursive)
; CALLED BY: N/A - general purpose
; 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
;   :dest-default - 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)
;   :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: none
; SIDE EFFECTS: pops up a dialog box
; PSEUDOCODE: 
;-------------------------------------------------------------------------------

(defun general-popup (&key (header nil) (source nil)
		      (dest-type 'integer) (dest-reqd nil)
		      (dest-default nil) (msg nil)
		      (prompt "Enter a Message")
		      (resp-type 'string) (resp-reqd nil)
		      (stream (clim:open-root-window :sheet)))
  
  (let ((response nil) (exit-boxes nil) (abort-msg nil) (destination nil)
	(new-resp-reqd 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 (Default=~A)" dest-default))
		 (setq destination (clim:accept dest-type
						:stream stream
						:prompt dest-prompt
						;; See NOTE#1 in header
						:default dest-default 
						:provide-default t
						))
		 (terpri stream)
		 (terpri stream))
		(t (setq destination t)))
	  (cond (resp-reqd 
		 (setq response (clim:accept resp-type
					     :stream stream
					     :prompt prompt))
		 (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 [Default], 1=Yes)? "
						  :prompt-mode :raw
						  ;; See NOTE#1 in header
						  :default 0
						  :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) "")
	       ;(null destination) (string-equal (princ-to-string destination) "")
	       )
	   (multiple-value-setq  (response destination new-resp-reqd)
	     (general-popup
	       :header header
	       :source source :dest-type dest-type :dest-reqd dest-reqd
	       :dest-default dest-default :msg msg :prompt prompt :resp-type resp-type
	       :resp-reqd resp-reqd :stream stream)))
	  )

    (values response destination new-resp-reqd)
    ))



0,,
Follow-Ups:
Main Index | Thread Index