!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! TWW_EVE.TPU -- Source for numerous extensions to the EVE interface. ! ! This file contains most of the DEC EVEplus ! procedures, a few modified EVE procedures, and ! a bunch of original ones. ! ! To create the TPU$SECTION file, use the command ! ! $ EDIT/TPU/SECTION=EVESECINI/COMMAND=TWW_EVE ! !--------------------------------------------------------------------------- !++ ! ! EVEPLUS_KERNEL.TPU - Routines required by multiple modules ! ! Routine to insert text, even in overstrike mode ! !-- procedure eveplus_insert_text(the_text) ! Copy_text in insert mode LOCAL old_mode; old_mode := get_info(current_buffer, "mode"); set(INSERT, current_buffer); copy_text(the_text); set(old_mode, current_buffer); endprocedure; procedure eveplus_search_quietly(target, dir) ! Search w/o "String not found" on_error return(0); endon_error; return(search(target, dir)); endprocedure; procedure eveplus_replace(old, new) ! Simple replace function local ptr, old_mode; on_error return(0); endon_error; ptr := search(old, current_direction); if (ptr <> 0) then position(ptr); erase(ptr); old_mode := get_info(current_buffer, "mode"); set(INSERT, current_buffer); copy_text(new); set(old_mode, current_buffer); return(1); else return(0); endif; endprocedure; ! This routine translates a buffer name to a buffer pointer ! ! Inputs: ! buffer_name String containing the buffer name ! procedure eveplus_find_buffer(buffer_name) ! Find a buffer by name local the_buffer, ! Used to hold the buffer pointer the_name; ! A read/write copy of the name the_name := buffer_name; change_case(the_name, UPPER); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); exitif (the_name = get_info(the_buffer, "name")); the_buffer := get_info(buffer, "next"); endloop; return the_buffer; endprocedure procedure eveplus_defined_procedure(x) ! See if a procedure is defined local temp; on_error if (error = tpu$_multiplenames) then return(1); else return(0); endif; endon_error; temp := expand_name(x, PROCEDURES); return(1); endprocedure; ! Page 2 procedure eveplus_set_shift_key ( new_shift_key ) ! Define shift key, save old local old_shift_key; old_shift_key := eveplus_g_shift_key; eveplus_g_shift_key := new_shift_key; if new_shift_key = ctrl_y_key then set (shift_key, key_name (pf1, shift_key)); undefine_key ( old_shift_key ); else set ( shift_key, new_shift_key ); define_key ("execute (lookup_key (eve$get_shift_key, program))", new_shift_key, "shift key"); endif; return ( old_shift_key ); endprocedure ! Page 3 procedure eveplus_key ! Redefine a key, saving old definition ( new_pgm, ! Valid 1st argument for define_key builtin default_key, ! Default keyname if user hasn't defined one new_doc, ! Valid 3rd argument for define_key builtin key_string ) ! String containing name for user defined keys ! 1) Determine if we have a user specified key; if not, use default. ! 2) Save the present definition & doc. of the user specified key. ! 3) Do a define key on the new key information. ! A note on methods: ! We use a string argument for the variable name of the user specified key ! so that: 1) We can successfully pass it to this procedure if its not defined. ! 2) We can generate variables to hold the old key's info, avoiding ! passing more arguments for these. ! We combine the string argument with string constants to form valid TPU ! statements which we then execute. (Ha! We TPU programmers can limp ! along without LISP very well thanks!) on_error endon_error; eveplus$x := default_key; ! default, to global variables; the variables eveplus$x_string := key_string; ! Move arguments, which are local by eveplus$x_old_pgm := 0; ! in and EXECUTE statement are all global. ! Determine if we have a user specified key; if not, use default. if expand_name ( eveplus$x_string, variables ) <> eve$x_null then execute ( 'if(get_info('+eveplus$x_string+',"type")=integer)then ' +'eveplus$x:='+eveplus$x_string+';' +'else ' +eveplus$x_string+':=eveplus$x;' +'endif;' ); else execute ( eveplus$x_string+ ':= eveplus$x;' ); endif; ! Save the present definition & doc. of the user specified key ! one exists. eveplus$x_old_pgm := lookup_key ( eveplus$x, program); if (get_info ( eveplus$x_old_pgm, "type") = program) then execute( eveplus$x_string +'_doc := lookup_key ( eveplus$x, comment);' +eveplus$x_string +'_pgm := lookup_key ( eveplus$x, program);'); else execute( eveplus$x_string +'_doc := "~none~";'); endif; ! Do a define key on the new key information define_key ( new_pgm, eveplus$x, new_doc ); endprocedure ! Page 4 procedure eveplus_restore_key ( the_key ) ! Restore a saved key definition. ! This is the companion procedure to EVEplus_key, and restores the previous ! definition of a key saved during EVEplus_key. See EVEplus_key for ! more info. on_error endon_error; eveplus$x_string := the_key; if expand_name ( eveplus$x_string+'_pgm', variables ) <> eve$x_null then execute ( 'define_key('+eveplus$x_string+'_pgm,' +eveplus$x_string+',' +eveplus$x_string+'_doc); '); else execute ( 'undefine_key ('+eveplus$x_string+'); '); endif; endprocedure !+ ! RECCUTPAS.TPU - Eve version of rectangular cut and paste !- ! ! TPU emulation of rectangular CUT/PASTE including following routines: ! EVE_DRAW_BOX ! EVE_RECTANGULAR_REMOVE ! EVE_RECTANGULAR_INSERT_HERE ! EVE_RECTANGULAR_SELECT ! EVEPLUS_PAD_BLANK ! EVE_SET_RECTANGULAR ! EVE_SET_NORECTANGULAR ! EVEPLUS_SET_MODE ! EVEPLUS_BLANK_CHARS ! EVEPLUS_ADVANCE_HORIZONTAL ! ! Rectangular CUT/PASTE provides a way to select a corner of a rectangular ! region on the screen that is to be CUT. This select point is highlighted ! in reverse video. The cursor can then be positioned to the opposite ! corner of the box at which point the CUT can be done to place the rectangular ! region in paste_buffer. PASTE can then be done to overstrike the ! rectangular region in paste_buffer onto the current_buffer using the ! current position as the upper left corner for the pasted region. Note ! that no provision is made if there are TAB chars in the current buffer. ! Also, no provision is made if the cut or paste is done with part of the ! region to be cut or pasted over not being visible on the screen. ! ! These procedures can be run with the current buffer set to overstrike ! or insert mode - CUT/PASTE need to switch to insert mode temporarily ! to get the chars replaced properly, but the previous mode setting for ! the current buffer is restored when either the cut or paste routine completes. ! ! GLOBAL VARIABLES created/used ! eveplus_v_begin_select - position where selected region begins ! eve$x_vt200_keypad ! ! GLOBAL VARIABLES used ! current_buffer ! paste_buffer ! ! This TPU file rebinds the SELECT/REMOVE/INSERT HERE keys to the included ! routines and initializes the eveplus_v_begin_select variable when the ! eve_set_rectangular procedure is executed. The standard Eve key bindings ! are restored when the eve_set_norectangular procedure is executed. ! !+ ! Procedure to calculate the current column from the current offset, treating ! TAB characters as up to 8 blanks. !- PROCEDURE edd_current_column LOCAL i, line, col; line := current_line; IF INDEX(line,ASCII(9)) = 0 THEN edd_current_column := current_offset ELSE i := 1; col := 0; LOOP EXITIF i > current_offset; IF SUBSTR(line,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8 ELSE col := col + 1 ENDIF; i := i + 1 ENDLOOP; edd_current_column := col ENDIF ENDPROCEDURE !+ ! Procedure to replace TAB characters by the appropriate number of ! blanks on the current line, then pad the line out to a given length, if it ! is shorter. The routine assumes overstrike mode is in ! effect. It leave the current position at the beginning of the line. !- PROCEDURE edd_replace_tabs_with_blanks_and_pad(target_length) LOCAL i, col, cur_length, new_line, eight_blanks; !+ ! Make sure we're not on the EOB marker. !- IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN IF INDEX(CURRENT_LINE, ASCII(9)) <> 0 THEN new_line := ''; eight_blanks := " "; i := 1; col := 0; LOOP EXITIF i > LENGTH(CURRENT_LINE); IF SUBSTR(CURRENT_LINE,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8; new_line := new_line + SUBSTR(eight_blanks,1,col-LENGTH(new_line)) ELSE new_line := new_line + SUBSTR(CURRENT_LINE,i,1); col := col + 1 ENDIF; i := i + 1 ENDLOOP; MOVE_HORIZONTAL(-CURRENT_OFFSET); COPY_TEXT(new_line) ENDIF ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET); !+ ! Now pad out the line if we have to !- IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN cur_length := 0 ELSE cur_length := LENGTH(CURRENT_LINE) ENDIF; IF cur_length < target_length THEN MOVE_HORIZONTAL(cur_length); COPY_TEXT(eveplus_blank_chars(target_length - cur_length)); ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDPROCEDURE PROCEDURE eve_draw_box LOCAL saved_mode, end_column, start_column, temp, end_select, top_bottom_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode !- saved_mode := eveplus_set_mode(INSERT); !+ ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; !+ ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. !- IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; !+ ! We may be building the box on the first line of the buffer. In ! that case, we must put a new top line in the buffer. !- MOVE_HORIZONTAL(-CURRENT_OFFSET); IF MARK(NONE) = BEGINNING_OF(CURRENT_BUFFER) THEN SPLIT_LINE; POSITION(BEGINNING_OF(CURRENT_BUFFER)); COPY_TEXT(eveplus_blank_chars(start_column)); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDIF; !+ ! Move back one line and put in the top line of the box !- top_bottom_text := '+' + eveplus_blank_chars(end_column-start_column+1) + '+'; TRANSLATE(top_bottom_text, "-", " "); SET(OVERSTRIKE, current_buffer); MOVE_VERTICAL(-1); !+ ! Replace all TABs with blanks on this line and pad it, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET); !+ ! Step through the selected lines, putting vertical bars on either side ! of the selected text. !- LOOP EXITIF MARK(NONE) > end_select; !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); !+ ! If START_COLUMN is zero, we must insert a vertical bar to do the ! left column, then put the right vertical bar one column farther out ! than normal. !- IF start_column = 0 THEN SET(INSERT, CURRENT_BUFFER); COPY_TEXT("|"); SET(OVERSTRIKE, CURRENT_BUFFER); MOVE_HORIZONTAL(end_column + 1); ELSE MOVE_HORIZONTAL(start_column-1); COPY_TEXT("|"); MOVE_HORIZONTAL(end_column - CURRENT_OFFSET + 1) ENDIF; COPY_TEXT("|"); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; !+ ! Now put in the bottom line of the box. !- !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); !+ ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting !- POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); IF start_column = 0 THEN MOVE_HORIZONTAL(1) ELSE MOVE_HORIZONTAL(start_column) ENDIF; SET(saved_mode, CURRENT_BUFFER) ENDPROCEDURE PROCEDURE eve_rectangular_remove LOCAL saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, cut_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode and erase PASTE_BUFFER !- saved_mode := eveplus_set_mode(INSERT); ERASE(paste_buffer); !+ ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; !+ ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. !- IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; !+ ! Get a string of the appropriate number of blanks to paste back in !- pad_chars := eveplus_blank_chars(end_column - start_column + 1); !+ ! Step through the selected lines, copying the text to the paste buffer ! and replacing it with blanks as we go. Replace all TABs with blanks ! before we look at it so we get the columns straight. !- MOVE_HORIZONTAL(-current_offset); SET(OVERSTRIKE, current_buffer); LOOP EXITIF MARK(NONE) > end_select; !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); !+ ! Obtain the text we're cutting !- cut_text := SUBSTR(CURRENT_LINE, start_column + 1, end_column - start_column + 1); !+ ! Replace the text with blanks !- MOVE_HORIZONTAL(start_column); COPY_TEXT(pad_chars); !+ ! Copy the text to the paste buffer !- save_position := MARK(NONE); POSITION(paste_buffer); COPY_TEXT(cut_text); MOVE_HORIZONTAL(1); !+ ! Reposition to the other buffer and move to the next line !- POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; !+ ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting !- POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(saved_mode, CURRENT_BUFFER) ENDPROCEDURE PROCEDURE eve_rectangular_insert_here !+ ! This procedure pastes the rectangular region in the paste buffer ! using the current position in the current buffer as the upper left corner. !- LOCAL save_position, start_column, paste_line, save_buffer, save_mode; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); start_column := edd_current_column; save_mode := eveplus_set_mode(OVERSTRIKE); POSITION(BEGINNING_OF(paste_buffer)); IF MARK(NONE) = END_OF(paste_buffer) THEN MESSAGE("Paste buffer is empty"); RETURN ENDIF; !+ ! Loop through lines in the paste buffer, putting them at the ! appropriate offset in the current buffer. !- LOOP EXITIF MARK(NONE) = END_OF(paste_buffer); !+ ! Get the current line of the paste buffer. !- paste_line := CURRENT_LINE; MOVE_VERTICAL(1); !+ ! Convert tabs to blanks on the line in the current buffer. !- POSITION(save_buffer); edd_replace_tabs_with_blanks_and_pad(start_column+1); !+ ! Position at the correct offset and overwrite the text there. !- MOVE_HORIZONTAL(start_column); COPY_TEXT(paste_line); MOVE_VERTICAL(1); POSITION(paste_buffer) ENDLOOP; !+ ! Position to start of pasted text and restore old mode setting. !- POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(save_mode, CURRENT_BUFFER) ENDPROCEDURE PROCEDURE EVE_RECTANGULAR_SELECT if eveplus_v_begin_select = 0 then eveplus_pad_blank; eveplus_v_begin_select := mark(REVERSE); message("Selection started. Press Remove when finished."); else eveplus_v_begin_select := 0; message("Selection cancelled"); endif; endprocedure ! eve_rectangular_select PROCEDURE EVEPLUS_PAD_BLANK !+ ! This procedure drops a space at the current position if the current ! character is null so that any mark will be for an existing character. ! In EDD, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EDD, we ! want to highlight the select point so we need a character there. ! The cursor is returned to its original position after the space is ! copied to the current position in the current buffer. !- IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN copy_text(" "); move_horizontal(-1) ELSE if current_character = "" then copy_text(" "); move_horizontal(-1); endif ENDIF endprocedure ! eveplus_pad_blank PROCEDURE EVEPLUS_SET_MODE(new_mode) !+ ! This procedure returns the current mode for the current buffer ! and sets it to the value in NEW_MODE. !- eveplus_set_mode := get_info(current_buffer,"MODE"); set(new_mode, current_buffer); endprocedure ! eveplus_set_mode PROCEDURE EVEPLUS_BLANK_CHARS(eveplus_v_blank_count) !+ ! This procedure returns a string of eveplus_v_blank_count blank chars. !- local eveplus_v_blank_chars, eveplus_v_oldlen, eveplus_v_blanks_so_far; ! Length of blank char string so far IF eveplus_v_blank_count = 0 THEN RETURN "" ENDIF; eveplus_v_blank_chars := " "; eveplus_v_blanks_so_far := 1; loop exitif eveplus_v_blanks_so_far >= eveplus_v_blank_count; eveplus_v_oldlen := LENGTH(eveplus_v_blank_chars); eveplus_v_blank_chars := eveplus_v_blank_chars + eveplus_v_blank_chars; eveplus_v_blanks_so_far := eveplus_v_blanks_so_far + eveplus_v_oldlen; endloop; IF eveplus_v_blanks_so_far > eveplus_v_blank_count THEN eveplus_v_blank_chars := SUBSTR(eveplus_v_blank_chars,1,eveplus_v_blank_count) ENDIF; RETURN eveplus_v_blank_chars endprocedure ! eveplus_blank_chars PROCEDURE EVEPLUS_ADVANCE_HORIZONTAL(eveplus_v_columns,eveplus_v_blank_chars) !+ ! This procedure advances current_offset to be eveplus_v_columns from ! current_offset. eveplus_v_blanks_chars must be ! a string of blank chars of at least length eveplus_v_columns. !- local eveplus_v_save_offset, ! current_offset on entry to this procedure eveplus_v_eol_columns; ! Number of columns to [EOL] eveplus_v_save_offset := current_offset; if eveplus_v_columns <= 0 then move_horizontal(eveplus_v_columns); else !+ ! Find out how far to [EOL]. !- eveplus_v_eol_columns := length(current_line)-current_offset; if eveplus_v_eol_columns >= eveplus_v_columns then move_horizontal(eveplus_v_columns); else move_horizontal(eveplus_v_eol_columns); copy_text(substr(eveplus_v_blank_chars,1, eveplus_v_columns-eveplus_v_save_offset)); endif; endif; endprocedure ! eveplus_advance_horizontal !+ ! describe key !- ! This procedure will prompt for a key stroke or shift sequence and look ! up the comment that was attributed to the keystroke when it was defined. ! If there was no comment given, the message "Key Has No Function..." is ! displayed in the message area at the bottom of the screen. Otherwise, ! the key's function is displayed. This function assumes that there will ! always be some sort of comment given when keys are defined to user ! procedures. This may not be an accurate assumption in all circumstances. ! The value of this function depends on the descriptive nature of the names ! of user routines. It should be noted that this works on DEFINE KEY ! operations also. So use the whole function name to get the best ! description. ! PROCEDURE eve_describe_key LOCAL key_to_describe, key_description; MESSAGE("Press Key to Describe:"); key_to_describe := READ_KEY; key_description := LOOKUP_KEY(key_to_describe,COMMENT); IF key_description <> "" THEN MESSAGE("Function Description: " + key_description); ELSE MESSAGE("Key Has No Function..."); ENDIF; ENDPROCEDURE; !+ ! DISPLAY_CHARACTER.TPU !- ! This procedure writes a one line message describing the current character ! in terms of Octal, Decimal, Hexadecimal and (sometimes) '^' notation. ! PROCEDURE eve_display_character LOCAL i,cc,reps,rep; REPS := "01234567" + "89101112131415" + "1617181920212223" + "2425262728293031" + "32127132133134135136" + "137138139140141142143" + "144145146147148149150" + "151155156157158159"; ! Handle end-of-buffer condition IF MARK( NONE ) = END_OF( CURRENT_BUFFER ) THEN MESSAGE( 'At end of buffer, no current character.' ); RETURN; ENDIF; ! Convert the character to an integer the hard way (no builtin yet) i := 0; LOOP; EXITIF i > 255; EXITIF CURRENT_CHARACTER = ASCII(i); i := i + 1; ENDLOOP; IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL ! Provide ^ notation for ASCII control characters IF i < 32 THEN cc := ', ^' + ASCII(i+64); ELSE cc := ''; ENDIF; ! Provide mnemonic representation, too. IF ( I <= 32) OR ( I = 127) OR (( I > 131) AND ( I < 152)) OR (( I > 154) AND ( I < 160)) THEN REP := SUBSTR( REPS, INDEX( REPS, STR( I)) + LENGTH( STR( I)), 5); IF SUBSTR( REP, 5, 1) <> ">" THEN REP := SUBSTR( REP, 1, 4); ENDIF; ELSE REP := CURRENT_CHARACTER; ENDIF; ! Format and output the results MESSAGE( FAO( "Current Character is '!AS', Decimal=!UB, " + "Hex=!-!XB, Octal=!-!OB!AS", REP, i, cc ) ); ENDPROCEDURE; ! eve_display_character !+ ! MATCHING.TPU - Routine to automatically insert close parentheses etc. !- procedure eve_set_matching(the_arg) ! Turn on electric open parens LOCAL the_key, the_keys, ptr; the_keys := the_arg; if (the_keys = "") then the_keys := read_line("Match what characters: "); endif; ptr := 1; loop exitif (ptr > length(the_keys)); the_key := substr(the_keys, ptr, 1); if (index(eveplus_matchable_open, the_key) <> 0) then define_key("eveplus_insert_matched", key_name(the_key), " typing"); else message('"' + the_key + '" is not matchable'); return; endif; ptr := ptr + 1; endloop; endprocedure; procedure eve_set_nomatching(the_arg) ! Turn off electric open parens LOCAL the_key, the_keys, ptr; the_keys := the_arg; if (the_keys = "") then the_keys := read_line("Remove matching for what characters: "); endif; ptr := 1; loop exitif (ptr > length(the_keys)); the_key := substr(the_keys, ptr, 1); if (index(eveplus_matchable_open, the_key) <> 0) then undefine_key(key_name(the_key)); else if (index(eveplus_matchable_close, the_key) = 0) then message('"' + the_key + '" is not matchable'); return; endif; endif; ptr := ptr + 1; endloop; endprocedure; !+ ! FIX_CRLFS.TPU - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs !- procedure eve_fix_crlfs LOCAL the_range; on_error if (ERROR <> tpu$_STRNOTFOUND) then message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE)); return; endif; endon_error; ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); SET( TIMER, ON, "Removing CRLFs"); loop the_range := search(ascii(13)+ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Next remove naked LFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); SET( TIMER, ON, "Removing LFs"); loop the_range := search(ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Finally, remove naked CRs. If they are not at the BOL, add a line break. ! position(beginning_of(current_buffer)); SET( TIMER, ON, "Removing CRs"); loop the_range := search(ascii(13), FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then split_line; endif; erase(the_range); endloop; SET( TIMER, OFF, ""); endprocedure; procedure eveplus_insert_matched ! Insert the two characters LOCAL the_key, which; the_key := ascii(last_key); which := index(eveplus_matchable_open, the_key); if (which <> 0) then eveplus_insert_text(the_key); eveplus_insert_text(substr(eveplus_matchable_close, which, 1)); move_horizontal(-1); else message("That key isn't matchable."); return; endif; endprocedure ! Insert the second of two match characters (close character), and display ! the line with the matching open character in the message window, with ! the open character highlighted. Try to handle quotes by skipping over ! strings when encountered - doesn't work perfectly if already in a quoted ! strings. Doesn't handle comments. ! Parameters: ! ! match_chars String - characters to be matched; e.g. "()" ! quote_chars String - quote characters; e.g. "'""" procedure eveplus_match (match_chars, quote_chars) ! Find the open paren local this_position, ! Marker - current cursor position right_matches, ! Integer - number of opens to close all_chars, ! String - match_chars + quote_chars match_pattern, ! Pattern - any (all_chars) match_position, ! Marker - current position during searches this_quote; ! String - current quote character on_error ! Just continue endon_error; if length (match_chars) <> 2 then message ("Must have 2 characters to match"); return; endif; copy_text (substr (match_chars, 2, 1)); this_position := mark (none); right_matches := 1; move_horizontal (-1); all_chars := match_chars + quote_chars; match_pattern := any (all_chars); loop match_position := search (match_pattern, reverse); exitif match_position = 0; position (match_position); if index (quote_chars, current_character) > 0 then this_quote := current_character; move_horizontal (-1); match_position := search (this_quote, reverse); exitif match_position = 0; position (match_position); else if current_character = substr (match_chars, 1, 1) then right_matches := right_matches - 1; else right_matches := right_matches + 1; endif; endif; exitif right_matches = 0; endloop; if right_matches = 0 then eveplus_display_line; else message ("No matching parentheses found"); endif; position (this_position); endprocedure; ! Internal routine for eveplus_match ! Display current line in message window, with current position highlighted procedure eveplus_display_line ! Display the matching line local this_position, ! Marker - current cursor position this_line, ! String - current line start_of_line, ! Marker - Start of current line this_offset; ! Integer - offset of this_position this_position := mark (blink); this_offset := current_offset; move_horizontal (- current_offset); start_of_line := mark (none); move_horizontal (length (current_line)); this_line := create_range (start_of_line, mark (none), none); message (this_line); position (end_of (message_buffer)); move_vertical (-1); move_horizontal (this_offset); eveplus_this_position := mark (blink); position (this_position); endprocedure; procedure eve_set_flashing(arg) ! Turn on flashing parens LOCAL the_key, the_keys, key_number, ptr; eve$prompt_string(arg, the_keys, "Flash what characters: ", "No flashing set"); ptr := 1; loop exitif (ptr > length(the_keys)); the_key := substr(the_keys, ptr, 1); key_number := index(eveplus_matchable_close, the_key); if (key_number <> 0) then define_key ("eveplus_match ('" + substr(eveplus_matchable_open, key_number, 1) + the_key + "', '""''')", key_name (the_key), " typing"); else message('"' + the_key + '" is not matchable'); return; endif; ptr := ptr + 1; endloop; endprocedure; procedure eve_set_noflashing(arg) ! Turn off flashing parens LOCAL the_key, the_keys, ptr; eve$prompt_string(arg, the_keys, "Remove flashing for what characters: ", "No flashing characters removed"); ptr := 1; loop exitif (ptr > length(the_keys)); the_key := substr(the_keys, ptr, 1); if (index(eveplus_matchable_close, the_key) <> 0) then undefine_key(key_name(the_key)); else if (index(eveplus_matchable_open, the_key) = 0) then message('"' + the_key + '" is not matchable'); return; endif; endif; ptr := ptr + 1; endloop; endprocedure; !+ ! LIST_COMMANDS.TPU - Routine to list all EVE (or EVEplus) ! commands (sort alphabetically, perhaps) !- procedure eve_list_commands local the_names, column_width, total_width, how_many_columns, temp; eve_mark("eveplus_saved_buffer"); the_names := expand_name("eve_", procedures) + " "; position(eve$choice_buffer); erase(eve$choice_buffer); message("Building command list"); loop exitif (the_names = eve$x_null); temp := index (the_names, " "); if (temp = 0) then message("Can't find space"); return; endif; copy_text (substr (the_names, 1, temp-1)); the_names := substr(the_names, temp+1, length(the_names)); split_line; erase_line; endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(line_begin & "EVE_", FORWARD); exitif (temp = 0); position(temp); erase(temp); endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace(" EVE_", " ") = 0); endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(" ", FORWARD); exitif (temp = 0); position(temp); erase(temp); split_line; endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace("_", " ") = 0); endloop; if (eveplus_defined_procedure("eveplus_sort")) then message("Sorting command list"); execute('eveplus_sort ( current_buffer , "" );'); endif; eve$format_choices; set (status_line, info_window, reverse, " Eve commands -- DO will remove this list"); position(show_buffer); erase(show_buffer); copy_text(eve$choice_buffer); position(beginning_of(current_buffer)); set(screen_update, off); eve_go_to("eveplus_saved_buffer"); set(screen_update, on); map (info_window, show_buffer); message(" "); endprocedure !++ ! ! End of EVEPLUS routines ! !---------------------------------------------------------------------------- !++ ! ! Modified EVESECINI routines, plus added EVE commands. ! !-- ! ! Learn mode procedures Modification: allow LEARNed procedures ! to be bound to typing keys, if desired. ! ! Begin learn sequence ! procedure eve_learn message ("Press keystrokes to be learned. Press CTRL/R to remember these keystrokes."); learn_begin (exact); endprocedure; ! ! Remember a learn sequence. Must be bound to a key in order to work; ! cannot be used from command line ! procedure eve_remember 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 ("Nothing to remember"); return; else if error = tpu$_recurlearn then define_error := 1; endif; endif; endon_error; learn_sequence := learn_end; loop learn_key := eve$prompt_key ("Press the key that you want to use to do what was just learned: "); ! Return gets you out without redefining a key if learn_key = ret_key then message ("Key sequence not remembered"); return; endif; if eve$lookup_comment (learn_key) = "do" then message ("You cannot use the DO key for a learn sequence"); else define_key (learn_sequence, learn_key, "sequence", "USER KEY MAP"); if define_error then message ("That key was already used in the learn sequence"); define_error := 0; else ! clear LEARN message if still there message ("Key sequence remembered"); exitif 1; endif; endif; endloop; endprocedure; PROCEDURE EVE_UNDEFINE_KEY LOCAL THE_KEY; THE_KEY := EVE$PROMPT_KEY( "Press the key that you want to undefine: "); UNDEFINE_KEY( THE_KEY); MESSAGE( "Definition removed"); ENDPROCEDURE !+ ! TOGGLE_STATUS_LINE.TPU !- ! Eve commands to turn the status line on and off for the current window. ! Having the status line off is particularly useful in making slides ! directly from the terminal. ! ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! ! Update: Tom Williams December 29, 1986 ! Added code to include margins and line count in the ! status line. ! ! Parameters: ! ! this_window Window whose status line is being set - input procedure eve$set_status_line (this_window) local this_buffer, ! Current buffer mode_string, ! String version of current mode margin_string, ! String of left & right margins length_string, ! String version of current length direction_string, ! String version of current direction buffer_name; ! String containing name of current buffer this_buffer := get_info (this_window, eve$kt_buffer); if (this_buffer = 0) or (get_info (this_window, "status_line") = 0) then return; endif; if get_info (this_buffer, eve$kt_mode) = insert then mode_string := "Insert "; else mode_string := "Overstrike"; endif; if get_info (this_buffer, "direction") = reverse then direction_string := "Reverse"; else direction_string := "Forward"; endif; buffer_name := get_info (this_buffer, eve$kt_name); if length (buffer_name) > eve$x_max_buffer_name_length then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length); else buffer_name := buffer_name + substr (eve$kt_spaces, 1, eve$x_max_buffer_name_length - length (buffer_name)); endif; margin_string := fao( "Margins !3UW,!3UW ", get_info( this_buffer, "left_margin"), get_info( this_buffer, "right_margin")); length_string := fao( "!14AS", fao( "!5UW Line!%S", get_info( this_buffer, "record_count"))); set (status_line, this_window, reverse, " " + buffer_name + " " + margin_string + length_string + mode_string + " " + direction_string); endprocedure; procedure eve_status_line_off set (status_line, current_window, none, ""); endprocedure; procedure eve_status_line_on set (status_line, current_window, reverse, " Buffer"); eve$set_status_line (current_window); endprocedure; PROCEDURE EVE_TOGGLE_STATUS_LINE ! ! Turn status line on/off ! IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") = 0 THEN EVE_STATUS_LINE_ON; ELSE EVE_STATUS_LINE_OFF; ENDIF; ENDPROCEDURE; !+ ! BUFED.TPU - Routines to list, goto & delete buffers !- procedure eve_list_buffers ! List non-system buffers bufed_list_buffers(FALSE) endprocedure procedure eve_list_all_buffers ! List system and non-system buffers bufed_list_buffers(TRUE) endprocedure procedure eve_destroy_buffer(the_name) ! Delete a buffer by name local the_buffer, buffer_name; if (not eve$prompt_string(the_name, buffer_name, "Delete buffer: ", "Cancelled")) then return; endif; the_buffer := eveplus_find_buffer(buffer_name); if (the_buffer <> 0) then bufed_destroy_buffer(buffer_name, the_buffer); else message("No such buffer: " + buffer_name); endif; endprocedure; ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT and REMOVE keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! ! Modification: ! ! TWW October 20, 1986 ! Add code to start at the current buffer. ! procedure bufed_list_buffers(show_system) ! Build the buffer list local OLD_BUFFER, ! Buffer to start on. last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed temp; ! Used to build the record count as a string OLD_BUFFER := get_info( CURRENT_BUFFER, "name"); eve_buffer("LIST BUFFER"); set(system, current_buffer); set(no_write, current_buffer); erase(current_buffer); message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); if (show_system or (get_info(the_buffer, "system") = 0)) then split_line; eveplus_insert_text(" "); eveplus_insert_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then eveplus_insert_text(""); else loop exitif (current_offset > 33); eveplus_insert_text(" "); endloop; endif; eveplus_insert_text(temp); if (get_info(the_buffer, "modified")) then eveplus_insert_text("Modified "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "no_write")) then eveplus_insert_text("No-write "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "system")) then eveplus_insert_text("System "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "permanent")) then eveplus_insert_text("Permanent"); else eveplus_insert_text(" "); endif; temp := current_line; move_horizontal (-current_offset); erase (create_range (mark (none), end_of (current_buffer), none)); edit (temp, trim_trailing); copy_text (temp); endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; if (eveplus_defined_procedure("eveplus_sort")) then message("Sorting buffer list"); execute('eveplus_sort ( current_buffer , "" ); '); endif; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly("", FORWARD); exitif (temp = 0); position(temp); erase(temp); eveplus_insert_text(" -"); split_line; eveplus_insert_text(" "); endloop; position(beginning_of(current_buffer)); eveplus_insert_text(" Buffer name Lines Attributes"); split_line; temp := eveplus_search_quietly( OLD_BUFFER, FORWARD); IF TEMP <> 0 THEN POSITION( TEMP); ELSE position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); ENDIF; if (not bufed_x_active) then set(informational,off); eveplus_key("bufed_select_buffer", e4, "select buffer", "bufed_select_key"); eveplus_key("bufed_remove_buffer", e3, "remove buffer", "bufed_remove_key"); set(informational,on); endif; bufed_x_active := TRUE; message(" "); endprocedure ! This routine is temporarily bound to the REMOVE key. It deletes ! the buffer listed on the current line. It only works in the ! "LIST BUFFER" buffer. If it is struck outside of that buffer, ! it restores the original binding of the SELECT and REMOVE keys and ! and executes the program originally associated with the REMOVE key. ! The routine bufed_select_buffer also unbinds this key. ! procedure bufed_remove_buffer ! Delete the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_remove_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_remove_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then if (bufed_destroy_buffer(the_name, the_buffer)) then move_horizontal(-current_offset); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-current_offset); erase_line; else move_horizontal(-current_offset); endif; erase_line; endif; endif; endif; endprocedure ! This routine actually destroys a specific buffer. ! ! Inputs: ! the_name The name of the buffer (display only) ! the_buffer Pointer to the buffer to destroy ! procedure bufed_destroy_buffer(the_name, the_buffer) ! Delete a buffer local answer, problem, new_buffer; bufed_destroy_buffer := FALSE; problem := ""; if ((get_info(the_buffer, "modified")) and (get_info(the_buffer, "record_count") <> 0)) then problem := "modified "; endif; if (get_info(the_buffer, "system")) then problem := problem + "system "; endif; if (problem <> "") then answer := read_line(substr(the_name, 1, 32) + " is a " + problem + "buffer. Are you sure? "); change_case (answer, lower); if ((length (answer) = 0) or (answer <> substr ("yes", 1, length (answer)))) then message("No buffer deleted."); return; endif; endif; if (current_buffer <> the_buffer) then delete(the_buffer); else new_buffer := get_info(buffers, "first"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "next"); endloop; if (new_buffer = 0) then eve_buffer("Main"); else eve_buffer(get_info(new_buffer, "name")); endif; if (get_info (the_buffer, "name") = "MAIN") then erase (the_buffer); else delete (the_buffer); endif; endif; bufed_destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure; ! This routine is temporarily bound to the SELECT. It puts you in ! the buffer listed on the current line, and restores the original ! meanings of the SELECT and REMOVE keys. It only works in the ! "LIST BUFFERS" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT and REMOVE keys, ! and executes the code originally associated with SELECT. ! procedure bufed_select_buffer ! Goto the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_select_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_select_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then eve_buffer(the_name); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; endif; endif; endprocedure; ! This routine scans the line the cursor is on and if it is in the ! proper format for a buffer listing, it returns both the name of ! the buffer and a pointer to it. ! procedure bufed_get_the_buffer(the_name, the_buffer) ! Scan a buffer line local the_start; ! A mark pointing to the buffer name. the_name := ""; the_buffer := 0; if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); else move_horizontal(-current_offset); if (search(ANCHOR & " ", FORWARD) = 0) then message("This is not a buffer listing"); else move_horizontal(2); the_start := mark(none); move_horizontal(-2); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-2); else move_horizontal(32-current_offset); endif; the_name := create_range(the_start, mark(none), bold); the_name := substr(the_name, 1, length(the_name)); edit(the_name, TRIM_TRAILING, OFF); the_buffer := eveplus_find_buffer(the_name); if (the_buffer = 0) then message("No such buffer: " + the_name); endif; move_horizontal(2-current_offset); endif; endif; bufed_get_the_buffer := the_buffer; endprocedure; ! ! Search and replace procedure. Case-sensitivity of search is ! same as for the find command. If case-insensitive, replacements ! are done to match case of current occurrence. ! ! Update by TWW: added "memory" for repeated invocation. ! ! Parameters: ! ! replace_parameter_1 Old string - input ! replace_parameter_2 New string - input PROCEDURE eve_replace (replace_parameter_1, replace_parameter_2) local target, ! Local copy of replace_parameter_1 replacement, ! Local copy of replace_parameter_2 this_buffer, ! Current buffer this_mode, ! Keyword for current mode lowercase_target, ! Lowercase version of target string lowercase_replacement, ! Lowercase version of replacement string uppercase_target, ! Uppercase version of target string uppercase_replacement, ! Uppercase version of replacement string capital_target, ! Capitalized version of target string capital_replacement, ! Capitalized version of replacement string how_exact, ! Keyword to indicate case-sensitivity replace_range, ! Range of current occurrence highlight_range, ! Reverse-video version of replace_range replace_action, ! String reply to prompt action_length, ! Length of replace_action asking, ! True unless "all" option has been chosen this_occurrence, ! String of replace_range occurrences; ! Number of replacements made so far this_buffer := current_buffer; this_mode := get_info (current_buffer, eve$kt_mode); set (insert, this_buffer); asking := 1; if not (eve$prompt_string (replace_parameter_1, target, "Old string: ", "No string to replace")) then return; endif; replacement := replace_parameter_2; if replacement = eve$kt_null then replacement := read_line ("New string: "); ! empty string is ok here endif; TWW_REPLACE_P1 := target; ! Save for Replace Next command. TWW_REPLACE_P2 := replacement; ! Save for Replace Next command. lowercase_target := target; if get_info (lowercase_target, eve$kt_type) = string then change_case (lowercase_target, lower); endif; lowercase_replacement := replacement; change_case (lowercase_replacement, lower); if (lowercase_target = target) and (lowercase_replacement = replacement) then how_exact := no_exact; uppercase_target := target; if get_info (uppercase_target, eve$kt_type) = string then change_case (uppercase_target, upper); endif; capital_target := target; if get_info (capital_target, eve$kt_type) = string then eve$capitalize_string (capital_target); endif; uppercase_replacement := replacement; change_case (uppercase_replacement, upper); capital_replacement := replacement; eve$capitalize_string (capital_replacement); else how_exact := exact; endif; loop replace_range := eve$find (target, 1); exitif replace_range = 0; highlight_range := create_range (beginning_of (replace_range), end_of (replace_range), eve$x_highlighting); position (beginning_of (replace_range)); update (current_window); loop if asking then replace_action := read_line ("Replace? Type yes, no, all, last, or quit: "); change_case (replace_action, lower); else replace_action := "yes"; endif; action_length := length (replace_action); if (replace_action = substr ("yes", 1, action_length)) or (replace_action = substr ("all", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length)) or (action_length = 0) then highlight_range := 0; this_occurrence := erase_character (length (replace_range)); if how_exact = exact then copy_text (replacement); else ! Make sure non-alphabetic target is replaced by lowercase if this_occurrence = lowercase_target then copy_text (lowercase_replacement); else if this_occurrence = uppercase_target then copy_text (uppercase_replacement); else if this_occurrence = capital_target then copy_text (capital_replacement); else copy_text (lowercase_replacement); endif; endif; endif; endif; if current_direction = reverse then move_horizontal (- length (replacement)); endif; occurrences := occurrences + 1; update (current_window); if (replace_action = substr ("all", 1, action_length)) and (action_length > 0) then asking := 0; message ("Replacing all occurrences..."); set (screen_update, off); endif; exitif 1; else if (replace_action = substr ("no", 1, action_length)) or (replace_action = substr ("quit", 1, action_length)) then highlight_range := 0; if current_direction = forward then position (end_of (replace_range)); move_horizontal (1); endif; update (current_window); exitif 1; endif; endif; endloop; exitif (action_length > 0) and ((replace_action = substr ("quit", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length))); endloop; set (screen_update, on); message (fao ("Replaced !SL occurrence!%S", occurrences)); set (this_mode, this_buffer); endprocedure; ! ! Repeated (remembered) version of the ! Search and replace procedure. Case-sensitivity of search is ! same as for the find command. If case-insensitive, replacements ! are done to match case of current occurrence. ! PROCEDURE tww_replace_next local target, ! Local copy of replace_parameter_1 replacement, ! Local copy of replace_parameter_2 this_buffer, ! Current buffer this_mode, ! Keyword for current mode lowercase_target, ! Lowercase version of target string lowercase_replacement, ! Lowercase version of replacement string uppercase_target, ! Uppercase version of target string uppercase_replacement, ! Uppercase version of replacement string capital_target, ! Capitalized version of target string capital_replacement, ! Capitalized version of replacement string how_exact, ! Keyword to indicate case-sensitivity replace_range, ! Range of current occurrence highlight_range, ! Reverse-video version of replace_range replace_action, ! String reply to prompt action_length, ! Length of replace_action asking, ! True unless "all" option has been chosen this_occurrence, ! String of replace_range occurrences, ! Number of replacements made so far PROMPT; ! Prompt for the "Replace?" query this_buffer := current_buffer; this_mode := get_info (current_buffer, eve$kt_mode); set (insert, this_buffer); asking := 1; target := TWW_REPLACE_P1; ! Save for Replace Next command. replacement := TWW_REPLACE_P2; ! Save for Replace Next command. lowercase_target := target; if get_info (lowercase_target, eve$kt_type) = string then change_case (lowercase_target, lower); endif; lowercase_replacement := replacement; change_case (lowercase_replacement, lower); if (lowercase_target = target) and (lowercase_replacement = replacement) then how_exact := no_exact; uppercase_target := target; if get_info (uppercase_target, eve$kt_type) = string then change_case (uppercase_target, upper); endif; capital_target := target; if get_info (capital_target, eve$kt_type) = string then eve$capitalize_string (capital_target); endif; uppercase_replacement := replacement; change_case (uppercase_replacement, upper); capital_replacement := replacement; eve$capitalize_string (capital_replacement); else how_exact := exact; endif; PROMPT := "Replace """ + target + """ with """ + replacement + """ {Y, N, A, L, Q}? "; loop replace_range := eve$find (target, 1); exitif replace_range = 0; highlight_range := create_range (beginning_of (replace_range), end_of (replace_range), eve$x_highlighting); position (beginning_of (replace_range)); update (current_window); loop if asking then replace_action := read_line (PROMPT); change_case (replace_action, lower); else replace_action := "yes"; endif; action_length := length (replace_action); if (replace_action = substr ("yes", 1, action_length)) or (replace_action = substr ("all", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length)) or (action_length = 0) then highlight_range := 0; this_occurrence := erase_character (length (replace_range)); if how_exact = exact then copy_text (replacement); else ! Make sure non-alphabetic target is replaced by lowercase if this_occurrence = lowercase_target then copy_text (lowercase_replacement); else if this_occurrence = uppercase_target then copy_text (uppercase_replacement); else if this_occurrence = capital_target then copy_text (capital_replacement); else copy_text (lowercase_replacement); endif; endif; endif; endif; if current_direction = reverse then move_horizontal (- length (replacement)); endif; occurrences := occurrences + 1; update (current_window); if (replace_action = substr ("all", 1, action_length)) and (action_length > 0) then asking := 0; message ("Replacing all occurrences..."); set (screen_update, off); endif; exitif 1; else if (replace_action = substr ("no", 1, action_length)) or (replace_action = substr ("quit", 1, action_length)) then highlight_range := 0; if current_direction = forward then position (end_of (replace_range)); move_horizontal (1); endif; update (current_window); exitif 1; endif; endif; endloop; exitif (action_length > 0) and ((replace_action = substr ("quit", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length))); endloop; set (screen_update, on); message (fao ("Replaced !SL occurrence!%S", occurrences)); set (this_mode, this_buffer); endprocedure; procedure eve_dcl (dcl_parameter) ! ! TWW modifications: ! Added dollar sign prefix to DCL command line ! in the buffer; Added code to call FIX CRLFs ! after commands (like $ SHOW USERS, etc.) local dcl_string, ! Local copy of dcl_parameter this_position, ! Marker for current cursor position this_buffer, ! Current buffer this_dcl_command; ! Position of this DCL command on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; endon_error; if not (eve$prompt_string (dcl_parameter, dcl_string, "DCL command: ", "No DCL command entered")) then return; endif; if (get_info (eve$x_dcl_process, "type") = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon"); endif; this_buffer := current_buffer; this_position := mark (none); if this_buffer <> eve$dcl_buffer then if eve$x_number_of_windows = 2 then eve_other_window; if current_buffer <> eve$dcl_buffer then map (current_window, eve$dcl_buffer); endif; else unmap (eve$main_window); map (eve$top_window, this_buffer); eve$set_status_line (eve$top_window); update (eve$top_window); map (eve$bottom_window, eve$dcl_buffer); eve$x_number_of_windows := 2; eve$x_this_window := eve$bottom_window; endif; endif; set (status_line, current_window, reverse, " DCL buffer"); position (end_of (eve$dcl_buffer)); ! Process the DCL command string split_line; move_vertical( -1); copy_text ("$ " + dcl_string); this_dcl_command := mark( none); update (current_window); send (dcl_string, eve$x_dcl_process); Eve_fix_crlfs; position ( this_dcl_command); tww_top; update (current_window); if this_buffer <> eve$dcl_buffer then eve_other_window; endif; return (1); endprocedure; ! Page 87 ! Associate a key with an Eve command. Prompts for the key. ! Defined keys can be identified by a leading space in the comment field. ! Need this to be able to differentiate during keypad initialization. ! ! Parameters: ! ! define_parameter String containing command name - input ! ! TWW modification: bind to USER KEY MAP... ! procedure eve_define_key (define_parameter) local command_name, ! Local copy of define_parameter full_command_name, ! Full command string returned by eve$parse the_key, ! Keyword for key to be defined paren_index, ! Index into full_command_name to end name define_comment; ! String (with leading space) to associate ! with the_key on_error if error = tpu$_notdefinable then message ("No key defined"); return; endif; endon_error; if not (eve$prompt_string (define_parameter, command_name, eve$x_eve_command_prompt, "No key defined")) then return; endif; full_command_name := eve$parse (command_name); ! Eve$Parse will display messages and handle ambiguities if full_command_name = eve$kt_null then return; endif; the_key := eve$prompt_key ("Press the key that you want to define: "); paren_index := index (full_command_name, "("); if paren_index = 0 then define_comment := substr (full_command_name, 5, length (full_command_name)); else define_comment := substr (full_command_name, 5, paren_index - 5); endif; ! Return gets you out without redefining a key if the_key = ret_key then message ("No key defined"); else if eve$lookup_comment (the_key) = "do" then message ("You cannot bind another command to the DO key"); else if eve$alphabetic (the_key) = eve$kt_null then define_key (full_command_name, the_key, define_comment, "USER KEY MAP"); message ("Key defined"); else message ("You cannot bind another command to a typing key"); endif; endif; endif; endprocedure; ! ! Lifted from EVEPLUS ! procedure eve_search(the_arg) ! Wild-card search procedure local the_direction, the_target, my_key; my_key := last_key; ! How were we invoked? if (my_key = RET_KEY) then ! Was it SEARCH ? my_key := DO; endif; if (current_direction = FORWARD) then the_direction := 'Forward '; else the_direction := 'Reverse '; endif; the_target := the_arg; if (the_arg = '') then the_target := read_line(the_direction + 'wild-card search: '); endif; if (the_target = '') then if (last_key <> my_key) then return; endif; else if (build_pattern(the_target, the_target) = 1) then execute( 'eveplus_search_target := ' + the_target +';' ); else eveplus_search_target := the_target; endif; endif; eve_find(eveplus_search_target); endprocedure !+ ! Build a pattern for pattern searching. Pattern characters are: ! ! « - beginning of line ! » - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! # - multi-character wildcard, cross record boundaries ! _ - quote next character ! ^ - next char. is ctrl character ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. !- PROCEDURE build_pattern( input_string, result_string ) LOCAL s1, s2, i, j, c, quote_next, ctrl_next, match_started, pat; s1 := ''; s2 := ''; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; pat := ''; !+ ! Process each character in the input string !- LOOP EXITIF i > LENGTH(input_string); c := SUBSTR(input_string, i, 1); !+ ! Do quoting if we're supposed to !- IF quote_next = 1 THEN IF c = "'" THEN s1 := s1 + "''" ELSE s1 := s1 + c ENDIF; s2 := s2 + c; i := i + 1; quote_next := 0 ELSE !+ ! Do CTRL/n quoting if we're supposed to !- IF ctrl_next = 1 THEN CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1); s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 ELSE !+ ! A normal character or wildcard !- CASE c FROM '' TO 'ÿ' ['_']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['^']: !+ ! CTRL next character !- ctrl_next := 1; i := i + 1; ['«']: !+ ! Begin-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_BEGIN"; i := i + 1; ['»']: !+ ! End-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_END"; i := i + 1; ['#']: !+ ! General match, crossing record boundaries. ! ! Start by eating all following wildcards. !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('«»*#%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Ignore the wildcard if at end-of-pattern string !- IF i <= LENGTH(input_string) THEN !+ ! Get the stop character (which may be quoted) !- CASE SUBSTR(input_string, i, 1) FROM '' TO 'ÿ' ['_']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1) ENDIF; ['^']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1); CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1) ENDIF; [INRANGE]: c := SUBSTR(input_string, i, 1) ENDCASE; !+ ! Double it if apostrophe !- IF c = "'" THEN c := "''" ENDIF; !+ ! Put it in the pattern !- IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& SCANL('" + c + "')" ENDIF; ['*']: !+ ! General wildcard, not crossing record boundaries ! ! Eat following * and % !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('*%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Use REMAIN if at end of input_string !- IF i > LENGTH(input_string) THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& REMAIN" ELSE !+ ! Ignore * if followed by # !- IF SUBSTR(input_string, i, 1) <> "#" THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; !+ ! Use REMAIN if « or » follows !- IF (SUBSTR(input_string, i, 1) = "«") OR (SUBSTR(input_string, i, 1) = "»") THEN pat := pat + "& REMAIN" ELSE !+ ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. !- pat := pat + "& MATCH('"; match_started := 1 ENDIF ENDIF ENDIF; ['%']: !+ ! Single-character wildcard. ! ! Start by counting consecutive %s !- j := 0; LOOP EXITIF i > LENGTH(input_string); EXITIF SUBSTR(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 ENDLOOP; !+ ! Put it in the pattern !- IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& ARB(" + STR(j) + ")"; ["'"]: !+ ! Apostrophes must be doubled in STR1 !- s1 := s1 + "''"; s2 := s2 + "'"; i := i + 1; [INRANGE]: !+ ! Just an ordinary character !- s1 := s1 + c; s2 := s2 + c; i := i + 1; ENDCASE ENDIF ENDIF ENDLOOP; !+ ! Empty out STR1 !- IF (LENGTH(s1) > 0) AND (LENGTH(pat) > 0) THEN IF match_started THEN pat := pat + s1 + "')" ELSE pat := pat + "& '" + s1 + "'" ENDIF ENDIF; !+ ! Return either a string or a pattern string !- IF LENGTH(pat) > 0 THEN result_string := SUBSTR(pat, 3, LENGTH(pat) - 2); RETURN 1 ELSE result_string := s2; RETURN 0 ENDIF ENDPROCEDURE !+ ! SORT.TPU !-! ! procedure eveplus_sort (bname,astring) eveplus$$shell_sort(bname); endprocedure ! ! Sort the named buffer. Prompt for buffer name if not specified ! procedure eve_sort_buffer (buffer_to_sort) local v_buf ,p_buf; if not eve$prompt_string (buffer_to_sort, v_buf, "Sort buffer: ", "Cancelled") then return; endif; p_buf := eveplus_find_buffer (v_buf); if (p_buf <> 0) then eveplus$$shell_sort (p_buf); else message ("Buffer "+v_buf+" not found"); endif; endprocedure ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! procedure eveplus$$string_compare (string1, string2) local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0 else return 1 endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1, v_i, 1); change_case (v_c1, upper); v_c2 := substr (string2, v_i, 1); change_case (v_c2, upper); v_p1 := index (v_alpha, v_c1); v_p2 := index (v_alpha, v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; endprocedure ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! procedure eveplus$$shell_sort (buffer_to_sort) local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); eveplus$x_shellstep_0 := 1; eveplus$x_shellstep_1 := 4; eveplus$x_shellstep_2 := 13; eveplus$x_shellstep_3 := 40; eveplus$x_shellstep_4 := 121; eveplus$x_shellstep_5 := 364; eveplus$x_shellstep_6 := 1093; eveplus$x_shellstep_7 := 3280; eveplus$x_shellstep_8 := 9841; eveplus$x_shellstep_9:= 32767; eveplus$x_gshell := 0; eveplus$x_shell_index := 0; ! ! Find the highest step to use ! loop eveplus$x_gshell := 0; exitif (eveplus$x_shell_index >= 6); execute ("if (get_info (current_buffer, 'record_count') <"+ fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+ " then eveplus$x_gshell := 1;endif;"); if eveplus$x_gshell then exitif 1; endif; eveplus$x_shell_index := eveplus$x_shell_index + 1; endloop; v_record := get_info (current_buffer, 'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing eveplus$x_shell_index. ! loop execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL", eveplus$x_shell_index)); v_j := eveplus$x_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - eveplus$x_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (eveplus$$string_compare (v_jline, v_iline) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - eveplus$x_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; eveplus$x_shell_index := eveplus$x_shell_index - 1; exitif (eveplus$x_shell_index < 0); endloop; position (v_pos); endprocedure !+ ! WHAT.TPU - Displays a message with the current line number, ! total number of lines in the file, and the percentage. ! ! TWW modification: doesn't count EOB line now. !- ! procedure eve_what_line ! What line am I on? local this_position, ! marker - current position start_of_buffer, ! marker - beginning of current buffer this_line_position, ! marker - position at start of this_line total_lines, ! integer - total lines in buffer high_line, ! integer - high line limit for binary search low_line, ! integer - low line limit for binary search this_line, ! integer - line number of current guess percent; ! integer - percent of way through buffer ! Initialization this_position := mark (none); start_of_buffer := beginning_of (current_buffer); total_lines := get_info (current_buffer, "record_count") + 1; high_line := total_lines; if this_position = end_of (current_buffer) then low_line := total_lines; else low_line := 1; endif; ! Binary search loop exitif high_line - low_line <= 1; this_line := low_line + ((high_line - low_line) / 2); position (start_of_buffer); move_vertical (this_line - 1); if mark (none) > this_position then high_line := this_line; else low_line := this_line; if mark (none) = this_position then high_line := this_line; endif; endif; endloop; ! TPU will truncate numbers on division; make it round instead percent := (((low_line * 1000) / total_lines)+5)/10; ! Display message and return to original position message (fao ("You are on line !SL out of !SL (!SL%)", low_line, (total_lines - 1), percent)); position (this_position); endprocedure; ! ! Adjust location of the border between the two EVE windows. ! PROCEDURE EVE_ADJUST_WINDOWS LOCAL LAST_WINDOW, LAST_MARK, AMOUNT; ON_ERROR RETURN; ENDON_ERROR; LAST_WINDOW := CURRENT_WINDOW; LAST_MARK := MARK( NONE); IF EVE$X_NUMBER_OF_WINDOWS = 1 THEN MESSAGE( "Only one window on screen"); RETURN; ENDIF; IF LAST_KEY = KEY_NAME( UP, SHIFT_KEY) THEN ADJUST_WINDOW( EVE$TOP_WINDOW, 0, -1); ADJUST_WINDOW( EVE$BOTTOM_WINDOW, -1, 0); ELSE IF LAST_KEY = KEY_NAME( DOWN, SHIFT_KEY) THEN ADJUST_WINDOW( EVE$BOTTOM_WINDOW, 1, 0); ADJUST_WINDOW( EVE$TOP_WINDOW, 0, 1); ELSE AMOUNT := INT( READ_LINE( "Move division how far down (-n to go up)? ")); ADJUST_WINDOW( EVE$TOP_WINDOW, 0, AMOUNT); ADJUST_WINDOW( EVE$BOTTOM_WINDOW, AMOUNT, 0); ENDIF; ENDIF; POSITION( LAST_WINDOW); POSITION( LAST_MARK); ENDPROCEDURE; PROCEDURE TWW_BACKSPACE ! ! Emulates EDT backspace. ! ON_ERROR RETURN; ENDON_ERROR; IF CURRENT_OFFSET = 0 THEN MOVE_VERTICAL( -1); ELSE POSITION( SEARCH( LINE_BEGIN, REVERSE)); ENDIF; ENDPROCEDURE; ! ! Interactive calculation of formulae -- no operator precedence. ! PROCEDURE EVE_CALCULATE( WHAT) LOCAL EXPRESSION; IF EVE$PROMPT_STRING( WHAT, EXPRESSION, "Expression: ", "No expression entered") THEN EVALUATE( EXPRESSION, TWW_ACCURACY); MESSAGE( EXPRESSION + " = " + TWW_RESULT); ENDIF; ENDPROCEDURE PROCEDURE EVE_CHANGE_CASE( NEW_CASE_IN) ! ! Works on Select Range; if none, toggles current character. ! LOCAL HERE, NEW_CASE; NEW_CASE := NEW_CASE_IN; IF EVE$X_SELECT_POSITION = 0 THEN IF CURRENT_DIRECTION = FORWARD THEN HERE := MARK (NONE); CHANGE_CASE( CREATE_RANGE( HERE, HERE, NONE), INVERT); MOVE_HORIZONTAL( 1); ELSE MOVE_HORIZONTAL( -1); HERE := MARK (NONE); CHANGE_CASE( CREATE_RANGE( HERE, HERE, NONE), INVERT); ENDIF; RETURN; ENDIF; IF NEW_CASE = "" THEN MESSAGE( "Uppercase, Lowercase, or Invert? "); NEW_CASE := READ_CHAR; ENDIF; IF (NEW_CASE = "U") OR (NEW_CASE = "u") THEN NEW_CASE := UPPER; ELSE IF (NEW_CASE = "L") OR (NEW_CASE = "l") THEN NEW_CASE := LOWER; ELSE IF (NEW_CASE = "I") OR (NEW_CASE = "i") THEN NEW_CASE := INVERT; ELSE MESSAGE( "Case change cancelled"); EVE$X_SELECT_POSITION := 0; RETURN; ENDIF; ENDIF; ENDIF; CHANGE_CASE( SELECT_RANGE, NEW_CASE); EVE$X_SELECT_POSITION := 0; MESSAGE( ""); RETURN; ENDPROCEDURE; PROCEDURE EVE_ERASE_BUFFER ERASE( CURRENT_BUFFER); ENDPROCEDURE; PROCEDURE TWW_GET_DCL_SYMBOL( SYMBOL) ! ! Get a global symbol from the DCL table. ! LOCAL CALL_STRING, COMMAND_STRING, STATUS; ON_ERROR RETURN( ""); ENDON_ERROR STATUS := 1; CALL_STRING := "LIB$GET_SYMBOL " + '"' + SYMBOL + '"' + ", TWW_DCL_SYMBOL$"; COMMAND_STRING := CALL_USER( STATUS, CALL_STRING); EXECUTE( COMMAND_STRING); IF (STATUS AND 1) = 1 THEN RETURN( TWW_DCL_SYMBOL); ELSE MESSAGE( TWW_GETMSG( STATUS) + " for " + SYMBOL); RETURN( ""); ENDIF; ENDPROCEDURE PROCEDURE TWW_GETMSG( STATUS) ! ! Interface with system service $GETMSG. ! LOCAL CALL_STRING, COMMAND_STRING; ON_ERROR RETURN( "Error..."); ENDON_ERROR CALL_STRING := "LIB$SYS_GETMSG " + STR( STATUS) + ",, TWW_MESSAGE$, " + STR( GET_INFO( SYSTEM, "MESSAGE_FLAGS")); COMMAND_STRING := CALL_USER( STATUS, CALL_STRING); EXECUTE( COMMAND_STRING); RETURN( TWW_MESSAGE); ENDPROCEDURE !++ ! ! Write out and compile the current buffer, which is assumed to be ! the current work file. Similar commands to link and run. ! !-- PROCEDURE EVE_COMPILE( APPENDAGE) ! ! Write out this buffer, which we assume to be the work file. ! ! ******************************************************************* ! ** ** ! ** It is assumed that the user of this command has used WORK.COM ** ! ** to define CW, LW, and RW ({Compile|Link|Run} Work). ** ! ** ** ! ******************************************************************* ! LOCAL COMMAND_STRING; EVE_WRITE_FILE( ""); COMMAND_STRING := TWW_GET_DCL_SYMBOL( "CW") + APPENDAGE; EVE_DCL( COMMAND_STRING); ENDPROCEDURE PROCEDURE EVE_LINK( APPENDAGE) LOCAL COMMAND_STRING; COMMAND_STRING := TWW_GET_DCL_SYMBOL( "LW") + APPENDAGE; EVE_DCL( COMMAND_STRING); ENDPROCEDURE PROCEDURE EVE_RUN( APPENDAGE) LOCAL COMMAND_STRING; COMMAND_STRING := TWW_GET_DCL_SYMBOL( "RW") + APPENDAGE; EVE_DCL( COMMAND_STRING); ENDPROCEDURE PROCEDURE EVE_DATE ! ! Insert a pretty date into the current buffer. ! LOCAL DAY, FULL_DATE, FULL_MONTH, RAW_DATE, RAW_MONTH; RAW_DATE := FAO( "!%D", 0); RAW_MONTH := SUBSTR( RAW_DATE, 4, 3); ! ! Get FULL_MONTH based on abbreviated RAW_MONTH. ! IF RAW_MONTH = "JAN" THEN FULL_MONTH := "January "; ELSE IF RAW_MONTH = "FEB" THEN FULL_MONTH := "February "; ELSE IF RAW_MONTH = "MAR" THEN FULL_MONTH := "March "; ELSE IF RAW_MONTH = "APR" THEN FULL_MONTH := "April "; ELSE IF RAW_MONTH = "MAY" THEN FULL_MONTH := "May "; ELSE IF RAW_MONTH = "JUN" THEN FULL_MONTH := "June "; ELSE IF RAW_MONTH = "JUL" THEN FULL_MONTH := "July "; ELSE IF RAW_MONTH = "AUG" THEN FULL_MONTH := "August "; ELSE IF RAW_MONTH = "SEP" THEN FULL_MONTH := "September "; ELSE IF RAW_MONTH = "OCT" THEN FULL_MONTH := "October "; ELSE IF RAW_MONTH = "NOV" THEN FULL_MONTH := "November "; ELSE IF RAW_MONTH = "DEC" THEN FULL_MONTH := "December "; ENDIF; ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF;ENDIF; ! ! Extract any leading space from the day. ! IF SUBSTR( RAW_DATE, 1, 1) = " " THEN DAY := SUBSTR( RAW_DATE, 2, 1); ELSE DAY := SUBSTR( RAW_DATE, 1, 2); ENDIF; ! ! Get and output FULL_DATE. ! FULL_DATE := FULL_MONTH + DAY + ", " + SUBSTR( RAW_DATE, 8, 4); COPY_TEXT( FULL_DATE); ENDPROCEDURE; PROCEDURE TWW_DELETE_TO_EOL ! ! Emulate EDT DEL command. ! LOCAL HERE, RANGE_TO_DELETE; ON_ERROR RETURN; ENDON_ERROR; HERE := MARK( NONE); POSITION( SEARCH( LINE_END, FORWARD)); IF MARK( NONE) = HERE THEN MESSAGE( "Already at end of line"); RETURN; ENDIF; MOVE_HORIZONTAL ( -1); RANGE_TO_DELETE := CREATE_RANGE( HERE, MARK( NONE), NONE); EVE$X_RESTORE_TEXT := SUBSTR( RANGE_TO_DELETE, 1, 9999); EVE$X_RESTORING_LINE := 0; ERASE( RANGE_TO_DELETE); ENDPROCEDURE; PROCEDURE TWW_DELETE_START_OF_WORD ! ! EDT ^J emulation. ! LOCAL AT_LEFT_MARGIN, END, RANGE_TO_DELETE, START; ON_ERROR RETURN; ENDON_ERROR; EVE$X_RESTORING_LINE := 0; END := MARK( NONE); AT_LEFT_MARGIN := CURRENT_COLUMN = GET_INFO( CURRENT_BUFFER, "LEFT_MARGIN"); IF CURRENT_OFFSET = 0 THEN ! ! We are at the beginning of the physical line. ! APPEND_LINE; EVE$X_RESTORE_TEXT := ""; EVE$X_RESTORING_LINE := 1; ELSE MOVE_HORIZONTAL( -1); END := MARK( NONE); IF AT_LEFT_MARGIN THEN ! ! We're at the left margin, but not column 1. ! MOVE_HORIZONTAL( -CURRENT_OFFSET); MOVE_VERTICAL( -1); POSITION( SEARCH( LINE_END, FORWARD)); EVE$X_RESTORING_LINE := 1; ELSE ! ! Not at the left margin, nor column 1. Business as usual. ! EVE$START_OF_WORD; ENDIF; START := MARK( NONE); RANGE_TO_DELETE := CREATE_RANGE( START, END, NONE); EVE$X_RESTORE_TEXT := SUBSTR( RANGE_TO_DELETE, 1, 9999); ERASE( RANGE_TO_DELETE); ENDIF; ENDPROCEDURE; PROCEDURE TWW_LONGEST_LINE ! ! Returns the length of the longest line in the current buffer. ! LOCAL MAX; ON_ERROR RETURN( MAX); ENDON_ERROR; POSITION( BEGINNING_OF( CURRENT_BUFFER)); MAX := 0; LOOP EXITIF MARK( NONE) = END_OF( CURRENT_BUFFER); POSITION( SEARCH( LINE_END, FORWARD)); IF CURRENT_OFFSET > MAX THEN MAX := CURRENT_OFFSET; ENDIF; POSITION( SEARCH( LINE_BEGIN, FORWARD)); ENDLOOP; RETURN( MAX); ENDPROCEDURE; PROCEDURE TWW_PAD( WIDENESS) ! ! Pad current buffer with spaces to the passed width. ! ON_ERROR RETURN; ENDON_ERROR; POSITION( BEGINNING_OF( CURRENT_BUFFER)); LOOP EXITIF MARK( NONE) = END_OF( CURRENT_BUFFER); POSITION( SEARCH( LINE_END, FORWARD)); LOOP EXITIF CURRENT_OFFSET >= WIDENESS; COPY_TEXT( " "); ENDLOOP; POSITION( SEARCH( LINE_BEGIN, FORWARD)); ENDLOOP; POSITION( BEGINNING_OF( CURRENT_BUFFER)); ENDPROCEDURE; ! ! Break a window into as many columns as cleanly possible. ! Make ! 1 ! 2 ! ... ! 7 ! 8 ! into ! 1 2 3 ! 4 5 6 ! 7 8 ! PROCEDURE EVE_MAKE_COLUMNS LOCAL COLUMN, ! Column index COLUMN_WIDTH, ! Space-padded per/column COLUMNS, ! How many LINE_TO_MOVE, ! Stuff to copy M1, ! Markers RECORD_COUNT, ! Total records ROW, ! Row index ROWS, ! Display rows WIDENESS; ! Window width ON_ERROR RETURN; ENDON_ERROR; WIDENESS := GET_INFO( CURRENT_WINDOW, "WIDTH"); RECORD_COUNT := GET_INFO( CURRENT_BUFFER, "RECORD_COUNT"); COLUMN_WIDTH := TWW_LONGEST_LINE; COLUMNS := WIDENESS / (COLUMN_WIDTH + 2); IF COLUMNS > 1 THEN COLUMN_WIDTH := WIDENESS / COLUMNS; ROWS := ( RECORD_COUNT + COLUMNS - 1) / COLUMNS; COLUMN := 1; POSITION( BEGINNING_OF( CURRENT_BUFFER)); TWW_PAD( COLUMN_WIDTH); ! Space pad... LOOP EXITIF MARK( NONE) = END_OF( CURRENT_BUFFER); EXITIF COLUMN > COLUMNS; POSITION( BEGINNING_OF( CURRENT_BUFFER)); ROW := 1; LOOP EXITIF ROW > ROWS; POSITION( SEARCH( LINE_END, FORWARD)); M1 := MARK( NONE); POSITION( BEGINNING_OF( CURRENT_BUFFER)); MOVE_VERTICAL( ROWS); EXITIF MARK( NONE) = END_OF( CURRENT_BUFFER); LINE_TO_MOVE := ERASE_LINE; POSITION( M1); MOVE_TEXT( LINE_TO_MOVE); POSITION( SEARCH( LINE_BEGIN, FORWARD)); ROW := ROW + 1; ENDLOOP; COLUMNS := COLUMNS + 1; ENDLOOP; ENDIF; EVE_TRIM; ENDPROCEDURE; PROCEDURE EVE_DIRECTORY ! ! Get a directory without calling outside of TPU. ! LOCAL CURRENT_FILE, FILE_SPEC, FULL_CURRENT_FILE; FILE_SPEC := FILE_PARSE( READ_LINE( "File(s): "), "[]*.*;*"); TWW_OLD_BUFFER := CURRENT_BUFFER; ERASE( TWW_DIRECTORY_BUFFER); POSITION( TWW_DIRECTORY_BUFFER); LOOP FULL_CURRENT_FILE := FILE_SEARCH( FILE_SPEC); EXITIF FULL_CURRENT_FILE = ""; CURRENT_FILE := FILE_PARSE( FULL_CURRENT_FILE,"","", NAME) + FILE_PARSE( FULL_CURRENT_FILE,"","", TYPE) + FILE_PARSE( FULL_CURRENT_FILE,"","", VERSION); COPY_TEXT( CURRENT_FILE); SPLIT_LINE; ENDLOOP; ERASE_LINE; EVE_MAKE_COLUMNS; POSITION( BEGINNING_OF( TWW_DIRECTORY_BUFFER)); SET( STATUS_LINE, INFO_WINDOW, REVERSE, "Press to continue."); MAP( INFO_WINDOW, CURRENT_BUFFER); UPDATE( INFO_WINDOW); ADD_KEY_MAP( EVE$X_KEY_MAP_LIST, "FIRST", "BROWSE KEY MAP"); ENDPROCEDURE ! ! Use CALL_USER to support calculation routine. The CALL_USER routine we ! are using uses LIB$FIND_IMAGE_SYMBOL and LIB$CALLG to call virtually ! ANY routine in the RTL (or any other in a shareable image), as long as ! the arguments are all either read-only literals or write-only variables. ! In addition, the only data types currently supported are string and ! longword. The calling sequence for CALL_USER is ! ! string := CALL_USER( status-int, call-string) ! ! where: "string" will receive the text of VAXTPU commands ! to be executed, ! ! "status-int" receives the longword status (result) ! of the call, ! ! "call-string" contains the info on what to call and ! what parameters to pass to it. ! ! Format for call-string: ! ! shr-filespec>routine-name [p1[, p2...]] ! ! Where: "shr-filespec" is the name of a shareable image file ! containing the specified routine. If the filespec does ! not conform to the form SYS$SHARE:name.EXE, you must ! define a logical name to point to it explicitly. The ! right angle bracket is required after the filespec. ! ! "routine-name" is the name of the routine to call ! ! p1-pN are the parameters to be passed on the call. A ! parameter can be either (1) a literal integer, (2) a ! quoted literal string, or (3) a variable name. The ! variable name must be followed by a dollar sign ($) ! if it is to receive a string; or a percent sign (%) ! if it is to receive an integer. ! PROCEDURE EVALUATE( EXPRESSION, ACCURACY) LOCAL COMMANDS, STATUS, STRING_TO_EXECUTE, STRING_TO_SEND; STRING_TO_SEND := "EVAL_SHR>EVALUATE " + "TWW_RESULT$, " + STR( ACCURACY) + ", '" + EXPRESSION + "'"; STATUS := 1; STRING_TO_EXECUTE := CALL_USER( STATUS, STRING_TO_SEND); IF (STATUS AND 1) = 1 THEN EXECUTE( STRING_TO_EXECUTE); ELSE MESSAGE( TWW_GETMSG( STATUS)); ENDIF; RETURN; ENDPROCEDURE ! ! Support procedure for EVE_DIRECTORY and TWW_KEYPAD HELP ! PROCEDURE TWW_END_BROWSING REMOVE_KEY_MAP( EVE$X_KEY_MAP_LIST, "BROWSE KEY MAP"); UNMAP( INFO_WINDOW); POSITION( TWW_OLD_BUFFER); ENDPROCEDURE PROCEDURE TWW_FIND_SAVED_MARKER ! ! Look for !//+\\! mark, which can stay between editing sessions. ! ON_ERROR MESSAGE( "Marker not found"); RETURN; ENDON_ERROR IF CURRENT_DIRECTION = FORWARD THEN POSITION( SEARCH( "!//+\\!", FORWARD, EXACT)); ELSE POSITION( SEARCH( "!//+\\!", REVERSE, EXACT)); ENDIF; ERASE_CHARACTER( 7); ENDPROCEDURE PROCEDURE EVE_HEADER ! ! This procedure gets the specified file from the ! logical directory HEADER:, inserts it at the line nearest ! to the current position, and positions the cursor at the ! top of the newly inserted text. ! LOCAL HEADER_TO_GET, TEMP_STRING, TOP_OF_NEW_TEXT; TEMP_STRING := READ_LINE( "Header to include : "); HEADER_TO_GET := FILE_SEARCH( FILE_PARSE( TEMP_STRING, "HEADER:MEMO.TXT", "HEADER:MEMO.TXT")); IF HEADER_TO_GET = "" THEN HEADER_TO_GET := FILE_SEARCH( FILE_PARSE( TEMP_STRING, "HEADER:MEMO.TXT", "HEADER:MEMO.TXT")); ENDIF; MOVE_HORIZONTAL( -CURRENT_OFFSET); IF MARK( NONE) = BEGINNING_OF( CURRENT_BUFFER) THEN TOP_OF_NEW_TEXT := 0; ELSE MOVE_VERTICAL( -1); TOP_OF_NEW_TEXT := MARK( NONE); ENDIF; IF ( MARK( NONE) <> END_OF( CURRENT_BUFFER)) AND ( TOP_OF_NEW_TEXT <> 0) THEN MOVE_VERTICAL( 1); ENDIF; READ_FILE( HEADER_TO_GET); IF TOP_OF_NEW_TEXT = 0 THEN POSITION( BEGINNING_OF( CURRENT_BUFFER)); ELSE POSITION( TOP_OF_NEW_TEXT); MOVE_VERTICAL( 1); ENDIF; ENDPROCEDURE PROCEDURE EVE_HELP( DUMMY) ! ! Get help text on whatever, from any help library. ! MAP( INFO_WINDOW, HELP_BUFFER); HELP_TEXT( TWW_HELP_LIBRARY, READ_LINE( TWW_HELP_LIBRARY_NAME + " Topic: "), ON, HELP_BUFFER); UNMAP( INFO_WINDOW); ENDPROCEDURE PROCEDURE TWW_FORMAT_HELP ! ! Get help with no prompting. Find a "format", if possible. ! Put it in a second window. ! LOCAL FORMAT_MARKER, FORMAT_PATTERN, THIS_BUFFER, THIS_POSITION, TOPIC; ON_ERROR IF ERROR = TPU$_STRNOTFOUND THEN MESSAGE( "No format found"); EVE_OTHER_WINDOW; ELSE MESSAGE( "Unknown error..."); ENDIF; RETURN; ENDON_ERROR; THIS_BUFFER := CURRENT_BUFFER; FORMAT_PATTERN := (( " " | " ") & "format:") | (( " " | " ") & "format"); TOPIC := READ_LINE( TWW_HELP_LIBRARY_NAME + " Format Topic: "); IF TOPIC = "" THEN RETURN; ENDIF; IF THIS_BUFFER <> HELP_BUFFER THEN IF EVE$X_NUMBER_OF_WINDOWS = 2 THEN EVE_OTHER_WINDOW; IF CURRENT_BUFFER <> HELP_BUFFER THEN MAP (CURRENT_WINDOW, HELP_BUFFER); ENDIF; ELSE UNMAP (EVE$MAIN_WINDOW); MAP (EVE$TOP_WINDOW, THIS_BUFFER); EVE$SET_STATUS_LINE (EVE$TOP_WINDOW); UPDATE (EVE$TOP_WINDOW); MAP (EVE$BOTTOM_WINDOW, HELP_BUFFER); EVE$X_NUMBER_OF_WINDOWS := 2; EVE$X_THIS_WINDOW := EVE$BOTTOM_WINDOW; ENDIF; ENDIF; SET( STATUS_LINE, CURRENT_WINDOW, REVERSE, "Help Library: " + TWW_HELP_LIBRARY_NAME); HELP_TEXT( TWW_HELP_LIBRARY, TOPIC, OFF, HELP_BUFFER); POSITION( BEGINNING_OF( HELP_BUFFER)); FORMAT_MARKER := SEARCH( FORMAT_PATTERN, FORWARD, NO_EXACT); IF FORMAT_MARKER <> 0 THEN POSITION( FORMAT_MARKER); MOVE_HORIZONTAL( -CURRENT_OFFSET); UPDATE( CURRENT_WINDOW); TWW_TOP; UPDATE( CURRENT_WINDOW); ELSE MESSAGE( 'Could not find "Format"'); ENDIF; EVE_OTHER_WINDOW; ENDPROCEDURE PROCEDURE TWW_KEY_HELP ! ! Get keypad help from EDI:TWW_EVE.HLB ! TWW_OLD_BUFFER := CURRENT_BUFFER; HELP_TEXT( "EVEPLUS:TWW_EVE.HLB", "KEY_DEFINITIONS", OFF, HELP_BUFFER); SET( STATUS_LINE, INFO_WINDOW, REVERSE, " Use Prev & Next Screen keys. Press to continue."); POSITION( BEGINNING_OF( HELP_BUFFER)); ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; MAP( INFO_WINDOW, HELP_BUFFER); UPDATE( INFO_WINDOW); ADD_KEY_MAP( EVE$X_KEY_MAP_LIST, "FIRST", "BROWSE KEY MAP"); ENDPROCEDURE PROCEDURE TWW_INCREMENTAL_SEARCH ! ! Find a string, building search string one character at a time. ! LOCAL CHAR, DESTINATION, STRING_BEGIN, STRING_END, SEARCH_STRING, SEARCH_TYPE, TEMP_STRING; SEARCH_STRING := ""; MESSAGE( "Enter characters to find."); LOOP CHAR := READ_CHAR; EXITIF CHAR = ASCII( 13); SEARCH_STRING := SEARCH_STRING + CHAR; TEMP_STRING := SEARCH_STRING; EDIT( TEMP_STRING, LOWER); ! ! If all lowercase, use a no-exact search; otherwise, exact. ! IF TEMP_STRING <> SEARCH_STRING THEN SEARCH_TYPE := EXACT; ELSE SEARCH_TYPE := NO_EXACT; ENDIF; DESTINATION := 0; DESTINATION := SEARCH( SEARCH_STRING, CURRENT_DIRECTION, SEARCH_TYPE); IF DESTINATION <> 0 THEN STRING_BEGIN := BEGINNING_OF( DESTINATION); STRING_END := END_OF( DESTINATION); DESTINATION := CREATE_RANGE( STRING_BEGIN, STRING_END, BOLD); POSITION( DESTINATION); UPDATE( CURRENT_WINDOW); ELSE SET( BELL, ALL, ON); MESSAGE( 'String "' + SEARCH_STRING + '" not found'); SET( BELL, ALL, OFF); SET( BELL, BROADCAST, ON); SEARCH_STRING := SUBSTR( SEARCH_STRING, 1, LENGTH( SEARCH_STRING) - 1); ENDIF; ENDLOOP; EVE$X_TARGET := SEARCH_STRING; MESSAGE( ""); ENDPROCEDURE !++ ! ! Command to allow a TPU-pattern search. It is assumed that the user is aware ! of the "&", "|", and the built-ins. Beware of bugs. ! !-- PROCEDURE EVE_PATTERN_SEARCH( WHAT) LOCAL COMMAND_TO_EXECUTE, DESTINATION, THAT_WAY, THE_PATTERN, THIS_WAY; ON_ERROR RETURN; ENDON_ERROR; IF EVE$PROMPT_STRING( WHAT, THE_PATTERN, "Pattern: ", "No pattern entered") THEN THIS_WAY := CURRENT_DIRECTION; IF THIS_WAY = FORWARD THEN THAT_WAY := REVERSE; ELSE THAT_WAY := FORWARD; ENDIF; COMMAND_TO_EXECUTE := "EVE$X_TARGET := (" + THE_PATTERN + ");"; EXECUTE( COMMAND_TO_EXECUTE); !EVE_FIND( EVE$X_TARGET); DESTINATION := SEARCH( EVE$X_TARGET, THIS_WAY, NO_EXACT); IF DESTINATION <> 0 THEN POSITION( DESTINATION); ELSE DESTINATION := SEARCH( EVE$X_TARGET, THAT_WAY, NO_EXACT); IF DESTINATION <> 0 THEN IF EVE$INSIST_Y_N( "Found it in the other direction. Go there? ") THEN POSITION( DESTINATION); EVE_CHANGE_DIRECTION; ENDIF; ELSE MESSAGE( 'Could not find ' + THE_PATTERN); ENDIF; ENDIF; ENDIF; ENDPROCEDURE PROCEDURE TWW_INSERT_FILENAME ! ! Insert the output file name and type into the current buffer. ! LOCAL FULL_FILE_SPEC, SMALL_FILE_SPEC; FULL_FILE_SPEC := GET_INFO( CURRENT_BUFFER, "OUTPUT_FILE"); SMALL_FILE_SPEC := FILE_PARSE( FULL_FILE_SPEC, "", "", NAME) + FILE_PARSE( FULL_FILE_SPEC, "", "", TYPE); COPY_TEXT( SMALL_FILE_SPEC); ENDPROCEDURE PROCEDURE EVE_JUMP_SCROLL; SET( TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE( ASCII( 27) + "[?4l"); UPDATE( MESSAGE_WINDOW); MESSAGE( ""); SET( TEXT, MESSAGE_WINDOW, BLANK_TABS); ENDPROCEDURE PROCEDURE TWW_LEFT_MARGIN_AT_CURSOR ! ! Set left margin to current cursor position. ! SET( MARGINS, CURRENT_BUFFER, CURRENT_COLUMN, GET_INFO( CURRENT_BUFFER, "RIGHT_MARGIN")); IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") = 0 THEN MESSAGE( "Left margin set at " + STR( CURRENT_COLUMN)); ELSE EVE$SET_STATUS_LINE( CURRENT_WINDOW); MESSAGE( ""); ENDIF; ENDPROCEDURE PROCEDURE TWW_SET_LEFT_MARGIN LOCAL LEFT_MARGIN, RIGHT_MARGIN; RIGHT_MARGIN := GET_INFO( CURRENT_BUFFER, "RIGHT_MARGIN"); LEFT_MARGIN := INT( READ_LINE( "Set left margin to: ")); IF LEFT_MARGIN > RIGHT_MARGIN THEN MESSAGE("That would make the left margin larger than the right."); RETURN; ELSE SET( MARGINS, CURRENT_BUFFER, LEFT_MARGIN, RIGHT_MARGIN); IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") = 0 THEN MESSAGE( "Left margin set at " + STR( LEFT_MARGIN)); ELSE EVE$SET_STATUS_LINE( CURRENT_WINDOW); MESSAGE( ""); ENDIF; ENDIF; ENDPROCEDURE PROCEDURE TWW_SET_RIGHT_MARGIN LOCAL LEFT_MARGIN, RIGHT_MARGIN; LEFT_MARGIN := GET_INFO( CURRENT_BUFFER, "LEFT_MARGIN"); RIGHT_MARGIN := INT( READ_LINE( "Set right margin to: ")); IF RIGHT_MARGIN < LEFT_MARGIN THEN MESSAGE("That would make the right margin smaller than the left."); RETURN; ELSE SET( MARGINS, CURRENT_BUFFER, LEFT_MARGIN, RIGHT_MARGIN); IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") = 0 THEN MESSAGE( "Right margin set at " + STR( RIGHT_MARGIN)); ELSE EVE$SET_STATUS_LINE( CURRENT_WINDOW); MESSAGE( ""); ENDIF; ENDIF; ENDPROCEDURE PROCEDURE TWW_MIDDLE ! ! Set cursor line to middle of the screen. ! LOCAL WINDOW_ROW, WHERE_WE_WERE, WINDOW_BOTTOM, WINDOW_TOP; WHERE_WE_WERE := MARK( NONE); WINDOW_ROW := GET_INFO( CURRENT_WINDOW, "CURRENT_ROW"); WINDOW_BOTTOM := GET_INFO( CURRENT_WINDOW, "VISIBLE_BOTTOM"); WINDOW_TOP := GET_INFO( CURRENT_WINDOW, "VISIBLE_TOP"); SCROLL( CURRENT_WINDOW, WINDOW_ROW - ( WINDOW_BOTTOM + WINDOW_TOP) / 2); POSITION( WHERE_WE_WERE); ENDPROCEDURE PROCEDURE TWW_MOVE_BY_CHAR ! ! Emulate EDT command C. ! IF CURRENT_DIRECTION = FORWARD THEN CURSOR_HORIZONTAL( 1); ELSE CURSOR_HORIZONTAL( -1); ENDIF; ENDPROCEDURE PROCEDURE TWW_MOVE_BY_HALF_WINDOW ! ! Like EDT Section move (KP8) ! LOCAL HEIGHT, ROW; HEIGHT := GET_INFO( CURRENT_WINDOW, "VISIBLE_LENGTH") - 1; IF CURRENT_DIRECTION = FORWARD THEN SCROLL( CURRENT_WINDOW, HEIGHT / 2); ELSE SCROLL( CURRENT_WINDOW, -( HEIGHT / 2)); ENDIF; ENDPROCEDURE; PROCEDURE TWW_MOVE_BY_LINE ! ! More EDT stuff. ! LOCAL OFFSET; OFFSET := -CURRENT_OFFSET; MOVE_HORIZONTAL( OFFSET); IF CURRENT_DIRECTION = FORWARD THEN MOVE_VERTICAL( 1); ELSE IF OFFSET = 0 THEN MOVE_VERTICAL( -1); ENDIF; ENDIF; ENDPROCEDURE; PROCEDURE TWW_MOVE_BY_PARAGRAPH ! ! Find paragraph beginning, delimited by blank line. ! LOCAL DIR, PARAGRAPH; ON_ERROR IF ERROR = TPU$_STRNOTFOUND THEN IF CURRENT_DIRECTION = FORWARD THEN POSITION( END_OF( CURRENT_BUFFER)); ELSE POSITION( BEGINNING_OF( CURRENT_BUFFER)); ENDIF; ENDIF; RETURN; ENDON_ERROR; DIR := CURRENT_DIRECTION; IF DIR = REVERSE THEN MOVE_HORIZONTAL( -CURRENT_OFFSET); MOVE_VERTICAL( -2); ENDIF; PARAGRAPH := SEARCH( ( LINE_BEGIN & LINE_END & LINE_BEGIN), DIR, EXACT); IF PARAGRAPH <> 0 THEN POSITION( PARAGRAPH); MOVE_VERTICAL( 1); ENDIF; ENDPROCEDURE; PROCEDURE TWW_MOVE_TO_EOB ! ! I prefer to move to the end of the last line in the buffer... ! LOCAL HERE; POSITION( END_OF( CURRENT_BUFFER)); IF MARK( NONE) <> BEGINNING_OF( CURRENT_BUFFER) THEN MOVE_HORIZONTAL( -1); HERE := MARK( NONE); POSITION( HERE); ENDIF; ENDPROCEDURE PROCEDURE TWW_MOVE_TO_EOL ! ! More EDT stuff. ! ON_ERROR RETURN; ENDON_ERROR; IF CURRENT_DIRECTION = FORWARD THEN MOVE_HORIZONTAL( 1); ELSE MOVE_VERTICAL( -1); ENDIF; POSITION( SEARCH( LINE_END, FORWARD)); ENDPROCEDURE; PROCEDURE TWW_NEXT_SCREEN ! ! Jump, without scrolling, one full screen. ! LOCAL HEIGHT, ROW; HEIGHT := GET_INFO( CURRENT_WINDOW, "VISIBLE_LENGTH"); IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") <> 0 THEN ! There is a status line. The window's shorter than we think. HEIGHT := HEIGHT - 1; ENDIF; SET( SCROLLING, CURRENT_WINDOW, OFF, 0, 0, 0); SCROLL( CURRENT_WINDOW, HEIGHT); SET( SCROLLING, CURRENT_WINDOW, ON, 0, 0, 0); ENDPROCEDURE; PROCEDURE TWW_PREVIOUS_SCREEN ! ! Jump, without scrolling, one full screen. ! LOCAL HEIGHT, ROW; HEIGHT := GET_INFO( CURRENT_WINDOW, "VISIBLE_LENGTH"); IF GET_INFO( CURRENT_WINDOW, "STATUS_LINE") <> 0 THEN ! There is a status line. The window's shorter than we think. HEIGHT := HEIGHT - 1; ENDIF; SET( SCROLLING, CURRENT_WINDOW, OFF, 0, 0, 0); SCROLL( CURRENT_WINDOW, -HEIGHT); SET( SCROLLING, CURRENT_WINDOW, ON, 0, 0, 0); ENDPROCEDURE; PROCEDURE TWW_OPEN_LINE ! ! EDT, eat your heart out. ! LOCAL CURRENT_MODE, LEFT_OFFSET; CURRENT_MODE := GET_INFO( CURRENT_BUFFER, "MODE"); LEFT_OFFSET := GET_INFO( CURRENT_BUFFER, "LEFT_MARGIN") - 1; SET( INSERT, CURRENT_BUFFER); SPLIT_LINE; ! ! Add spaces until the line is at the left margin. ! LOOP EXITIF CURRENT_OFFSET >= LEFT_OFFSET; COPY_TEXT( " "); ENDLOOP; MOVE_HORIZONTAL( -CURRENT_OFFSET - 1); SET( CURRENT_MODE, CURRENT_BUFFER); ENDPROCEDURE ! Page 69 ! 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 eve$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. procedure eve$check_bad_window ! File and window commands if (current_window = message_window) or (current_window = eve$command_window) or (current_window = tww_outline_window) or (current_window = info_window) then if current_window = info_window then unmap (info_window); endif; position (eve$x_this_window); return (1); else return (0); endif; endprocedure; PROCEDURE TWW_OUTLINE IF GET_INFO( TWW_OUTLINE_WINDOW, "VISIBLE") THEN ! ! Alternate between current "editing" window and ! outline window. ! IF CURRENT_WINDOW = TWW_OUTLINE_WINDOW THEN POSITION( EVE$X_THIS_WINDOW); ELSE POSITION( TWW_OUTLINE_WINDOW); ENDIF; ELSE ! ! Create it first, then go into it. ! TWW_OUTLINE_ON; POSITION( TWW_OUTLINE_WINDOW); ENDIF; ENDPROCEDURE ! ! Procedure to add the OUTLINE window at the top of the screen. ! PROCEDURE TWW_OUTLINE_ON EVE$CHECK_BAD_WINDOW; IF CURRENT_WINDOW = EVE$MAIN_WINDOW THEN ADJUST_WINDOW( EVE$MAIN_WINDOW, 4, 0); ELSE ADJUST_WINDOW( EVE$BOTTOM_WINDOW, 2, 0); ADJUST_WINDOW( EVE$TOP_WINDOW, 4, 2); POSITION( EVE$X_THIS_WINDOW); ENDIF; IF TWW_OUTLINE_BUFFER = 0 THEN MAP( TWW_OUTLINE_WINDOW, CURRENT_BUFFER); TWW_OUTLINE_BUFFER := CURRENT_BUFFER; ELSE MAP( TWW_OUTLINE_WINDOW, TWW_OUTLINE_BUFFER); ENDIF; ENDPROCEDURE ! ! Procedure to remove the OUTLINE window from the top of the screen. ! PROCEDURE TWW_NO_OUTLINE EVE$CHECK_BAD_WINDOW; UNMAP( TWW_OUTLINE_WINDOW); IF CURRENT_WINDOW = EVE$MAIN_WINDOW THEN ADJUST_WINDOW( EVE$MAIN_WINDOW, -4, 0); ELSE ADJUST_WINDOW( EVE$TOP_WINDOW, -4, -2); ADJUST_WINDOW( EVE$BOTTOM_WINDOW, -2, 0); ENDIF; ENDPROCEDURE !+ ! PRINT.TPU - !- ! ! ! A set of procedures that implement the following EVE commands for ! printing on the printer attached to your terminal. ! ! PRINT FILE - Print named file (will prompt if not specified) ! PRINT FF - Print a formfeed. ! PRINT RANGE - Print the current select range or the current buffer ! if no select active. ! PRINT SCREEN - Print the current screen display. ! ! In the interest of saving paper, these procedures do not automatically ! print a formfeed at the end of the listing. Use PRINT FF to cause ! paper eject between listings. ! ! ! Print the current screen. ! procedure EVE_PRINT_SCREEN set (text, message_window, no_translate); message(ascii(27) + '[i'); update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was MESSAGE(""); endprocedure ! ! Procedure to print a range. Accepts the range as input ! procedure eve$print_range (range_to_print, brief_message) local v_pos ; v_pos := mark(none); set (text, message_window, no_translate); message(ascii(27) + '[5i'); !Turn on printer controller mode update (message_window); if (brief_message <> eve$x_null) then message (brief_message); update (message_window); endif; position(beginning_of(range_to_print)); ! ! Print the range. Note that we have to do carriage control ourselves ! loop exitif (mark(none) >= end_of (range_to_print)); message (current_line); !Write line to printer update (message_window); !Make sure it gets out message (ascii (13)+ascii(10)); !Write crlf update (message_window); move_vertical (1); !Next line in range endloop; message(ascii(27) + '[4i'); !Turn off printer controller mode update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was MESSAGE(""); position(v_pos); endprocedure ! ! EVE command to print a range, or the whole buffer if ! there is no select active. Does not clear the select range ! procedure EVE_PRINT_RANGE local v_range ,v_line ,v_pos ; v_pos := mark(none); if (eve$x_select_position = 0) then v_range := create_range (beginning_of(current_buffer), end_of(current_buffer), none); else v_range := create_range (eve$x_select_position, mark(none), none); endif; eve$print_range (v_range, eve$x_null); endprocedure ! ! EVE PRINT FILE command. Accepts a file name, and prints the ! file on the printer port. ! procedure EVE_PRINT_FILE(file_to_print) local print_file ,v_pos ,v_file ,v_header ; on_error position (v_pos); return; endon_error; v_pos := mark(none); if eve$prompt_string (file_to_print, print_file, "File to print: ", "No file printed") then position (eve$choice_buffer); erase (current_buffer); v_file := read_file (print_file); message (eve$x_null); v_header := fao("[!AS !%D]!/!/",v_file, 0); eve$print_range (create_range (beginning_of (current_buffer), end_of (current_buffer), none),v_header); erase (current_buffer); position (v_pos); endif; endprocedure ! ! Procedure to print a form feed on the printer port ! procedure EVE_PRINT_FF set (text, message_window, no_translate); message(ascii(27) + '[5i' +ascii(12) +ascii(27) + '[4i'); update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was MESSAGE(""); refresh; endprocedure PROCEDURE EVE_RULER ! ! Put a ruler in the status line. It will go away when you ! do anything -- like set margins, insert/oversrike, etc. ! LOCAL TEMP_STRING; TEMP_STRING := "····+····1····+····2····+····3····+····4····+····5" + "····+····6····+····7····+····8····+····9····+····0" + "····+····1····+····2····+····3··"; SET( STATUS_LINE, CURRENT_WINDOW, NONE, TEMP_STRING); SET( STATUS_LINE, CURRENT_WINDOW, REVERSE, TEMP_STRING); ENDPROCEDURE PROCEDURE EVE_SCROLL; MESSAGE( "Press any key to stop."); SCROLL( CURRENT_WINDOW); EVE$PROMPT_KEY ("Press any key to resume editing."); MESSAGE( ""); ENDPROCEDURE; PROCEDURE EVE_SET_ACCURACY( WHAT) ! ! Support procedure for Calculate. ! LOCAL PROMPT, ACCURACY_STRING; PROMPT := "Accuracy <" + STR( TWW_ACCURACY) + ">: "; IF EVE$PROMPT_STRING( WHAT, ACCURACY_STRING, PROMPT, "Accuracy unchanged") THEN TWW_ACCURACY := INT( ACCURACY_STRING); ENDIF; ENDPROCEDURE PROCEDURE EVE_SET_HELP ! ! Support for HELP stuff. Any library you like. ! LOCAL TEMP_STRING; TEMP_STRING := READ_LINE( "New help library: "); IF TEMP_STRING = "" THEN TEMP_STRING := "TPUHELP"; ENDIF; TWW_HELP_LIBRARY := FILE_SEARCH( FILE_PARSE( TEMP_STRING + "*", "SYS$HELP:TPUHELP.HLB", "SYS$HELP:TPUHELP.HLB")); TWW_HELP_LIBRARY_NAME := FILE_PARSE( TWW_HELP_LIBRARY, "", "", NAME); SET( STATUS_LINE, INFO_WINDOW, REVERSE, "Help Library: " + TWW_HELP_LIBRARY_NAME + " (Press ^Z to exit)"); ENDPROCEDURE PROCEDURE EVE_SMOOTH_SCROLL; SET( TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE( ASCII( 27) + "[?4h"); UPDATE( MESSAGE_WINDOW); MESSAGE( ""); SET( TEXT, MESSAGE_WINDOW, BLANK_TABS); ENDPROCEDURE PROCEDURE EVE_SPAWN ! ! Better than DEC's. ! SPAWN( READ_LINE( "$ ")); ENDPROCEDURE PROCEDURE TWW_NEXT_TAB( COLUMN) ! ! Support procedure for TABS_TO_SPACES. ! RETURN(( COLUMN + 7) / 8) * 8 + 1; ENDPROCEDURE PROCEDURE TWW_TABS_TO_SPACES LOCAL CURRENT_MODE, TAB, WHERE_WE_WERE; ON_ERROR !+++ ! ! Sooner or later the search will be unsuccessful. When it is, ! exit. ! !--- POSITION( WHERE_WE_WERE); SET( CURRENT_MODE, CURRENT_BUFFER); RETURN; ENDON_ERROR; ! ! Initialize some things. ! WHERE_WE_WERE := MARK( NONE); CURRENT_MODE := GET_INFO( CURRENT_BUFFER, "MODE"); ! Insert/Overstrike TAB := ASCII( 9); POSITION( BEGINNING_OF( CURRENT_BUFFER)); LOOP ! ! Find the next tab character. ! POSITION( SEARCH( TAB, FORWARD, EXACT)); ! ! Go to the next character. Use TPU's idiosyncrasy of ! replacing the current tab with spaces when overlaid ! with a space in overstrike mode. ! MOVE_HORIZONTAL( 1); CURSOR_HORIZONTAL( -1); COPY_TEXT( " "); ENDLOOP; RETURN; ENDPROCEDURE PROCEDURE TWW_TABS ! ! Procedure to change white space from tabs to spaces and from ! leading spaces to tabs. Currently, tab stops at 9, 17, etc. are ! assumed. ! LOCAL CURRENT_MODE, DEST_COL, DUMMY, INSERTION_STRING, NON_WHITE_SPACE, SPACE, TAB, TAB_AND_SPACE, TAB_OR_SPACE, THIS_COLUMN, WHERE_WE_WERE, WHITE_RANGE, WHITE_SPACE, WHITE_START; ON_ERROR !+++ ! ! Sooner or later the search will be unsuccessful. When it is, ! exit. ! !--- POSITION( WHERE_WE_WERE); SET( CURRENT_MODE, CURRENT_BUFFER); SET( TIMER, OFF, ""); RETURN; ENDON_ERROR; !+++ ! ! Beginning of routine. ! !--- ! ! Initialize some things. ! WHERE_WE_WERE := MARK( NONE); CURRENT_MODE := GET_INFO( CURRENT_BUFFER, "MODE"); ! Insert/Overstrike TAB := ASCII( 9); SPACE := ASCII( 32); ! ! Prompt for conversion type. ! MESSAGE( "Press or for a white space filler"); TAB_OR_SPACE := READ_CHAR; ! ! Trim all lines of trailing spaces & tabs. ! EVE_TRIM; IF TAB_OR_SPACE = SPACE THEN !+++ ! ! Change all tabs to spaces. ! !--- SET( OVERSTRIKE, CURRENT_BUFFER); MESSAGE( "Changing tabs to spaces."); TWW_TABS_TO_SPACES; RETURN; ELSE IF TAB_OR_SPACE = TAB THEN !+++ ! ! Change leading multiple spaces to tabs. ! !--- SET( INSERT, CURRENT_BUFFER); MESSAGE( "Changing spaces to tabs."); POSITION( BEGINNING_OF( CURRENT_BUFFER)); ! ! Define search string. ! TAB_AND_SPACE := TAB + SPACE; NON_WHITE_SPACE := NOTANY( TAB_AND_SPACE); LOOP ! ! Find multiple leading spaces. Define a range ! containing them. ! POSITION( SEARCH(( LINE_BEGIN & " "), FORWARD, EXACT)); WHITE_START := MARK( NONE); POSITION( SEARCH( NON_WHITE_SPACE, FORWARD, EXACT)); ! ! Find the current column. The UPDATE command ! is required. ! UPDATE( CURRENT_WINDOW); DEST_COL := CURRENT_COLUMN; MOVE_HORIZONTAL( -1); ! Don't include this character. WHITE_RANGE := CREATE_RANGE( WHITE_START, MARK(NONE), NONE); ERASE( WHITE_RANGE); THIS_COLUMN := 1; LOOP ! ! Add as many tabs as will fit. ! EXITIF TWW_NEXT_TAB( THIS_COLUMN) > DEST_COL; COPY_TEXT( TAB); ! Change to string build later. THIS_COLUMN := TWW_NEXT_TAB( THIS_COLUMN); ENDLOOP; LOOP ! ! Add enough spaces to reach the destination column. ! EXITIF THIS_COLUMN >= DEST_COL; COPY_TEXT( SPACE); ! Change to string build later. THIS_COLUMN := THIS_COLUMN + 1; ENDLOOP; ENDLOOP; RETURN; ELSE ! ! The user pressed something other than a space or a tab. ! MESSAGE( "Illegal character -- Modification cancelled."); RETURN; ENDIF; ENDIF; ENDPROCEDURE PROCEDURE EVE_TIME ! ! Insert pretty time into the current buffer. ! LOCAL RAW_TIME, HALF, HOUR; RAW_TIME := FAO( "!%T", 0); HOUR := INT( SUBSTR( RAW_TIME, 1, 2)); IF HOUR >= 12 THEN HALF := " PM"; IF HOUR > 12 THEN HOUR := HOUR - 12; ENDIF; ELSE HALF := " AM"; ENDIF; ! ! Output the time. ! COPY_TEXT( STR( HOUR) + SUBSTR( RAW_TIME, 3, 3) + HALF); ENDPROCEDURE; PROCEDURE TWW_TOGGLE_WINDOWS ! ! Toggle between ONE WINDOW and TWO WINDOWS. ! IF EVE$X_NUMBER_OF_WINDOWS = 1 THEN EVE_TWO_WINDOWS ELSE EVE_ONE_WINDOW ENDIF; ENDPROCEDURE; PROCEDURE TWW_TOGGLE_NUMERIC ! ! Toggle between NUMERIC and NON-NUMERIC Entry ! IF TWW_NUMERIC THEN TWW_NUMERIC := 0; REMOVE_KEY_MAP( EVE$X_KEY_MAP_LIST, "NUMERIC KEY MAP"); SET( SHIFT_KEY, PF1, "TPU$KEY_MAP_LIST"); MESSAGE( "Application keypad restored."); ELSE TWW_NUMERIC := 1; ADD_KEY_MAP( EVE$X_KEY_MAP_LIST, "FIRST", "NUMERIC KEY MAP"); SET( SHIFT_KEY, CTRL_Y_KEY, "TPU$KEY_MAP_LIST"); MESSAGE( "Numeric keypad enabled."); ENDIF; ENDPROCEDURE; PROCEDURE TWW_TOP ! ! Put current line at top of the window. ! LOCAL WINDOW_ROW, WHERE_WE_WERE, WINDOW_TOP; WHERE_WE_WERE := MARK( NONE); WINDOW_ROW := GET_INFO( CURRENT_WINDOW, "CURRENT_ROW"); WINDOW_TOP := GET_INFO( CURRENT_WINDOW, "VISIBLE_TOP"); SCROLL( CURRENT_WINDOW, WINDOW_ROW - WINDOW_TOP); POSITION( WHERE_WE_WERE); ENDPROCEDURE PROCEDURE EVE_TRIM ! ! Trim trailing blanks and tabs from all lines in the current ! buffer. ! LOCAL DROSS, SPACE_AND_TAB, STUFF_TO_ERASE, TRAILING_BLANKS, WHERE_WE_WERE; ON_ERROR ! ! Sooner or later the search will be unsuccessful. When it is, ! exit. ! POSITION( WHERE_WE_WERE); SET( TIMER, OFF, ""); RETURN; ENDON_ERROR; SET( TIMER, ON, "Trimming spaces"); WHERE_WE_WERE := MARK( NONE); POSITION( BEGINNING_OF( CURRENT_BUFFER)); SPACE_AND_TAB := ASCII( 32) + ASCII( 9); TRAILING_BLANKS := SPAN( SPACE_AND_TAB) @DROSS & LINE_END; LOOP STUFF_TO_ERASE := SEARCH( TRAILING_BLANKS, FORWARD, EXACT); ERASE( DROSS); ENDLOOP; ENDPROCEDURE; PROCEDURE TWW_SETUP_KEYS ON_ERROR ENDON_ERROR ! ! Create a key map. ! TWW_KEY_MAP := CREATE_KEY_MAP( "TWW KEY MAP"); USER_KEY_MAP := CREATE_KEY_MAP( "USER KEY MAP"); !++ ! ! Put permanent definitions in the TWW key map. ! Put personal definitions in the USER key map. ! !-- ! ! Unshifted "keypad" keys ! SET( SHIFT_KEY, PF1); DEFINE_KEY( "EVE_OTHER_WINDOW", PF2, "Other Window", "TWW KEY MAP"); DEFINE_KEY( "EVE_FIND( EVE$X_TARGET)", PF3, "Find Next", "TWW KEY MAP"); DEFINE_KEY( "EVE_ERASE_LINE", PF4, "Erase Line", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_BY_LINE", KP0, "Move by Line", "TWW KEY MAP"); DEFINE_KEY( "EVE_MOVE_BY_WORD", KP1, "Move by Word", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_TO_EOL", KP2, "Move to End of Line", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_BY_CHAR", KP3, "Move by Character", "TWW KEY MAP"); DEFINE_KEY( "EVE_FORWARD", KP4, "Forward", "TWW KEY MAP"); DEFINE_KEY( "EVE_REVERSE", KP5, "Reverse", "TWW KEY MAP"); DEFINE_KEY( "EVE_REMOVE", KP6, "Remove", "TWW KEY MAP"); DEFINE_KEY( "EVE_UPPERCASE_WORD", KP7, "Uppercase Word", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_BY_HALF_WINDOW", KP8, "Scroll ½ Window", "TWW KEY MAP"); DEFINE_KEY( "EVE_GO_TO( '')", KP9, "Go To Mark", "TWW KEY MAP"); DEFINE_KEY( "EVE_ERASE_WORD", MINUS, "Erase Word", "TWW KEY MAP"); DEFINE_KEY( "EVE_ERASE_CHARACTER", COMMA, "Erase Character", "TWW KEY MAP"); DEFINE_KEY( "EVE_RETURN", ENTER, "Enter", "TWW KEY MAP"); DEFINE_KEY( "EVE_SELECT", PERIOD, "Select", "TWW KEY MAP"); ! ! Unshifted VT200 keys ! DEFINE_KEY( "EVE_DATE", F7, "Date", "TWW KEY MAP"); DEFINE_KEY( "TWW_SET_RIGHT_MARGIN", F8, "Set Right Margin", "TWW KEY MAP"); DEFINE_KEY( "TWW_FIND_SAVED_MARKER", F9, "Find Saved Marker", "TWW KEY MAP"); DEFINE_KEY( "EVE_CALCULATE( '')", F11, "Calculate Expression", "TWW KEY MAP"); DEFINE_KEY( "TWW_BACKSPACE", F12, "Move to Beginning of Line", "TWW KEY MAP"); DEFINE_KEY( "TWW_DELETE_START_OF_WORD", F13, "Delete to start of Word", "TWW KEY MAP"); DEFINE_KEY( "EVE_HELP( '')", HELP, "Help", "TWW KEY MAP"); DEFINE_KEY( "TWW_TOGGLE_WINDOWS", F17, "Toggle 1 <--> 2 Windows", "TWW KEY MAP"); DEFINE_KEY( "EVE_LIST_BUFFERS", F18, "Select User Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_REPEAT( '')", F19, "Repeat", "TWW KEY MAP"); DEFINE_KEY( "EVE_SPAWN", F20, "Spawn DCL Command", "TWW KEY MAP"); DEFINE_KEY( "TWW_PREVIOUS_SCREEN", E5, "Previous Screen", "TWW KEY MAP"); DEFINE_KEY( "TWW_NEXT_SCREEN", E6, "Next Screen", "TWW KEY MAP"); ! ! Unshifted control keys ! DEFINE_KEY( "TWW_LEFT_MARGIN_AT_CURSOR", CTRL_A_KEY, "Indent at Cursor", "TWW KEY MAP"); DEFINE_KEY( "EVE_DISPLAY_CHARACTER", CTRL_D_KEY, "Display Current Character", "TWW KEY MAP"); DEFINE_KEY( "TWW_INSERT_FILENAME", CTRL_F_KEY, "Insert Output Filename in Text", "TWW KEY MAP"); DEFINE_KEY( "TWW_KEY_HELP", CTRL_H_KEY, "Keyboard Help Diagram", "TWW KEY MAP"); DEFINE_KEY( "EVE_DEFINE_KEY( '')", CTRL_K_KEY, "Define Key", "TWW KEY MAP"); DEFINE_KEY( "EVE_LEARN", CTRL_L_KEY, "Learn", "TWW KEY MAP"); DEFINE_KEY( "TWW_TOGGLE_NUMERIC", CTRL_N_KEY, "Toggle Numeric Entry", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_BY_PARAGRAPH", CTRL_P_KEY, "Paragraph", "TWW KEY MAP"); DEFINE_KEY( "EVE_WRITE_FILE( '')", CTRL_Z_KEY, "Write File", "TWW KEY MAP"); DEFINE_KEY( "EVE_DO( '')", KEY_NAME( ASCII( 29)), "Do", "TWW KEY MAP"); ! ! Shifted (GOLD) keypad keys ! DEFINE_KEY( "TWW_OPEN_LINE", KEY_NAME( KP0, SHIFT_KEY), "Open Line", "TWW KEY MAP"); DEFINE_KEY( "EVE_CHANGE_CASE( '')", KEY_NAME( KP1, SHIFT_KEY), "Change Case", "TWW KEY MAP"); DEFINE_KEY( "TWW_DELETE_TO_EOL", KEY_NAME( KP2, SHIFT_KEY), "Delete to EOL", "TWW KEY MAP"); DEFINE_KEY( "TWW_REPLACE_NEXT", KEY_NAME( KP3, SHIFT_KEY), "Replace Next", "TWW KEY MAP"); DEFINE_KEY( "TWW_MOVE_TO_EOB", KEY_NAME( KP4, SHIFT_KEY), "Bottom of Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_TOP", KEY_NAME( KP5, SHIFT_KEY), "Top of Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_INSERT_HERE", KEY_NAME( KP6, SHIFT_KEY), "Insert Here", "TWW KEY MAP"); DEFINE_KEY( "EVE_CAPITALIZE_WORD", KEY_NAME( KP7, SHIFT_KEY), "Capitalize Word", "TWW KEY MAP"); DEFINE_KEY( "EVE_FILL_PARAGRAPH", KEY_NAME( KP8, SHIFT_KEY), "Fill Paragraph", "TWW KEY MAP"); DEFINE_KEY( "EVE_MARK( '')", KEY_NAME( KP9, SHIFT_KEY), "Set Mark", "TWW KEY MAP"); DEFINE_KEY( "EVE_BUFFER( '')", KEY_NAME( PF2, SHIFT_KEY), "Go to Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_SEARCH( '')", KEY_NAME( PF3, SHIFT_KEY), "Wild-Card Search", "TWW KEY MAP"); DEFINE_KEY( "EVE_RESTORE", KEY_NAME( PF4, SHIFT_KEY), "Undelete Text", "TWW KEY MAP"); DEFINE_KEY( "TWW_OUTLINE", KEY_NAME( MINUS, SHIFT_KEY), "Outline Window", "TWW KEY MAP"); DEFINE_KEY( "TWW_NO_OUTLINE", KEY_NAME( COMMA, SHIFT_KEY), "Remove Outline Window", "TWW KEY MAP"); DEFINE_KEY( "EVE_REPLACE( '', '')", KEY_NAME( ENTER, SHIFT_KEY), "Replace Text", "TWW KEY MAP"); DEFINE_KEY( "MESSAGE( 'GOLD Cancelled')", KEY_NAME( PERIOD, SHIFT_KEY), "Cancel", "TWW KEY MAP"); DEFINE_KEY( "EVE_ADJUST_WINDOWS", KEY_NAME( UP, SHIFT_KEY), "Adjust Windows (up)", "TWW KEY MAP"); DEFINE_KEY( "EVE_ADJUST_WINDOWS", KEY_NAME( DOWN, SHIFT_KEY), "Adjust Windows (down)", "TWW KEY MAP"); DEFINE_KEY( "EVE_SHIFT_LEFT( '8')", KEY_NAME( LEFT, SHIFT_KEY), "Shift Left", "TWW KEY MAP"); DEFINE_KEY( "EVE_SHIFT_RIGHT( '8')", KEY_NAME( RIGHT, SHIFT_KEY), "Shift Right", "TWW KEY MAP"); ! ! Shifted (GOLD) function (VT200) keys ! DEFINE_KEY( "EVE_TIME", KEY_NAME( F7, SHIFT_KEY), "Time", "TWW KEY MAP"); DEFINE_KEY( "TWW_SET_LEFT_MARGIN", KEY_NAME( F8, SHIFT_KEY), "Set Left Margin", "TWW KEY MAP"); DEFINE_KEY( "COPY_TEXT( '!//+\\!')", KEY_NAME( F9, SHIFT_KEY), "Insert Marker", "TWW KEY MAP"); DEFINE_KEY( "EVE_SET_HELP", KEY_NAME( HELP, SHIFT_KEY), "Set Help Library", "TWW KEY MAP"); DEFINE_KEY( "EVE_DCL('')", KEY_NAME( DO, SHIFT_KEY), "Execute DCL Command", "TWW KEY MAP"); DEFINE_KEY( "EVE_LIST_ALL_BUFFERS", KEY_NAME( F18, SHIFT_KEY), "Select Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_PATTERN_SEARCH('')", KEY_NAME( F19, SHIFT_KEY), "Pattern Search", "TWW KEY MAP"); DEFINE_KEY( "TWW_INCREMENTAL_SEARCH", KEY_NAME( E1, SHIFT_KEY), "Incremental Search", "TWW KEY MAP"); DEFINE_KEY( "EVE_RECTANGULAR_SELECT", KEY_NAME( E4, SHIFT_KEY), "Rectangular Select"); DEFINE_KEY( "EVE_RECTANGULAR_REMOVE", KEY_NAME( E3, SHIFT_KEY), "Rectangular Cut"); DEFINE_KEY( "EVE_RECTANGULAR_INSERT_HERE", KEY_NAME( E2, SHIFT_KEY), "Rectangular Paste"); DEFINE_KEY( "EVE_DRAW_BOX", KEY_NAME( F20, SHIFT_KEY), "Draw Box"); ! ! Shifted (GOLD) control keys ! DEFINE_KEY( "TWW_TABS", KEY_NAME( ASCII( 9), SHIFT_KEY), "Convert Tabs <--> Spaces", "TWW KEY MAP"); DEFINE_KEY( "EVE_FIX_CRLFS", KEY_NAME( ASCII( 10), SHIFT_KEY), "Purge CR/LF characters", "TWW KEY MAP"); DEFINE_KEY( "EVE_UNDEFINE_KEY", KEY_NAME( ASCII( 11), SHIFT_KEY), "Undefine key", "TWW KEY MAP"); ! ! Shifted (GOLD) Typing keys ! DEFINE_KEY( "EVE_SET_ACCURACY( '')", KEY_NAME( "A", SHIFT_KEY), "Set Calculate Accuracy", "TWW KEY MAP"); DEFINE_KEY( "SET( TEXT, CURRENT_WINDOW, BLANK_TABS)", KEY_NAME( "B", SHIFT_KEY), "Blank Tabs", "TWW KEY MAP"); DEFINE_KEY( "EVE_CENTER_LINE", KEY_NAME( "C", SHIFT_KEY), "Center Line", "TWW KEY MAP"); DEFINE_KEY( "EVE_DIRECTORY", KEY_NAME( "D", SHIFT_KEY), "Directory", "TWW KEY MAP"); DEFINE_KEY( "EVE_GET_FILE( '')", KEY_NAME( "E", SHIFT_KEY), "Edit File", "TWW KEY MAP"); DEFINE_KEY( "TWW_FORMAT_HELP", KEY_NAME( "F", SHIFT_KEY), "Get Format", "TWW KEY MAP"); DEFINE_KEY( "SET( TEXT, CURRENT_WINDOW, GRAPHIC_TABS)", KEY_NAME( "G", SHIFT_KEY), "Graphic Tabs", "TWW KEY MAP"); DEFINE_KEY( "EVE_HEADER", KEY_NAME( "H", SHIFT_KEY), "Get Header (Boilerplate)", "TWW KEY MAP"); DEFINE_KEY( "EVE_INCLUDE_FILE( '')", KEY_NAME( "I", SHIFT_KEY), "Include File", "TWW KEY MAP"); DEFINE_KEY( "EVE_JUMP_SCROLL", KEY_NAME( "J", SHIFT_KEY), "Jump Scroll", "TWW KEY MAP"); DEFINE_KEY( "EVE_DESCRIBE_KEY", KEY_NAME( "K", SHIFT_KEY), "Display Key Function", "TWW KEY MAP"); DEFINE_KEY( "EVE_TOGGLE_STATUS_LINE", KEY_NAME( "L", SHIFT_KEY), "Toggle Status Line", "TWW KEY MAP"); DEFINE_KEY( "TWW_MIDDLE", KEY_NAME( "M", SHIFT_KEY), "Cursor to Middle", "TWW KEY MAP"); DEFINE_KEY( "COPY_TEXT( TWW_RESULT)", KEY_NAME( "P", SHIFT_KEY), "Put Calculated Result in Buffer", "TWW KEY MAP"); DEFINE_KEY( "EVE_RULER", KEY_NAME( "R", SHIFT_KEY), "Ruler", "TWW KEY MAP"); DEFINE_KEY( "EVE_SMOOTH_SCROLL", KEY_NAME( "S", SHIFT_KEY), "Smooth Scroll", "TWW KEY MAP"); DEFINE_KEY( "TWW_TOP", KEY_NAME( "T", SHIFT_KEY), "Cursor to Top", "TWW KEY MAP"); DEFINE_KEY( "SET( TEXT, CURRENT_WINDOW, NO_TRANSLATE)", KEY_NAME( "N", SHIFT_KEY), "No Translate", "TWW KEY MAP"); DEFINE_KEY( "EVE_TRIM", KEY_NAME( " ", SHIFT_KEY), "Trim Trailing Spaces", "TWW KEY MAP"); ! ! Add this key map to the EVE key map list. ! ADD_KEY_MAP( EVE$X_KEY_MAP_LIST, "FIRST", "TWW KEY MAP"); ADD_KEY_MAP( EVE$X_KEY_MAP_LIST, "FIRST", "USER KEY MAP"); ! ! Set up temporary key map for browsing; to escape. ! BROWSE_KEY_MAP := CREATE_KEY_MAP( "BROWSE KEY MAP"); DEFINE_KEY( "TWW_END_BROWSING", RET_KEY, "Resume Editing", "BROWSE KEY MAP"); ! ! Set up temporary key map for numeric entry. ! NUMERIC_KEY_MAP := CREATE_KEY_MAP( "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '0')", KP0, "0", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '1')", KP1, "1", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '2')", KP2, "2", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '3')", KP3, "3", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '4')", KP4, "4", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '5')", KP5, "5", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '6')", KP6, "6", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '7')", KP7, "7", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '8')", KP8, "8", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '9')", KP9, "9", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '.')", PERIOD, ".", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( ',')", COMMA, ",", "NUMERIC KEY MAP"); DEFINE_KEY( "COPY_TEXT( '-')", MINUS, "-", "NUMERIC KEY MAP"); DEFINE_KEY( "EVE_SPACE", PF1, "Space", "NUMERIC KEY MAP"); DEFINE_KEY( "EVE_TAB", PF2, "Tab", "NUMERIC KEY MAP"); ENDPROCEDURE PROCEDURE TPU$LOCAL_INIT BUFED_REMOVE_KEY_PGM := COMPILE("MESSAGE('Key not defined');"); BUFED_SELECT_KEY_PGM := COMPILE("MESSAGE('Key not defined');"); BUFED_X_ACTIVE := FALSE; EVE$ARG1_CALCULATE := EVE$ARG1_BUFFER; EVE$ARG1_CHANGE_CASE := EVE$ARG1_BUFFER; EVE$ARG1_COMPILE := EVE$ARG1_BUFFER; EVE$ARG1_DESTROY_BUFFER := EVE$ARG1_BUFFER; EVE$ARG1_LINK := EVE$ARG1_BUFFER; EVE$ARG1_PRINT_FILE := EVE$ARG1_BUFFER; EVE$ARG1_RUN := EVE$ARG1_BUFFER; EVE$ARG1_SEARCH := EVE$ARG1_BUFFER; EVE$ARG1_SET_FLASHING := EVE$ARG1_BUFFER; EVE$ARG1_SET_MATCHING := EVE$ARG1_BUFFER; EVE$ARG1_SET_NOFLASHING := EVE$ARG1_BUFFER; EVE$ARG1_SET_NOMATCHING := EVE$ARG1_BUFFER; EVE$ARG1_SORT_BUFFER := EVE$ARG1_BUFFER; EVE$ARG1_SET_ACCURACY := EVE$ARG1_BUFFER; EVE$ARG1_PATTERN_SEARCH := EVE$ARG1_BUFFER; EVE$X_MAX_BUFFER_NAME_LENGTH := 23; EVE$X_HOT_ZONE_SIZE := 0; EVEPLUS_MATCHABLE_CLOSE := ")]}>»''"""; EVEPLUS_MATCHABLE_OPEN := "([{<«'`"""; EVEPLUS_SEARCH_TARGET := ''; EVEPLUS_V_BEGIN_SELECT := 0; TWW_ACCURACY := 2; TWW_DIRECTORY_BUFFER := CREATE_BUFFER( "Directory"); TWW_HELP_LIBRARY := FILE_SEARCH( FILE_PARSE( "", "SYS$HELP:TPUHELP.HLB", "SYS$HELP:TPUHELP.HLB")); TWW_HELP_LIBRARY_NAME := FILE_PARSE( TWW_HELP_LIBRARY, "", "", NAME); TWW_DCL_SYMBOL := ''; TWW_RESULT := ''; TWW_MESSAGE := ''; TWW_NUMERIC := 0; TWW_OUTLINE_WINDOW := CREATE_WINDOW( 1, 4, OFF); TWW_OUTLINE_BUFFER := 0; SET( PAD, TWW_OUTLINE_WINDOW, ON); SET( VIDEO, TWW_OUTLINE_WINDOW, REVERSE); SET( INSERT, EVE$COMMAND_BUFFER); SET( NO_WRITE, TWW_DIRECTORY_BUFFER); SET( SYSTEM, TWW_DIRECTORY_BUFFER); SET( SHIFT_KEY, PF1, "TPU$KEY_MAP_LIST"); EVE$SET_STATUS_LINE( EVE$MAIN_WINDOW); ENDPROCEDURE ! ! Define the keys, save the section, and quit. ! TWW_SETUP_KEYS; COMPILE( "PROCEDURE TWW_SETUP_KEYS ENDPROCEDURE"); SAVE( "TWW_EVE"); QUIT;