(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED " 1-Mar-88 15:02:43" {ERINYES}<CATE3>SEDIT>DO-TEST-MENU.\;2
 2579   

      |changes| |to:|  (VARS DO-TEST-MENUCOMS)
                       (FUNCTIONS XCL-TEST::DO-TEST-MENU-SETUP XCL-TEST::DO-TEST-MENU-MESSAGE 
                              XCL-TEST::DO-TEST-MENU-CLEANUP XCL-USER::DO-TEST-MENU-CLEANUP 
                              XCL-USER::DO-TEST-MENU-MESSAGE XCL-USER::DO-TEST-MENU-SETUP)

      |previous| |date:| "29-Feb-88 17:46:54" {ERINYES}<CATE3>SEDIT>DO-TEST-MENU.\;1)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT DO-TEST-MENUCOMS)

(RPAQQ DO-TEST-MENUCOMS
 ((FUNCTIONS XCL-TEST::DO-TEST-MENU-CLEANUP XCL-TEST::DO-TEST-MENU-MESSAGE 
                                XCL-TEST::DO-TEST-MENU-SETUP)))

(CL:DEFUN XCL-TEST::DO-TEST-MENU-CLEANUP
 (XCL-TEST::WINDOW-LIST) 
                                           "This lets us clean up things, close the window and so on"
   (TEDIT.QUIT (CL:SECOND XCL-TEST::WINDOW-LIST))
   (CLOSEW (CL:FIRST XCL-TEST::WINDOW-LIST)))


(CL:DEFUN XCL-TEST::DO-TEST-MENU-MESSAGE
 (XCL-TEST::WINDOW-LIST XCL-TEST::IMPORTANT XCL-TEST::MESSAGE
                                                ) "The window list is built in do-test-menu-setup"
   (LET* ((XCL-TEST::WINDOW (CL:FIRST XCL-TEST::WINDOW-LIST))
          (STREAM (CL:SECOND XCL-TEST::WINDOW-LIST))
          (XCL-TEST::STREAM-LENGTH (GETFILEINFO STREAM 'LENGTH))
          (XCL-TEST::REGION (WINDOWPROP XCL-TEST::WINDOW 'REGION))
          (XCL-TEST::X-POSITION (CL:FIRST XCL-TEST::REGION))
          (XCL-TEST::Y-POSITION (+ (CL:SECOND XCL-TEST::REGION)
                                   (CL:FOURTH XCL-TEST::REGION)))
          (XCL-TEST::RESULTS NIL))
         (TEDIT.DELETE STREAM 0 XCL-TEST::STREAM-LENGTH)
         (TEDIT.INSERT STREAM XCL-TEST::MESSAGE)
         (MENU (CREATE
 MENU
                      ITEMS _ '((XCL-TEST::SUCCESS T)
                                (XCL-TEST::FAILURE NIL))
                      MENUROWS _ 1)
               (CONS XCL-TEST::X-POSITION XCL-TEST::Y-POSITION)
               T)))


(CL:DEFUN XCL-TEST::DO-TEST-MENU-SETUP
 (XCL-TEST::TEST-GROUP-TITTLE) 
                                           "Set up a TEdit window to put text in giving instructions"
   (LET* ((XCL-TEST::WINDOW (CREATEW NIL XCL-TEST::TEST-GROUP-TITTLE))
          (STREAM (OPENTEXTSTREAM NIL XCL-TEST::WINDOW)))
         (LIST XCL-TEST::WINDOW STREAM)))

(PUTPROPS DO-TEST-MENU COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP