;;; $Header: /ct/debug/debugcmds.l,v 1.16 84/02/13 11:04:04 john Exp $
;;; $Log:	/ct/debug/debugcmds.l,v $
;;;Revision 1.16  84/02/13  11:04:04  john
;;;Who knows...
;;;
;;;Revision 1.15  84/01/26  16:04:30  susan
;;;Made any vms/unix dependencies happen at runtime.
;;;
;;;Revision 1.14  84/01/07  11:47:50  susan
;;;Removed a couple of local function definitions from the file.
;;;
;;;Revision 1.13  83/12/13  09:17:44  susan
;;;Changed ct_send to ct_csend or get/set-iv.
;;;
;;;Revision 1.12  83/11/22  17:52:30  susan
;;;control-c will pop out to VMS if there are
;;;no debugger options selected by the user
;;;
;;;Revision 1.11  83/11/10  17:23:13  susan
;;;Changed various things...added initializtion of 
;;;control_c so that it doesn't happen without
;;;a function call.  Made the string "Command: "
;;;become *db%command_string*.
;;;
;;;Revision 1.10  83/10/26  10:50:54  susan
;;;Removed argument to db%screen_refresh
;;;
;;;Revision 1.9  83/10/25  17:17:44  susan
;;;Added secret command '^&' with password 'alligator
;;;so that we can break after we've made a debugger
;;;version and turned off feature debugging.
;;;
;;;Revision 1.8  83/10/18  16:26:16  susan
;;;Repaired compile error caused by a new special
;;;'tempstring' showing up.
;;;
;;;Revision 1.7  83/10/17  01:11:23  susan
;;;Minor modifications in db%new_window_configs to remove unnecessary
;;;nilling of *current_exposed_window_list*
;;;
;;;Revision 1.6  83/10/16  20:04:48  susan
;;;attempting to fix reconfigure windows
;;;
;;;Revision 1.5  83/10/16  14:13:35  susan
;;;Parentheses is wrong place.
;;;
;;;Revision 1.4  83/10/16  14:05:46  susan
;;;Fixed unbalanced parentheses
;;;
;;;Revision 1.3  83/10/16  11:54:14  susan
;;;Took out all references to echoing.  Repaired 'find string' to
;;;search through whatever the *db%current_window* was for the
;;;string.  
;;;
;;;Revision 1.2  83/10/12  12:37:49  susan
;;;no changes
;;;
;;;Revision 1.1  83/10/09  11:13:17  susan
;;;Initial revision
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;;                          DEBUG_CMDS                              ;;;
;;; Susan Rosenbaum                               August, 1983       ;;;
;;;                                                                  ;;;
;;; Functions for handling debugger commands.                        ;;;
;;;                                                                  ;;;
;;; 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 'dbutils))	;;debugger utils.

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

#+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)
#+franz
;declare the functions that are only called in this file
(declare (localf db%new_window_configs))
		 

(declare (special
	   *db%testing_p*
	   *db%window_count*
	   *db%bottom_mode_line*
	   *db%current_window*
	   *db%window_list*
	   *db%debugger_p*
	   *db%part_debugger_p*
	   *db%source_files*
	   *db%command_string*
	   *db%code_window*
	   *db%current_file*
	   *db%top_mode_line*
	   *db%user_window*
	   *db%help_file*
	   *current_exposed_window_list*
	   *current_debug_windows_config*
	   *db%kill_char*
	   *integer_last*
	   *integer_first*
	   *db%debug_menu*
	   *db%debug_menu_mode_line*
	   *db%large_debug_menu*
	   *db%large_debug_menu_mode_line*
	   *db%small_debug_menu*
	   *db%small_debug_menu_mode_line*))


	;;;;;;;;;;;;;;;;    
(defun  db%expand_window ()
	;;;;;;;;;;;;;;;;
  ;;Expands the current window to its max size by looking at
  ;;*db%window_count* and seeing which window is currently 'it'
  ;;*db%code_window = 0
  ;;*db%user_window = 1
  ;;*db%output_window = 2
  (ct_if *db%testing_p*				;if testing, only expand 2 windows
	 (ct_selectq  *db%window_count*
		      (0
			(db%new_window_configs '(21 1 0)))
		      (1
			(db%new_window_configs '(1 21 0)))
		      (2
			(db%new_window_configs '(1 1 20))))
	 (ct_selectq  *db%window_count*		;if debugging, expand 3 windows
		      (0
			(db%new_window_configs '(20 1 1)))
		      (1
			(db%new_window_configs '(1 20 1)))
		      (2
			(db%new_window_configs '(1 1 20))))))

	;;;;;;;;;;;;;;;;;;
(defun  db%default_windows ()
	;;;;;;;;;;;;;;;;;;
  ;;;puts the windows back into their original configurations
  (ct_if *db%testing_p* (db%new_window_configs '(11 11 0))  ;;if testing, do just 2 windows
	 (db%new_window_configs '(12 5 5))))	;else, do all 3 windows


	;;;;;;;;;;;;;;;;;;;;
(defun  db%configure_windows ()
        ;;;;;;;;;;;;;;;;;;;;
  ;;Reconfigure the window configuration according to the value returned from
  ;;*db%wgetnumberstring.  The first value will be for *db%code_window*, the
  ;;second for *db%user_window*, and the third for *db%output_window*.  If only
  ;;1 or 2 numbers is given, the other(s) default to 0.
  (db%change_mode_line *db%bottom_mode_line*
		       "Enter number of lines for each window : ")
  (let* ((number_string (db%wgetnumberstring *db%bottom_mode_line*))
	 ;;get the numbers that were input
	 (number_values (db%get_numbers_from_string number_string 3))
	 ;;get the total number of lines input
	 (total (apply '+ number_values))
	 (new_lines nil))
    (ct_if (not (second number_values))
	   (setq number_values (append number_values (list 0))))
    (ct_if (not (third number_values))
	   (setq number_values (append  number_values (list 0))))
    ;;the total number of lines must be 22
    (ct_if (not (equal 22 total))
	   (db%user_interface_error
	     "The total number of lines must add up to exactly 22")
	   (progn
	     (loop for lines in number_values
		   ;;none of the line amounts can be negatvie
		   if (minusp lines)
		   do
		   (progn
		     (db%user_interface_error
		       "Illegal Negative Value for Window Size")
		     (return nil))
		   finally
		   (progn
		     ;;set *db%current_window* to be the first window
		     ;;(starting from the current-current one) with
		     ;;a non-zero number of lines.  Set up *db%window_count*
		     ;;accordingly
		     (loop while t
			   if
			   (zerop (car
				    (nthcdr *db%window_count*
					    number_values)))
			   do
			   (progn
			     (setq *db%window_count*
				   (#+franz mod
				    #+lispm remainder
				    (1+ *db%window_count*) 3))
			     (setq *db%current_window*
				   (car
				     (nthcdr *db%window_count*
					     *db%window_list*))
				   ))
			   else do   (return (db%new_window_configs
					       number_values)))))))))
      
	     
		    
		    
	 
    
	;;;;;;;;;;;;;;
(defun  db%next_window ()
	;;;;;;;;;;;;;;
  ;;Go to the next window in the *db%window_list* by incrementing and moding
  ;;the *db%window_count*.  Make sure to get a window that has more than
  ;;zero lines displayed
  (loop while t
	do (setq *db%window_count* (#+franz mod
				    #+lispm remainder (1+ *db%window_count*) 3))
	do (setq *db%current_window* (car (nthcdr
					    *db%window_count* *db%window_list*)))
	do (ct_if (not (zerop
			 (ct_csend db%debug_window *db%current_window* lines-displayed)))
		  (return nil))))
	;;;;;;;;;;;;;;;;;;
(defun  db%previous_window ()
	;;;;;;;;;;;;;;;;;;
  ;;Go to the previous window in the *db%window_list* by decrementing and moding
  ;;the *db%window_count*.  Make sure to get a window that has more than
  ;;zero lines displayed
  (loop while t
	do (setq *db%window_count* (#+franz mod
				    #+lispm remainder (+ 2 *db%window_count*) 3))
	do (setq *db%current_window* (car (nthcdr
					    *db%window_count* *db%window_list*)))
	do (ct_if (not (zerop
			 (ct_csend db%debug_window  *db%current_window* lines-displayed)))
		  (return nil))))
	;;;;;;;;;;;;
(defun  db%next_page ()
	;;;;;;;;;;;;
  ;;send a ':next_page message to the current window
  (ct_csend db%debug_window  *db%current_window* :next_page))


	;;;;;;;;;;;;;;;;
(defun  db%previous_page ()
	;;;;;;;;;;;;;;;;
  ;;send a ':previous_page message to the current window
  (ct_csend db%debug_window *db%current_window* :previous_page))


	;;;;;;;;;;;;;
(defun  db%first_page ()
	;;;;;;;;;;;;;
  ;;send a ':top_file message to the current window
    (ct_csend db%debug_window *db%current_window* :top_file))


	;;;;;;;;;;;;
(defun  db%last_page ()
	;;;;;;;;;;;;
  ;;send a ':bottom_file message to the current window
  (ct_csend db%debug_window *db%current_window* :bottom_file))


       ;;;;;;;
(defun db%quit()
       ;;;;;;;
  (ct_if *db%debugger_p* (db%quit_debugger)
	 (*throw 'db%quit_system nil)))


	;;;;;;;;;;;;;;
(defun  db%find_string ()
	;;;;;;;;;;;;;;
  ;;Ask the user for the desired string and send the current
  ;;window a ':search message.  If found, reposition the 
  ;;window on the requested string; otherwise, give an 
  ;;error that the string wasn't found
    (db%change_mode_line *db%bottom_mode_line*
			 "Enter string:  ")
    (let* ((input_string (db%wgetstr *db%bottom_mode_line*))
	   (current_xpos (get-iv db%debug_window *db%current_window* current_xpos))
	   (current_ypos (get-iv db%debug_window *db%current_window* current_ypos))
	   (return_pos nil))
      (setq return_pos (ct_csend db%debug_window *db%current_window* :search input_string
				current_xpos current_ypos))
      (ct_if return_pos
	     (progn
	       (set-iv db%debug_window *db%current_window* current_xpos (first return_pos))
	       (set-iv db%debug_window *db%current_window* current_ypos
			(second return_pos)))
	     (db%user_interface_error "String not found"))))
			
	;;;;;;;;;;;;;;
(defun  db%choose_file ()
	;;;;;;;;;;;;;;
  ;;Give a menu from which the user can choose the file that he wants
  ;;to see displayed.  The files available are those that were originally
  ;;input when the session was begun and are found in *db%source_files*
  (let ((file_name (db%ask_literal "Select a file: " *db%source_files*)))
    (ct_if (probef file_name)
	   (progn
	     (ct_csend db%debug_window *db%code_window* :display-file
		       file_name)
	     (db%change_file_name file_name))
	   (db%user_interface_error "File not found"))))

       ;;;;;;;;;;
(defun db%help_me ()
       ;;;;;;;;;;
  ;;Display the help file in *db%user_window*
  (ct_csend db%debug_window *db%user_window* :add-file
			  *db%help_file*))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Auxiliary functions to help with the debug commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;;;;;;;
(defun db%index (tempstring char &optional (start_pos #+franz 1 #+lispm 0))
       ;;;;;;;;
  #| loop through tempstring from start_pos until 'char' is found
     and return the index ; return nil otherwise  |#
  (loop for i from start_pos to #+franz (string-length tempstring)
				#+lispm (1- (string-length tempstring))
	do (ct_if (equal char (substring tempstring i #+franz 1
					              #+lispm (1+ i)))
		  (return i))
	finally (return nil)))

       ;;;;;;;;;;;;
(defun db%non_index (tempstring char &optional (start_pos 1))
       ;;;;;;;;;;;;
  #| return the index in the string which
     is not equal to 'char'  , beginning the search at 'start_pos|#
       (loop for i from start_pos to (string-length tempstring)
	     do (ct_if (not (equal char (substring tempstring i 1)))
		       (return i))
	     finally (return nil)))

       ;;;;;;;;;;;;;;;;;;;;;;;;
(defun db%convert_string_to_number (string)
       ;;;;;;;;;;;;;;;;;;;;;;;;
  #| convert a string, possibly beginning with '+' or '-'
     to its numeric equivalent  |#
  (let ((tempnum 0)
	(tempstring string)
	(negp nil))
    (ct_if (equal (substring tempstring 1 1) "-")
	   (progn
	     (setq negp t)
	     (setq tempstring (substring tempstring 2)))
	   (ct_if (equal (substring tempstring 1 1) "+")
		  (setq tempstring (substring tempstring 2))))
    (loop for i from 1 to (string-length tempstring)
	  for num = (getcharn tempstring i)
	  with place_value = 1
	  do (setq tempnum (+ (* place_value tempnum) (- num 48)))
	  do (setq place_value (* place_value 10)))
    (ct_if negp (setq tempnum (- 0 tempnum)))
    tempnum))

       ;;;;;;;;;;;;;;;;;;;;;;;
(defun db%get_numbers_from_string (string number_of_numbers)
       ;;;;;;;;;;;;;;;;;;;;;;;
  ;;loop through 'string for up to 'number_of_numbers,
  ;;converting each string-number found to its
  ;;numeric equivalent and returning the list
  ;;of numbers that are made
  (loop for i from 1 to number_of_numbers
	with tstring = string
	with tempstring
	for start_pos = (db%non_index tstring " ")
	until (not start_pos)
	for end_pos = (db%index tstring " " start_pos)
	if end_pos 
	  do (setq tempstring (substring tstring start_pos
					 (- end_pos start_pos)))
	  else  do (setq tempstring (substring tstring start_pos))
	collect (db%convert_string_to_number  tempstring)
	if end_pos
        	do (setq tstring  (substring tstring end_pos))
		else do (setq tstring " ")))
		
       ;;;;;;;;;;;;;;;;;;
(defun db%new_window_configs (lines_list)
       ;;;;;;;;;;;;;;;;;;
  #| Reconfigure the debug windows to contain the number of lines
     found in lines_list---(first lines_list) will be the amount
     of lines for *db%code_window*, (second lines_list) will
     be the amount of lines for *db%user_window*, and
     (third lines_list) will be the number of lines for
     *db%output_window*    |#
       (clear)			       ;;clear the screen
       (refresh)
       ;;get rid of old mode lines
       (delwin *db%top_mode_line*)
       (delwin *db%bottom_mode_line*)
       ;;make new mode lines
       (setq *db%top_mode_line*
	     (newwin 1 80 (first lines_list) 0))
       (setq *db%bottom_mode_line*
	     (newwin 1 80 (+  1 (first lines_list) (second lines_list)) 0))
       (db%change_file_name  *db%current_file*)
       (setq *current_exposed_window_list* (list *db%top_mode_line*
						   *db%bottom_mode_line*))
       (db%change_mode_line  *db%bottom_mode_line* *db%command_string*)
       ;;make new curses windows for each window currently hanging
       ;;around
       (let ((temp_window_config *current_debug_windows_config*))
	 (setq *current_debug_windows_config* nil)
	    (loop for (window lines cols start_y start_x curses_win)
		  in temp_window_config
		  for new_lines in lines_list
		  with new_y = 0
		  do (delwin (get-iv db%debug_window (eval window)
				      curses-window))
		  do (set curses_win  (newwin new_lines cols new_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- new_lines))
		  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 new_lines)
		  do (setq *current_debug_windows_config*
			   (append *current_debug_windows_config*
				 (list (list  window new_lines cols
				       new_y start_x curses_win))))
		  do (setq *current_exposed_window_list*
			   (append (list (eval window))
				   *current_exposed_window_list*))
		  do (setq new_y (+ new_y new_lines 1))))
       ;;finally, reposition the *db%current_window* again
       (ct_csend db%debug_window  *db%current_window*  :reposition_cursor))



	;;;;;;;;;;;;;;;;;
(defun db%init_control_c ()
	;;;;;;;;;;;;;;;;;
  ;;Initialize the function *db%kill_char*
  ;;for catching a control-c entered by the user
  (setq *db%kill_char* nil)
  (signal 2 'db%control_c))


       ;;;;;;;;;;;;
(defun db%control_c (signal)
       ;;;;;;;;;;;;
  ;;the function called to intercept a control-c 
  signal
  ;;if under the debugger, set the *db%kill_char* to 
  ;;'t so that interpreter execution will be halted the
  ;;next time around the loop
  ;;Otherwise, throw out to VMS
  (ct_if (or *db%debugger_p*
	     *db%part_debugger_p*)
	 (setq *db%kill_char* t)
	 (db%quit))
  ;;if debugging, cause a lisp break; but first,
  ;;turn off crmode and turn echo on
  (ct_if (status feature debugging)
	 (progn
	   (nocrmode)
	   (echo)
	   (break)
	   (crmode)
	   (noecho))))


       ;;;;;;;;;;;;;
(defun db%ask_cursor (&optional window)
       ;;;;;;;;;;;;;
  ;;return the (x,y) cursor position from the given window,
  ;;or from *db%current_window* if no window is supplied
  (ct_if window
	 (list (get-iv db%debug_window window current_xpos)
	       (get-iv db%debug_window window current_ypos))
	 (list (get-iv db%debug_window *db%current_window* current_xpos)
	       (get-iv db%debug_window *db%current_window* current_ypos))))

		  
       ;;;;;;;;;;;;;
(defun db%ask_string (prompt max_length &optional default)
       ;;;;;;;;;;;;;
  ;;Prompt the user to input a string of at most 'max_length
  ;;with prompt 'prompt and the default answer of 'default
  (let ((temp_string nil)
	(long_string (ct_if (eq max_length 'positive)
			 *integer_last*
			 max_length)))
    (ct_if default
	   (setq temp_string (ct_format nil "~A  [~A]:~3X"
					prompt  default))
	   (setq temp_string (ct_format nil "~A [null string]:~3X"
					prompt )))
    (loop while t
	  with input_string = nil
	  do (db%change_mode_line *db%bottom_mode_line*
				  temp_string)
	  do (setq input_string (db%wgetstr *db%bottom_mode_line*))
	  do (ct_if (equal input_string "")
		    (ct_if default (return default)
			   (return nil)))
	  when (< (string-length input_string) long_string)
	       return input_string
	       else do (db%user_interface_error "String too long"))))

       ;;;;;;;;;;;;;;
(defun db%ask_integer (prompt low high &optional default)
       ;;;;;;;;;;;;;;
  ;;Prompt the user to input an integer with prompt 'prompt,
  ;;lowest allowed value 'low, highest allowed value 'high,
  ;; and optional default value 'default
  (let ((temp_string nil)
	(low_num (ct_if (eq low 'negative)
			*integer_first*
			low))
	(high_num (ct_if (eq high 'positive)
			 *integer_last*
			 high)))
		 
    (ct_if default
	   (setq temp_string (ct_format nil "~A (~D to ~D) [~D]:~3X"
					prompt low high default))
	   (setq temp_string (ct_format nil "~A (~D to ~D) [~D]:~3X"
					prompt low high low)))
    (loop while t
	  with input_num = nil
	  do (db%change_mode_line *db%bottom_mode_line*
			 temp_string)
	  do (setq input_num (db%wgetnumberstring *db%bottom_mode_line*))
	  do (ct_if (or (eq input_num #\return)
			(eq input_num #\linefeed)
			(equal input_num ""))
		    (ct_if default (return default)
			   (return low)))
	  do (setq input_num (first (db%get_numbers_from_string input_num 1)))
	  when (and (>= input_num low_num)
		     (<= input_num high_num))
	     return input_num
	   else do (db%user_interace_error "Invalid number"))))

       ;;;;;;;;;;;;;;
(defun db%ask_literal (prompt item_list &optional default)
       ;;;;;;;;;;;;;;
  ;;ask the user to choose from a menu with 'prompt being
  ;;the prompt displayed and item_list consisting of either
  ;;an atom which will return itself as a value or
  ;;(item value) where item is displayed and value is returned
  ;;if that item is chosen.  The optional default choice is
  ;;found in 'default, which again will be either an item
  ;;or an item,value pair.
   (let* ((return_item (ct_if (atom (first item_list))
			     (first item_list)
			     (second (first item_list))))
	 (default_number 1)
	 (temp_string)
	 (temp_window_list *current_exposed_window_list*)
	 (temp_current_window *db%current_window*))
    (unwind-protect
      (progn
	(ct_if (> (length item_list) 5)
	       (progn
		 (setq *db%debug_menu* *db%large_debug_menu*)
		 (setq *db%current_window* *db%large_debug_menu*)
		 (setq *db%debug_menu_mode_line* *db%large_debug_menu_mode_line*))
	       (progn
		 (setq *db%debug_menu* *db%small_debug_menu*)
		 (setq *db%current_window* *db%small_debug_menu*)
		 (setq *db%debug_menu_mode_line* *db%small_debug_menu_mode_line*)))
	(setq *current_exposed_window_list*
	      (append  *current_exposed_window_list*
		       (list *db%debug_menu* *db%debug_menu_mode_line*)))
	(ct_csend db%debug_window *db%debug_menu* :clear)
	;;;next line is temporary
	(ct_csend db%debug_window *db%debug_menu* :display-string "" nil)
	(wstandout *db%debug_menu_mode_line*)
	(touchwin *db%debug_menu_mode_line*)
	(wrefresh *db%debug_menu_mode_line*)
	(loop for i from 1 to (length item_list)
	      for element in item_list
	      do (ct_csend db%debug_window *db%debug_menu* :add-line
			  (format nil "~3X~D:~2X~A" i
				  (ct_if (atom element)
					 element
					 (first element)) nil))
	      do (ct_if (and default
			     (equal default element))
			(setq default_number i)))
	(setq temp_string (ct_format nil "~A ~2X [~D]:~3X"
				     prompt default_number))
	(ct_csend db%debug_window *db%debug_menu* :touchwin)
	(ct_csend db%debug_window *db%debug_menu* :beginning)
	(loop while t
	      with input_num = nil
	      do (db%change_mode_line *db%debug_menu_mode_line*
				      temp_string)
	      do (setq input_num (db%wgetmenu_choices *db%debug_menu_mode_line* temp_string))
	      do (ct_if (or (eq input_num #\return)
			    (eq input_num #\linefeed)
			    (equal input_num ""))
			(progn
			  (ct_if default
				 (ct_if (atom default) (return default)
					(return (second default)))
				 (return return_item))))
	      do (setq input_num (1- (first
				       (db%get_numbers_from_string input_num 1))))
	      when (and (>= input_num 0)
			(<= input_num (1- (length item_list))))
	      do
	      (progn
		(setq return_item (car (nthcdr input_num item_list)))
		(ct_if (atom return_item)
		       (return return_item)
		       (return (second return_item))))
	      else do (db%user_interface_error "No such menu item")))
      (progn
	(wclear *db%debug_menu_mode_line*)
	(wrefresh *db%debug_menu_mode_line*)
	(setq *current_exposed_window_list*
	      temp_window_list)
	(setq *db%current_window* temp_current_window)
	(db%redisplay_after_menu *db%debug_menu*)))))

       ;;;;;;;;;;;;;;;;;;;;;;;
(defun db%ask_multiple_literal (prompt item_list &optional default)
       ;;;;;;;;;;;;;;;;;;;;;;;
  ;;ask the user to choose from a menu with 'prompt being
  ;;the prompt displayed and item_list consisting of either
  ;;an atom which will return itself as a value or
  ;;(item value) where item is displayed and value is returned
  ;;if that item is chosen.  The optional default choice is
  ;;found in 'default, which again will be either an item
  ;;or an item,value pair.
  ;;Multiple items are allowed to be chosen.
  (let* ((initial_item (first item_list))
	 (return_item_list (ct_if (atom initial_item)
				  (list initial_item)
				  (list (second initial_item))))
	 (default_number 1)
	 (temp_string nil)
	 (temp_current_window *db%current_window*)
	 (temp_window_list *current_exposed_window_list*))
    (unwind-protect
      (progn
	(ct_if (> (length item_list) 5)
	       (progn
		 (setq *db%debug_menu* *db%large_debug_menu*)
		 (setq *db%current_window* *db%large_debug_menu*)
		 (setq *db%debug_menu_mode_line* *db%large_debug_menu_mode_line*))
	       (progn
		 (setq *db%debug_menu* *db%small_debug_menu*)
		 (setq *db%current_window* *db%small_debug_menu*)
		 (setq *db%debug_menu_mode_line* *db%small_debug_menu_mode_line*)))
	(setq *current_exposed_window_list*
	      (append  *current_exposed_window_list*
		       (list *db%debug_menu* *db%debug_menu_mode_line*)))
	(ct_csend db%debug_window *db%debug_menu* :clear)
	;;;next line is temporary
	(ct_csend db%debug_window *db%debug_menu* :display-string "" nil)
	(wstandout *db%debug_menu_mode_line*)
	(touchwin *db%debug_menu_mode_line*)
	(wrefresh *db%debug_menu_mode_line*)
	(loop for i from 1 to (length item_list)
	      for element in item_list
	      do (ct_csend db%debug_window *db%debug_menu* :add-line
			  (format nil "~3X~D:~2X~A" i
				  (ct_if (atom element)
					 element
					 (first element)) nil))
	      do (ct_if (and default
			     (equal default element))
			(setq default_number i)))
	(setq temp_string (ct_format nil "~A ~2X [~D]:~3X"
				     prompt default_number))
	(ct_csend db%debug_window *db%debug_menu* :touchwin)
	(ct_csend db%debug_window  *db%debug_menu* :beginning)
	(loop while t
	      with input_num = nil
	      with input_numbers = nil
	      do (db%change_mode_line *db%debug_menu_mode_line*
				      temp_string)
	      do (setq input_num (db%wgetmenu_choices *db%debug_menu_mode_line* temp_string))
	      do (ct_if (or (eq input_num #\return)
			    (eq input_num #\linefeed)
			    (equal input_num ""))
			(progn
			  (ct_if default
				 (ct_if (atom default) (return (list default))
					(return (list (seocnd default))))
				 (return return_item_list))))
	      do (setq input_numbers  (db%get_numbers_from_string input_num
							       (length item_list)))
	      when (db%legal_input_numbers input_numbers  (length item_list))
	      do		
	      (progn
		(setq input_numbers
		      (loop for number in input_numbers
			    with new_list = nil
			    if (not (memq number new_list))
			    do (setq new_list (append new_list (list number)))
			    finally (return new_list)))
		(setq return_item_list
		      (loop for number in input_numbers
			    for return_item = (car (nthcdr (1- number)
							   item_list))
			    with return_item_value
			    do (ct_if (atom return_item)
				      (setq return_item_value return_item)
				      (setq return_item_value
					    (second return_item)))
			    collect return_item_value))
		(return return_item_list))
	      else do (db%user_interface_error  "No such menu item")))
      (progn
	(wclear *db%debug_menu_mode_line*)
	(wrefresh *db%debug_menu_mode_line*)
	(setq *current_exposed_window_list*
	      temp_window_list)
	(setq *db%current_window* temp_current_window)
	(db%redisplay_after_menu *db%debug_menu*)))))




       ;;;;;;;;;;;;;;;;;;;
(defun db%legal_input_numbers (number_list max_num)
       ;;;;;;;;;;;;;;;;;;;
  ;;Checks that each number in 'number_list is between
  ;;1 and the max_num allowed
    (loop for number in number_list
	  if (not (and
		     (>= number 1)
		     (<= number max_num)))
	      do (return nil)
	  finally (return t)))

       ;;;;;;;;;;;;;
(defun db%secret_out ()
       ;;;;;;;;;;;;;
  ;;Asks for the "secret" password so that we can still
  ;;break into a dumped version of the interpreter/debugger
  ;;that has debugging turned off
    (let ((secret_string (db%ask_string "What is the secret password? "
					'positive)))
	 (ct_if (equal secret_string "alligator")
		(break t))))