;;; $Header: /ct/debug/screens.l,v 1.18 84/02/13 10:59:31 john Exp $
;;; $Log:	/ct/debug/screens.l,v $
;;;Revision 1.18  84/02/13  10:59:31  john
;;;Who knows.
;;;
;;;Revision 1.17  84/01/26  15:43:17  susan
;;;  Fixed screens problems by doing a lines-displayed message
;;;to the db%output_window under db%vms_inter and making sure
;;;that db%user_window and db%code_window have no curses files.
;;;Made any vms or unix dependencies happen at runtime.
;;;
;;;Revision 1.16  84/01/10  09:43:18  susan
;;;Now check that the temporary output listing file exists
;;;before send a display-file message to the window.  If
;;;it's not there (probably dumped with a front-end run and
;;;are running with debug_debug), just display the empty 
;;;string in the window instead of blowing up.
;;;
;;;Revision 1.15  84/01/07  11:43:34  susan
;;;Repaired a couple of functions that needed db% in front
;;;of their names and made a couple of things NOT be
;;;local functions in this file.
;;;
;;;Revision 1.14  84/01/06  13:44:49  susan
;;;Modified the calls to db%get_file(s) to pass an extra
;;;argument as to whether the file is required to exist
;;;or not.  Attempted to make batch execution work
;;;correctly for both the interpreter and testing--output
;;;will go to the VMS sysout for both of these.  Also
;;;added correct error messages for batch execution.  
;;;Cleared a bunch of specials directly under db%vms_inter
;;;rather than doing separately under db%parse_options
;;;or db%initial_screen.
;;;
;;;Revision 1.13  83/12/14  17:26:59  susan
;;;Made the testing screen work the same as the debugger...the
;;;front end of the interpreter doesn't go through windows.
;;;
;;;Revision 1.12  83/12/13  09:10:05  susan
;;;Changed ct_send to ct_csend or get/set-iv.  Modified the
;;;front end of the interpreter to not go through scrool
;;;windows...it now lists directly to the screen and uses
;;;a temp file with which to display itself in the debugger.
;;;Modified the db%code_window and db%output_window to be
;;;'write_only for faster execution.
;;;
;;;Revision 1.11  83/11/22  17:46:42  susan
;;;.obj -> .int....internal rather than object or diana
;;;for the suffix
;;;
;;;Revision 1.10  83/11/10  17:25:59  susan
;;;Changed a little here and there.  The commnad
;;;Monitor Variable -> Monitor Value, Monitor
;;;Statement -> Monitor Program, Read Value ->
;;;Describe Object.  Added a function db_get_mode
;;;to be able to tell whether we're running in 
;;;batch mode or interactively and give errors if
;;;we're doing the wrong things in batch mode.  Added
;;;a couple of new, informative mode lines to the bottom
;;;of the single window formation.  
;;;
;;;Revision 1.9  83/10/25  17:10:58  susan
;;;Again, tried to repair windows so that the initial debuggert
;;;screen will show up correctly.
;;;
;;;Revision 1.8  83/10/19  15:18:56  susan
;;;moved around the code that makes the debug menus to
;;;exist before asking for the menu with exercises
;;;
;;;Revision 1.7  83/10/18  11:06:19  susan
;;;Changed checking argv to be the same on vms and unix since
;;;Alfred provided that feature.
;;;
;;;Revision 1.6  83/10/17  01:07:07  susan
;;;Moved the display-file call for the current file from
;;;db%debug_command to under db%initial_debugger_screen
;;;so that repositioning in the file after an interpreter
;;;interruption will happen correctly.
;;;
;;;Revision 1.5  83/10/16  15:13:01  susan
;;;Removed (echo) in db%initial_screen
;;;
;;;Revision 1.4  83/10/16  11:46:11  susan
;;;Changed function to handle echoing myself rather than
;;;having echo turned on.  
;;;Fixed controlg problem with db%ask_literal and db%ask_integer
;;;so that these commands can be aborted.
;;;
;;;
;;;Revision 1.3  83/10/13  08:20:07  susan
;;;Put squirrely (tyi) back in under db%initial_screens
;;;to soak up the initial carriage return sent to lisp.
;;;
;;;Revision 1.2  83/10/12  12:01:10  susan
;;;repaired damaget to call to "adai" to send the correct number of
;;;streams
;;;
;;;Revision 1.1  83/10/09  11:06:22  susan
;;;Initial revision
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;;                          SCREENS                                 ;;;
;;; Susan Rosenbaum                               August, 1983       ;;;
;;;                                                                  ;;;
;;; Functions for handling the debugger portion of the user interface;;;
;;;                                                                  ;;;
;;; This file is part of a proprietary software project.  Source     ;;;
;;; code and documentation describing implementation details are     ;;;
;;; available on a confidential, non-disclosure basis only.  These   ;;;
;;; materials, including this file in particular, are trade secrets  ;;;
;;; of Computer * Thought Corporation.                               ;;;
;;;                                                                  ;;;
;;; (c) Copyright 1982 and 1983,  Computer * Thought Corporation.    ;;;
;;;     All Rights Reserved.                                         ;;;
;;;                                                                  ;;;
;;; Reference materials:                                             ;;;
;;;   Foderaro and Sklower, The FRANZ LISP Manual, September 1981.   ;;;
;;;   Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981.   ;;;
;;;   Charniak et al., 1980.  Artificial Intelligence Programming.   ;;;
;;;   Miller, 1982.  The C*T Ada Tutor: Guide to the Implementation. ;;;
;;;                                                                  ;;;
;;;   The following code assumes familiarity with these materials.   ;;;
;;;                                                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ensure presence of needed files. 

(comment Assumes ct_load and some suitable file_map are present)

(eval-when (compile load eval) (ct_load 'aip))	   ;AIP macros pkg. 

(eval-when (compile load eval) (ct_load 'compat))  ;Franz/LM compat pkg.

(eval-when (compile load eval) (ct_load 'ctflav))  ;flavors

(eval-when (compile load eval) (ct_load 'scroll))   ;scrolling windows


(eval-when (compile load eval) (ct_load 'ctstrl))    ;;Bill' string package

(eval-when (compile load eval) (ct_load 'windowfnc)) ;;window functions

(eval-when (compile load eval) (ct_load 'debugcmds))  ;;debugcmds

(eval-when (compile load eval) (ct_load 'dbutils))	;;debugger utils.


#+franz
(eval-when (compile load eval) (ct_load 'format))  ; Print formating

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiler Declarations and Global Variables -- 

#+franz (declare (macros t))
#+franz (setq *flavor-expand-macros* t)

;declare the functions that are only called in this file
#+franz
(declare (localf db%parse_options
	         db%filename_prefix
	         db%initial_screen
	         db%secondary_screen
		 db%front_end_debugger_execution
		 db%front_end_testing_execution
		 db%initial_testing_screen
		 db%choose_exercise
		 db%find_exercise))



;;;;;;;;;;;;;;;;;;;;;;;;
;;;The windows for the debugger screen
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;top window in debugger screen
(defvar  *db%code_window* nil)	       ;;an instance of debug window
(defvar  *db%code_window_curses* nil)  ;;the code window's curses window
(defvar  *db%user_window* nil)	       ;;an instance of debug window
(defvar  *db%user_window_curses* nil)  ;;the user window's curses window
(defvar  *db%output_window* nil)       ;;an instance of debug window
(defvar  *db%output_window_curses* nil);;the output window's curses window
(defvar  *db%top_mode_line*    nil)    ;;a curses window
(defvar  *db%bottom_mode_line*  nil)   ;;a curses window
(defvar  *db%large_debug_menu*  nil)    ;;a debug window used for menu choices
(defvar  *db%large_debug_menu_curses* nil)   ;;the large_debug_menu curses window
(defvar  *db%large_debug_menu_mode_line* nil)  ;;the mode line for large debug menu
(defvar  *db%small_debug_menu* nil)    ;;a debug window used for small menu choices
(defvar  *db%small_debug_menu_curses* nil)  ;;the small debug menu curses window
(defvar  *db%small_debug_menu_mode_line* nil)  ;;the mode line for small menu
(defvar  *db%debug_menu*  nil)			;used to contain current debug menu
(defvar  *db%debug_menu_mode_line*  nil)        ;used to contain current mode line
;;;;;;;;;;;;;;;
;;;The window currently handling user I/O
(defvar  *db%current_window* nil)


;;the count (mod 3) of which of the three debugger windows
;;is the current one..used when the command next and or 
;;previous window is given
(defvar *db%window_count* 0)

;;;db%window_list contains the list of debug windows to be
;;;used with the functions 'next_window, 'previous_window
(defvar *db%window_list*  nil)

;;;db%current_file contains the name of the file in the code window
(defvar *db%current_file* nil)

;;;the initial (default) configuration for the debugger screen
;;;the first entry is the window name, the second is the number of lines
;;;for the window, the third is the number of columns for the window,
;;;the fourth is the starting y position, the fifth is the
;;;starting x position, and the sixth is the name of the scrolling window
;;;associated with it    
(defvar *initial_debug_windows*
    '((*db%code_window*      12 80 0 0 *db%code_window_curses*)
     (*db%user_window*       5 80 13 0 *db%user_window_curses*)))

(defvar *initial_testing_windows*
    '((*db%code_window*      11 80 0 0 *db%code_window_curses*)
     (*db%user_window*       11 80 12 0 *db%user_window_curses*)))

(defvar *initial_debug_output_window*
    '((*db%output_window*     5 80 19 0 *db%output_window_curses*)))

(defvar *initial_testing_output_window*
    '((*db%output_window*     0 80 23 0 *db%output_window_curses*)))



;;;contains the current name/coordinate configuration for
;;;the debug windows    
(defvar *current_debug_windows_config* nil)

;;;the initial (default) configuration for the mode windows
;;;the first entry is the window name, the second is the number of lines
;;;for the window, the third is the number of columns for the window,
;;;the fourth is the starting y position and the fifth is the
;;;starting x position
(defvar *initial_debug_mode_windows*
     '((*db%top_mode_line*     1 80 12 0)
       (*db%bottom_mode_line*  1 80 18 0)))

(defvar *initial_testing_mode_windows*
     '((*db%top_mode_line*     1 80 11 0)
       (*db%bottom_mode_line*  1 80 23 0)))



;;*db%menu_command_list* is an assoc list of user commands and their
;;corresponding functions and print values that can be used on menus,
;;single_screens, windows (under testing or the debugger), or
;;with the debugger itself
(defvar *db%menu_command_list*
	'(((n p) (db%next_page) "Next Page")
	  ((p p) (db%previous_page) "Previous Page")
	  ((f p) (db%first_page) "First Page")
	  ((l p) (db%last_page) "Last Page")
	  ((r w) (db%screen_refresh) "Refresh Windows")
	  ((^ &) (db%secret_out) "Secret Out")))

;;*db%single_screend_command_list* is an assoc list of user commands
;;and their corresponding functions and print values that can be
;;used on single-screens, windows, or with the debugger itself
(defvar *db%single_screen_command_list*
    '(((f s) (db%find_string) "Find String")
      ((q s) (db%quit) "Quit Session")
      ((h m) (db%help_me) "Help Me")))


;;*db%window_command_list* is an assoc list of user commands
;;and their corresponding functions and print values that can be
;;used on windows or with the debugger itself
(defvar *db%window_command_list*
    '(((e w) (db%expand_window) "Expand Window")
     ((d w) (db%default_windows) "Default Windows")
     ((c w) (db%configure_windows) "Configure Windows")
     ((n w) (db%next_window) "Next Window")
     ((p w) (db%previous_window) "Previous Window")
     ((c f) (db%choose_file) "Choose File")))



;;*db%debugger_command_list* is an assoc list of user commands
;;that can be used with the debugger
(defvar *db%debugger_command_list*
    '(((m p) (db%set_code_monitor) "Monitor Program")
     ((m v) (db%set_data_monitor) "Monitor Value")
     ((r m) (db%remove_monitor) "Remove Monitor")
     ((d o) (db%inspect) "Describe Object")
     ((b p) (db%start) "Begin Program")
     ((c p) (db%resume) "Continue Program")
     ((d s) (db%debugger_state) "Debugger State")
     ((t a) (db%top_of_stack) "Top of Activation Records")
     ((b a) (db%bottom_of_stack) "Bottom of Activation Records")
     ((u a) (db%up_stack) "Up Activation Record")
     ((d a) (db%down_stack) "Down Activation Record")
     ((s a) (db%show_stack) "Show Activation Record")
     ((d t) (db%display_tag) "Display Tag")))


;;;Globals for user input
(defvar *db%source_files*  nil)
(defvar *db%input_library* nil)
(defvar *db%object_input_file* nil)
(defvar *db%object_output_file* nil)
(defvar *db%listing_file* nil)



;;;a list of the windows that are currently exposed.  
(defvar *current_exposed_window_list* nil)

;;special to have the string "Command" 
(defvar *db%command_string* "Command:  ")

;;a special to use when directing any output into never-never land
(declare (special *bit_bucket*))

;;;#+(and (not vms) unix) (setq *bit_bucket* (fileopen "/dev/null" "w"))
;;;;#+vms (setq *bit_bucket* (fileopen "NL:" "w"))
#+lispm (setq *bit_bucket*   'si:null-stream)
#+unix (setq *bit_bucket* *db%output_window*)


(declare (special *db%testing_p*
		  *db%exercise_p*
		  *db%check_only_p*
		  *db%part_debugger_p*
		  *db%execute_p*
		  *db%kill_char*
		  *db%front_end_output*
		  *fetch_hook*
		  *db%current_exercise*
		  *db%debugger_p*
		  *db%echop*
		  *db%doing_command*
		  *db%lines*
	      	  *db%cols*
	          **dt_backend_call**
		  *db%current_line*
		  *db%current_col*
		  *db%hidden_files*
		  **exer_ta_info**
		  *db%temp_output_file*
		  *db%batch_mode*
		  ptport))
(setq *db%debugger_p* nil)

;;Make this work at run time so we don't have to worry about compiling this file
;;specially for vms.
;; *db%temp_dir* used for the directory if temp files are needed
(defconst *db%temp_dir*
          (cond ((and (status feature unix) (status nofeature vms))
		 (ct_string_append #// "tmp" #// )
		)
		((and (status feature unix) (status feature vms))
		  "SYS$CTADATMP:"
		)
	  )
)

;; *db%temp_dir* used for the directory if temp files are needed
;(defconst *db%temp_dir*
;	  #+(and unix (not vms))(ct_string_append #// "tmp" #// )
;	  #+vms "SYS$CTADATMP:")


	  
    


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INTERNAL/EXTERNAL FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


       ;;;;;;;;;;;;
(defun db%vms_inter ()
       ;;;;;;;;;;;;
  #|The top-level function for running the interpreter/debugger
    It sets up the control-c function so that we can catch it,
    initializes curses, and then determines whether we need
    to go through the interactive session or grab user-supplied
    options from the command stream that started the session.  |#
    (db%init_control_c)
    (initscr)
    (crmode)					;put in cbreak mode
    (noecho)
    (clear)
    (refresh)
    ;;if getting into this through a lisp function call, get rid of the
    ;;initial carriage-return character in the input buffer
#+franz   (ct_if (tyipeek) (tyi))
    ;;make all of the curses windows needed now
    (setq *db%output_window_curses* (newwin (1- *db%lines*) *db%cols* 0 0))
    (set-iv db%debug_window *db%output_window* curses-window *db%output_window_curses*)
    (set-iv db%debug_window *db%output_window* lines-displayed
	    (1- *db%lines*))
    ;;make sure that the next windows don't have curses windows
    (set-iv db%debug_window *db%user_window* curses-window nil)
    (set-iv db%debug_window *db%code_window* curses-window nil)
    ;;make *db%debug_menus* but don't touch it for exposure
    (setq *db%large_debug_menu_curses* (newwin 10 *db%cols* 0 0))
    (setq *db%large_debug_menu_mode_line* (newwin 1 *db%cols* 10 0))
    (set-iv db%debug_window *db%large_debug_menu* curses-window *db%large_debug_menu_curses*)
    (setq *db%small_debug_menu_mode_line*  (newwin 1 *db%cols* 5 0))
    (setq *db%small_debug_menu_curses* (newwin 5 *db%cols* 0 0))
    (set-iv db%debug_window *db%small_debug_menu* curses-window *db%small_debug_menu_curses*)
    (setq *db%doing_command* nil)
    (setq *db%batch_mode* (db_get_mode))  ;;see if running interactive
                                       ;;(returns 1), or batch
				       ;;(returns 0)
      ;;;begin by clearing everybody out
      (setq *db%exercise_p* nil)
      (setq *db%testing_p* nil)
      (setq *db%check_only_p* nil)
      (setq *db%part_debugger_p* nil)
      (setq *db%source_files* nil)
      (setq *db%debugger_p* nil)
      (setq *db%execute_p* nil)
      (setq *db%object_input_file* nil)
      (setq *db%object_output_file* nil)
      (setq *db%input_library* nil)
      (setq *db%temp_output_file* nil)
      (setq *db%current_exercise* nil)
      (setq *db%front_end_output* nil)
      (setq *db%current_exercise* nil)
      (setq *db%kill_char* nil)
      (*catch 'db%quit_system
	      (ct_if (not (> (argv -1) 1))
		     (db%initial_screen)  ;;;do interactive session
		     (db%parse_options)))	;parse the user-supplied options
      (nocrmode)				;back to VMS/UNIX
      (echo)
      (endwin)
      ;;if a temporary output file, get rid of it!
      (ct_if *db%temp_output_file* (syscall 10 *db%temp_output_file*))
      (exit))			;end curses


       ;;;;;;;;;;;;;;;;
(defun db%parse_options ()
       ;;;;;;;;;;;;;;;;
  #|db%parse_options parses the options input by the user to DCL
    and initializes all of the various specials |#
    (let ((tempfiles nil)
	  (tempdebug nil)
	  (nextarg 2)
	  (numargs (1- (argv -1)))		;the number of arguments to DCL
	  (pos 0))
      (setq tempfiles (ct_string (argv 1)))	;get the input file(s)
      (setq pos (ct_string_search_char    #// tempfiles))	;find the first switch
      ;;if there are switches, separate them from the filename(s)
      ;;by putting the file name(s) in tempfiles and the rest of the info into
      ;;tempdebug
      (ct_if pos (progn
		   (setq tempdebug (ct_substring tempfiles pos))	
		   (setq tempfiles (ct_substring tempfiles
						 0 pos)))
	     (setq tempdebug tempfiles))
      ;;get all of the source files into the special *db%source_files*
      ;;by keying off of the '+' that separates each name
      (loop until (not (ct_string_search_char #/+ tempfiles ))
	    with pluspos
	    finally
	    (ct_if (not (equal tempfiles ""))
		   (setq *db%source_files*
			 (append *db%source_files*
					   (list  tempfiles ))))
	    do (setq pluspos (ct_string_search_char #/+ tempfiles))
	    do (setq *db%source_files*
		     (append *db%source_files*
			     (list (ct_substring tempfiles 0 pluspos))))
	    do (setq tempfiles (ct_substring tempfiles (1+ pluspos))))
      ;;get all of the switches into the local 'tempdebug
      (loop  for i from nextarg to numargs
	     for arg =  (argv i)
	     do (setq tempdebug (concat tempdebug arg)))
      ;;loop through the switches, picking off each option and its
      ;;option_value (if it exists) and then settting up the 
      ;;appropriate global information that the switch implies
      (loop until (not (ct_string_search_char #// tempdebug))
	    for start_slashpos = (ct_string_search_char #// tempdebug )
	    for end_slashpos = (ct_string_search_char
				 #// tempdebug (1+ start_slashpos))
	    for option = (ct_if end_slashpos
				(ct_substring tempdebug (1+ start_slashpos)
					      end_slashpos)
				(ct_substring tempdebug (1+ start_slashpos)))
	    for option_value = nil
	    with equalpos = nil
	    do (ct_if end_slashpos (setq tempdebug (ct_substring
						     tempdebug end_slashpos))
		      (setq tempdebug ""))
	    do (ct_if (ct_string_search_char #/= option)
		      (progn
			(setq equalpos (ct_string_search_char #/= option))
			(setq option_value (ct_substring option
							 (1+ equalpos)))
			(setq option (ct_substring option 0 equalpos))
			))
	    do
	    ;;on the basis of the current option, set up its
	    ;;values
	    (cond ((equal option "debug")
		   (ct_if option_value
			  (cond ((equal option_value "error")
				 (setq
				   *db%part_debugger_p*
				   t))
				((equal option_value "always")
				 (setq *db%debugger_p*
				       t))
				((equal option_value "never")
				 (setq *db%debugger_p* nil)
				 (setq *db%part_debugger_p* nil))
				(t
				   (db%dcl_error "Invalid Debug Option")))
			  ;;*db%part_debugger_p* is the default if no
			  ;;option values was given
			  (setq *db%part_debugger_p* t)))
		  ((equal option "library")
		   (ct_if option_value
			  (setq *db%object_input_file*
				(list option_value))))
;;;;;;remove commenting when doing a testing dump
;;		     ((equal option "exercise")
;;		      (setq *db%exercise_p* t)
;;		      (ct_if option_value
;;			     (progn
;;			       (setq *db%current_exercise*
;;				     (db%find_exercise option_value))
;;			       (ct_if (not *db%current_exercise*)
;;				      (db%dcl_error "Invalid Exercise")))))
		  ((equal option "list")
		   (ct_if option_value
			  (setq *db%listing_file*
				option_value)
			  ;;if "list" option was given with no file name
			  ;;make this file name be the name of the first
			  ;;source file input postfixed by 'lis
			  (setq *db%listing_file*
				(ct_string_append
				  (db%filename_prefix
				    (car *db%source_files*))
				  "lis"))))
		  ((equal option "mode")
		   (ct_if option_value
			  (cond ((equal option_value "check")
				 (setq
				   *db%check_only_p*
				   t))
				((equal option_value "execute")
				 (setq
				   *db%execute_p* t))
;;;remove commenting when doing a testing dump
				;;   ("test"
				;;    (setq *db%testing_p* t))
				(t
				 (db%dcl_error
				   "ERROR: Invalid mode option")))))
		  ((equal option "object")
		   (ct_if option_value
			  (setq *db%object_output_file*
				option_value)
			  (setq *db%object_output_file*
				(ct_string_append
				  (db%filename_prefix
				    (car *db%source_files*))
				  "int"))))
		  (t
		   (db%dcl_error "ERROR: Invalid Option"))))
         ;;see if doing something illegal in batch mode
         (cond ((and (zerop *db%batch_mode*)
		     (or
			*db%debugger_p*
			*db%part_debugger_p*))
		   (ct_print
		      "ERROR: Only option for batch mode is check or execute"
		      ptport)
		   (exit))
	       ((and (zerop *db%batch_mode*)
		     (or *db%exercise_p*
			 *db%testing_p*)
		     (not *db%current_exercise*))
		(ct_print
 "ERROR: Must specify an exercise number for exercise in batch mode."
                   ptport)
		(exit)))
	 
	 (ct_if (and *db%testing_p*
			 (or *db%check_only_p* *db%debugger_p*
			     *db%part_debugger_p* *db%object_input_file*
			     *db%object_output_file*))
	       (db%dcl_error "ERROR: Invalid options with TESTING"))
	 (ct_if (and *db%check_only_p*
			 (or *db%debugger_p* *db%part_debugger_p*
			     *db%execute_p*))
		(db%dcl_error "ERROR:  Invalid options with CHECK-ONLY"))
	 (ct_if (and *db%exercise_p*
			  *db%object_input_file*)
		(db%dcl_error "ERROR: Invalid to input an internal file with EXERCISE"))
	 (ct_if (and *db%exercise_p*
			  *db%object_output_file*)
		(db%dcl_error "ERROR: Invalid to output an internal file with EXERCISE"))
	 (ct_if *db%object_input_file*
		(ct_if (not (probef (first *db%object_input_file*)))
		       (db%dcl_error "ERROR: Non-Existent Input Library")))
	 (loop for file in *db%source_files*
	       if (not (probef file))
	         do (db%dcl_error
		       (ct_format nil "ERROR: Invalid File Name: ~A"
				  file))))
      (cond
	(*db%testing_p* (db%front_end_testing_execution))
	(t (db%front_end_debugger_execution))))



       ;;;;;;;;;;;;;;;;;;
(defun db%filename_prefix (filename)
       ;;;;;;;;;;;;;;;;;;
  #| Returns the prefix of 'filename ---up to the period
       |#
  (let ((barpos (ct_string_search_char #/] filename))
	(equalpos 0))
    (ct_if barpos
	   (setq equalpos (ct_string_search_char #/. filename barpos))
	   (setq equalpos (ct_string_search_char #/. filename)))
    (ct_substring filename 0 (1+ equalpos))))


       ;;;;;;;;;;;;
(defun db%dcl_error (string)
       ;;;;;;;;;;;;
  #| Used when there is an user error in the input on the
     command line--prints 'string, the error and throws
     the user back into VMS/UNIX   |#
  (ct_princ string)
  (terpri)
    (*throw 'db%quit_system nil))


       ;;;;;;;;;;;;;;;;;;;;;;;
(defun db%initial_make_windows ()
       ;;;;;;;;;;;;;;;;;;;;;;;
  ;;make all of the debug windows before dumping
  ;;The *db%output_window* will be the only one actually allocated
  ;;any lines, since it will be the only one showing when the system
  ;;begins talking to the interpreter.
  ;;None of the curses windows are made now, since this seems
  ;;to be a real lose
  (setq *db%output_window*  (make-instance 'db%debug_window
					   'lines-displayed
					   (1- *db%lines*)
					   'max_xpos
					   (1- *db%cols*)
					   'max_ypos
					   (- *db%lines* 2)
					   'current_xpos
					   0
					   'current_ypos
					   0))
  (loop for (window lines cols start_y start_x curses_win)
	in *initial_debug_windows*
	do (set window (make-instance 'db%debug_window
				      'write_only
				      t
				      'lines-displayed
				      0
				      'max_xpos
				      0
				      'max_ypos
				      0)))
  (setq *db%large_debug_menu* (make-instance 'db%debug_window
					     'lines-displayed
					     10
					     'max_xpos
					     (1- *db%cols*)
					     'max_ypos
					     9))
  (setq *db%small_debug_menu* (make-instance 'db%debug_window
					     'lines-displayed
					     5
					     'max_xpos
					     (1- *db%cols*)
					     'max_ypos
					     4)))
    
	 

       ;;;;;;;;;;;;;;;;;
(defun db%initial_screen  ()
       ;;;;;;;;;;;;;;;;;
  #| Sets up the inital screen for the system and calls the
     appropriate function based on the user's choice when the
     user hasn't input any switches at the top level.--this
     handles the first screen of the interactive session. |#
    (let* ((init_win  (newwin *db%lines*  *db%cols*  0  0))
	   (choice1  " 1:  CHECK ")
	   (choice2  " 2:  EXECUTE ")
	   (choice3  " 3:  EXECUTE/DEBUG ")
;;;*******remove commenting when dumping testing*******
;;	   (choice4  " 4:  EXERCISE ")
;;	   (choice5  " 5:  TESTING ")
	   (strformat nil)
	   (option_string nil)
	   (option_numbers nil)
	   (option 0))
      (setq *current_exposed_window_list* (list init_win))
      (wrefresh init_win)			;output the intial window
      (wstandout init_win)
      (setq strformat (db%center_strings choice1 choice2 choice3))
;;;*******remove commenting when dumping testing******
      ;;(setq strformat (db%center_strings choice1 choice2 choice3
      ;;choice4 choice5))	;format strings
      (loop for (position string) in strformat
	    do (progn
		 (wmove init_win 4 position)
		 (wstandout init_win)
		 (waddstr init_win string)
		 (wstandend init_win)))
      (wrefresh init_win)
      (wstandend init_win)
      ;;*db%current_line* and *db%current_col* is used for positioning
      ;;during user prompting
      (setq *db%current_line* 10)
      (setq *db%current_col* 0)
      (setq *db%echop* t)
      ;;get the options desired by the user
      (setq option_numbers
	    (loop while t
		  with input_numbers
		  do (wmove init_win *db%current_line*  *db%current_col*)
		  do (waddstr init_win "  ENTER OPTION:  ")	;get user's choice
		  do (wrefresh init_win)
		  do (setq option_string (db%wgetnumberstring init_win))
		  if (not (equal option_string ""))
		  do
		  (progn
		    ;;get a list of the numbers input by the user
		    (setq input_numbers
			  (db%get_numbers_from_string option_string
						   (string-length
						     option_string)))
;;;*******
;;;;change to '5' when dumping testing
		    (ct_if (not (db%legal_input_numbers input_numbers 3)) ;;5 with test
			   (progn
			     (wmove init_win (+ 4 *db%current_line*) 0)
			     (waddstr init_win "ILLEGAL CHOICE")
			     (beep)
			     (drain))
			   (cond
			     ;;testing must stand alone
			     ((and
				(memq 5 input_numbers)
				(or
				  (memq 1 input_numbers)
				  (memq 2 input_numbers)
				  (memq 3 input_numbers)))
			      (beep)
			      (drain)
			      (wmove init_win (+ 4 *db%current_line*) 0)
			      (waddstr init_win
				       "TEST OPTION EXECUTES ALONE"))
			     ;;check-only option cannot run with anything else
			     ((and
				(memq 1 input_numbers)
				(or
				  (memq 2 input_numbers)
				  (memq 3 input_numbers)))
			      (beep)
			      (drain)
			      (wmove init_win (+ 4 *db%current_line*) 0)
			      (waddstr init_win
				       "CHECK OPTION HAS NO EXECUTION"))
			     ;;cannot choose both execute and execute/debug
			     ((and
				(memq 2 input_numbers)
				(memq 3 input_numbers))
			      (beep)
			      (drain)
			      (wmove init_win (+ 4 *db%current_line*) 0)
			      (waddstr init_win
				       "CHOOSE EXECUTE OPTION WITH or WITHOUT DEBUG"))
			     (t
			      (ct_if (memq 4 input_numbers)
				     (setq *db%exercise_p* t))
			      (ct_if (memq 1 input_numbers)
				     (setq *db%check_only_p* t))
			      (ct_if (memq 5 input_numbers)
				     (setq *db%testing_p* t))
			      (ct_if (memq 3 input_numbers)
				     (setq *db%debugger_p* t))
			      (return t)))))
		  else do (progn
			    (beep)
			    (drain)
			    (wmove init_win (+ 4 *db%current_line*) 0)
			    (waddstr init_win "MUST SELECT AN OPTION"))
		  )))
    	       (db%secondary_screen))



       ;;;;;;;;;;;;;;;;;;;
(defun db%secondary_screen ()
       ;;;;;;;;;;;;;;;;;;;
  #| Handles the input of file and library names from
     the user before calling the interpreter   |#
    (let*  ((interp_win  (newwin *db%lines*  *db%cols*  0  0)))
          (clear)
	  (refresh)
	  (setq *current_exposed_window_list* (list interp_win))	;set-up new
	  (touchwin interp_win)			                        ;window
	  (wclear interp_win)
	  (wrefresh interp_win)
	  (setq  *db%current_line* 0)
	  (setq  *db%current_col* 0)
	  (wmove interp_win *db%current_line*  *db%current_col*)
	  ;;initialize all of the file possibilities to nil
	  (setq *db%source_files* nil)
	  (setq *db%input_library* nil)
	  (setq *db%object_output_file* nil)
	  (setq *db%object_input_file* nil)
	  (setq *db%listing_file* nil)
	  ;;get the source file(s)
	  (setq *db%source_files*
		(db%get_files interp_win  "  Source Files:  "
			      t))	;source files
	  ;;if not under testing or an exercise, can input an optional
	  ;;input library
	  (ct_if (not (or *db%exercise_p*
			  *db%testing_p*))
		 (setq *db%object_input_file*
		       (db%get_file  interp_win  "  Library File:  "
				    t)))   ;input libs.
	  (ct_if *db%object_input_file* (setq *db%object_input_file*	
					      (list *db%object_input_file*)))
	  ;;if not under testing or an exercise, can output the diana
	  ;;object
	  (ct_if (not (or *db%testing_p* *db%exercise_p*))
		 (setq *db%object_output_file*
		       (db%get_file  interp_win  "  Internal File:  "
				    nil)))	;diana object
	  ;;get the optional listing file--if this is nil, output will
	  ;;default to going to the screen
	  (setq *db%listing_file*
		  (db%get_file  interp_win  "  Listing File:  "
			       nil))	;listing
	  (setq *db%current_col* 0)
	  (db%new_lines interp_win 1)
	  (wmove interp_win *db%current_line* *db%current_col*)
	  (delwin interp_win))			;get rid of the window
	  (cond
	    (*db%testing_p* (db%front_end_testing_execution))
	    (t (db%front_end_debugger_execution))))


	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	  	
(defun  db%front_end_debugger_execution ()
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;Runs the front end of the intepreter and then
  ;;jumps to the correct place
  (let ((env_code nil))
  (clear)
  (refresh)
  (setq *db%echop* nil)
  (noecho)
  (setq *db%bottom_mode_line* (newwin 1 80 23 0))
  #|  change to running the front-end without windows
  ;;emphasize to curses that this window is in standard video
  (wstandend (get-iv db%debug_window *db%output_window* curses-window))
  (ct_csend db%debug_window *db%output_window* :clear)
  (setq *db%bottom_mode_line* (newwin 1 80 23 0))
  (setq *current_exposed_window_list* (list *db%output_window*
					    *db%bottom_mode_line*))
  (setq *db%current_window* *db%output_window*)
  (db%change_mode_line *db%bottom_mode_line* "Executing:  Running the Interpreter ")
  (ct_csend db%debug_window *db%current_window*  :reposition_cursor)
  |#
  ;;if running EXERCISE, make sure *db%current_exercise* is
  ;;set-up.
  (ct_if  *db%exercise_p*
	 (progn
	    (ct_if (not *db%current_exercise*)
		   (setq *db%current_exercise* (db%choose_exercise)))
	    (setq env_code (exer_ta_get *db%current_exercise* 'env_code))
	    (ct_if env_code
		   (progn
		      (setq *db%input_library* (list (ct_load_get env_code)))
		      (setq *db%hidden_files*
			    (append *db%hidden_files*
				    `(,(car *db%input_library*))))))))
  ;;run the front end with 'adai, saving the value returned from
  ;;the function in *db%front_end_output*.  If running in
  ;;batch mode, send output to terminal_output and input from
  ;;terminal_input
    (cond ((zerop *db%batch_mode*) 	;;see if in batch mode
	   (setq *db%front_end_output* (adai *db%object_input_file*
					     *db%input_library*
					     *db%source_files*
					     (terminal_output)
					     (terminal_input)
					     (terminal_output)
					     (terminal_input)
					     (terminal_output))))
	  (*db%listing_file*
	     (with_open_outfile (output_file *db%listing_file*)
				(setq *db%front_end_output*
				      (adai
					 *db%object_input_file*
					 *db%input_library*
					 *db%source_files*
					 output_file
					 *db%output_window*
					 *db%output_window*
					 *db%output_window*
					 *db%output_window*
							  ))))
	  (t
	     (let
		((file_name (ct_string_append *db%temp_dir* (gensym)
					      ".tmp")))
		(setq ptport (outfile file_name))
		(setq *db%temp_output_file* file_name)
		;;run the interpreter without windows
		(setq *db%front_end_output* (adai *db%object_input_file*
						  *db%input_library*
						  *db%source_files*
						  (terminal_output)
						  *db%output_window*
						  *db%output_window*
						  *db%output_window*
						  *db%output_window*))
		(drain poport)
		(drain ptport)
		(close ptport)	       ;;close that sucker
		(setq ptport nil))))
  ;;see if the user wanted to save the diana output
  (ct_if (and *db%object_output_file*
	      (car *db%front_end_output*))
	 (save_tree *db%object_output_file*))
  ;;if there was a good diana tree formed, go on to user request
  (clear)
  (ct_if (car *db%front_end_output*)
	 (cond (*db%debugger_p*
		(setq *db%front_end_output* (cons 't *db%front_end_output*))
		(apply 'db%debugger *db%front_end_output*)
		(*throw 'db%quit_system nil))
	       (*db%part_debugger_p*
		;;display the output under the windows now
		(wstandend (get-iv db%debug_window *db%output_window* curses-window))
		(ct_csend db%debug_window *db%output_window* :clear)
		(setq *current_exposed_window_list* (list *db%output_window*
							  *db%bottom_mode_line*))
		(setq *db%current_window* *db%output_window*)
		(db%change_mode_line *db%bottom_mode_line*
				     "Executing:  Running the Interpreter ")
		(ct_if (probef *db%temp_output_file*)
		       (ct_csend db%debug_window *db%output_window* :display-file
				 *db%temp_output_file* nil nil nil nil)
		       (ct_csend db%debug_window *db%output_window* :display-string
				 ""))
		(ct_csend db%debug_window *db%output_window* :end)
		(setq *db%front_end_output* (cons 'nil *db%front_end_output*))
		(apply 'db%debugger *db%front_end_output*)
		(*throw 'db%quit_system nil))
	       ;;if running in batch, do the right thing and then end
	       ((zerop *db%batch_mode*)
		;;if not running just the check option, run the backend
		(ct_if (not *db%check_only_p*)
		       (apply 'run_diana_int *db%front_end_output*))
		(exit))
	       ((not *db%check_only_p*)
		(wstandend
		   (get-iv db%debug_window *db%output_window* curses-window))
		(ct_csend db%debug_window *db%output_window* :clear)
		(setq *current_exposed_window_list* (list *db%output_window*
							  *db%bottom_mode_line*))
		(setq *db%current_window* *db%output_window*)
		(db%change_mode_line *db%bottom_mode_line*
				     "Executing:  Running the Interpreter ")
		(ct_if (probef *db%temp_output_file*)
		       (ct_csend db%debug_window *db%output_window* :display-file
				 *db%temp_output_file* nil nil nil nil nil)
		       (ct_csend db%debug_window *db%output_window* :display-string
				 ""))	
		(ct_csend db%debug_window *db%output_window* :end)
		(apply 'run_diana_int *db%front_end_output*))
	       (t nil)))
	 ;;if bad tree, don't change window configurations
  ;;emphasize to curses that this window is in standard video
  (wstandend (get-iv db%debug_window *db%output_window* curses-window))
  (ct_csend db%debug_window *db%output_window* :clear)
  (setq *current_exposed_window_list* (list *db%output_window*
					    *db%bottom_mode_line*))
  (setq *db%current_window* *db%output_window*)
  (db%change_mode_line *db%bottom_mode_line* *db%command_string*)
  ;;display the output under the windows now
  (ct_if (probef *db%temp_output_file*)
	 (ct_csend db%debug_window *db%output_window* :display-file
		   *db%temp_output_file* nil nil nil nil)
	 (ct_csend db%debug_window *db%output_window* :display-string
		   ""))
  (ct_csend db%debug_window *db%output_window* :end)
  ;;get the user's commands for the window
  (db%wgetwindow_choices *db%bottom_mode_line* *db%command_string*)))


	;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun  db%initial_debugger_screen ()
	;;;;;;;;;;;;;;;;;;;;;;;;;;
  #| Make the debugger screen with three windows and two mode lines.
     Each of the windows will be an instance of db%debug_window.
     The windows have already been formed, but need to have their
     underlying curses windows set up correctly.   |#
	  (clear)			       ;;clear the screen
	  (refresh)
	  ;;get rid of the one-liner at the bottom of the screen
	  (delwin *db%bottom_mode_line*)
	  (setq *db%window_list* nil)
	  (setq *current_exposed_window_list* nil)
	  (setq *current_debug_windows_config*
		(append *initial_debug_windows* *initial_debug_output_window*))
	  (loop for (window lines cols start_y start_x curses_win)
		in *initial_debug_windows*
		do (set curses_win  (newwin lines cols start_y start_x))
		  do (set-iv db%debug_window (eval window)
			      curses-window (eval curses_win))
		  do (set-iv db%debug_window (eval window)
			      max_ypos (1- lines))
		  do (set-iv db%debug_window (eval window)
			      max_xpos (1- cols))
		  do (set-iv db%debug_window (eval window)
			      current_xpos 0)
		  do (set-iv db%debug_window (eval window)
			      current_ypos 0)
		  do (ct_csend db%debug_window (eval window)	
			      :set-lines lines)
		  do (setq *current_debug_windows_config*
			   (append *current_debug_windows_config*
				 (list (list  window lines cols
				       start_y start_x curses_win))))
		  do (setq *current_exposed_window_list*
			   (append (list (eval window))
				   *current_exposed_window_list*))
		  do (setq *db%window_list* (append
					      *db%window_list* (list (eval
								       window)))))
	  (loop for (window lines cols start_y start_x) in *initial_debug_mode_windows*
		do (set window
			(newwin  lines  cols  start_y  start_x))
		do (setq *current_exposed_window_list*
			 (append (list (eval window)) *current_exposed_window_list*)))
	  (loop for (window lines cols start_y start_x curses_win)
		in *initial_debug_output_window*
		do (set curses_win (newwin lines cols start_y start_x))
		do (set-iv db%debug_window (eval window) curses-window
			   (eval curses_win))
		do (set-iv db%debug_window (eval window) lines-displayed lines)
		do (set-iv db%debug_window (eval window) max_ypos (1- lines))
		do (ct_csend db%debug_window (eval window) :end)
		do (setq *current_exposed_window_list*
			 (append (list (eval window))
				 *current_exposed_window_list*))
		do (setq *db%window_list* (append
					    *db%window_list* (list (eval
								     window)))))
	  (db%change_mode_line  *db%bottom_mode_line* "Initializing Debugger")
	  (db%change_mode_line  *db%top_mode_line* "File Name: ")
	  ;;;set up current window to be a debug window,
	  ;;;not just one of the raw curses windows
	  (setq *db%current_file* (first *db%source_files*))
	  (wstandend (get-iv db%debug_window *db%code_window* curses-window))
	  (wstandend (get-iv db%debug_window *db%user_window* curses-window))
	  (wstandend (get-iv db%debug_window *db%output_window* curses-window))
	  (ct_if (probef *db%current_file*)
		 (ct_csend db%debug_window  *db%code_window* :display-file  
			   *db%current_file*)
		 (ct_csend db%debug_window  *db%code_window* :display-string ""))
	  (db%change_file_name *db%current_file*)
	  (ct_if (probef *db%temp_output_file*)
		 (ct_csend db%debug_window *db%output_window* :display-file
			   *db%temp_output_file* nil nil nil nil nil)
		 (ct_csend db%debug_window *db%output_window* :display-string ""))
	  (ct_csend db%debug_window *db%output_window* :end)
	  (setq *db%current_window* *db%code_window*)
	  (setq *db%window_count* 0)
	  (ct_csend db%debug_window   *db%current_window* :reposition_cursor)
	  (refresh))


	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	  	
(defun  db%front_end_testing_execution ()
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;called when TESTING has been chosen.  *db%output_window* will
  ;;be used for the initial output.
  (let ((env_code nil))
  (clear)
  (refresh)
  (setq *db%echop* nil)
  (noecho)
  (setq *db%bottom_mode_line* (newwin 1 80 23 0))
  ;;emphasize to curses that this window is in standard video
  #|  Change to running the front-end without windows
  (wstandend (get-iv db%debug_window *db%output_window* curses-window))
  (ct_csend db%debug_window *db%output_window* :clear)
  (setq *db%bottom_mode_line* (newwin 1 80 23 0))
  (setq *current_exposed_window_list* (list *db%output_window*
					    *db%bottom_mode_line*))
  (setq *db%current_window* *db%output_window*)
  (db%change_mode_line *db%bottom_mode_line* "Executing:  Running the Interpreter ")
  (setq *db%current_window* *db%output_window*)
  |#
  ;;if an exercise hasn't been specified from the command line sequence,
  ;;must get one from the user
  (ct_if (not *db%current_exercise*)
	 (progn
	    (setq *db%current_exercise* (db%choose_exercise))
	    (setq env_code (exer_ta_get *db%current_exercise* 'env_code))
	    (ct_if env_code
		   (setq *db%hidden_files* (append  *db%hidden_files*
						   `(,(ct_load_get
							 env_code)))))))
  ;;we can't stop in testing
  (setq *fetch_hook* nil)        ;;turn off control-c handling by the interpreter
  (setq *db%current_file* (first *db%source_files*))
  ;;run the exercise with testing
  ;;first see if running in batch mode, if so, direct output to
  ;;terminal_output..otherwise, send it to the *db%output_window*
  (ct_if (zerop *db%batch_mode*)
	   (run_exercise_test *db%current_exercise*
			      *db%source_files* (terminal_output))
	   (run_exercise_test *db%current_exercise*
			      *db%source_files* *db%output_window*))
  ;;see if a good diana tree was formed
  (ct_if (car **dt_backend_call**)
	 (progn
	   ;;make the two-window testing screen
	   (db%initial_testing_screen)
	   (ct_if (probef *db%current_file*)
		  (ct_csend db%debug_window *db%code_window*
			    :display-file  *db%current_file*)
		  (ct_csend db%debug_window *db%code_window*
			    :display-string ""))
	   (db%change_file_name *db%current_file*)
	   ;;go see what the user wants to do next
	   (db%testing_command))
	 ;;if there was a syntax error, can't show the user much
	 ;;more than an error and leave in one-screen mode
	 (progn
	   (setq *db%bottom_mode_line* (newwin 1 80 23 0))
	   (db%change_mode_line *db%bottom_mode_line* *db%command_string*)
	   (db%wgetwindow_choices *db%bottom_mode_line*
				  *db%command_string*)))))


	;;;;;;;;;;;;;;;;;;;;;;;;;
(defun  db%initial_testing_screen ()
	;;;;;;;;;;;;;;;;;;;;;;;;;
  #| Make the testing screen with two windows and two mode lines.
       Each of the windows will be a scrolling window.    |#
	  (clear)			       ;;clear the screen
	  (refresh)
	  ;;get rid of the one-liner at the bottom of the screen
	  (delwin *db%bottom_mode_line*)
	  (setq *db%window_list* nil)
	  (setq *current_exposed_window_list* nil)
	  (setq *current_debug_windows_config*
		(append *initial_testing_windows* *initial_testing_output_window*))
	  (loop for (window lines cols start_y start_x curses_win)
		in *initial_testing_windows*
		do (set curses_win  (newwin lines cols start_y start_x))
		do (set-iv db%debug_window (eval window)
			    curses-window (eval curses_win))
		do (set-iv db%debug_window (eval window)
			    max_ypos (1- lines))
		do (set-iv db%debug_window (eval window)
			    max_xpos (1- cols))
		do (set-iv db%debug_window (eval window)
			    current_xpos 0)
		do (set-iv db%debug_window (eval window)
			    current_ypos 0)
		do (ct_csend db%debug_window (eval window)
			    :set-lines lines)
		do (setq *current_debug_windows_config*
			 (append *current_debug_windows_config*
				 (list (list  window lines cols
					      start_y start_x curses_win))))
		do (setq *current_exposed_window_list*
			 (append (list (eval window))
				 *current_exposed_window_list*))
		do (setq *db%window_list* (append
					    *db%window_list* (list (eval
								     window)))))
	  (loop for (window lines cols start_y start_x) in
		*initial_testing_mode_windows*
		do (set window
			(newwin  lines  cols  start_y  start_x))
		do (setq *current_exposed_window_list*
			 (append (list (eval window))
				 *current_exposed_window_list*)))
	  (db%change_mode_line  *db%top_mode_line* "File Name: ")
	  (db%change_mode_line  *db%bottom_mode_line*
			       "Initializing Testing System")
	  (loop for (window lines cols start_y start_x curses_win)
		in *initial_testing_output_window*
		do (set curses_win (newwin lines cols start_y start_x))
		do (set-iv db%debug_window (eval window) curses-window
			   (eval curses_win))
		do (set-iv db%debug_window (eval window) lines-displayed lines)
		do (set-iv db%debug_window  (eval window) max_ypos (1- lines))
		do (ct_csend db%debug_window (eval window) :end)
		do (setq *current_exposed_window_list*
			 (append (list (eval window))
				 *current_exposed_window_list*))
		do (setq *db%window_list* (append
					    *db%window_list* (list (eval
								     window)))))
	  ;;;set up current window to be a debug window,
	  ;;;not just one of the raw curses windows
	  (setq *db%current_window* *db%user_window*)
	  (setq *db%window_count* 1)
	  (ct_csend db%debug_window  *db%current_window*  :reposition_cursor)
	  (wstandend (get-iv db%debug_window *db%code_window* curses-window))
	  (wstandend (get-iv db%debug_window *db%user_window* curses-window))
	  (refresh))


    
       ;;;;;;;;;;;;;;;;			
(defun db%debug_command ()
       ;;;;;;;;;;;;;;;
  ;;gets the debug commands for the debugger, echos them, and executes 
  (noecho)
  (setq *db%doing_command* t)
  (setq *db%echop* nil)
  (loop do
	;;set up the catch for any control-g
	(*catch 'db%catch_command
	  (progn
	    (db%change_mode_line  *db%bottom_mode_line* *db%command_string*)
	    (ct_csend db%debug_window *db%current_window* :reposition_cursor)
	    (loop for command = (db%wgetcommand *db%bottom_mode_line*)
		  ;;the command_stream can come from any of the command lists
		  for command_stream =
		  (or (assoc command *db%menu_command_list*)
		      (assoc command *db%single_screen_command_list*)
		      (assoc command *db%window_command_list*)
		      (assoc command *db%debugger_command_list*))
		  with command_print = nil
		  with command_function = nil
		  if (not command_stream)
		  do (progn
			(db%user_interface_error "Illegal Command")
			(db%change_mode_line *db%bottom_mode_line*
					     *db%command_string*))
		  else do
		  (progn
		    (setq command_function (second command_stream))
		    ;;echo the command being executed
		    (setq command_print
			  (ct_string_append "Executing: "
					    (third command_stream)))
		    (db%change_mode_line *db%bottom_mode_line*
					 command_print)
		    ;;execute the command
		    (eval command_function)
		    (db%change_mode_line  *db%bottom_mode_line*
					  *db%command_string*)
		    ;;put the cursor back to its correct position
		    (ct_csend db%debug_window *db%current_window*
			     :reposition_cursor)))))))	


       ;;;;;;;;;;;;;;;;;;
(defun db%testing_command ()
       ;;;;;;;;;;;;;;;;;;
  ;;gets the commands for the testing windows, echos them, and executes
  ;;the command
  (noecho)
  (setq *db%doing_command* t)
  (setq *db%echop* nil)
  (loop do
	(*catch 'db%catch_command
	  (progn
	    (ct_csend db%debug_window *db%current_window* :reposition_cursor)
	    (db%change_mode_line  *db%bottom_mode_line*  *db%command_string*)
	    (loop for command = (db%wgetcommand *db%bottom_mode_line*)
		  for command_stream =
		  (or (assoc command *db%menu_command_list*)
		      (assoc command *db%single_screen_command_list*)
		      (assoc command *db%window_command_list*))
		  with command_print = nil
		  with command_function = nil
		  if (not command_stream)
		  do (progn
			(db%user_interface_error "Illegal Testing Command")
			(db%change_mode_line *db%bottom_mode_line*
					     *db%command_string*))
		  else do
		  (progn
		    (setq command_function (second command_stream))
		    (setq command_print
			  (ct_string_append "Executing: "
					    (third command_stream)))
		    (db%change_mode_line *db%bottom_mode_line*
					 command_print)
		    (eval command_function)
		    (db%change_mode_line  *db%bottom_mode_line*
					  *db%command_string*)
		    (ct_csend db%debug_window *db%current_window*
			     :reposition_cursor)))))))

       ;;;;;;;;;;;;;;;;;;
(defun db%choose_exercise ()
       ;;;;;;;;;;;;;;;;;;
  ;;loops through **exer_ta_info** and makes a menu to preset
  ;;to the student consisting of the current exercises.
  ;;returns the name of the exercise chosen.  If no throw is made,
  ;;the loop terminates normally with an exercise_choice returned.
  ;;Otherwise, the user aborted the choice of an exercise and is
  ;;thrown back out to the top-level
  (let* ((exercise_list (ta_menu_develop))
	 (exercise_choice nil))
	(loop while t
	      do (*catch 'db%catch_command
			 (progn
			    (setq exercise_choice
				  (db%ask_literal
				     "SELECT AN EXERCISE" exercise_list))
			    (return exercise_choice)))
	      do (progn
		    (db%dcl_error
  "ERROR:  Program aborted..no exercise selected for /EXERCISE option.")))))



       ;;;;;;;;;;;;;;;;
(defun db%find_exercise (print_name)
       ;;;;;;;;;;;;;;;;
  ;;used when an exercise is given at the command level,
  ;;i.e., /EXERCISE=short_name.  Looks through **exer_ta_info**
  ;;to find whether that short_name is valid and if it is, returns
  ;;the exercise that goes with that short_name
  (loop for exercise in **exer_ta_info**
	for exercise_name = (car exercise)
	for list = (cdr exercise)
	for short_name = (cadr (assoc 'short_name list))
	if (equal print_name short_name)
	 do (return exercise_name)
	finally (return nil)))

       ;;;;;;;;;;;;;;;;;;
(defun db%point_in_window (window x y)
       ;;;;;;;;;;;;;;;;;;
    ;;;make window the current window and update its
    ;;;current x and y positions to 'x and 'y
    (set-iv db%debug_window window current_xpos x)
    (set-iv db%debug_window window current_ypos y)
    (setq *db%window_count*
	  (loop for entry in *db%window_list*
		for i from 0 to 2
		if (equal entry window)
		do (return i)))
    (setq *db%current_window* window))



;;;;;;;;;
;;;TESTING FUNCTIONS
;;;;;;;;;

(defun debug_debug ()
    (initscr)
#+franz   (tyi)
    (crmode)
    (*catch 'db%quit_system
	    (apply 'db%debugger *db%front_end_output*)
	    (clear)
	    (refresh)
	    (nocrmode)
	    (echo)
	    (endwin)
	    (exit)))

  #|  OLD TESTING STUFF    
(defun test_debug ()
    (initscr)
#+franz    (tyi)
    (crmode)
    (db%initial_debugger_screen)
	 (nocrmode)
	 (echo)
	 (setq *db%echop* t)
	 (endwin))


(defun file_debug ()
    (initscr)
#+franz    (tyi)
    (crmode)
    (db%test_debugger_screen)
    (ct_send *db%code_window* ':display-file
	     #+franz "/mnt/susan/user_int/recfact.ada"
	     #+lispm "bigbird://mnt//susan//user_int//recfact.ada")
    (ct_send *db%user_window* ':display-file
	     #+franz "/mnt/susan/user_int/fake.inter"
	     #+lispm "bigbird://mnt//susan//user_int//fake.inter")
    (ct_send *db%output_window* ':display-file
	     #+franz "/mnt/susan/user_int/out.ada"
	     #+lispm "bigbird://mnt//susan//user_int//out.ada")
    (db%change_mode_line *db%top_mode_line*
			 "File Name: /usr/jill/fact.ada")
#+franz    (setq *db%source_files*  '("/mnt/susan/user_int/recfact.ada"))
#+lispm    (setq *db%source_files* '("bigbird://mnt//susan//user_int//recfact.ada"))
    (db%debug_command)
	 (nocrmode)
	 (echo)
	 (setq *db%echop* t)
	 (endwin))

					;end curses

(defun new_debug_debug ()
    (initscr)
#+franz   (tyi)
    (crmode)
    (setq *db%kill_char* nil)
   (setq *db%output_window_curses* (newwin (1- *db%lines*) *db%cols* 0 0))
    (setq *db%output_window*  (make-instance 'db%debug_window
					     'curses-window
					      *db%output_window_curses*
					      'lines-displayed
					      (1- *db%lines*)
					      'max_xpos
					      (1- *db%cols*)
					      'max_ypos
					      (- *db%lines* 2)))
	  
    (setq *db%front_end_output* (list 't *last_diana* 
			  *db%output_window*
			  *db%output_window*
			  *db%output_window*
			  *db%output_window*
			  *db%output_window*))
    (apply 'db%debugger *db%front_end_output*)
    (nocrmode)
    (echo)
    (setq *db%echop* t)
    (endwin))

(defun output_debug ()
    (initscr)
#+franz  (tyi)

    (crmode)
    (setq *current_exposed_window_list* nil)
    (setq *db%window_list* nil)
    (setq *winio-editing-string* "")
    (db%test_debugger_screen)
    (setq *db%current_window* *db%output_window*)
    (setq *db%window_count* 2)
    (loop for i from 1
	  do (ct_format *db%output_window* "~%Prompt #~D" i)
;	  do (ct_print "Prompt" *db%output_window*)
	  do (ct_princ i *db%output_window*)

	  do (setq test  (loop for char = (ct_tyi *db%output_window*)
			       until (or (= char #\return) (= char #\linefeed))
			       collect char))
	  until (< (length test) 3))
    (db%debug_command)
    (nocrmode)
    (echo)
    (setq *db%echop* t)
    (endwin))



(defun ta_debug ()
    (initscr)
#+franz    (tyi)
    (crmode)
    (db%test_debugger_screen)
    (ct_send *db%code_window* ':display-file
	     #+franz "/mnt/susan/tad.top"
	     #+lispm "bigbird://mnt//susan//user_int//recfact.ada")
    (ct_send *db%user_window* ':display-file
	     #+franz "/mnt/susan/tad.middle"
	     #+lispm "bigbird://mnt//susan//user_int//fake.inter")
    (ct_send *db%output_window* ':display-file
	     #+franz "/mnt/susan/tad.bottom"
	     #+lispm "bigbird://mnt//susan//user_int//out.ada")
  (db%change_mode_line *db%top_mode_line*
			 "File Name: /usr/jack/bubble_sort.ada")
    #+franz (dump_screen_to_file (get_pname (gensym)))
	 (nocrmode)
	 (echo)
	 (setq *db%echop* t)
	 (endwin))






(defun testing_debug ()
    (initscr)
#+franz    (tyi)
    (crmode)
   (setq *db%testing_p* t)
   (setq *db%output_window_curses* (newwin *db%lines* *db%cols* 0 0))
    (setq *db%output_window*  (make-instance 'db%debug_window
					     'curses-window
					      *db%output_window_curses*
					      'lines-displayed
					      *db%lines*
					      'max_xpos
					      (1- *db%cols*)
					      'max_ypos
					      (1- *db%lines*)))
    (db%initial_testing_screen)
    (db%change_mode_line *db%top_mode_line*
			 "File Name: //mnt//susan//userint//recfact.ada")
    #+franz    (setq *db%source_files*  '("/mnt/susan/userint/recfact.ada"))
    (ct_send *db%user_window* ':display-string "")
    (db%testing_command)
	 (nocrmode)
	 (setq *db%echop* t)
	 (echo)
	 (setq *db%echop* t)
	 (endwin))


#+lispm (setq *options* '([abc.ada]temp.ada+def.ada//debug=always //list))
#+lispm (defun argv (number)
	  (ct_if (>= (1- (length *options*)) number)
	       (car (nthcdr number *options*))
	       2))
   |#