;;; $Header: /ct/debug/windowfnc.l,v 1.20 84/01/26 16:01:23 susan Exp $
;;; $Log:	/ct/debug/windowfnc.l,v $
;;;Revision 1.20  84/01/26  16:01:23  susan
;;;Made all vms/unix dependencies happen at runtime.
;;;
;;;Revision 1.19  84/01/07  11:46:01  susan
;;;Removed a couple of local function definitions from the file.
;;;
;;;Revision 1.18  84/01/06  13:40:06  susan
;;;Changed db%get_files to know whether the file has to exist
;;;
;;;Revision 1.17  83/12/16  13:43:03  susan
;;;Revitalized the ability to dump the screen to a file.
;;;
;;;Revision 1.16  83/12/12  16:50:22  susan
;;;Changed ct_send to ct_csend and added calls to get-iv and
;;;set-iv.  Fixed cursor movement so that it doesn't echo
;;;in the command line (db%bottom_mode_line).
;;;
;;;Revision 1.15  83/11/28  16:13:55  susan
;;;Made *db%blanks* 79 rather than 80 characters, this
;;;seems to make curses happy---UGH!
;;;
;;;Revision 1.14  83/11/10  17:17:41  susan
;;;Changed all sorts of things...made db%change_mode_line
;;;work correctly. Echo the first character in a command and
;;;then echo the entire command before a <cr>.  Give
;;;a warning message if a <cr> isn't given after a command,
;;;but force the user to explicitly blow it off.
;;;Change db%user_interface_error and db%throw_control_g to
;;;see if *db%user_window* has a curses-window and if not
;;;to write error messages to *db%output_window*.
;;;
;;;Revision 1.13  83/10/26  10:46:08  susan
;;;Fixed db%screen_refresh to actually do the right thing.
;;; Took away all arguments to this function.
;;;
;;;Revision 1.12  83/10/25  17:13:35  susan
;;;Caused commands to be echoed before the carriage
;;;return is hit so that the user can check before
;;;actually entering the command.
;;;Played around with db%change_mode_line
;;;
;;;Revision 1.11  83/10/19  17:00:38  susan
;;;Commented out the loading of Peter's dump to screen pgm.
;;;
;;;Revision 1.10  83/10/18  12:45:23  susan
;;;Changed *help_file* to *db%help_file* and moved where the
;;;file lives to a different place.
;;;
;;;Revision 1.9  83/10/18  11:43:39  susan
;;;Fixed calling variables within loop 'char' when then
;;;should have been 'number' under db%wgetchn and db%wgetchns
;;;
;;;Revision 1.8  83/10/17  02:34:16  susan
;;;Added (wmove window 0 0) before adding the db%blanks
;;;to clear out a mode line
;;;
;;;Revision 1.7  83/10/17  01:01:50  susan
;;;Fixed curses strangeness by removing a (wclear window)
;;;in db%change_mode_line and adding a (wmove window 0 0)
;;;before adding the string of db%blanks to the window.
;;;
;;;Revision 1.6  83/10/16  20:03:26  susan
;;;Allow for capital letters
;;;
;;;Revision 1.5  83/10/16  14:02:58  susan
;;;Fixed non-matching parentheses
;;;
;;;Revision 1.4  83/10/16  11:40:09  susan
;;;Changed functions to handle echoing myself rather
;;;than having echo turned on.
;;;
;;;Revision 1.3  83/10/12  16:30:23  susan
;;;Made the loading of Peter's dump_to_screen file and
;;;execution of the function contigent on the fact that 
;;;we're on the Unix Vax
;;;
;;;Revision 1.2  83/10/12  11:53:09  susan
;;;Revised handling of arrow keys to not go back and refresh
;;;the "Command:  " line...stops the jumping back and forth between
;;;windows.  
;;;Also, added a ct_load of 'dumpscrint, Peter's dump_to_screen function
;;;to be used with debugging
;;;
;;;Revision 1.1  83/10/09  11:10:59  susan
;;;Initial revision
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;;                          WINDOW_FNC                              ;;;
;;;                                                                  ;;;
;;;  Susan Rosenbaum                               August, 1983      ;;;
;;;                                                                  ;;;
;;; Functions for managing the user interface.  Does all of the      ;;;
;;; decision making process as to whether a particular key is        ;;;
;;; acceptable as input to the current function.                     ;;;
;;;                                                                  ;;;
;;; 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 'ctstrl))  ;;Bill's string stuff

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

(eval-when (compile load eval) (ct_load 'ctflav)) ; ; flavor stuff
    
(eval-when (compile load eval) (ct_load 'scroll))    ; ; db%debug_window
                                                    ; ; methods

#+franz
(eval-when (compile load eval) (ct_load 'format))  ; Print formating
  ;;load this dump-to-screen file specifically when we want it, not
  ;;all of the time
;;    #+(and franz
;;       (not vms))
;; (eval-when (compile load eval) (ct_load 'dumpscrint));;dumpto screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

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


; declare the local functions to this file
#+franz
(declare (localf db%wgetch
	         db%wgetchn
	         db%wgetchns
	         db%screen_snapshot
		 db%screen_refresh
		 db%throw_control_g))
		 
		 

    
;;;Constants corresponding to the ascii code for
;;;the control characters that are handled
(defconst control_g  7)
(defconst control_h  8)
(defconst control_l  12)
(defconst control_u  21 )
(defconst *slash*  47 )
(defconst left_bracket #+franz 91 #+lispm 133)
(defconst question_mark 63 )

;;;maximum number of lines for a window
(defvar *db%lines* 24)

;;;maximum number of columns for a window    
(defvar *db%cols*  80)




;;;keep track of the current location on the screen when
;;;prompting the user for a series of intormation
(defvar *db%current_line* 0)
(defvar *db%current_col*  0)


;;;the file that is displayed in the *db%user_window* when a 
;;;? or <esc>help-me is typed
(defconst *db%help_file*
    (cond ((and (status feature unix) (status feature vms))
	   "sys$ctada:help.fil")
	  ((and (status feature unix) (status nofeature vms))
	   "/ct/debug/help.fil")
	  ((status feature lispm)
	   "bigbird://ct//debug//help.fil")))


(declare (special *db%echop*
		  *db%doing_command*
		  *db%user_window*
		  *db%menu_command_list*
		  *db%single_screen_command_list*
		  *db%window_command_list*
		  *db%debugger_command_list*
		  *db%bottom_mode_line*
		  *db%current_window*
		  *db%command_string*
	          *db%current_file*
	          *db%top_mode_line*
		  *db%output_window*
		  *current_exposed_window_list*))
    
;;;used on the mode lines to cause a reverse video on the entire screen
(declare (special *db%blanks*))
(setq *db%blanks* "")
(loop for i from 1 to 79
    do (setq *db%blanks* (ct_string_append " " *db%blanks*)))

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

       ;;;;;;;;;
(defun db%wgetch (window)
       ;;;;;;;;;
  #|Get a character from the given window...the legal characters
    are return, linefeed, rubout, backspace, and all printable characters |#
    (loop for char = (wgetch window)
	  if (and  (status feature debugging)
		  (equal char control_h))		;do we want a picture 
	    do (db%screen_snapshot window)
	   else if (equal char control_l)		;refresh wanted?
	    do (db%screen_refresh)
	   else if (and (equal char control_g)
			*db%doing_command*)
	     do (db%throw_control_g)
	   else if (or				;legal character?
			(eq char #\return)
			(eq char #\linefeed)
			(eq char #\rubout)
			(eq char #\backspace)
			(eq char #\space)
			(and
			   (>= char 32)
			   (< char 127)))
	     do (return char)))


       ;;;;;;
(defun db%tyi (window)
       ;;;;;;
  #|Get a character from the given window for the ct_tyi function.
     Everything except control_h and control_l are returned with no
     outlawing of input characters.   |#
     (loop for char = (wgetch window)
	   if (and (status feature debugging)
		   (equal char control_h))		;do we want a picture 
	    do (db%screen_snapshot window)	;;of the screen?
	   else if (equal char control_l)		;refresh wanted?
	    do (db%screen_refresh)
	   else do (return char)))


       ;;;;;;;;;;
(defun db%wgetchn (window)
       ;;;;;;;;;;
  #| Get a number from the given window.  The legal characters handled
     here are return, linefeed, rubout, backspace, and 0-9.   |#
       (loop for number = (wgetch window)
	     if (and (status feature debugging)
		     (equal number control_h))	;is a picture wanted?
	      do (db%screen_snapshot window)
	      else if (equal number control_l)	;is a refresh wanted?
	       do (db%screen_refresh)
	       else if (and (equal number control_g)
			    *db%doing_command*)
	        do (db%throw_control_g)
		else if (or
			  (eq number #\return)
			  (eq number #\linefeed)
			  (eq number #\rubout)
			  (eq number #\backspace)
			  (and
			    (> number *slash*)  ;;a "/"
			    (< number #/:)))
		 do (return number)))

       ;;;;;;;;;;;
(defun db%wgetchns (window)
       ;;;;;;;;;;;
  #| Get numbers from the given window.  The legal characters handled
     here are return, linefeed, space, rubout, backspace, and 0-9, + and -   |#
       (loop for number = (wgetch window)
	     if (and (status feature debugging)
		     (equal number control_h))	;is a picture wanted?
	     do (db%screen_snapshot window)
	     else if (equal number control_l)	;is a refresh wanted?
	     do (db%screen_refresh)
	     else if (and (equal number control_g)
			  *db%doing_command*)
	     do (db%throw_control_g)
	     else if (or			;legal number?
		       (eq number #\return)
		       (eq number #\linefeed)
		       (eq number #\rubout)
		       (eq number #\space)
		       (eq number #\backspace)
		       (eq number #/+)
		       (eq number #/-)
		       (and
			 (> number *slash*)  ;;a "/"
			 (< number #/:)))
	     do (return number)))
                   


       ;;;;;;;;;;;;;;
(defun db%wgetcommand (window)
       ;;;;;;;;;;;;;;
  #| Get a command from the user...either a debugger command or a screen
     handling request--returns a list containing the 2-letter command
     input by the user |#
       (loop for char =  (wgetch window)
	     with return_value = nil
	     if (and (status feature debugging)
			  (equal char control_h))    
	     do (db%screen_snapshot window)
	     else if (equal char control_l)
	     do (db%screen_refresh)
	     else if (equal char question_mark)
	     do (ct_csend db%debug_window *db%user_window* :add-file
			 *db%help_file*)	
	     else			;;perhaps a debugger command
	     do (progn                  
		  (setq return_value (db%wgetcommand_char window char))
		  (ct_if (not (equal return_value 'arrow))
			 (return return_value)))))



       ;;;;;;;;;;;;;;;;;;;
(defun db%wgetcommand_char (window char)
       ;;;;;;;;;;;;;;;;;;;
  #|Get a character from the given window with which
    to complete a debugger command..the legal characters
    are a-z, arrow keys,  and control-g. 'char will be passed in
    and the rest must be input in this function |#
       (loop for char1 = char
	     with char2 = nil
	     with char3 = nil
	     if (not (equal char1 #\esc))
	  	do (progn	
		     (wstandout window)	
		     (waddch window (ct_char_upcase char1))
		     (wrefresh window)
		     (wstandend window))
	     if (equal char1 control_g)		;;abort this command?
	      do (db%throw_control_g)
	     else if (or (and			;legal character?--a-z
			   (> char1 #/`)
			   (< char1 #/{))
			 (eq char1 #/^))		;beginning of the 'secret command'
	      do (progn
		  (setq char2 (wgetch window))
		  (ct_if (equal char2 control_g)	;control_g = abort
			 (db%throw_control_g))
		  (let* ((command_char
			   (list (ascii char1) (ascii char2)))
			 ;;the command_stream can come from any of the
			 ;;specials containing commands
			 (command_stream
			   (or (assoc command_char *db%menu_command_list*)
			       (assoc command_char
				      *db%single_screen_command_list*)
			       (assoc command_char
				      *db%window_command_list*)
			       (assoc command_char
				      *db%debugger_command_list*)))
			 ;;echo the command currently being entered
			 (command_print
			   (ct_string_append *db%command_string*
					     (third
					       command_stream))))
		    ;;if exists, display the command currently being
		    ;;entered on the window
		    (ct_if command_stream
			   (progn
			     (db%change_mode_line window command_print)
			     (ct_csend db%debug_window *db%current_window*
				      :reposition_cursor)))
		    (ct_if (or
			       (and (> char2 #/')   ;legal character?--a-z
				    (< char2 #/}))
			       (eq char2 #/&))	;last character for the 'secret cmd.
			   (return
			     (loop for char3 =  (wgetch window)
				   if (or
					(equal char3 #\return)
					(equal char3 #\linefeed))
				   do (return 
					#+franz (list (ascii char1) (ascii char2))
					#+lispm (list (ascii (- char1 32))
						      (ascii (- char2 32))))
				   else if  (equal char3 control_g)
				   do (return (db%throw_control_g))
				   else
				   do 
				   (db%user_interface_error
				     "Illegal Character--Use <return> to select the command"
				     )))
			   (progn
			     (db%user_interface_error "Illegal Command")
			     (*throw 'db%catch_command nil)))))
	     else if (equal char1 #\esc)  ;;arrow key?
	      do (progn
		  (setq char2 (wgetch window))
		  (ct_if (or (equal char2 left_bracket)	
			     (equal char #/O))
			 (progn
			   (setq char3 (wgetch window))
			   (ct_selectq
			     char3
			     (#+franz 65   	       ;;up-arrow
			      (ct_csend db%debug_window *db%current_window* :up_arrow))
			     
			     (#+franz 66	       ;;down-arrow
			      (ct_csend db%debug_window  *db%current_window* :down_arrow))
			     
			     (#+franz 67	       ;;right arrow
			      (ct_csend db%debug_window  *db%current_window* :right_arrow))
			     
			     (#+franz 68	       ;;left arrow
			      (ct_csend db%debug_window  *db%current_window* :left_arrow)))
			   (return 'arrow))
			 (progn
			   (db%user_interface_error "Illegal Command")
			   (*throw 'db%catch_command nil))))
	     else do (progn
		       (db%user_interface_error "Illegal Command")
		       (*throw 'db%catch_command nil))))

    
       ;;;;;;;;;;;;;;;;;;
(defun db%screen_snapshot  (window)
       ;;;;;;;;;;;;;;;;;;
  #| Take a picture of the current screen and save it in a file
     under the current directory with the name 'g###'.    |#
	 #+(and franz (not vms)) (dump_screen_to_file (get_pname (gensym)))
	 (ct_if *db%echop*
	     (progn
		(waddch window #\backspace)			;back up from ^H
		(waddch window #\backspace)
		(waddch window #\backspace)))
	 (wrefresh window))

       ;;;;;;;;;;;;;;;;;    
(defun db%screen_refresh ()
       ;;;;;;;;;;;;;;;;;
  ;;refresh the entire screen by refreshing 'curscr
    (let ((curscr (getcurscr)))
	 (wrefresh curscr)
	 (ct_csend db%debug_window *db%current_window* :reposition_cursor)))



       ;;;;;;;;;;;;;;;;;;;;;;;
(defun db%redisplay_after_menu (menu_window)
  ;;;;;;;;;;;;;;;;;;;;;;;
  #| Refresh the screen by touching and refreshing each of the
    currently exposed windows after clearing the menu window from
    the screen.   |#
       ;;first, clean out the menu_window
       (ct_csend db%debug_window  menu_window :display-string "")

       ;;if entries in the *current_exposed_window_list*, refresh them;
       ;;otherwise, refresh by clearing the screen
       (ct_if *current_exposed_window_list*
	      (loop for window in *current_exposed_window_list*
		    ;refresh each window
		    do (ct_if (instancep window)
			      (progn
				 (ct_csend db%debug_window window :touchwin)
				 (ct_csend db%debug_window window :wrefresh))
			      (progn
				 (touchwin window)
				 (wrefresh window))))
;;	      (progn
;;		 (clear)
;;		 (refresh))
       )
       (ct_if *db%current_window*
	      (ct_csend db%debug_window *db%current_window* :reposition_cursor)))


       ;;;;;;;;;;
(defun db%wgetstr (window)
       ;;;;;;;;;;
  #| Get a string from the user on the given window.  The character is
     retrieved from the function db%wgetch.  If a backspace or rubout is
     input, the last character is removed from the screen.  Input
     is taken until a return or linefeed is typed. All echo is done by
     the db%wgetch function.  Echo itself is turned off.|#
    (loop for char = (db%wgetch window)
	  with string = ""
	  until (or				;finished?
		   (eq char #\return)
		   (eq char #\linefeed))
	  do (ct_selectq
		char
		((#\rubout #\backspace)
		   (cond ((not (equal string ""))
			  ;;if not a blank input already, notice the
			  ;;last char, and move back over it.  Clobber
			  ;;the last char from the input buffer and
			  ;;clear to end of line.  Add backspaces
			  ;;and spaces to keep reverse video happy
			  (waddch window #\backspace)
			  (waddch window #\space)
			  (waddch window #\backspace)
			  (touchwin window)
			  (wrefresh window)
			  (setq string
				(substring string #+lispm 0
					          #+franz 1
					   (1- (string-length string))))
			  )))
		(t
		  (waddch window char)
		  (wrefresh window)
		   (setq string (ct_string_append string char))))	;update string
	  finally (progn
		     (tyo #\return)		;echo the return
		     (return string))))		;return the string


       ;;;;;;;;;;
(defun db%wgetnum (window)
       ;;;;;;;;;;
  #|Get a number from the user on the current window.  If a
    rubout or backspace is input, the last number typed is removed
    from the screen, with the number being generated updated 
    accordingly.  Input is taken until a return or linefeed is typed. The
    value returned is the actual number input, not its character
    representation |#
    (loop for char = (db%wgetchn window)
	  with num = 0
	  with input_num = nil
	  with place = 1
	  until (or
		   (eq char #\return)		;finished?
		   (eq char #\linefeed))
	  do (ct_selectq
		char
		((#\rubout #\backspace)
		   (cond ((not (equal input_num nil))
			  ;;if not a blank input already, notice the
			  ;;last number, and move back over it.  Clobber
			  ;;the last number from the input buffer,
			  ;;recompute the number and
			  ;;clear to end of line.  Add spaces and
			  ;;backspace to appease reverse video
			  (waddch window #\backspace)
			  (waddch window #\space)
			  (waddch window #\backspace)
			  (wrefresh window)
			  (touchwin window)
			  (setq num (quotient (- num (mod num place)) place))
			  (setq place (quotient place 10))
			  (ct_if (eq place 1) (setq input_num nil))))
		(t
		  (progn
		    (waddch window num)
		    (wrefresh window)
		    (setq input_num t)
		    (setq num (+ (* num place) (- char 48)))	;update number
		    (setq place (* 10 place))	                ;keep track of
		    ))))				                ;place value
	  finally (progn
		     (tyo #\return)		;echo the return
		     (return num))))		;return the number

       ;;;;;;;;;;;;;;;;;;;
(defun db%wgetnumberstring (window)
       ;;;;;;;;;;;;;;;;;;;
  #| Get a string of numbers from the user on the given window.  The character is
     retrieved from the function db%wgetchns.  If a backspace or rubout is
     input, the last character is removed from the screen.  Input
     is taken until a return or linefeed is typed.  The value of the numbers
     will be handled by the calling function.  This function returns
     everything in a one long string |#
    (loop for char = (db%wgetchns window)
	  with string = ""
	  until (or				;finished?
		   (eq char #\return)
		   (eq char #\linefeed))
	  do (ct_selectq
		char
		((#\rubout #\backspace)
		   (cond ((not (equal string ""))
			  ;;if not a blank input already, notice the
			  ;;last char, and move back over it.  Clobber
			  ;;the last char from the input buffer and
			  ;;clear to end of line.  Add spaces and
			  ;;backspaces to appease reverse video
			  (waddch window #\backspace)
			  (waddch window #\space)
			  (waddch window #\backspace)
			  (wrefresh window)
			  (setq string
				(substring string #+lispm 0
					          #+franz 1
					   (1- (string-length string)))))))
		(t
		  (progn
		    (waddch window char)
		    (wrefresh window)
		    (setq string (ct_string_append string char)))))	;update string
	  finally (progn
		     (tyo #\return)		;echo the return
		     (return string))))		;return the string

       ;;;;;;;;;;;;;;;;;;
(defun db%wgetmenu_choices (window menu_prompt)
       ;;;;;;;;;;;;;;;;;;;
  #| Get a string of numbers from the user on the given window.  The character is
     retrieved from the function db%wgetch.  If a backspace or rubout is
     input, the last character is removed from the screen.  Input
     is taken until a return or linefeed is typed.   |#
    (loop for char = (db%wgetmenu_input window menu_prompt)
	  with string = ""
	  until (or				;finished?
		   (eq char #\return)
		   (eq char #\linefeed))
	  do (ct_selectq
		char
		((#\rubout #\backspace)
		   (cond ((not (equal string ""))
			  ;;if not a blank input already, notice the
			  ;;last char, and move back over it.  Clobber
			  ;;the last char from the input buffer and
			  ;;clear to end of line.  Add spaces and
			  ;;backspaces to appease reverse video
			  (waddch window #\backspace)	
			  (waddch window #\space)
			  (waddch window #\backspace)
			  (setq string
				(substring string #+lispm 0
					          #+franz 1
					   (1- (string-length string))))
			  (touchwin window)
			  (wrefresh window))))
		(t
		  (waddch window char)
		  (wrefresh window)
		  (setq string (ct_string_append string char))))	;update string
	  finally (progn
		     (return string))))



       ;;;;;;;;;;;;;;;;;;
(defun db%wgetmenu_input (window menu_prompt)
       ;;;;;;;;;;;;;;;;;;
  #| Get a number from the given window to be returned as the
     selection from a menu.  The legal characters handled
     here are return, linefeed, rubout, backspace, and 0-9, + and -   |#
     (loop for number = (wgetch window)
	   if (and (status feature debugging)
		   (equal number control_h))	;is a picture wanted?
	     do (db%screen_snapshot window)
	    else if (equal number control_l)	;is a refresh wanted?
	      do (db%screen_refresh)
	      else if (equal number control_g)  ;abort the menu selection process?
	     do (db%throw_control_g)		
	     else if (or				;legal number?
		       (eq number #\return)
		       (eq number #\linefeed)
		       (eq number #\rubout)
		       (eq number #\space)
		       (eq number #\backspace)
		       (eq number #/+)
		       (eq number #/-)
		       (and
			 (> number *slash*)  ;;a "/"
			 (< number #/:)))
	      do (return number)
	      else 
	      do (progn
		   (let ((command nil)
			 (command_stream nil)
			 (command_function nil)
			 (command_print nil))
			(setq command
			      (db%wgetcommand_char window number))    
			(setq command_stream
			      (assoc command *db%menu_command_list*))
			(ct_if (not command_stream)
			       (progn
				  (db%user_interface_error "Illegal Menu Command")
				  (db%change_mode_line window menu_prompt))
			       (progn
				  (setq command_function (second command_stream))
				  (setq command_print
					(ct_string_append "Executing: "
						       (third command_stream)))
				  (db%change_mode_line window command_print)
				  (eval command_function)
				  (db%change_mode_line  window
						       menu_prompt)))))))
	     

       ;;;;;;;;;;;;;;;;;;;;;
(defun db%wgetwindow_choices (window menu_prompt)
       ;;;;;;;;;;;;;;;;;;;;;
  #|  Accept a select group of commands on a window.  Used
      when only one window is shown to the user---when
      the debugger hasn't been chosen as an option or when
      a syntatic error has occured and the debugger or
      testing cannot legally be entered   |#
       (noecho)
       (setq *db%doing_command* t)
       (loop do
	     (*catch 'db%catch_command
	       (progn
		 (ct_csend db%debug_window *db%current_window*
			  :reposition_cursor)
		 (loop for number = (wgetch window)
		       if (and (status feature debugging)
			       (equal number control_h))	;is a picture wanted?
		       do (db%screen_snapshot window)
		       else if (equal number control_l)	;is a refresh wanted?
		       do (db%screen_refresh)
		       else			;get the command
		       do (progn
			    (let ((command nil)
				  (command_stream nil)
				  (command_function nil)
				  (command_print nil))
			      (setq command
				    (db%wgetcommand_char window number))    
			      (setq command_stream
				    (or
				      (assoc command *db%menu_command_list*)
				      (assoc command
					     *db%single_screen_command_list*)))
			      (ct_if (not command_stream)
				     (progn	;illegal command
				       #+franz (tyo control_g)
				       #+lispm (beep)
				       #+franz (drain)
				       (db%user_interface_error
						  "Illegal Window Command")
				       (db%change_mode_line *db%bottom_mode_line*
							    menu_prompt)
				       (ct_csend db%debug_window *db%current_window*
						:reposition_cursor))
				     (progn	;legal command
				       (setq command_function (second command_stream))
				       ;;CURSES loses here
				       ;;(setq command_print
				       ;;(ct_string_append "Executing: "
				       ;;(third command_stream)))
				       ;;echo the command currently executing 
				       ;;(db%change_mode_line *db%bottom_mode_line*
				       ;;command_print)
				       ;;perform the desired function
				       (eval command_function)
				       ;;change the mode line back to its original state
				       (db%change_mode_line  *db%bottom_mode_line*
							     menu_prompt)
				       (ct_csend db%debug_window *db%current_window*
						:reposition_cursor))))))))))

       ;;;;;;;;;
(defun db%wclear   (window)
       ;;;;;;;;;
  #|  Clear the given window of all information, touch it
      and refresh it.  |#
    (wclear window)
    (touchwin window)
    (wrefresh window))
	     


	;;;;;;;;;;;;		
(defun  db%get_files  (win prompt must_existp)
	;;;;;;;;;;;;
   #| Get input from the user of file names until a carriage return is received on
      an empty line.  Each file name is entered on a separate line   |#
    (let*  ((source_list nil))
	  (setq *db%current_col* 0)
	  (db%new_lines win 2)
	  (wstandout win)
	  ;;display the prompt for the command
	  (waddstr win prompt)
	  (wstandend win)
	  (wrefresh win)
	  (setq  *db%current_col* 10)
	  (db%new_lines win 1)
	  (setq source_list
		(loop for file_name = (db%wgetstr win)
		      until (equal file_name  "")
		      if (and must_existp
			      (not (probef file_name)))	;does this file exist?
		      		       ;;check must_existp first to see if
				       ;;it needs to and signal error if
				       ;;it doesn't
		        do (progn
			   (beep)
			   (drain)
			   (db%new_lines win 1)
			   (wclrtoeol win)
			   (waddstr win "Invalid File Name; Re-input: ")
			   (wrefresh win))
			else
			collect file_name
			do (db%new_lines win 1)))
	  source_list))




       ;;;;;;;;;;;
(defun db%get_file  (win  prompt must_existp)
  ;;;;;;;;;;;
  #|Get one file name from the user  |#
       (let (file_name nil)
	 (setq *db%current_col* 0)
	 (db%new_lines win 2)
	 (wstandout win)
	 ;;display the prompt for the command
	 (waddstr win prompt)
	 (wstandend win)
	 (wrefresh win)
	 (setq  *db%current_col* 10)
	 (db%new_lines win 1)
	 (loop for file_name = (db%wgetstr win)
	       if (equal file_name "")
	         do (return nil)
		else if (and must_existp
			     (not (probef file_name)))	;does this file exist--
				       ;;check must_existp first to see if
				       ;;it needs to and signal error
				       ;;if it's not around
		 do
		  (progn
		    (beep)
		    (drain)
		    (db%new_lines win 1)
		    (wclrtoeol win)
		    (waddstr win "Invalid File Name; Re-input: ")
		    (wrefresh win))
		  else do (return  file_name)	;return the file name
		  do (db%new_lines win 1))))


       ;;;;;;;;;;;;
(defun db%new_lines (win number)
       ;;;;;;;;;;;;
  #| See if a scroll is needed before the next type-out of
     a line on the screen...causes the current window 'win'
     to wrap-around if necessary by seeing how many lines
     'number' are wanted for the line increment|#
    (let ((line_num (+ *db%current_line* number))
	  (max_lines (1- *db%lines*)))
	 (touchwin win)
	 (ct_if  (or				;see if need to scroll
		    (= line_num max_lines)
		    (> line_num max_lines))
		(progn				;if so, wrap around to the top
		   (setq *db%current_line* 0)
		   (wmove win *db%current_line* 0)
		   (wclrtoeol win)
		   (wmove win (1+ *db%current_line*) 0))
		(progn				;otherwise, clear the lines
		   (ct_if (> number 1)		;are about to input onto
			  (loop for i from 1 to (1- number)
				with line_num =  *db%current_line*
				do (progn
				      (setq line_num (1+ line_num))
				      (wmove win line_num 0)
				      (wclrtoeol win))))
		   (setq *db%current_line* (+ number *db%current_line*))
		   (wmove win *db%current_line* 0)))
	 (wclrtoeol win)
	 (wmove win *db%current_line* *db%current_col*)
	 (wrefresh win)))


	  
	;;;;;;;;;;;;;;
(defun  db%center_strings  (&rest args)
	;;;;;;;;;;;;;;
  #|  Takes an arbitrary number of strings and centers them
      on the screen.  A list is return of ((position string) (position string))
      for each string in the list, where position is the column on which
      to being the string.    |#
    (let*  ((numstrings (length args))
	    (strlength  0)
	    (spacelength 0)
	    (strformat nil))
	  (loop for string in args
		do (setq strlength (+ strlength (string-length string))))
	  (setq spacelength (quotient (- *db%cols* strlength)
				      (1+ numstrings)))
	  (setq strformat
		(loop for string in args
		      with start = 0
		      do (setq start (+ start spacelength))
		      collect (list start string)
		      do (setq start (+ (string-length string) start))))

    strformat))
	  
       ;;;;;;;;;;;;;;;;;;;
(defun db%change_mode_line  (window  new_line)
       ;;;;;;;;;;;;;;;;;;
  #| Display 'new_line on 'window  in reverse video by adding
     *db%blanks* to reverse the entire line and then writing
     'new_line on top of that   |#
       (move 0 0)
       (refresh)
      (wstandout window)
      (wmove window 0 0)
      (wclrtoeol window)
      (waddstr window *db%blanks*)
      (wmove window 0 0)
      (waddstr window new_line)
      (wmove window 0 (1+ (string-length new_line)))
      (wrefresh window)
      (wstandend window)
      (standend))

                     				       

(defun db%change_file_name (file_name)
    #| Display a new file name on the db%top_mode_line |#
        				       ; change the current file name
    (setq *db%current_file* file_name)
    (db%change_mode_line  *db%top_mode_line* 
	(ct_string_append  "File Name: " file_name)))

	;;;;;;;;;;;;;;;;;;;
(defun  db%add_to_mode_line  (window  pos  new_line)
	;;;;;;;;;;;;;;;;;;;
   #| Add 'new_line to the current mode line at position 'pos  |#
    (wmove window 0 pos)
    (for i from 1 to (length new_line)
	 do (waddch window " "))
    (wmove window 0 pos)
    (waddstr window new_line)
    (wrefresh window))
    
       ;;;;;;;;;;;;;;;;;;;;;;;		    
(defun db%user_interface_error (error_string)
       ;;;;;;;;;;;;;;;;;;;;;;;
  #| Signal a user interface error by beeping, adding
     'error_string to the *db%user_window*, and then
     repositioning the cursor on the current window  |#
       ;;see if there is a curses-window for the *db%user_window*
       ;;if is, write to that; otherwise, write to the
       ;;*db%output_window*
       (let ((error_window (ct_if (get-iv db%debug_window *db%user_window*
					  curses-window)
				  *db%user_window*
				  *db%output_window*)))
	 #+franz (tyo control_g)
	 #+lispm (beep)
	 #+franz (drain)
	 (ct_format error_window "~A~%" error_string)
	 (ct_csend db%debug_window *db%current_window* :reposition_cursor)))

	;;;;;;;;;;;;;;;;;;			 
(defun  db%throw_control_g ()
	;;;;;;;;;;;;;;;;;;
  #| Throw out of the current debug command after
     rudely beeping  |#
       ;;see if there is a curses-window for the *db%user_window*
       ;;if is, write to that; otherwise, if there is 
       ;;one for *db%output_window*, write to that; else write
       ;;to (terminal_output)
       (let ((error_window (cond
			      ((get-iv db%debug_window
				       *db%user_window* curses-window)
			       *db%user_window*)
			      ((get-iv db%debug_window
				       *db%output_window* curses-window)
			       *db%output_window*)
			      (t (terminal_output)))))
	 #+franz (tyo control_g)
	 #+lispm (beep)
	 #+franz (drain)
	 (ct_format error_window "Command Aborted~%")
	 (*throw 'db%catch_command nil)))


;;;;TESTING FUNCTIONS

#|
       ;;;;
(defun test ()
       ;;;;
    (initscr)
    (nocrmode)
    (raw)
    (tyi)
    (let ((tempstring nil)
	  (win (newwin 0 0 0 0)))
	 (wstandout win)
	 (waddstr win "Input now:  ")
	 (wstandend win)
	 (waddstr win "  ")
	 (wrefresh win)
	 (setq temp (db%wgetstr win))
	 (wstandend win)
	 (wrefresh win)
	 (noraw)
	 (endwin)
  temp	 ))

  |#