!
!+
!	Kalamazoo College Supplement to SYS$LIBRARY:EDTSECINI
!
!                    COPYRIGHT © 1985, 1986, 1987 BY
!	Richard D. Piccard, Michael L. Penix, and Kalamazoo College, 
!	Kalamazoo, Michigan, to the extent not copyright by DIGITAL. 
!                         ALL RIGHTS RESERVED
!
!
!	The following copyright line appears in several locations
!	throughout the code, indicating sections that are tightly based
!	on DIGITAL's EDTSECINI.TPU or EVESECINI.TPU files. 
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!	In those locations where the above line appears, the 
!	following should be understood:
!
!
!                    COPYRIGHT © 1983, 1984, 1985 BY
!               DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
!                           ALL RIGHTS RESERVED
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
!
!
!	Functional 4-OCT-1985   Michael L. Penix and Richard D. Piccard
!
!	Enhancement history is as noted in the headings of the various 
!	routines, as well as here:
!
!		18-DEC-1985  RDP:  Globally substitute "kaz$" -> "kaz_" in 
!				   procedure and global variable names to
!				   conform with DIGITAL standard practice. 
!
!		27-FEB-1986  RDP:  bind key definitions and relinquish 
!				   space, at end of this code, like EDTSECINI.
!
!		10-MAR-1986  RDP:  Change global variable names from
!				   "kaz_" to "kaz_x_" throughout.
!
!
!	The major vulnerabilities to changes by DIGITAL are in those variables 
!	and procedures whose names begin with "EDT$"; they reference the 
!	contents of DIGITAL's EDTSECINI file, which is "subject to change 
!	without notice."  The Release Notes for VMS 4.6 indicate that no 
!	further changes will be made by DIGITAL.
!


!
!
!	To activate after revisions, play with the revised version privately 
!	to verify correct operation, then verify that the first executable 
!	line of procedure tpu$local_init, below, correctly identifies the 
!	new version, and then execute a command procedure such as the 
!	one shown below.  The example command procedure assumes that 
!	SYS$MANAGER:SYSTARTUP.COM includes the following line:
!
!	$ assign/system/exec sys$share:kazsecini.tpu$section tpusecini
!
!
!========================================================================
!
!  $ copy/read/write fri:[piccard.tpuwork]kazsecini.tpu sys$share:*
!  $ public syst:[syslogin]kazsecini.tpu
!  $ NEWTPU := EDIT/TPU-
!      /SECTION=SYS$LIBRARY:EDTSECINI-
!      /COMMAND=sys$share:kazsecini.tpu
!  $ assign/user sys$output sys$input
!  $ NEWTPU
!  $ purge/keep=1 sys$login:kazsecini.new
!  $ copy/read/write sys$login:kazsecini.new sys$share:*
!  $ public sys$share:kazsecini.new
!  $ rename sys$share:kazsecini.new sys$share:kazsecini.tpu$section
!  $ INSTALL :== $ SYS$SYSTEM:INSTALL/COMMAND_MODE
!  $ INSTALL
!      replace SYS$SHARE:KAZSECINI.TPU$SECTION
!      exit
!  $ purge/keep=2 sys$share:kazsecini.*
!  $ exit
!
!========================================================================
!
!-


!
!				Table of Contents
!
!
!	TPU$LOCAL_INIT
!
!
!	Pointer motion
!
!		KAZ_END_PARAG
!		KAZ_END_SENT
!		KAZ_MOTION
!		KAZ_PAGE_LENGTH
!		KAZ_RESTORE
!		KAZ_TAB_JUMP
!		KAZ_TOP_PARAG
!		KAZ_TOP_SENT
!
!
!	Text alteration
!
!		KAZ_FILL_PARAG
!		KAZ_INCLUDE
!		KAZ_OVERSTRIKE
!		KAZ_RETURN
!		KAZ_SWAP_CHARACTERS
!
!
!	Conveniences
!
!		DCL
!		KAZ_ALPHABETIC
!		KAZ_GET_KEY_INFO
!		KAZ_GET_OUT
!		KAZ_LEARN
!		KAZ_REMEMBER
!
!
!	Programmers' delights
!
!		KAZ_SWAP_DELIM
!		KAZ_DCL_COMPILE
!		KAZ_FIND_LINE
!		KAZ_MATCH_LEFT_PARENTHESIS
!		KAZ_MATCH_RIGHT_PARENTHESIS
!
!
!	Clean up after DIGITAL
!
!		EDT$INIT_VARIABLES
!		EDT$PRESERVE_BLANKS
!		EDT$SHOW
!		EDT$TAB_ADJUST
!		EDT$WRAP_WORD
!
!
!	Buffer manipulation
!
!		KAZ_BUFFER_STACK
!		KAZ_CHECK_BAD_WINDOW
!		KAZ_CLEVER_WRITE
!		KAZ_ERASE_BUF
!		KAZ_FIND_BUFFER
!		KAZ_GOTO_BUFFER
!		KAZ_GRAB_A_BUFFER
!		KAZ_INIT_BUFFER
!		KAZ_OTHER_WINDOW
!		KAZ_PROMPT_STRING
!		KAZ_SHOW_BUF
!		KAZ_STATUS_LINE
!		KAZ_WINDOWS
!		KAZ_WRITE_BUF
!
!
!
!	KAZ_DEFINE_KEYS
!
!
!	save the context compactly and quit


procedure tpu$local_init
!
!+
!		 4-NOV-1985  RDP, Forrest Piehl:  sound bell for broadcasts
!
!		 6-NOV-1985  RDP:  clean up the sentence delimiter pattern. 
!
!		 8-NOV-1985  MLP:  Set info_window normal video and no pad.
!
!		19-NOV-1985  RDP:  Set(message_flags,5) to shorten output. 
!
!		17-DEC-1985  RDP:  expand message buffer, set(message_flags,1)
!
!		 2-MAR-1986  RDP and MLP:  three permanent windows (MAIN, top, 
!				   and bottom); all global variables newly
!				   provided by this section code begin 
!				   "kaz_x_". 
!
!		14-MAR-1986  RDP:  use ANY(string) construction to define 
!				   kaz_x_sent_delim.  See L&T-17 of DECUS
!				   SIG Newsletter for March, 1986.  
!
!		21-MAR-1986  RDP:  return scrolling to normal for vt-100's, 
!				   but retain "jumpy" scrolling for GIGI's.
!
!	        17-SEP-1986  RDP:  to use global variable for name of 
!				   most recently specified buffer.
!
!		18-SEP-1986  RDP:  to write to journal file more often.
!
!		25-SEP-1987  RDP:  include KAZSECINI in line mode 
!				   SHOW VERSION response.
!
!		28-SEP-1987  RDP:  move set(message_flags,1) to procedure
!				   edt$init_variables
!
!		01-OCT-1987  RDP:  turn scrolling OFF for GIGI's; VMS 4.6
!				   workaround from Edward M. King of CSC.
!-

local		gigi,
  		screen_length;

!
!	first initialize global variables
!
    kaz_x_version := ' - KAZSECINI 9/28/87';
!
!		next line is space, tab, ff, lf, cr, vt
    edt$x_word := " 	

";
    kaz_x_word_delim := 'text';
!
    kaz_x_sent_delim :=  
      ANY('.?!')
      &(
    	' ' | 
    	line_end |
    	(any('''")}]') & ' ') | 
    	(any('''")}]') & line_end)
      );
!
    KAZ_X_parag_delim := line_begin & line_end;
!
    KAZ_x_empty := '';
    kaz_x_make_buf_var := kaz_x_empty;
!
!			quoted (") string next is space, tab
    kaz_x_blanktab := ''&(notany (" 	") | line_end);
!
!		following line retired 9-MAR-1986 along with kaz_overstrike
!    kaz_x_entry_mode := 'insert';
!
    kaz_x_latest_name := 'MAIN';
    kaz_x_previous_name := 'MAIN';
    edt$x_tab_size := 4;
    edt$x_tab_goal := edt$x_tab_size;
    edt$x_tab_set := 1;
!
    define_key('edt$wrap_word',key_name(' '));
    edt$x_wrap_position := 65;
!
!
    kaz_x_window_size := 21;
    kaz_x_dcl_process := 0;
!
    kaz_x_this_window := current_window;
    kaz_x_number_of_windows := 1;
!
!	now execute some statements to set up the environment
!
!
! create the dcl buffer
!
    dcl_buffer := KAZ_init_buffer ("DCL_buffer", "[End of DCL]");
!
! Create windows for top and bottom halves of the screen
! Top window may be one line longer than bottom window.
!
    screen_length := get_info (screen, "visible_length");
!
    kaz_x_main_window_length := screen_length - 2;
    kaz_x_bottom_window_length := kaz_x_main_window_length / 2;
    kaz_x_top_window_length := 
      kaz_x_main_window_length - kaz_x_bottom_window_length;
    kaz_x_top_window := create_window (1, kaz_x_top_window_length, on);
    kaz_x_bottom_window :=
      create_window 
        (kaz_x_top_window_length + 1, kaz_x_bottom_window_length, on);
!
    gigi := get_info(SCREEN, "vk100");
    if (gigi = 0)
    then
      set (scrolling,KAZ_x_top_window,on,3,3,0);
      set (scrolling,KAZ_x_bottom_window,on,3,3,0);
      set (scrolling,main_window,on,7,7,0);
    else
      set (scrolling,KAZ_x_top_window,off,2,2,3);
      set (scrolling,KAZ_x_bottom_window,off,2,2,3);
      set (scrolling,main_window,off,4,4,6);
      set (scrolling,message_window,off,0,0,0);
    endif;
!
    set (status_line,kaz_x_top_window,none,"");
    set (status_line,kaz_x_bottom_window,none,"");
!
!	do some pretties
!

    set(bell,broadcast,on);
    SET (VIDEO,INFO_WINDOW,NONE);
    SET (PAD,INFO_WINDOW,OFF);
    set (max_lines,message_buffer,40);
!				the following reduces the maximum 
!				accumulation of keystrokes not yet on disk.
    SET (JOURNALING,4)
!
endprocedure


procedure KAZ_end_parag
!
!+
!		10-OCT-1985  RDP:  permit successful motion by paragraphs at
!				   beginning and end of buffer;  thereby
!				   correcting PF1 + F failures at those points. 
!
!		 8-MAR-1986  RDP:  add on_error code to kaz_end_parag, in order
!				   to suppress error message at end of buffer.
!-

local	parag_end_range;

on_error
  if parag_end_range = 0 then
    position (end_of(current_buffer));
    return 1;
  endif;
endon_error;

move_horizontal(+1);
parag_end_RANGE := SEARCH(kaz_x_parag_delim,forward,EXACT);
if parag_end_range = 0 then 
  position (end_of(current_buffer));
else
  position(parag_end_range);    
  move_vertical(+1);
endif;
endprocedure


procedure KAZ_end_sent
!
!+
!	move forward to beginning of next sentence
!-

    local	non_space,
		non_space_range,
		sent_end_range;

    sent_end_RANGE := SEARCH(kaz_x_sent_delim,forward,EXACT);
    if sent_end_range = 0
    	then 
    	    return;
    endif;
    position(end_of(sent_end_range));
!
!	the notany is space, tab
    non_space := ''&(line_begin | notany (' 	'));
    non_space_range := search(non_space,forward,exact);
    if non_space_range = 0
    then
	return;
    endif;
    position(non_space_range);
endprocedure


Procedure kaz_motion(which_way)
!
!+
!	EDT up/down arrow motion w/ grace near tabs; 
!
!	from DECUS Symposium 12/85 "Programming with TPU."
!
!		29-OCT-1985  RDP:  screen jump up and down by move_vertical;
!				   at the top and bottom of the buffer, this
!				   will generate an error message but also 
!				   move the cursor to the appropriate end of
!				   the buffer. 
!
!		17-DEC-1985  RDP:  Procedure kaz_motion from DECUS to get 
!				   better tracking with up and down arrows 
!				   around tabs. 
!
!		 2-MAR-1986  RDP and MLP:  Use kaz_motion in definition of 
!				   PF1 + up and PF1 + down arrows.
!-

LOCAL	temp_col,
    	last_col,
    	new_col,
    	eob,
    	buf;

buf := current_buffer;
eob := end_of(buf);

last_col := get_info(buf,'offset_column');

If (last_col <> edt$x_prev_column)
then
    edt$x_target_column := last_col;
endif;
move_vertical (which_way);
new_col := get_info(buf,'offset_column');
!+
!	now get as close to the target as possible
!-

If new_col <> edt$x_target_column
then
    if new_col < edt$x_target_column
    then
    	loop
    	exitif mark(none) = eob;
    	exitif current_character = '';
    	exitif new_col >= edt$x_target_column;
    	move_horizontal (1);
    	temp_col := get_info(buf,'offset_column');
    	if temp_col > edt$x_target_column
	then
    	    move_horizontal(-1);
    	    exitif
    	else
    	    new_col := temp_col
    	endif;
    	endloop;
    else
        loop
        exitif current_offset = 0;
        exitif new_col <= edt$x_target_column;
        move_horizontal(-1);
        new_col := get_info(buf,'offset_column');
        endloop;
    endif;
endif;

edt$x_prev_column := new_col;
endprocedure


procedure KAZ_page_length(called_page_size)
!
!+
!	move to nth line following the first previous form-feed
!
!	Rev. 17-SEP-1986 R. D. Piccard for variable n; was fixed at 58
!-

    local		found_range;

!		next line's search string is a ff character
    found_range := search('',reverse,exact);
    if found_range=0
    	then position (beginning_of(current_buffer));
    	else position (found_range);
    endif;
    move_horizontal(+1);
    move_horizontal(-current_offset);
    move_vertical(called_page_size);
endprocedure


PROCEDURE KAZ_RESTORE
!
!+
!	restore pointer to previously marked position, erasing 
!	the mark.
!
!		14-OCT-1985  RDP:  modify KAZ_RESTORE to leave cursor unmoved 
!				   if no mark is present.
!-

local		start_mark,
		bizz_mark,
    		bizz_mark_range;

on_error
  if bizz_mark_range = 0
  then
    position (start_mark);
    message ('No mark found in this buffer.');
    return;
  endif;
endon_error;

bizz_MARK := '^^&&^^';
start_mark := mark(none);
POSITION (BEGINNING_OF (CURRENT_BUFFER));
bizz_MARK_RANGE := SEARCH(bizz_MARK,FORWARD,EXACT);
POSITION (bizz_MARK_RANGE);
ERASE (bizz_MARK_RANGE);
ENDPROCEDURE


procedure KAZ_tab_jump
!
!+
!	Moves the pointer 8 characters in the current direction. 
!	One might sensibly choose the command cursor_horizontal
!	but that doesn't go from one line to the next and can be hanging
!	out in space beyond the end of the line. 
!-

on_error
  if current_direction = forward
  then
    position(end_of(current_buffer));
  else
    position(beginning_of(current_buffer));
  endif;
  return 1;
endon_error;

if current_direction = forward
then
  move_horizontal(+8)
else
  move_horizontal(-8)
endif;
endprocedure


procedure KAZ_top_parag
!
!+
!	Move backward one paragraph.
!
!		10-OCT-1985  RDP:  permit successful motion by paragraphs at
!				   beginning and end of buffer;  thereby
!				   correcting PF1 + F failures at those points. 
!-

local	parag_top_range;

on_error
  if parag_top_range = 0 then
    position (beginning_of(current_buffer));
    return 1;
  endif;
endon_error;

move_horizontal(-2);
parag_top_RANGE := SEARCH(kaz_x_parag_delim,reverse,EXACT);
if parag_top_range = 0 then 
  position (beginning_of(current_buffer));
else
  position(parag_top_range);    
  move_vertical(+1);
endif;
endprocedure


procedure KAZ_top_sent
!
!+
!	move backward to beginning of sentence
!
!		27-NOV-1985  RDP:  Revised KAZ_top_sent.  
!-

local	non_space_range,
	  non_space,
	  space,
	  space_range,
	  start_mark,
	  next_mark,
	  this_mark,
	  sent_top_range;

on_error
  if sent_top_range = 0
  then
    position(start_mark);
    return;
  endif;
  if space_range = 0
  then
    return;
  endif;
  if non_space_range = 0
  then
    return;
  endif;
endon_error;

start_mark := mark(none);
move_horizontal(-5);
sent_top_RANGE := SEARCH(kaz_x_sent_delim,reverse);
position(beginning_of(sent_top_range));    
space := '' & (' ' | line_end);
space_range := search(space,forward);
position(space_range);
non_space_range := search(''&(line_begin | notany(' ')),forward);
position(non_space_range);
endprocedure


procedure KAZ_fill_parag
!
!+
!	Fill the present paragraph.
!
!		27-NOV-1985  RDP:  use native tpu fill for PF1 + F, suppress
!				   screen updating during paragraph fill, 
!				   leave cursor position unchanged.  
!
!		 1-DEC-1985  RDP:  use EDT$X_WORD for paragraph fill. 
!
!		21-MAR-1986  RDP:  use whole_parag_range, instead of double-use
!				   of parag_end_range, so that errors at end of
!				   buffer will be dealt with correctly. 
!-

local		begin_mark, 
  		top,
  		whole_parag_range,
  		parag_end_range;

on_error
  if parag_end_range = 0 
  then 
    whole_parag_range := create_range(top,end_of(current_buffer),none);
  endif;
endon_error;

begin_mark := mark(none);
set(screen_update,off);
KAZ_top_parag;
move_horizontal(+1);
top := mark(none);
parag_end_RANGE := SEARCH(kaz_x_parag_delim,forward,EXACT);
if parag_end_range <> 0 
then 
  position(end_of(parag_end_range));
  move_horizontal(-1);
  whole_parag_range := create_range(top,mark(none),none);
endif;
fill(whole_parag_range,edt$x_word,1,edt$x_wrap_position);
position (begin_mark);
set(screen_update,on);
endprocedure


procedure KAZ_include
!
!+
!	include a file in the current buffer
!
!		16-OCT-1985  RDP:  PF1 + I for including file in current 
!				   buffer.  
!-

local		filename;

filename := read_line("Enter name of file to include: ");
read_file(filename);
endprocedure


procedure KAZ_overstrike
!
!+
!	swaps between overstrike and insert modes
!
!		16-OCT-1985  RDP:  kaz_overstrike (insert vs overstrike mode).
!
!		 9-MAR-1986  RDP:  replaced kaz_overstrike in favor of direct 
!				   definition of two keys, because of 
!				   multi-buffer confusion.
!
!		31-MAR-1986  RDP:  Use get_info to keep track of current 
!				   buffer's present mode.  Inspired 
!				   by EVESECINI.TPU.
!
!		 1-APR-1986  RDP and MLP:  Call kaz_status_line if not main
!				   buffer in main window; if it is, then 
!				   message.  Use local variables to reduce 
!				   use of current_ constructs.
!-

local		this_window,
                this_buffer,
                main_text;

this_window := current_window;
this_buffer := current_buffer;
if get_info (this_buffer, "mode") = insert 
then
  set (overstrike,this_buffer);
  main_text := 'OVERSTRIKE';
else
  set (insert,this_buffer);
  main_text := 'INSERT';
endif;    	
kaz_status_line (this_buffer,this_window);
if ((this_buffer = main_buffer) and (this_window = main_window))
then
  main_text := "This buffer is now set to " + main_text + " mode.";
  message (main_text);
endif;
endprocedure


procedure KAZ_return
!
!+
!	implements autoindent a'la Apple Pascal;
!	actuated when programming delimiters are used.
!
!		 2-DEC-1985  MLP:  autoindent for programming.
!-

local		orig_pos,		! beginning of new line
    		first_pos,              ! beginning of previous line
    		first_non_blank,
    		dupe;


set(screen_update,off);
split_line;
orig_pos := mark(none);
move_vertical (-1);
first_pos := mark(none);
!
! 	search for first non-space or tab character on this line
!
first_non_blank := search (kaz_x_blanktab,forward,exact);
if first_non_blank <> 0
then
  position (first_non_blank);
else
  position (orig_pos);
  set(screen_update,on);
  return;
endif;
if current_offset <> 0
then
  move_horizontal (-1);
  dupe := create_range(first_pos,mark(none),none);
  position (orig_pos);
  copy_text(dupe);
else 
  position (orig_pos);
endif;
set(screen_update,on);
endprocedure;


procedure KAZ_swap_characters
!
!+
!	Correct a common typographical error
!-

local	first_char;

first_char := erase_character(-1);
move_horizontal(+1);
copy_text (first_char);
endprocedure


procedure dcl (dcl_parameter)
!
!+
!	This command automatically creates a second window if needed, but
!	the user is left in the current buffer at the end of the command
!	(reduce trap-door risk).  Returns true if successful, false if no
!	dcl command was issued. 
!
! Parameters:
!
!	dcl_parameter		String containing DCL command - input
!
!		 2-MAR-1986  RDP and MLP:  DCL Window by PF1 + W. 
!-

local dcl_string,		! Local copy of dcl_parameter
      this_position,		! Marker for current cursor position
      that_buffer,
      this_buffer;		! Current buffer

on_error
  if error = tpu$_createfail then
    message ("DCL subprocess could not be created.");
    return (0);
  endif;
endon_error;

if not (kaz_prompt_string (dcl_parameter, dcl_string,
	   "DCL command: ", "No DCL command given")) 
then
  return;
endif;
!
if (get_info (kaz_x_dcl_process, "type") = unspecified) or
  	    (kaz_x_dcl_process = 0) 
then
  message ("Creating DCL subprocess ... ");
  kaz_x_dcl_process := create_process (dcl_buffer, "$ set noon");
  message 
    ("Use <PF1> + CTRL/W to use single window; use ENTER to toggle between windows.");
endif;
!
this_buffer := current_buffer;
this_position := mark (none);
if this_buffer <> dcl_buffer 
then
  if kaz_x_number_of_windows = 2 
  then
    kaz_other_window;
    if current_buffer <> dcl_buffer 
    then
      map (current_window, dcl_buffer);
      that_buffer := current_buffer;
      kaz_status_line(that_buffer,current_window);
      update(current_window);
    endif;
  else
    unmap (main_window);
    map (kaz_x_top_window, this_buffer);
    kaz_status_line(this_buffer,kaz_x_top_window);
    map (kaz_x_bottom_window, dcl_buffer);
    that_buffer := current_buffer;
    kaz_status_line(that_buffer,kaz_x_bottom_window);
    kaz_x_number_of_windows := 2;
    kaz_x_window_size := 10;
    kaz_x_this_window := kaz_x_bottom_window;
  endif;
endif;
!
! Process the DCL string - the $ will not be shown
!
position (end_of (dcl_buffer));
split_line;
copy_text (dcl_string);
update (current_window);
send (dcl_string, kaz_x_dcl_process);
position (end_of (dcl_buffer));
update (current_window);
if this_buffer <> dcl_buffer 
then
  kaz_other_window;
endif;
return (1);
endprocedure; 


procedure kaz_alphabetic (this_key)
!
!+
!	A support procedure for kaz_remember.
!       From EVESECINI.TPU, Page 9
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!
! Procedure to check if a key is a printing character (in DEC Multinational
! set).  Returns the character if alphabetic, else returns the null string.
!
! Parameters:
!
!	this_key		Keyword of key to check - input
!-

local ascii_key;		! String for this_key

ascii_key := ascii (this_key);
if ascii_key = ascii (0) 
then
  return (edt$x_empty);
else
  return (ascii_key);
endif;
endprocedure;


procedure KAZ_GET_KEY_INFO
!
!+
!	Terse HELP function.
!-

LOCAL 		key_to_interpret, 
    		key_info;

MESSAGE("Press the key you want information on: ");
key_to_interpret := read_key;
key_info := lookup_key(key_to_interpret, comment);
if key_info <> ""
then 
  message("Comment: " + key_info);
else 
  message("No comment is associated with that key.");
endif;
endprocedure


procedure KAZ_get_out
!
!+
!	Normal exit, with precautions against errors
!
!		17-DEC-1985  RDP:  add on_error to KAZ_get_out.  
!
!		14-MAR-1986  RDP:  prevent gobbling up the window on repeated 
!				   errors.
!
!		21-MAR-1986  RDP:  prevent "TPU Command:" prompt from obscuring
!				   the messages, by mapping message buffer to a
!				   window, either top or bottom. 
!
!		18-SEP-1986  RDP:  revise the error-handling to use kaz_windows
!				   with appropriate newly available arguments.
!-

local	this_window;

on_error
!
!		Be sure that hours of effort don't get thrown away
!

kaz_check_bad_window;
message (" ");
kaz_windows("2","message");
!  
message 
 ("If the above error is for disk quota, you can use <PF1> + PAD 7 and give");
message 
 ("  the TPU command SPAWN to get to the VMS $ prompt.  After PURGING excess");
message 
 ("  files, LOGOFF to return to editing and then try again to exit.");
return
endon_error;

  write_file(main_buffer);
  exit;
endprocedure


procedure kaz_learn
!
!+
!	Learn mode procedures are kaz_learn and kaz_remember
!
!       Modified slightly from EVESECINI.TPU, Page 89
!
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!		27-FEB-1986  RDP and MLP:  robust learn key sequence
!-

message
("Press keystrokes to be learned, ending with <PF1> + CTRL/K.");
learn_begin (exact);

endprocedure;


procedure kaz_remember
!
!+
! 	Remember a learn sequence.  Must be bound to a key in order to work;
!	cannot be used from command line.
!
!	Modified slightly from EVESECINI.
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!-

local learn_sequence,		! Learn sequence returned by end_learn builtin
      learn_key,                ! Keyword for key to bind sequence to
      define_error;		! Integer - true if recursive key definition

on_error
    if error = tpu$_notlearning then
	message ("You must begin a learn sequence with <PF1> + K.");
        return;
    else
	if error = tpu$_recurlearn then
	    define_error := 1;
	endif;
    endif;
endon_error;

learn_sequence := learn_end;

loop
!    			originally   learn_key := eve$prompt_key
     message
       ("Press the key to be used for that sequence, <RETURN> to discard it: ");
     learn_key := read_key;
     if learn_key = ret_key then
	message ("Key sequence discarded.");
	return;
     endif;

    if kaz_alphabetic (learn_key) = edt$x_empty then
      define_key (learn_sequence, learn_key, "Learned sequence.");
      if define_error then
        message ("Choose a key not already used in the learn sequence.");
        define_error := 0;
      else		! clear LEARN message if still there
        message ("Key sequence remembered.");
        exitif 1;
      endif;
    else
      message ("Choose a command key, not a printing key.");
    endif;
endloop;
endprocedure;


procedure KAZ_swap_delim
!
!+
!	Toggle between word processing and program writing 
!	definitions of the word delimiter.
!
!		23-DEC-1985  RDP:  revise kaz_swap_delims and kaz_define_keys,
!				   so that the comment for the definition of
!				   the return key is always just "return", 
!				   thereby permitting exit from keypad help!
!-

if (kaz_x_word_delim = 'text')
then
!		next line is space, tab, ff, lf, cr, vt, and punctuation
  edt$x_word := " 	

/<>[]{},.:*&!;+-=^()\|'";
  define_key ('KAZ_return',ret_key,'return');
  kaz_x_word_delim := 'program';
else
!		next line is space, tab, ff, lf, cr, vt
  edt$x_word := " 	

";
  define_key ('split_line',ret_key,'return');
  kaz_x_word_delim := 'text';
endif;    	
endprocedure


procedure kaz_DCL_COMPILE(LANGUAGE)
!
!+
!	This procedure will write the contents of the current buffer to a
!	file.  It then uses the DCL procedure to issue the compile
!	command and displays the results of that compile of the newly
!	updated file in the DCL window, including error messages.  The
!	cursor is returned to the buffer at the position it had when the
!	command was given.  The two windows will remain on screen. 
!
!	The argument must be the DCL verb for compilation of the program.
!	The default file type, if TPU doesn't have an input or an output 
!	file name, will be the first three characters of the argument.
!
!		 7-MAR-1986  MLP and RDP:  kaz_dcl_compile for in-editor write 
!				   and compile, uses kaz_clever_write.
!-

local       file_name, 
            dcl_command,
            buffer_ptr,
            buffer_name,
            len;

!
!	write the buffer out so that we can compile it
!
buffer_ptr := current_buffer;
buffer_name := get_info(buffer_ptr,"name");
file_name := kaz_clever_write(buffer_name,buffer_ptr,language);
!
! send the command to compile the program
!
dcl_command := LANGUAGE + ' ' + file_name;
dcl (dcl_command);
endprocedure


procedure KAZ_find_line
!
!+
!	Go to the user-specified line of the current buffer.
!
!		10-OCT-1985  MLP and RDP:  for PF1 + C = find line by number.
!-

local		line_no;

position(beginning_of(current_buffer));
line_no := read_line('Enter line number to find: ');
move_vertical ( int (line_no) - 1);
endprocedure


procedure kaz_match_left_parenthesis(called_paren_char)
!
!+
!Procedure de Personnalisation de L'editeur EVE/TPU
!Auteur Michel DANA /ENST Groupe Electronique
!Date: 4 Avril 1986
!Version 1.00
!
! Adapted to KAZSECINI by Richard D. Piccard on 19-SEP-1986
!
!	Can be fooled by parentheses in quotes, which in some languages 
!	are not syntactically "matching" to anything, but throw the count
!	off.
!
!		19-SEP-1986  RDP:  generalized with argument for ({[
!-

  		LOCAL 	par_pat,
  		        the_index,
  		        this_position,
  		        that_position;

if called_paren_char = '('
then
  par_pat:=any("()");
else
  if called_paren_char = '['
  then
    par_pat:=any("[]");
  else
    par_pat:=any("{}");
  endif;
endif;
!
set (screen_update,off);
the_index:=1;
this_position:=mark(none);
loop
  move_horizontal(1);
  that_position:=search(par_pat,forward);
  exitif that_position=0;
  position(that_position);   
  if current_character = called_paren_char
  then 
    the_index:=the_index+1;
  else 
    the_index:=the_index-1;
  endif;
  exitif the_index=0;
endloop;        

set(screen_update,on);
if that_position = 0
then 
  message ('No Matching Parenthesis');
  position (this_position);
else
  position (that_position);
endif;

endprocedure


procedure kaz_match_right_parenthesis(called_paren_char)
!
!+
!Procedure de Personnalisation de L'editeur EVE/TPU
!Auteur Michel DANA /ENST Groupe Electronique
!Date: 4 Avril 1986
!Version 1.00
!
! Adapted to KAZSECINI by Richard D. Piccard on 19-SEP-1986
!
!	Can be fooled by parentheses in quotes, which in some languages 
!	are not syntactically "matching" to anything, but throw the count
!	off.
!
!		19-SEP-1986  RDP:  generalized with argument for )}]
!-

 		LOCAL 	par_pat,
 		        the_index,
 		        this_position,
 		        that_position;

if called_paren_char = ')'
then
  par_pat:=any("()");
else
  if called_paren_char = ']'
  then
    par_pat:=any("[]");
  else
    par_pat:=any("{}");
  endif;
endif;
!
set (screen_update,off);
the_index:=1;
this_position:=mark(none);
loop
  that_position:=search(par_pat,reverse);
  exitif that_position=0;
  position(that_position);   
  if current_character = called_paren_char
  then 
    the_index:=the_index+1;
  else 
    the_index:=the_index-1;
  endif;
  exitif the_index=0;
endloop;        

set(screen_update,on);
if that_position = 0
then 
  message ('No Matching Parenthesis');
  position (this_position);
else
  position (that_position);
endif;
                
endprocedure 


procedure edt$init_variables		! initialize global variables
!
!+
!	Modified from EDTSECINI.TPU
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!
!		25-SEP-1987  RDP:  add following line, to shorten message 
!				   when file is read in.  It was suggested 
!				   by "The Heap" 7/85, and eliminates 
!				   identifier and facility; it used to be 
!				   in procedure tpu$local_init.
!-
!

set (message_flags,1);
!
! Initialize some variables
!
!
! Create the null variable
!
edt$x_empty := '';
edt$x_version : =0;
!
! Each command must be eleven characters long, with the first being a space
TRUE:=1;
FALSE:=0;
edt$x_search_begin := 1;
edt$x_terminators := ' 	=%';
edt$x_subs_term := '/';
edt$x_word := " 	

";
edt$x_prefixes := '	 %';
edt$x_wrap_position := 0;
edt$x_tab_size := 4;
edt$x_tab_goal := 8;
edt$x_tabs_set := 1;
edt$x_keypad_window := 0;
edt$x_delete_crlf:=0;
edt$x_appended_line := 0;
edt$x_section_distance:=16;
edt$x_beginning_of_select := 0;
edt$x_search_string := edt$x_empty;
edt$x_search_case := no_exact;
edt$x_deleted_char := edt$x_empty;
edt$x_deleted_word := edt$x_empty;
edt$x_deleted_line := edt$x_empty;
edt$x_search_range:=0;
edt$x_select_range := 0;
edt$x_repeat_count := 1;
edt$x_video:=reverse;
edt$x_info_stats_video := none;
edt$x_control_chars := "
	

";
edt$x_forward_word:=
! don't move off current character position
	      (
	      anchor
		&
! if on eol,then match that
              (
	      (line_end)
	      |
!leading spaces,on a word delimiter
	     (span(' ') ) )		!((span(' ')) & (any(edt$x_word) | edt$x_empty) ) )
	      |
!no leading spaces,on a word delimiter,move one past it
	      (any(edt$x_word))
	      |
!no leading spaces,on a real word,go one beyond it
	      (scan(edt$x_word))
	      |
!no leading spaces,on a last real word of line, match rest of line
	      REmain
             )
	     &
! after matching, skip over trailing spaces if any
! except if match occurred at the eol. In this case,don't skip over blanks

	     (line_begin|span(' ') | edt$x_empty)
;
endprocedure


procedure edt$preserve_blanks(flag)    ! support routine for fill
!
!+
!	Modified from EDTSECINI.TPU
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!	To prevent the dreaded word-split when the select range 
!	starts in a word that extends beyond the specified margin. 
!
!		 ?-OCT-1985  RDP:  "fix" the bug in FILL by adding
!				a procedure call. 
!
!		 6-AUG-1986  RDP:  bring the three lines of code into 
!				this procedure, avoiding the overhead.
!-

LOCAL 	original_position,
	b_mark,
	e_mark,
	sub_range,
	temp_range,
	all_done,
	temp_pattern;

on_error
all_done:=1; ! cause exit
endon_error;

	original_position:=mark(none);
	b_mark:=beginning_of(edt$x_select_range);

! skip leading spaces on first line only

	position (b_mark);
	move_horizontal (-current_offset);
	b_mark := mark(none);
!
!		the above three lines are Kalamazoo's fix of a bug.
!
	edt$skip_leading_spaces(b_mark);
	position(original_position);

	loop
	! skip leading blank lines of a paragraph
	edt$skip_lines(b_mark);
	all_done:=edt$find_whiteline(b_mark,e_mark); ! start looking here

	exitif  all_done;

! now only fill the range created between the blank lines

	sub_range:=create_range(b_mark,e_mark,none);

! go to line following the range
	position(e_mark);
	move_horizontal(1);
	move_vertical(1);

! pick up search at end of current_range
	b_mark:=mark(none);

! do the fill operation

	if flag then
		fill(sub_range,edt$x_word,1,edt$x_wrap_position);
	  else
		fill(sub_range,edt$x_word,1,get_info(current_window,'width'));
	endif;
exitif all_done;
endloop;
position(original_position);
endprocedure


procedure edt$show		! support routine for line mode(show cmd)
!
!+
!	Modified from EDTSECINI.TPU
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!	Modified  25-Sep-1987  RDP:  so that SHOW VERSION
!				  includes KAZSECINI date. 
!-
LOCAL		show_type ,
		buf ,
		cur_buf,
		pos ,
		term_char ,
		save_info_status,
		show_index ;
!+
! What do they want to know
!-
show_type := edt$next_token(edt$x_empty,term_char);
if (show_type = edt$x_empty)
then
    message('You must provide an option to SHOW');
    return 0;
endif;
show_index := index(edt$x_shows,(' ' + show_type));
show_index := ((show_index + edt$x_show_length - 1) / edt$x_show_length);

CASE show_index FROM 0 TO 6
[0]:
    message('Unsupported SHOW option:  ' + show_type);
    return 0;

[1]:
! SHOW BUFFER
    pos := current_window;
    cur_buf := current_buffer;
    erase(show_buffer);
    position(show_buffer);
    copy_text(' BUFFER NAME        LINES       FILE');
    split_line;
    copy_text('------------------------------------------------------');
    split_line;
    buf := get_info(buffers,'first');
    loop
	exitif buf = 0;
	if (buf = cur_buf)
	then
	    copy_text('=');
	else
	    copy_text(' ');
	endif;
	copy_text(get_info(buf,'name'));
	copy_text('	');              ! insert a tab
	copy_Text(str(get_info(buf,'record_count')));
	copy_text('	');              ! insert a tab
	copy_text(get_info(buf,'file_name'));
	split_line;
	buf := get_info(buffers,'next');
    endloop;
    set(status_line,info_window,reverse,'  ');
    set(width,info_window,get_info(screen,'width'));
    map(info_window,show_buffer);
    update(info_window);
    buf := read_line('Press RETURN to continue.',1);
    set(status_line,info_window,edt$x_info_stats_video,'Press CTRL-F to remove INFO_WINDOW and resume editing');
    unmap(info_window);
    position(pos);

[2]:
! SHOW SEARCH
    buf := 'Search settings: ';
    if (edt$x_search_begin)
    then
	buf := buf + 'BEGIN '
    else
	buf := buf + 'END   '
    endif;
    if (edt$x_search_case = exact)
    then
	buf := buf + 'EXACT   '
    else
	buf := buf + 'GENERAL '
    endif;
    message(buf);

[3]:
! SHOW SCREEN
    buf := 'Screen Width is ';
    buf := buf + str(get_info(current_window,'width'));
    message(buf);

[4]:
! SHOW VERSION
    message('TPU Version V'+str(get_info(system,'version'))+'.'+
			str(get_info(system,'update')) +
                          ' - ' + edt$x_version + kaz_x_version);

[5]:
! SHOW CURSOR
    buf := 'Cursor boundaries are  ';
    buf :=  buf + str((get_info(current_window,'scroll_top') +
			get_info(current_window,'original_top')));
    buf := buf + ':';
    buf :=  buf + str((get_info(current_window,'original_bottom') -
		get_info(current_window,'scroll_bottom')));
    message(buf);

[6]:
! SHOW WRAP
    IF (edt$x_wrap_position = 0)
    then
	message ('Nowrap');
    else
        message('Wrap setting: ' + str (edt$x_wrap_position));
    endif;
return 1;
ENDCASE;
endprocedure


procedure edt$tab_adjust !ctrl t (adjust tabs)
!
!+
!	Modified from EDTSECINI.TPU
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
! Do a tabs adjust for the select region
!
!	Modified to prevent forcing the new indentation to BE 
!	a multiple of the tab size.
!
!		 30-SEP-1986  RDP:  re-activate the V4.2 fix.
!-
LOCAL
    start_range ,
    end_range ,
    tab_level ,
    adjust_level ,
    original_goal ;

!+
! Get the range to adjust
!-
edt$select_range;
if (edt$x_select_range = 0)
then
    message('No select active');
    return 0;
endif;
adjust_level := edt$x_repeat_count;
edt$x_repeat_count := 1;
original_goal := edt$x_tab_goal;
start_range := beginning_of(edt$x_select_range);
end_range := end_of(edt$x_select_Range);
edt$x_select_range := 0;
position(start_range);
move_horizontal(-current_offset);
loop
    exitif mark(none) > end_range;
!+
! Go to beginning of line.
! Calculate tab depth for this line
! Strip off spaces and tabs at beginning of line.
! Set up new tab goal
! Call the tab routine.
!-
    if length (current_line) > 0
    then
    loop
	exitif (current_character <> ' ') AND (current_character <> '	');
	move_horizontal(1);
    endloop;
!    tab_level := get_info(current_buffer,'offset_column') / edt$x_tab_size;
!    edt$x_Tab_goal := (tab_level + adjust_level) * edt$x_tab_size;
!
!	the above two line deactivated and replaced by the next line
!	as indicated in initial comments.
!
    edt$x_Tab_goal := get_info(current_buffer,'offset_column') - 1 + 
			  (adjust_level * edt$x_tab_size) ;
    if (edt$x_tab_goal < 0) then edt$x_tab_goal := 0 endif;
    erase_character(-current_offset);
    edt$tab;
    endif;
    move_vertical(1);
    move_horizontal(-current_offset);
endloop;
edt$x_tab_goal := original_goal;
endprocedure


procedure edt$wrap_word		! space key (wrap word)
!
!+
!	Modified from EDTSECINI.TPU
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
! Procedure to wrap the word to the next line. Bound to space key when
! a SET WRAP is done.
!
!		28-SEP-1987  RDP:  use the full number of columns (the
!				   current_column is one beyond the last 
!				   character typed); if the previous
!				   character was a space, and are now 
!				   too far, then just split_line. 
!-

LOCAL	word_size ,
        temp_char,
	 trash_space ;
if edt$x_wrap_position = 0
then
    return
endif;
if current_column > edt$x_wrap_position + 1
then
    move_horizontal(-1);
    temp_char := current_character;
    move_horizontal(+1);
    if (temp_char = ' ')
    then
        split_line;
        return;
    else
	word_size := edt$beg_word;
	split_line;
	move_horizontal(word_size);
    endif;
endif;
copy_text(' ');
endprocedure


procedure kaz_buffer_stack(called_buffer_name)
!
!+
!	Maintains stack of two most recently selected buffers.
!	Called by kaz_goto_buffer and kaz_windows.
!
!			18-SEP-1986  RDP:  revised from one global variable
!-

  		LOCAL	a_buffer_name;

a_buffer_name := called_buffer_name;
edit(a_buffer_name,upper);
if (
    (kaz_x_previous_name = a_buffer_name)
    or
    (kaz_x_latest_name = a_buffer_name)
   )
then
  return;
else
  kaz_x_previous_name := kaz_x_latest_name;
  kaz_x_latest_name := a_buffer_name;
endif;

endprocedure


procedure kaz_check_bad_window
!
!+
!	From sys$library:evesecini.tpu, Page 69
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!	Used before issuing window/buffer manipulation commands.  Returns
!	true if current window is message window, info window, or command
!	window, in which case we may not want to do the command.  In
!	these cases, the cursor is repositioned to either the main window
!	or the top window, depending on the value of kaz_x_number_of_windows.  
!	This helps people who accidentally get stuck in one of these
!	windows.  The calling procedure determines the error message or
!	other action.  In other cases, returns false. 
!-

if  (current_window = message_window) or
    (current_window = info_window) 
then
  if current_window = info_window 
  then
    unmap (info_window);
  endif;
  position (kaz_x_this_window);
  return (1);
else
  return (0);
endif;
endprocedure;


PROCEDURE kaz_clever_write(buffer_name,buffer_ptr,language)
!
!+
!	Support procedure for kaz_write_buf and kaz_dcl_compile.
!
!		 4-MAR-1986  RDP:  kaz_write_buf modified to use default file
!				   spec for buffer, if it exists, and to 
!				   default to current buffer.  
!
!		 7-MAR-1986  RDP:  use index and substr in kaz_write_buf to get
!				   clean default file spec.  Implemented 
!				   kaz_clever_write to reduce code duplication. 
!-

LOCAL		file_name ,
		file_default_1,
		file_default_2,
		file_default_3,
		file_default_4,
		file_type_end,
		file_name_default,
		default_message;

!
!	first get tpu's input and output default files, 
!		using null strings if none
!
file_default_1 := get_info(buffer_ptr,"output_file");
if file_default_1 = 0
then
  file_default_1 := '';
endif;
!
file_default_2 := get_info(buffer_ptr,"file_name");
if file_default_2 = 0
then
  file_default_2 := '';
endif;
!
!	construct a last ditch default from buffer name and last argument
!
file_default_3 := buffer_name + '.' + substr(language,1,3);
!
!	let RMS build default file specification
!
file_default_4 := file_parse(file_default_1,file_default_2,file_default_3);
!
!	prune explicit version number, typically from input file name
!
file_type_end := index(file_default_4,';') - 1;
if file_type_end = -1
then
  file_type_end := length(file_default_4);
endif;
file_name_default := substr(file_default_4,1,file_type_end);
!
!	we have a default filespec, let the user override or accept it
!
default_message := 'Hit RETURN to write new version of: ' + 
			file_name_default;
message (default_message);
file_name := read_line("Enter file to write to: ");
if (file_name = kaz_x_empty)
then
!						user accepted default file spec
  write_file(buffer_ptr,file_name_default);
  return file_name_default;
else
!						user overrode default file spec
  write_file(buffer_ptr,file_name);
  return file_name;
endif;
endprocedure


procedure KAZ_erase_buf
!+
!	Erases the specified buffer.
!
!	Modified from "Edt line mode Write command" Page 25
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!-
   
LOCAL		buffer_ptr,
		buffer_name;

buffer_name := read_line("Enter buffer to erase: ");
if (buffer_name = KAZ_x_empty)
then
  message ('No buffer specified');
  return 0;
endif;
buffer_ptr := KAZ_find_buffer (buffer_name);
if (buffer_ptr = 0)
then 
  message ('Specified buffer does not exist');
  return 0;
else
  erase(buffer_ptr);
  return 1;
endif;
endprocedure


procedure KAZ_find_buffer ( buffer_name) 
!
!+
! 	Find the buffer by name.
!
!	FROM PAGE 21 OF EDTSECINI.TPU; 
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!-

LOCAL		upcased_name ,
	 	buffer_ptr ; 

upcased_name := buffer_name;
change_case(upcased_name,upper);
buffer_ptr := get_info(buffers,'first');
loop
  exitif buffer_ptr = 0;
  exitif upcased_name = get_info(buffer_ptr,'name');
  buffer_ptr := get_info(buffers,'next');
endloop;
return buffer_ptr;
endprocedure


procedure KAZ_goto_buffer(called_buffer_name)
!
!+
!	Full screen window editing of specified buffer. 
!
! 	Modified from EDTSECINI Page 22, support routine for line 
!	mode(= buffer cmd)
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!		 5-MAR-1986  RDP:  kaz_buffer renamed to kaz_goto_buffer to 
!				   permit buffers named "KAZ".  
!
!	        17-SEP-1986  RDP:  to use stack for most recently specified 
!				   buffers.
!
!	        22-SEP-1986  RDP:  used with argument MAIN for PF1 + M.
!
!		28-SEP-1987  RDP:  clean up message text.
!-

    		local	buffer_name;

!
! This is to move to a new buffer and map it to the main window. If
! the buffer does not exist, ask whether to create it with the NO_WRITE 
! attribute.  Get the buffer name from the command line.
!
if kaz_x_number_of_windows = 2
then
  message ('Please use the <ENTER> command to toggle between windows, or');
  message ('use the <PF1> + CTRL/W command to select single-window.');
  return;
else
  if (called_buffer_name = KAZ_x_empty) 
  then
    buffer_name := READ_LINE ("Enter buffer name: ");
  else
    buffer_name := called_buffer_name;
  endif;
  if (buffer_name = KAZ_x_empty)
  then
    message('No buffer specified');
    return 0;
  endif;
!
  kaz_buffer_stack (buffer_name);
  kaz_grab_a_buffer(buffer_name,main_window);
endif;
endprocedure


procedure kaz_grab_a_buffer(buffer_name,new_window)
!
!+
!	Support routine for kaz_window, kaz_main_buf, and kaz_goto_buffer;
!	modeled on EDTSECINI code.
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!		21-NOV-1985  RDP and MLP:  Query file writing for new buffers
!
!		 5-MAR-1986  RDP:  kaz_grab_a_buffer implemented to reduce code
!				   duplication. 
!
!		12-MAR-1986  RDP:  permit selection of input file even if not
!				   planning to write it out.
!
!		14-MAR-1986  RDP:  correct order of map and read_file steps.
!
!		28-SEP-1987  RDP:  if newly read file, leave at top.
!-

local		buffer_ptr,
                file_name,
  		file_write;


buffer_ptr := KAZ_find_buffer(buffer_name);
!
! IF it doesn't exist, create it first, otherwise just map to it
!
if buffer_ptr = 0
then
!	got to create new buffer
!
  kaz_x_make_buf_var := buffer_name;
  create_variable_string := 
      kaz_x_make_buf_var + "_buffer := create_buffer(kaz_x_make_buf_var)";
  execute (create_variable_string);
! Now get the pointer back, we know it is the last buffer in the list
  buffer_ptr := get_info (buffers,'last');
  message ('Hit RETURN to skip reading in from a file.');
  file_name := read_line("Enter name of file to read into buffer: ");
  if file_name <> kaz_x_empty
  then
    set (output_file,buffer_ptr,file_name);
  endif;
  file_write := read_line
      ("Write the contents of this buffer to disk upon exit [Y/N]? ");
  if (index(file_write,'y') = 0) and (index(file_write,'Y') = 0)
  then
    SET (NO_WRITE, buffer_ptr, ON);
  else
    SET (NO_WRITE, buffer_ptr, OFF);
  endif;
  set(eob_text, buffer_ptr, '[End of '+buffer_name+']');
  kaz_status_line(buffer_ptr,new_window);
  map(new_window,buffer_ptr);
  if file_name <> kaz_x_empty
  then
    read_file(file_name);
    position (beginning_of(buffer_ptr));
  endif;
!
else
!	buffer already exists
!
  kaz_status_line(buffer_ptr,new_window);
  map(new_window,buffer_ptr);
endif;
!
kaz_x_this_window := current_window;
return 1;
endprocedure


procedure KAZ_init_buffer (new_buffer_name, new_eob_text)
!
!+
!         FROM SYS$LIBRARY:EVESECINI.TPU, Page 110
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
! Procedure used to create an Eve system buffer.  Returns the new buffer.
!
! Parameters:
!
!	new_buffer_name		String for name of new buffer - input
!	new_eob_text		String for eob_text of new buffer - input
!-

local new_buffer;		! New buffer

new_buffer := create_buffer (new_buffer_name);
set (eob_text, new_buffer, new_eob_text);
set (no_write, new_buffer);
set (system, new_buffer);
return (new_buffer);
endprocedure;


procedure kaz_other_window
!
!+
!	Modified from SYS$LIBRARY:EVESECINI.TPU, Page 75
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
!	Switch to other window
!
!	        17-SEP-1986  RDP:  to use global variable for name of 
!				   most recently specified buffer.
!
!	        18-SEP-1986  RDP:  to use stack for two most recent
!				   buffer names.
!-

  		LOCAL	this_buffer_name;

kaz_check_bad_window;
if kaz_x_number_of_windows = 1 
then
  if get_info(current_buffer,"name") <> kaz_x_latest_name
  then
    kaz_goto_buffer(kaz_x_latest_name);
  else
    kaz_goto_buffer(kaz_x_previous_name);
  endif;
else
  if current_window = kaz_x_top_window 
  then
    position (kaz_x_bottom_window);
  else
    position (kaz_x_top_window);
  endif;
  kaz_x_this_window := current_window;
endif;
endprocedure;


procedure kaz_prompt_string (old_string, new_string, prompt_string,
			     no_value_message)
!
!+
!	From sys$library:evesecini.tpu, Page 12
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!
! Procedure used by commands which prompt for strings.
! Returns true if prompting worked or was not needed, false otherwise.
!
! Parameters:
!
!	old_string		Old string value - input
!	new_string		New string value - output
!	prompt_string		Text of prompt - input
!	no_value_message	Message printed if user hits Return to
!				get out of the command - input
!-

local read_line_string;		! String read after prompt

new_string := old_string;
if old_string = kaz_x_empty 
then
  new_string := read_line (prompt_string);
    if new_string = kaz_X_EMPTY 
    then
      message (no_value_message);
      return (0);
    else
      return (1);
    endif;
else
  return (1);
endif;
endprocedure;


procedure KAZ_show_buf
!+
!	Based on "EDT line mode Show command", Page 23
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!-
   
LOCAL		buf ,
		cur_buf,
		pos;

! SHOW BUFFER
pos := current_window;
cur_buf := current_buffer;
erase(show_buffer);
position(show_buffer);
copy_text(' BUFFER NAME        LINES       FILE');
split_line;
copy_text('------------------------------------------------------');
split_line;
buf := get_info(buffers,'first');
loop
  exitif buf = 0;
  if (buf = cur_buf)
  then
    copy_text('=');
  else
    copy_text(' ');
  endif;
  copy_text(get_info(buf,'name'));
  copy_text('	');              ! insert a tab
  copy_Text(str(get_info(buf,'record_count')));
  copy_text('	');              ! insert a tab
  copy_text(get_info(buf,'file_name'));
  split_line;
  buf := get_info(buffers,'next');
endloop;
set(status_line,info_window,reverse,'  ');
set(width,info_window,get_info(screen,'width'));
map(info_window,show_buffer);
update(info_window);
buf := read_line('Press RETURN to continue.',1);
set(status_line,info_window,none,'Press CTRL-F to remove INFO_WINDOW and resume editing');
unmap(info_window);
position(pos);
endprocedure


procedure kaz_status_line (buffer_ptr,window_ptr)
!
!+
!	Support procedure for buffer and window routines
!	this sets the status line for the window to indicate
!	the text entry mode, the buffer, and its default file spec.
!
!		 2-MAR-1986  RDP and MLP:  clean management of status lines.
!
!		 4-MAR-1986  RDP:  Status line updating cleaned up for 
!				   returning to MAIN.
!
!		 5-MAR-1986  RDP:  kaz_status_line implemented to reduce code 
!				   duplication. 
!
!		 1-APR-1986  RDP:  Display insert or overstrike mode first, 
!				   then buffer and file names. 
!-

local		file_1,
  		buffer_1,
  		status_1;

buffer_1 := get_info(buffer_ptr,"name");
if ((buffer_1 = 'MAIN') and (window_ptr = main_window))
then
  set (status_line,main_window,none,"");
else
!
!	get output file name; if blank, use input file name
!
  file_1 := get_info(buffer_ptr,"output_file");
  if file_1 = 0
  then
    file_1 := get_info(buffer_ptr,"file_name");
  endif;
  if get_info (buffer_ptr, "mode") = insert
  then
    status_1 := "INSERT mode      ";
  else
    status_1 := "OVERSTRIKE mode  ";  
  endif;
  status_1 := status_1 + buffer_1 + "   " + file_1;
  set (status_line,window_ptr,reverse,status_1);
endif;
return;
endprocedure


procedure KAZ_windows(called_window_count,called_buffer_name)
!
!+
!	Window control:  single- or double-window editing for use with 
!	multi-buffer commands.  
!
!	Query the number of windows, establish and map them.  
!
!		11-OCT-1985  RDP and MLP:  clean two-window dual-file using
!				   PF1 + CTRL/W to change between single- and 
!				   dual-window display;  PF1 + B and PF1 + M
!				   during dual-window just bounce between. 
!
!		 ?-MAR-1986  RDP and MLP:  use <ENTER> to toggle between 
!				   windows; initialize main, top, and bottom
!				   windows at startup.
!
!		12-MAR-1986  RDP:  set status line for 1 window before mapping,
!				   thereby eliminating one unneeded refresh.
!
!		14-MAR-1986  RDP:  use kaz_x_this_window for 2 -> 2 windows. 
!
!	        17-SEP-1986  RDP:  to use global variable for name of 
!				   most recently specified buffer.
!
!		18-SEP-1986  RDP:  use arguments; for kaz_get_out errors.
!
!
!	global variables are 	KAZ_x_top_window         the top window
!				KAZ_x_bottom_window          bottom 
!				kaz_x_empty	         empty string
!				kaz_x_number_of_windows  what it says
!				kaz_x_this_window        the latest
!-

local		window_count,
    		this_position,
    		this_buffer,
    		new_window,
		buffer_name,
		buffer_ptr,
		file_write,
    		file_name_2;

if (called_window_count = "0")
then
  window_count := read_line("Enter number of windows (1 or 2): ");
else
  window_count := called_window_count;
endif;
if window_count = "1"
then
!					here if normal usage
!
!	Ensure that there is one mapped window, with standard size, to current
!	buffer. 
!
  kaz_x_window_size := 21;
!
  this_position := mark(none);
  this_buffer := current_buffer;
  if kaz_x_number_of_windows = 2
  then
    unmap(kaz_x_top_window);
    unmap(kaz_x_bottom_window);
    kaz_status_line(this_buffer,main_window);
    map(main_window,this_buffer);
    kaz_x_this_window := main_window;
    position (this_position);
    kaz_x_number_of_windows := 1;
  endif;
!
  return 1;
else
  if window_count = "2"
  then
!					here for dual-window usage
!
!	ensure that there are two mapped windows, with half size, upper to
!	main buffer, and lower to second buffer, each w/ status line.
!
!
    message ('Toggle between windows using <ENTER>.');
    if (called_buffer_name <> kaz_x_empty)
    then
      buffer_name := called_buffer_name;
    else
      buffer_name := read_line("Enter name of second buffer: ");
      if (buffer_name = KAZ_x_empty)
      then
	message('No buffer specified');
	return 0;
      endif;
    endif;
!
    kaz_buffer_stack(buffer_name);
!
    if kaz_x_number_of_windows = 1
    then
      this_buffer := current_buffer;
      this_position := mark(none);
      unmap(main_window);
      kaz_status_line(this_buffer,kaz_x_top_window);
      map(kaz_x_top_window,this_buffer);
      position(this_position);
      kaz_x_this_window := current_window;
      new_window := kaz_x_bottom_window;
!
!
    else
      if kaz_x_this_window = kaz_x_top_window
      then
        new_window := kaz_x_bottom_window;
      else
        new_window := kaz_x_top_window;
      endif;
    endif;
!
    kaz_grab_a_buffer(buffer_name,new_window);
!
    kaz_x_window_size := 10;
    kaz_x_number_of_windows := 2;
    return 1;
  else
!					here for improper response
    message('Illegal, you must respond with 1 or 2.');
    return 0;
  endif;
endif;
endprocedure

    
procedure KAZ_write_buf  ! support routine for line mode(write cmd)
!
!+
!	Modified from "Edt line mode Write command", Page 25
!
!                    COPYRIGHT © DIGITAL EQUIPMENT CORPORATION
!-
   
LOCAL		buffer_ptr,
		buffer_name,
		buffer_name_default,
		default_message;

buffer_name_default := get_info(current_buffer,"name");
default_message := 'Hit <RETURN> to use default buffer name: ' + 
			    buffer_name_default;
message(' ');
message (default_message);
buffer_name := read_line("Enter buffer to write from: ");
if (buffer_name = KAZ_x_empty)
then
  buffer_name := buffer_name_default;
endif;
buffer_ptr := KAZ_find_buffer (buffer_name);
if (buffer_ptr = 0)
then 
  message ('Specified buffer does not exist');
  return 0;
endif;
!
!	we now know we have a real buffer; what file?
!
KAZ_CLEVER_WRITE(buffer_name,BUFFER_PTR,'txt');
endprocedure


procedure KAZ_define_keys
!
!+
!	Definitions are presented in alphabetical order, exotic keys first.
!
!		19-NOV-1985  RDP:  Eliminate KAZ_GET_RNO in favor of direct 
!				   definition of the key PF1 + R.
!
!		 9-MAR-1986  RDP:  Eliminate kaz_overstrike in favor of direct
!				   definitions of two keys to avoid confusion
!				   in multi-buffer environments.
!
!		31-MAR-1986  RDP:  Revive kaz_overstrike and define keys.
!
!		18-SEP-1986  RDP:  Modify key definitions to reflect arguments
!				   added to kaz_windows and kaz_page_length.
!
!		19-SEP-1986  RDP:  Include key definitions for parenthesis 
!				   matching; modify key definitions to 
!				   reflect arguments added to 
!				   kaz_match_left_parenthesis and to ..right..
!				   that generalize them for square and curly
!				   brackets, too.
!
!	        22-SEP-1986  RDP:  KAZ_GOTO_BUFFER used with argument MAIN 
!				   for PF1 + M, eliminating kaz_main_buf.
!-

!
!	exotic keys 
!

define_key("kaz_other_window",ENTER,"Toggle to other window or buffer.");
!
define_key('kaz_motion(-1)',up);
define_key ('kaz_motion(-(kaz_x_window_size))',
    		key_name(up,shift_key),"Jump up one screen.");
!
define_key('kaz_motion(+1)',down);
define_key ('kaz_motion(+(kaz_x_window_size))',
    		key_name(down,shift_key),"Jump down one screen.");
!
!			the ctrl_h key is really the <BACKSPACE> key
define_key ('KAZ_swap_characters',key_name(ctrl_h_key,shift_key),
    		"Swap characters.");
!
!			the ctrl_i key is really the <TAB> key
define_key ('KAZ_tab_jump',key_name(ctrl_i_key,shift_key),"Jump 8 characters.");
!
!			the named key below is PF1 + DELETE 
define_key ('KAZ_erase_buf',key_name('',shift_key),"Erase a buffer.");
DEFINE_KEY ('SPLIT_LINE',RET_KEY,'return');
!
define_key("kaz_match_left_parenthesis('(')",key_name('(',shift_key),
  "find match to left parenthesis.");
define_key("kaz_match_left_parenthesis('[')",key_name('[',shift_key),
  "find match to left square bracket.");
define_key("kaz_match_left_parenthesis('{')",key_name('{',shift_key),
  "find match to left curly bracket.");
!
define_key("kaz_match_right_parenthesis(')')",key_name(')',shift_key),
  "find match to right parenthesis.");
define_key("kaz_match_right_parenthesis(']')",key_name(']',shift_key),
  "find match to right square bracket.");
define_key("kaz_match_right_parenthesis('}')",key_name('}',shift_key),
  "find match to right curly bracket.");

!
!	begin ctrl/letter, gold letter, and gold ctrl/letter
!

!A
define_key('KAZ_overstrike',key_name('a',shift_key),
    		"Swap current buffer between insert and overstrike modes.");
define_key('kaz_overstrike',key_name(ctrl_a_key,shift_key),
    		"Swap current buffer between insert and overstrike modes.");
!B
define_key ('KAZ_top_sent',ctrl_b_key,"Move back one sentence.");
define_key ('KAZ_goto_buffer("")',Key_name('b',shift_key),"Edit a buffer.");
define_key ('KAZ_top_sent',key_name(ctrl_b_key,shift_key),
    		"Move back one sentence.");
!C
define_key('KAZ_find_line',key_name("c",shift_key),"Find a line by number.");
!D
!			the text copied below is underscore, escape, colon
!
DEFINE_KEY ('COPY_TEXT ("_:")' , key_name('d',shift_key),
				"Insert NEC escape sequence for subscripts.");
define_key ('KAZ_swap_delim',key_name(ctrl_d_key,shift_key),
    		"Swap definition of word for programming or text.");
!F
define_key ('KAZ_fill_parag',key_name('f',shift_key),
    		"Re-fill the present paragraph.");
define_key ('KAZ_end_sent',key_name(ctrl_f_key,shift_key),
    		"Move forward one sentence.");
!G
define_key ('KAZ_end_sent',ctrl_g_key,"Move forward one sentence.");
!H
define_key ('KAZ_get_key_info',key_name('h',shift_key),"Get help on a key.");
!I
define_key ('KAZ_include',key_name('i',shift_key),
    		"Include file in current buffer.");
!K
define_key ('kaz_learn',key_name('k',shift_key),'Start learn key sequence.');
define_key ('kaz_remember',key_name(CTRL_K_KEY,shift_key),
             'End learn key sequence.');
!M
define_key ('KAZ_goto_buffer("MAIN")',Key_name('M',shift_key),
    		"Edit MAIN buffer.");
!N
define_key ('KAZ_top_parag',ctrl_n_key,"Move back one paragraph.");
!O
define_key ('KAZ_write_buf',key_name('o',shift_key),
    		"Write a buffer to a file.");
!P
define_key ('KAZ_end_parag',ctrl_p_key,"Move forward one paragraph.");
define_key("kaz_DCL_COMPILE('PASCAL')",key_name("p",shift_key),
            "Write and compile the PASCAL file residing in current buffer");
define_key ('KAZ_page_length(+58)',key_name(CTRL_P_KEY,shift_key),
    		"Go to bottom of current page.");
!Q
define_key ('quit',   key_name('Q',shift_key),"Quit without writing file.");
!R
DEFINE_KEY ('KAZ_RESTORE' , CTRL_R_KEY,"Find the marker left by CTRL/V.");
define_key ('read_file (''standard.RNO'')',key_name('R',shift_key),
    		"Insert a copy of the file STANDARD.RNO.");
!S
define_key ('KAZ_show_buf',key_name('s',shift_key),"Show buffer information.");
!U
!			the text copied below is underscore, escape, semicolon
!
DEFINE_KEY ('COPY_TEXT ("_;")' , key_name('u',shift_key),
				"Insert NEC escape sequence for superscripts.");
!V
DEFINE_KEY ('COPY_TEXT ("^^&&^^")' , CTRL_V_KEY,
    		"Insert a marker to be found by CTRL/R.");
!
!			the text copied below is the backspace character
DEFINE_KEY ('COPY_TEXT ("")' , key_name('v',shift_key),
    		"Insert <BACK SPACE> character, for overstrikes.");
!W
DEFINE_KEY ("DCL('')",key_name('w',shift_key),'DCL window command key.');
define_key('KAZ_windows("0","")',key_name(ctrl_w_key,shift_key),
    		"Set up single- or dual-window.");
!Z
define_key ('KAZ_get_out',   key_name(CTRL_Z_KEY,shift_key),
    		"Quick normal EXIT.");

endprocedure

!
!	Use the EDTSECINI trick to save space:  bind the keys and then 
!	relinquish the space by re-defining a null kaz_define_keys.
!
kaz_define_keys;
compile ('procedure kaz_define_keys endprocedure');	

save ('sys$login:kazsecini.new');
quit;