!+-----------------------------------------------------------------| !| LSE INITIALIZATION TPU PROCEDURES: | !| | !| CURRENTLY INCLUDED ARE: | !| | !| EVE_KMS_DATE - insert current date before cursor | !| NUMERIC_KEYPAD - turn keypad to a numeric keypad | !| BOLD_TOGGLE - highlight PASCAL comments | !| CURSOR_POSITION - what is the current cursor position? | !| INSTANT_COMMENT - place ! at end of current line | !| FORTRAN_TRIM - remove tabs from beginning of lines in buffer | !| DELETE_TABS - replace all tabs with equivalent blanks | !| ALIGN_COMMENTS- reallign comments to a certain position | !| and right margin | !| UNWRAP_COMMENTS - remove the wrapped comments to one line | !| SHIFT_WINDOW - shift the current window or cursor left or | !| or right | !| DELETE_CURRENT_BUFFER | !| - delete the current buffer | !| VIEW_MESSAGES - convert normal gold "=" to view message buf. | !| LSE_and_PREV_COMMANDS- overrides the old "LSE_Command>" | !| SAVE_COMMAND - save previous commands for later recall | !| UP_ARROW - key "U" same as up_arrow at DCL level | !| key "D" same as down_arrow at DCL level | !| DIFFERENT_CASE- change the case to all upper or all lower | !| COPY_SELECT - copy the selected area to the paste buffer | !| ASCII_VAL - print ascii value of current character | !| VIEW - view control characters in translate window, | !| translate buffer | !| DEVIEW - replace control characters in translate | !| window, detranslate buffer | !| COMPILE - new version of compile stores object | !| file in the directory of the associated | !| source file. | !| LINE_PASTE - line numbers every line in the file | !| CLEAR - erases current buffer | !| ABS_LINE - move to the line indicated | !| REL_LINE - move up or down the indicated number | !| of lines | !| RECCUTPAS - rectangular cut and paste | !| (KEYS Select, Insert Here and Remove) | !| NEXT_BUFFER - goes to next buffer (KEY F19) | !| | !------------------------------------------------------------------+ !******************************************************************* ! EVE Command: KMS DATE ! Insert date before cursor !------------------------------------------------------------------- PROCEDURE eve_kms_date ! Insert DATE before cursor LOCAL report, date; ! report string will not effect EVE report := FAO("!%D",0); ! fill in DD-MMM-YYYYHH:MM:SS.SS date := substr(report,1,11); ! substring of the 1st 11 chrs == DATE copy_text(date); ! insert date ENDPROCEDURE PROCEDURE numeric_keypad DEFINE_KEY('COPY_TEXT(''0'')',KP0,'0'); DEFINE_KEY('COPY_TEXT(''1'')',KP1,'1'); DEFINE_KEY('COPY_TEXT(''2'')',KP2,'2'); DEFINE_KEY('COPY_TEXT(''3'')',KP3,'3'); DEFINE_KEY('COPY_TEXT(''4'')',KP4,'4'); DEFINE_KEY('COPY_TEXT(''5'')',KP5,'5'); DEFINE_KEY('COPY_TEXT(''6'')',KP6,'6'); DEFINE_KEY('COPY_TEXT(''7'')',KP7,'7'); DEFINE_KEY('COPY_TEXT(''8'')',KP8,'7'); DEFINE_KEY('COPY_TEXT(''9'')',KP9,'7'); DEFINE_KEY('COPY_TEXT('','')',COMMA,'COMMA'); DEFINE_KEY('COPY_TEXT(''.'')',PERIOD,'PERIOD'); DEFINE_KEY('COPY_TEXT(''-'')',MINUS,'MINUS'); DEFINE_KEY('COPY_TEXT(''('')',PF3,'('); DEFINE_KEY('COPY_TEXT('')'')',PF4,')'); ENDPROCEDURE PROCEDURE bold_toggle IF bold_flag <> "ON" THEN printbold; bold_flag := "ON" ELSE boldoff; boldflag := "OFF" ENDIF; ENDPROCEDURE PROCEDURE printbold LOCAL comment_begin_range, comment_end_range; POSITION (BEGINNING_OF( current_buffer )); LOOP comment_begin_range := SEARCH ('{',FORWARD); EXITIF (comment_begin_range = 0); POSITION (BEGINNING_OF( comment_begin_range)); COPY_TEXT('1m'); MOVE_HORIZONTAL(5); ENDLOOP; POSITION (BEGINNING_OF( current_buffer )); LOOP comment_end_range := SEARCH ('}',FORWARD); EXITIF (comment_end_range = 0); POSITION (BEGINNING_OF( comment_end_range)); MOVE_HORIZONTAL(1); COPY_TEXT('22m'); ENDLOOP; ENDPROCEDURE PROCEDURE boldoff LOCAL print_sequences, print_pattern; POSITION (BEGINNING_OF( current_buffer )); LOOP print_sequences := SEARCH ('1m',FORWARD); EXITIF (print_sequences = 0); POSITION (BEGINNING_OF( print_sequences )); ERASE (print_sequences); ENDLOOP; POSITION (BEGINNING_OF( current_buffer )); LOOP print_sequences := SEARCH ('22m',FORWARD); EXITIF (print_sequences = 0); POSITION (BEGINNING_OF( print_sequences )); ERASE (print_sequences); ENDLOOP; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure uses a feature of LSE to display tabs to the user. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE view_tabs IF tab_display = "ON" THEN tab_display := "0FF"; set (text,current_window,blank_tabs) ELSE tab_display := "ON"; set (text,current_window,graphic_tabs) ENDIF; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure prints the current cursor column position | !| and the current line number. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE cursor_position LOCAL current_marker, ! marker for current position line_counter, ! integer counts lines from file begin to end current_bol, ! marker to test against current position cursor_message; ! string to contain current line and position current_marker := MARK(NONE); ! mark current cursor position SET(SCREEN_UPDATE,OFF); ! don't update screen while counting POSITION(BEGINNING_OF(current_buffer)); line_counter := 0; LOOP line_counter := line_counter + 1; current_bol := MARK(NONE); EXITIF current_bol > current_marker; LSE$DO_COMMAND("GOTO LINE/BEGINNING /FORWARD"); ENDLOOP; cursor_message := FAO('line: !SL column: !SL', line_counter-1,current_column); POSITION(current_marker); SET(SCREEN_UPDATE,ON); MESSAGE (cursor_message); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| place an exclamation mark at screen position 80 on the current line | !| for adding a comment | !| | !+--------------------------------------------------------------------------------+ PROCEDURE instant_comment LOCAL end_of_new_line_actual, ! marks screen column of end of line comment_position; ! screen column for comment comment_position := 80; ! Set comment postion at column 80 IF current_offset <> LENGTH(current_line) THEN ! If not eol then goto eol LSE$DO_COMMAND("GOTO LINE/END /FORWARD") ! Goto end of line ENDIF; end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find actual column position eol IF end_of_new_line_actual > comment_position THEN ! If code line is long then append comment LSE$DO_COMMAND("DO ""SET INDENTATION CURRENT"",""ENTER LINE"""); end_of_new_line_actual := GET_INFO(current_buffer,"offset_column") ! Find actual column end of line ENDIF; LOOP ! Insert tabs and spaces until comment is at ! position IF (end_of_new_line_actual <= comment_position) THEN ! Move up to comment position with tabs COPY_TEXT(ASCII(9)); ! Copy tab to current position end_of_new_line_actual := ! Find new column position GET_INFO(current_buffer,"offset_column") ELSE LSE$DO_COMMAND("ERASE/TO CHARACTER /REVERSE"); ! Past current column so erase last TAB end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Get current column COPY_TEXT(SUBSTR(blank_line, 1,(comment_position - end_of_new_line_actual))) ! Copy blanks up till comment position ENDIF; EXITIF end_of_new_line_actual > comment_position; ! Exit when column at comment_postion ! is reached ENDLOOP; COPY_TEXT("! "); ! Copy comment delimeter ENDPROCEDURE !+---------------------------------------------------------------------------------+ !| | !| delete all tabs replacing them with correct number of blanks to maintain | !| current screen position | !| | !+---------------------------------------------------------------------------------+ PROCEDURE delete_tabs LOCAL tab_offset, current_marker; SET (TIMER,ON,"Reformatting..."); lse$create_select_range; ! Comments only to be justified in selected range POSITION(lse$select_range); ! Position to beginning of range IF current_offset <> 0 THEN LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE") ! Position to beginning of line ENDIF; blank_line := ' '; ! blank line LOOP LOOP tab_offset := INDEX(current_line,ASCII(9)); ! Find location of tab in current line EXITIF (tab_offset = 0); ! Exit loop if no tabs left in current line IF current_offset <> 0 THEN ! If not beginning of line LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE") ! then goto beginning of line ENDIF; MOVE_HORIZONTAL(tab_offset); ! Locate tab replace_tab; ! replace tab with blanks ENDLOOP; LSE$DO_COMMAND("GOTO LINE/BEGINNING /FORWARD"); ! Goto beginning of next line current_marker := MARK(NONE); ! Note current position EXITIF (current_marker > END_OF(lse$select_range)); ! Exit if it's outside the range ENDLOOP; DELETE(lse$select_range); ! Deselect user's select area SET (TIMER,ON,"Working..."); ! Return status message to original ENDPROCEDURE ! PROCEDURE replace_tab ! replace a tab with blanks LOCAL tab_end_offset, tab_begin_offset; tab_end_offset := GET_INFO(current_buffer,"offset_column"); ! Find actual column of tab end LSE$DO_COMMAND("UNTAB"); ! Delete the tab on left tab_begin_offset := GET_INFO(current_buffer,"offset_column"); ! Find actual column of tab start COPY_TEXT(SUBSTR(blank_line,1,(tab_end_offset - tab_begin_offset))); ! Replace with blanks ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| Trim off the indentation in a FORTRAN program. | !| This procedure is useful for re-indenting loops | !| and IF-THEN's in previously messy code | !| | !+--------------------------------------------------------------------------------+ PROCEDURE fortran_trim LOCAL label_area, code_area, line, current_marker, seventh_column; SET (TIMER,ON,"Reformatting..."); lse$create_select_range; ! Comments only to be justified in selected range POSITION(lse$select_range); ! Position to beginning of range LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE"); LOOP LOOP ! For each line in range seventh_column := GET_INFO(current_buffer,"offset_column"); ! Find actual column end of line EXITIF seventh_column > 6; ! stop if at column 6 MOVE_HORIZONTAL(1); ENDLOOP; label_area:=SUBSTR(current_line,1,current_offset); code_area:= SUBSTR(current_line,current_offset+1,length(current_line)); EDIT(label_area,TRIM_TRAILING); label_area := FAO('!AS!AS',label_area,' '); EDIT(code_area,TRIM_LEADING); ! cut off leading tabs ,spaces from column 7 on LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE"); ! Goto line beginning first_character := SUBSTR(label_area,1,1); IF (first_character <> 'C') AND (first_character <> 'c') AND (first_character <> '!') THEN LSE$DO_COMMAND("ERASE/TO LINE/END /FORWARD"); ! Hack off the line COPY_TEXT(label_area); ! Reinsert the line without leading spaces and ! tabs COPY_TEXT(code_area) ! Reinsert the comment ENDIF; LSE$DO_COMMAND("GOTO LINE/BEGINNING"); ! Goto the next line current_marker := MARK(NONE); EXITIF (current_marker > END_OF(lse$select_range)); ENDLOOP; DELETE(lse$select_range); SET (TIMER,ON,"Working..."); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| Align the comments (delimited by exclamation marks) in the selected range. | !| The comments are adjusted to a comment position and right margin specified | !| by ALIGN_COMMENTS. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE align_comments justify_comments_tabs_80 ( 80, 132); ENDPROCEDURE ! PROCEDURE justify_comments_tabs_80(comment_position, right_margin) LOCAL no_comment_marker,comment_marker,comment_index, comment_string,new_line,blank_line, comment_index_actual, comment_position, right_margin, end_of_new_line_actual, error_flag; ON_ERROR ! If EDIT finds unmatched quotes MESSAGE("ERROR: unmatched quotes in comment_string or line"); ! then let user know in what line MESSAGE(new_line); ! this occurred MESSAGE(comment_string); error_flag := 1; ! Set error flag ENDON_ERROR lse$create_select_range; ! Comments only to be justified inselected range unwrap_comments; ! unwrap wrapped comment lines SET (TIMER,ON,"Reformatting..."); POSITION(lse$select_range); ! Position to beginning of range IF current_offset <> 0 THEN LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE") ! Position to beginning of line ENDIF; LOOP ! For each line in range line := current_line; ! Extract current line comment_index := INDEX(line,"!"); ! Find position of comment IF (comment_index <> 0) AND (comment_index <> 1) THEN ! Comment found? LOOP ! Make sure exclamation mark is the last one comment_index_next := INDEX(SUBSTR(line,comment_index+1,LENGTH(current_line) - comment_index),"! "); ! find next comment EXITIF comment_index_next = 0; comment_index := comment_index_next + comment_index; ENDLOOP; LSE$DO_COMMAND('GOTO LINE/END /FORWARD'); end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find actual column end of line LSE$DO_COMMAND('GOTO LINE/BEGINNING /REVERSE'); MOVE_HORIZONTAL(comment_index-1); ! Position to comment MOVE_HORIZONTAL(1); IF (current_character <> ' ') THEN ! If character after comment <> blank COPY_TEXT(' '); ! then insert a blank MOVE_HORIZONTAL(-1); ! position back to character after comment line := current_line; ! redefine current_line UPDATE(current_window) ! show user inserted blank after comment ENDIF; MOVE_HORIZONTAL(-1); ! position back to comment current_position := GET_INFO(current_buffer,"offset_column"); ! Find actual column end of line IF (comment_position+1 <> current_position) OR (end_of_new_line_actual > right_margin) THEN ! Exit if comment needs no adjustment comment_marker := MARK(NONE); ! Mark comment EXITIF (comment_marker > END_OF(lse$select_range)); ! Exit if comment outside of select range comment_string := SUBSTR(line,comment_index,(LENGTH(line) - comment_index)+1); ! Extract comment EDIT(comment_string,TRIM_TRAILING,OFF); ! Trim off trailing blanks error_flag := 0; ! set error flag to 0 new_line := SUBSTR(current_line,1,comment_index-1) ; ! Extract line without comment EDIT(new_line,TRIM_TRAILING); ! Trim off triailing blanks of new line without IF (error_flag <> 1) THEN ! Don't process line if unmatched quotes LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE"); ! Position to beginning of line MOVE_HORIZONTAL(LENGTH(new_line)); ! Position to edited end of new line LSE$DO_COMMAND("ERASE/TO LINE/END /FORWARD"); ! Hack off the comment end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find actual column end of line blank_line := ' '; ! blank line IF end_of_new_line_actual > comment_position THEN ! If code line is long then append comment LSE$DO_COMMAND("DO ""SET INDENTATION CURRENT"",""ENTER LINE"""); end_of_new_line_actual := GET_INFO(current_buffer,"offset_column") ! Find actual column end of line ENDIF; LOOP ! Insert tabs and spaces until comment is ! atposition IF (end_of_new_line_actual <= comment_position) THEN COPY_TEXT(ASCII(9)); end_of_new_line_actual := GET_INFO(current_buffer,"offset_column") ELSE LSE$DO_COMMAND("ERASE/TO CHARACTER /REVERSE"); end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); COPY_TEXT(SUBSTR(blank_line,1,(comment_position - end_of_new_line_actual))) ENDIF; EXITIF end_of_new_line_actual > comment_position; ENDLOOP; COPY_TEXT(comment_string); LOOP ! Loop for each distinct split comment line end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); EXITIF end_of_new_line_actual < right_margin; ! Exit if no need to wrap comment LOOP LSE$DO_COMMAND("GOTO WORD /REVERSE"); ! Backup 1 word in comment end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find end of break in comment line EXITIF end_of_new_line_actual <= right_margin; ! Exit if break is within margin ENDLOOP; MOVE_HORIZONTAL(-1); LSE$DO_COMMAND("ERASE/TO LINE/END /FORWARD"); ! Delete the rest of the line LSE$DO_COMMAND("DO ""SET INDENTATION CURRENT"",""ENTER LINE"""); ! Open up a new line below current one end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find the end of the wrapped comment line LOOP ! Insert tabs and spaces until comment is ! atposition IF (end_of_new_line_actual <= comment_position) THEN ! See if wrapped comment starts within right margin COPY_TEXT(ASCII(9)); ! if so insert a tab before the comment end_of_new_line_actual := GET_INFO(current_buffer,"offset_column") ! Find the new start of the wrapped comment line ELSE LSE$DO_COMMAND("ERASE/TO CHARACTER /REVERSE"); ! Wrapped comment beginning not within right ! margin end_of_new_line_actual := GET_INFO(current_buffer,"offset_column"); ! Find end of comment line COPY_TEXT(SUBSTR(blank_line,1, (comment_position - end_of_new_line_actual))) ! Fill rest of comment line with tabs ENDIF; EXITIF end_of_new_line_actual > comment_position; ! Exit when comment starts in place ENDLOOP; COPY_TEXT("!"); ! Start next wrapped comment line LSE$DO_COMMAND("DO ""UNERASE LINE"", ""GOTO LINE/END /FORWARD"""); ! Paste in the comment to be wrapped ENDLOOP; LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE") ! Goto the beginning of the line ENDIF; UPDATE(CURRENT_WINDOW) ENDIF ENDIF; LSE$DO_COMMAND("GOTO LINE/BEGINNING /FORWARD"); no_comment_marker := MARK(NONE); EXITIF (no_comment_marker > END_OF(lse$select_range)); ENDLOOP; POSITION(END_OF(lse$select_range)); LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE"); DELETE(lse$select_range); SET (TIMER,ON,"Working..."); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure is used by the JUSTIFY_COMMENTS routine to "unwrap" | !| comments that have been previously wrapped onto more than one line | !| | !+--------------------------------------------------------------------------------+ PROCEDURE unwrap_comments LOCAL current_marker; SET (TIMER,ON,"Unwrapping..."); POSITION(lse$select_range); ! Position to beginning of range IF current_offset <> 0 THEN LSE$DO_COMMAND("GOTO LINE/BEGINNING /REVERSE") ! Position to beginning of line ENDIF; LOOP comment_offset := INDEX(current_line,'!'); ! Find comment offset in current line IF (comment_offset <> 0) AND (comment_offset <>1 ) THEN ! If comment found line := SUBSTR(current_line,2,comment_offset-2); ! Extract line prior to comment EDIT(line,COLLAPSE); ! Remove all tabs and spaces from extracted part IF (line = '') THEN ! If all tabs and spaces the line = wrapped comment MOVE_HORIZONTAL(comment_offset-1); ! Position at comment LSE$DO_COMMAND("ERASE/TO CHARACTER /FORWARD"); ! Erase exclamation mark LSE$DO_COMMAND("ERASE/TO LINE/BEGINNING /REVERSE"); ! Move comment to line beginning LSE$DO_COMMAND("ERASE/TO CHARACTER /REVERSE"); ! Append to previous line IF (INDEX(current_line,'!') = 0) THEN ! If line appended to is not commented LSE$DO_COMMAND("ENTER TEXT ""!""") ! then add a comment marker ENDIF; IF (current_character <> ' ') THEN LSE$DO_COMMAND("ENTER SPACE") ENDIF; UPDATE(current_window) ENDIF ENDIF; LSE$DO_COMMAND("GOTO LINE/BEGINNING /FORWARD"); ! Goto the next line current_marker := MARK(NONE); ! Mark the beginning of the new current line EXITIF (current_marker > END_OF(lse$select_range)); ! Exit if this marker is outside select range ENDLOOP; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure shifts the screen to the right or left by a half | !| | !+--------------------------------------------------------------------------------+ PROCEDURE shift_window(direction) LOCAL direction; SHIFT(CURRENT_WINDOW,direction); IF (direction > 0) THEN IF ((LENGTH(current_line)-current_offset) > direction) THEN MOVE_HORIZONTAL(direction) ELSE MOVE_HORIZONTAL(LENGTH(current_line)-current_offset) ENDIF ELSE eol_flag := GET_INFO(current_window,"beyond_eol"); IF (eol_flag = 0) THEN IF (current_offset > (direction * (-1))) THEN MOVE_HORIZONTAL(direction) ELSE MOVE_HORIZONTAL((current_offset * (-1))) ENDIF ENDIF ENDIF; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure deletes the current buffer. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE del_buffer LSE$DO_COMMAND("DELETE BUFFER"); ! use LSE to delete the curr buffer ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure maps the message buffer to the top half of the window. | !| It is a modification of the GOLD "=" LSE function. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE view_messages LOCAL bottom_window_buffer; IF two_window_flag <> "two windows" THEN ! Set up two windows LSE$DO_COMMAND("CHANGE WINDOW_MODE"); ! Set up top windows LSE$DO_COMMAND("PREVIOUS WINDOW"); ! Move cursor to top window LSE$DO_COMMAND("GOTO BUFFER $MESSAGES"); ! Map top window to message buffer two_window_flag := "two windows" ! set flag indicating two windows are set ELSE ! Remove bottom window bottom_window_buffer := GET_INFO(lse$bottom_window,"buffer"); ! Find buffer of bottom window MAP(lse$top_window,bottom_window_buffer); ! Map buffer of bottom window to top window LSE$DO_COMMAND("CHANGE WINDOW_MODE"); ! Remove top window two_window_flag := "one window" ! Set flag indicating normality again ENDIF; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This collection of procedures replaces the normal "LSE Command>" prompt by | !| a user defined procedure which maps to a buffer which saves commands. The | !| procedures govern the entry of previous commands into this buffer and allow | !| the user to retrieve them by using the up and down arrow keys similar to the | !| method used at the normal DCL command level. | !+--------------------------------------------------------------------------------+ ! PROCEDURE lse_and_prev_commands IF save_com_flag <> "save_buffer_defined" THEN save_com_flag := "save_buffer_defined"; save_com_buffer := CREATE_BUFFER('save_com_buffer'); SET (NO_WRITE, save_com_buffer); SET (SYSTEM, save_com_buffer); SET (MAX_LINES, save_com_buffer, 10); SET (SCREEN_UPDATE,OFF); MAP(LSE$$PROMPT_WINDOW,save_com_buffer); SET (STATUS_LINE,LSE$$PROMPT_WINDOW,NONE,''); ! Set status line off save_command (""); POSITION(save_buffer); UNMAP (LSE$$PROMPT_WINDOW); SET (SCREEN_UPDATE,ON); ENDIF; recall; ENDPROCEDURE ! PROCEDURE save_command (lse_command_line) LOCAL save_buffer, command_line_save; save_buffer := current_buffer; POSITION(END_OF(save_com_buffer)); ! map over COPY_TEXT(""); MOVE_VERTICAL(-1); command_line_save := FAO("!AS!AS","LSE Command> " ,lse_command_line); ERASE_LINE; COPY_TEXT(command_line_save); POSITION(END_OF(save_com_buffer)); COPY_TEXT("LSE Command> "); POSITION(save_buffer); ENDPROCEDURE ! PROCEDURE recall LOCAL lse_command_line, save_buffer2; SET (SCREEN_UPDATE,OFF); DEFINE_KEY('right_arrow',RIGHT,'right_arrow'); DEFINE_KEY('left_arrow',LEFT,'left_arrow'); DEFINE_KEY('parse_command',ctrl_m_key,'temp. parse command '); DEFINE_KEY('up_arrow',UP,'up_arrow'); DEFINE_KEY('down_arrow',DOWN,'down_arrow'); save_buffer2 := current_buffer; POSITION(END_OF(message_buffer)); MOVE_VERTICAL(-5); ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; POSITION(save_buffer2); SET (SCREEN_UPDATE,ON); save_buffer := current_buffer; MAP(LSE$$PROMPT_WINDOW,save_com_buffer); UPDATE(LSE$$PROMPT_WINDOW); POSITION(END_OF(save_com_buffer)); MOVE_VERTICAL(-1); MOVE_HORIZONTAL(LENGTH(current_line)); ! move to the end of the line !save_line := current_line; ENDPROCEDURE PROCEDURE PARSE_COMMAND LOCAL lse_command_line, save_buffer2; SET (SCREEN_UPDATE,OFF); lse_command_line := SUBSTR(current_line,LENGTH("LSE Command> "), (LENGTH(CURRENT_LINE) - LENGTH("LSE Command> ") + 1)); IF LENGTH(lse_command_line) <> 0 THEN save_command (lse_command_line) ENDIF; UNMAP (LSE$$PROMPT_WINDOW); POSITION(save_buffer); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/HORIZONTALLY /REVERSE'')', LEFT,'GOTO CHARACTER/HORIZONTALLY /REVERSE'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/HORIZONTALLY /FORWARD'')', RIGHT,'GOTO CHARACTER/HORIZONTALLY /FORWARD'); DEFINE_KEY('LSE$DO_COMMAND(''ENTER LINE'')',ctrl_m_key,'ENTER LINE'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/VERTICALLY /FORWARD'')' ,DOWN, 'GOTO CHARACTER/VERTICALLY /FORWARD'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/VERTICALLY /REVERSE'')' ,UP, 'GOTO CHARACTER/VERTICALLY /REVERSE'); save_buffer2 := current_buffer; POSITION(END_OF(message_buffer)); MOVE_VERTICAL(-5); ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; POSITION(save_buffer2); CHANGE_CASE(lse_command_line,UPPER); SET (SCREEN_UPDATE,ON); IF substr(lse_command_line,1,3) = "COM" THEN new_compile(lse_command_line) ELSE LSE$DO_COMMAND(lse_command_line) ENDIF; ENDPROCEDURE PROCEDURE up_arrow !ERASE_LINE; !COPY_TEXT(save_line); LSE$DO_COMMAND('GOTO CHARACTER/VERTICALLY /REVERSE'); MOVE_HORIZONTAL(LENGTH(CURRENT_LINE) - CURRENT_OFFSET); save_line := current_line; ENDPROCEDURE PROCEDURE down_arrow !ERASE_LINE; !COPY_TEXT(save_line); LSE$DO_COMMAND('GOTO CHARACTER/VERTICALLY /FORWARD'); IF (CURRENT_OFFSET = 0) THEN up_arrow ENDIF; MOVE_HORIZONTAL(LENGTH(CURRENT_LINE) - CURRENT_OFFSET); save_line := current_line; ENDPROCEDURE PROCEDURE right_arrow IF (CURRENT_OFFSET <= LENGTH(CURRENT_LINE)-1) THEN LSE$DO_COMMAND('GOTO CHARACTER/HORIZONTALLY /FORWARD') ENDIF; ENDPROCEDURE PROCEDURE left_arrow IF (CURRENT_OFFSET > LENGTH("LSE Command> ")) THEN LSE$DO_COMMAND('GOTO CHARACTER/HORIZONTALLY /REVERSE'); ENDIF; ENDPROCEDURE PROCEDURE undo LOCAL save_buffer2; UNMAP (LSE$$PROMPT_WINDOW); SET (SCREEN_UPDATE,OFF); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/HORIZONTALLY /REVERSE'')', LEFT,'GOTO CHARACTER/HORIZONTALLY /REVERSE'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/HORIZONTALLY /FORWARD'')', RIGHT,'GOTO CHARACTER/HORIZONTALLY /FORWARD'); DEFINE_KEY('LSE$DO_COMMAND(''ENTER LINE'')',ctrl_m_key,'ENTER LINE'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/VERTICALLY /FORWARD'')' ,DOWN, 'GOTO CHARACTER/VERTICALLY /FORWARD'); DEFINE_KEY('LSE$DO_COMMAND(''GOTO CHARACTER/VERTICALLY /REVERSE'')' ,UP, 'GOTO CHARACTER/VERTICALLY /REVERSE'); save_buffer2 := current_buffer; POSITION(END_OF(message_buffer)); MOVE_VERTICAL(-5); ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; POSITION(save_buffer2); SET (SCREEN_UPDATE,ON); ENDPROCEDURE !+-------------------------------------------------------------------------------+ !| End of procedures which allow for command buffering | !+-------------------------------------------------------------------------------+ ! !+--------------------------------------------------------------------------------+ !| | !| This procedure provides for additional functionality on the normal | !| change case keystroke (GOLD KP1) by allowing the user to set the selecte | !| region to upper or lower case absolutely. (i.e. not just to toggle lower | !| to upper and upper to lower | !| | !+--------------------------------------------------------------------------------+ PROCEDURE different_case(which_way) LOCAL which_way; ! 'UPPER' = upper case, 'LOWER' = lower case lse$create_select_range; ! Mark the users selected area SET (SCREEN_UPDATE,OFF); ! Don't update screen till end IF which_way = 'UPPER' THEN ! If upper case then change_case(lse$select_range,UPPER) ! change case of selected region to upper ENDIF; IF which_way = 'LOWER' THEN ! If lower case then change_case(lse$select_range,LOWER) ! change case of selected region to lower ENDIF; DELETE(lse$select_range); ! Remove selected region SET (SCREEN_UPDATE,ON); ! Show user all the changes ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure allows the user to move the selected range to another area | !| without deleting it. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE copy_select LOCAL save_buffer; lse$create_select_range; ! Mark user's selected area SET (SCREEN_UPDATE,OFF); ! Defer screen update till done save_buffer := current_buffer; ! Save name of the current buffer MAP(current_window,lse$$paste_buffer); ! Map current window to paste buffer ERASE(current_buffer); ! Erase the paste buffer COPY_TEXT(lse$select_range); ! Move text to the selected range MAP(current_window,save_buffer); ! Map back to the saved buffer SET (SCREEN_UPDATE,ON); ! Show user all changes DELETE(lse$select_range); ! Remove user's select range ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| | !| This procedure prints the current character or a suitable mnemonic | !| and the ascii value of that character in the message buffer area. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE ascii_val LOCAL counter, char_message; char := current_character; IF (ascii_flag <> "index_string_defined") THEN ! First time this function is used ascii_flag := "index_string_defined"; ! mark flag to show that index string is defined counter := 1; ! index first character in index string index_string := ""; ! initialize index string to blank LOOP ! Loop through valid ASCII range index_string := FAO('!AS!AS',index_string,ASCII(counter)); ! append successive ASCII characters to string counter := counter + 1; ! index successive characters EXITIF counter > 255; ! stop when at end of string and ASCII range ENDLOOP ENDIF; counter := INDEX(index_string,char); ! ASCII value = position of character in string control_translate(char); ! Translate character to mnemonic if unprintable char_message := FAO('character: !AS ascii_value: !SL', ! Place ascii value of character and mnemonic in char,counter); ! user's message area MESSAGE (char_message); ENDPROCEDURE; !+--------------------------------------------------------------------------------+ !| | !| The following procedure is used by Ascii_Val to find a | !| suitable mnemonic for characters that aren't visible. | !| | !+--------------------------------------------------------------------------------+ PROCEDURE control_translate (char) LOCAL char; CASE char FROM '' TO '' [''] : char := ''; ! ascii 0 [''] : char := ''; ! ascii 1 [''] : char := ''; ! ascii 2 [''] : char := ''; ! ascii 3 [''] : char := ''; ! ascii 4 [''] : char := ''; ! ascii 5 [''] : char := ''; ! ascii 6 [''] : char := ''; ! ascii 7 [''] : char := ''; ! ascii 8 [''] : char := ''; ! ascii 14 [''] : char := ''; ! ascii 15 [''] : char := ''; ! ascii 16 [''] : char := ''; ! ascii 17 [''] : char := ''; ! ascii 18 [''] : char := ''; ! ascii 19 [''] : char := ''; ! ascii 20 [''] : char := ''; ! ascii 21 [''] : char := ''; ! ascii 22 [''] : char := ''; ! ascii 23 [''] : char := ''; ! ascii 24 [''] : char := ''; ! ascii 25 [''] : char := ''; ! ascii 26 [''] : char := ''; ! ascii 27 [''] : char := ''; ! ascii 28 [''] : char := ''; ! ascii 29 [''] : char := ''; ! ascii 30 [''] : char := ''; ! ascii 31 [''] : char := '<128>'; ! ascii 128 [''] : char := '<129>'; ! ascii 129 [''] : char := '<130>'; ! ascii 130 [''] : char := '<131>'; ! ascii 131 [''] : char := ''; ! ascii 132 [''] : char := ''; ! ascii 133 [''] : char := ''; ! ascii 134 [''] : char := ''; ! ascii 135 [''] : char := ''; ! ascii 136 [''] : char := ''; ! ascii 137 [''] : char := ''; ! ascii 138 [''] : char := ''; ! ascii 139 [''] : char := ''; ! ascii 140 [''] : char := ''; ! ascii 141 [''] : char := ''; ! ascii 142 [''] : char := ''; ! ascii 143 [''] : char := ''; ! ascii 144 [''] : char := ''; ! ascii 145 [''] : char := ''; ! ascii 146 [''] : char := ''; ! ascii 147 [''] : char := ''; ! ascii 148 [''] : char := ''; ! ascii 149 [''] : char := ''; ! ascii 150 [''] : char := ''; ! ascii 151 [''] : char := '<152>'; ! ascii 152 [''] : char := '<153>'; ! ascii 153 [''] : char := '<154>'; ! ascii 154 [''] : char := ''; ! ascii 155 [''] : char := ''; ! ascii 156 [''] : char := ''; ! ascii 157 [''] : char := ''; ! ascii 158 [''] : char := ''; ! ascii 159 ENDCASE; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| The following procedures are all used by the procedure VIEW | !| They convert non-printable control characters in a designated | !| buffer to equivalent mnemonics of the type "<" + text + ">". | !| The control characters converted have ASCII values from | !| 0 - 8, 14 - 31 and 128 - 159. Only control characters in | !| this range are changed. | !+--------------------------------------------------------------------------------+ !+--------------------------------------------------------------------------------+ !| Initialize a buffer to translate into and name it "translation". | !| Create a window to view this buffer on the top part of the | !| screen. | !| Define a variable of data type PATTERN for matching any escape | !| characters that are to be converted. | !+--------------------------------------------------------------------------------+ PROCEDURE view_init_translate translate_buffer := CREATE_BUFFER ('translation'); ! create a new buffer to place translatd buffer SET (NO_WRITE, translate_buffer); ! no output file on translated buffer (default) translate_window := CREATE_WINDOW (1, 10, on); ! Create window to show translated buffer control_char_pat := ANY (''); ! Any of these control characters will be printed ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure performs the substitution of "meaningful characters" | !| for the single character. | !| Case from NUL to APC | !| The backwards questions mark is the placeholder for control characters | !| from ASCII(0) thru ASCII(159) on the VT2xx series of terminals | !+--------------------------------------------------------------------------------+ PROCEDURE view_translate_controls (char) CASE char FROM '' TO '' [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [' '] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT ('<128>'); [''] : COPY_TEXT ('<129>'); [''] : COPY_TEXT ('<130>'); [''] : COPY_TEXT ('<131>'); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT ('<152>'); [''] : COPY_TEXT ('<153>'); [''] : COPY_TEXT ('<154>'); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [INRANGE, OUTRANGE] : COPY_TEXT (char); ! copy same if not control char ENDCASE; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure controls the outer loop search for the special | !| control characters that we want to view | !+--------------------------------------------------------------------------------+ PROCEDURE view_controls (buf_name) LOCAL control_char, char_to_translate; ! ! When the search fails we know that we have either hit the end of ! the buffer or there were no more special characters found. ! ON_ERROR POSITION (BEGINNING_OF (translate_buffer)); ! Move to buffer top ! Make buffer "translation" visible on the top half of the screen. MAP (translate_window, translate_buffer); ! LSE$SET_STATUS_LINE(translate_window); SET(TIMER,ON,"Working..."); RETURN; ENDON_ERROR; !+--------------------------------------------------------------------------------+ !| This is the workhorse code that actually performs the translation | !+--------------------------------------------------------------------------------+ POSITION (translate_buffer); ! Move to the output buffer ERASE (translate_buffer); ! Clear it COPY_TEXT (buf_name); ! Make a copy of the original buffer POSITION (BEGINNING_OF (translate_buffer)); ! Move to top of the copy SET(TIMER,ON,"Translating"); LOOP ! Find all occurrences CONTROL_CHAR := SEARCH (control_char_pat, FORWARD); ! of control characters POSITION (control_char); ! Position on each one char_to_translate := CURRENT_CHARACTER; ! Save the character ERASE (control_char); ! then erase it view_translate_controls (char_to_translate); ! Substitute the new text ENDLOOP; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| The main procedure does the following: | !| Initialize the translate buffer if not already done | !| Remove the translate window if visible and quit | !| Find the variable of data type BUFFER associated with the | !| user's designated buffer of data type STRING. | !| Call the procedure that converts the designated buffer | !| and stores the output in the buffer named "translation" | !+--------------------------------------------------------------------------------+ PROCEDURE VIEW local View_Buf, First_Buffer, Next_Buf, Next_Buf_Name; IF translate_flag <> "initialized" THEN view_init_translate; translate_flag := "initialized" ENDIF; View_Flag := GET_INFO(translate_window,"visible"); IF View_Flag = 1 THEN UNMAP(translate_window) ELSE View_Buf := READ_LINE("Buffer to convert:(default current buffer)"); CHANGE_CASE(View_Buf,UPPER); IF View_Buf = "" THEN Next_Buf := GET_INFO(BUFFERS,"current"); view_controls(Next_Buf) ELSE First_Buffer := GET_INFO(BUFFERS,"first"); LOOP Next_Buf := GET_INFO(BUFFERS,"next"); EXITIF Next_Buf = 0; Next_Buf_Name := GET_INFO(next_buf,"NAME"); EXITIF Next_Buf_Name = View_Buf; ENDLOOP; If Next_Buf = 0 THEN MESSAGE("Buffer doesn't exist... try again") ELSE view_controls(Next_Buf) ENDIF ENDIF ENDIF; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| The following procedures are all used by the procedure DEVIEW. | !| These procedures reverse the action of the VIEW command and | !| store the result in a buffer named "detranslation". | !| They convert control character mnemonics of the type | !| "<" + text + ">" in a designated buffer (usually buffer | !| "translation") to equivalent control characters. The mnemonics | !| are converted back to control characters that have ASCII values | !| from 0 - 8, 14 - 31 and 128 - 159. | !| Call the procedure that converts the designated buffer | !| and stores the output in the buffer named "translation" | !+--------------------------------------------------------------------------------+ ! !+--------------------------------------------------------------------------------+ !| Initialize a buffer to reverse the translation into and name it | !| "detranslation". | !+--------------------------------------------------------------------------------+ PROCEDURE deview_init_translate detranslate_buffer := CREATE_BUFFER('detranslation'); SET (NO_WRITE, detranslate_buffer); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure reverses the substitution of control characters | !| for the substituted mnemonics created by procedure VIEW. | !| Unfortanately the only way the designer of this program could | !| see a way of doing this effectively was through the use of | !| a massive series of contional IF's; one for each character. | !+--------------------------------------------------------------------------------+ PROCEDURE deview_translate_controls (Mnemonic_to_Translate) LOCAL Mnemonic_to_Translate; ! ! The backwards questions mark is the placeholder for control characters ! from ASCII(0) thru ASCII(159) on the VT2xx series of terminals ! IF '' = Mnemonic_to_Translate THEN COPY_TEXT (''); RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<128>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<129>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<130>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<131>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<152>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<153>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '<154>' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; IF '' = Mnemonic_to_Translate THEN COPY_TEXT ('') ; RETURN ENDIF; COPY_TEXT(Mnemonic_to_Translate); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure controls the outer loop search for the | !| mnemonics that we want to translate | !+--------------------------------------------------------------------------------+ PROCEDURE deview_controls (buf_name) LOCAL Mnemonic_Range, Mnemonic_to_Translate, control_char, char_to_translate, pattern_counter, esc_text; POSITION (detranslate_buffer); ERASE (detranslate_buffer); COPY_TEXT (buf_name); ! Make a copy of the original buffer POSITION (BEGINNING_OF (detranslate_buffer)); SET(TIMER,ON,"Detranslating"); pattern_counter := 1; LOOP esc_text := '<' & MATCH ('>'); ! Define a pattern of type "< text >" Mnemonic_Range := SEARCH (esc_text, FORWARD); ! Find a string of type "< text >" EXITIF (Mnemonic_Range = 0); ! Exit loop when search fails POSITION (Mnemonic_Range); ! Postion on mnemonic Mnemonic_to_Translate := SUBSTR(Mnemonic_Range,1,5); ! Save the mnemonic ERASE (Mnemonic_Range); ! then erase it deview_translate_controls (Mnemonic_to_Translate); ! Substitute the esapes seq. ENDLOOP; ! Map to the window to view this buffer which was created by VIEW ! on the top part of the screen. MAP (translate_window, detranslate_buffer); LSE$SET_STATUS_LINE(translate_window); ! reset the status line SET(TIMER,ON,"Working..."); RETURN; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| The main procedure does the following: | !| Initialize the detranslate buffer if not already done | !| Remove the translate window if visible and quit | !| Find the variable of data type BUFFER associated with the | !| user's designated buffer of data type STRING. | !| Call the procedure that converts the designated buffer | !| and stores the output in the buffer named "detranslation" | !+--------------------------------------------------------------------------------+ PROCEDURE DEVIEW LOCAL View_Buf, First_Buffer, Next_Buf, Next_Buf_Name; IF detranslate_flag <> "deview_initialized" THEN deview_init_translate; detranslate_Flag := "deview_initialized" ENDIF; View_Flag := GET_INFO(translate_window,"visible"); IF View_Flag = 1 THEN UNMAP(translate_window) ELSE View_Buf := READ_LINE("Buffer to de-convert: (default buffer: translation)"); CHANGE_CASE(View_Buf,UPPER); IF View_Buf = "" THEN View_Buf := "TRANSLATION" ELSE CHANGE_CASE(View_Buf,UPPER) ENDIF; First_Buffer := GET_INFO(BUFFERS,"first"); LOOP Next_Buf := GET_INFO(BUFFERS,"next"); EXITIF Next_Buf = 0; Next_Buf_Name := GET_INFO(next_buf,"NAME"); EXITIF Next_Buf_Name = View_Buf; ENDLOOP; If Next_Buf = 0 THEN MESSAGE("Buffer doesn't exist... try again") ELSE deview_controls(Next_Buf) ENDIF ENDIF; ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure modifies the compile command denoted by the letters "COM" | !| to write the object file out to the same directory as the source file. | !| By default, the object file is written to the directory int which LSE | !| was invoked. We don't like that! | !+--------------------------------------------------------------------------------+ PROCEDURE new_compile(com_line) LOCAL com_line,buffer_file,dir_spec,name_spec, len_com_line,loc_dol_sign,copy_com_line,journal_file; buffer_file := GET_INFO(current_buffer,"FILE_NAME");! file name to compile dir_spec := FILE_PARSE(buffer_file,"","",DIRECTORY); name_spec := FILE_PARSE(buffer_file,"","",NAME); len_com_line := LENGTH(com_line); loc_dol_sign := INDEX(com_line,"$"); copy_com_line := com_line; IF loc_dol_sign = 0 THEN copy_com_line := FAO("!AS!AS!AS!AS",copy_com_line, " $/obj=",dir_spec,name_spec) ELSE copy_com_line := FAO("!AS!AS!AS!AS",copy_com_line, "/obj=",dir_spec,name_spec) ENDIF; LSE$DO_COMMAND(copy_com_line); journal_file := GET_INFO(SYSTEM,"journal_file"); journal_close; journal_open(journal_file); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| These procedures inserts line numbers incrementing by one at the beginning of | !| each line for the whole file. | !+--------------------------------------------------------------------------------+ PROCEDURE line_number_paste IF line_num_flag <> "on" THEN line_num_flag := "on"; ins_line_paste ELSE line_num_flag := "off"; del_line_paste ENDIF; ENDPROCEDURE ! PROCEDURE ins_line_paste LOCAL number_string,number,count,number_indent,curr_pos; SET (INFORMATIONAL,ON); SET (INSERT,current_buffer); curr_pos := MARK(NONE); POSITION (BEGINNING_OF (current_buffer)); ! Position cursor at top count := GET_INFO(current_buffer,"record_count"); number := 1; LOOP number_string := FAO("!5ZL!AS",number," "); MOVE_TEXT(number_string); MOVE_HORIZONTAL(-6); MOVE_VERTICAL(1); EXITIF count = number; number := number + 1; ENDLOOP; SET (INSERT,current_buffer); POSITION (curr_pos); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure deletes the line numbers placed by the ins_line_paste procedure| !| from the file. | !+--------------------------------------------------------------------------------+ PROCEDURE del_line_paste LOCAL mrker,number,count,rnge,curr_pos; SET (INFORMATIONAL,ON); curr_pos := MARK(NONE); POSITION (BEGINNING_OF (current_buffer)); ! Position cursor at top count := GET_INFO(current_buffer,"record_count"); number := 1; LOOP mrker := SELECT(NONE); MOVE_HORIZONTAL(6); rnge := select_range; mrker := 0; ERASE (rnge); MOVE_VERTICAL(1); EXITIF number = count; number := number + 1; ENDLOOP; SET (INSERT,current_buffer); POSITION (curr_pos); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure clears the current buffer. | !+--------------------------------------------------------------------------------+ PROCEDURE clear ERASE (current_buffer) ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure places the user at the line in the file that he specifies. | !+--------------------------------------------------------------------------------+ PROCEDURE abs_line LOCAL dest_line_number,user_input,move_to; user_input := READ_LINE ('Absolute Line Number: ',4); move_to:= int(user_input); message(fao("Moving to line !SL",move_to)); SET (SCREEN_UPDATE,OFF); position (beginning_of (current_buffer)); ! Position cursor at top move_vertical(move_to-1); SET (SCREEN_UPDATE,ON); ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure moves the user up or down a specified number of lines | !+--------------------------------------------------------------------------------+ PROCEDURE rel_line LOCAL dest_line_number,user_input,move_to; user_input := READ_LINE ('Relative Line Number: ',4); move_to:= int(user_input); SET (SCREEN_UPDATE,OFF); ! message(fao("Moving to line = !SL",move_to)); move_vertical(move_to); SET (SCREEN_UPDATE,ON); 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 ! lse$$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(lse$$cut_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(lse$$cut_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(lse$$cut_paste_buffer)); IF MARK(NONE) = END_OF(lse$$cut_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(lse$$cut_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(lse$$cut_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 EVE_SET_RECTANGULAR eveplus_v_begin_select := 0; define_key("eve_rectangular_remove", e3, "edd_remove"); define_key("eve_rectangular_insert_here", e2, "edd_insert_here"); define_key("eve_rectangular_select", e4, "edd_select"); endprocedure Procedure EVE_SET_NORECTANGULAR eveplus_v_begin_select := 0; define_key("eve_remove", e3, "cut"); define_key("eve_insert_here", e2, "paste"); define_key("eve_select", e4, "set select mark"); endprocedure 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 PROCEDURE tpu$define_keys_edd EVEPLUS_V_BEGIN_SELECT := 0; DEFINE_KEY("EVE_RECTANGULAR_SELECT", E4, "EDD SELECT"); DEFINE_KEY("EVE_RECTANGULAR_REMOVE", E3, "EDD CUT"); DEFINE_KEY("EVE_RECTANGULAR_INSERT_HERE", E2, "EDD PASTE"); !DEFINE_KEY("EVE_DRAW_BOX", F20, "EDD DRAW BOX") ENDPROCEDURE PROCEDURE tpu$init_proc_edd eveplus_v_begin_select := 0 ENDPROCEDURE PROCEDURE TPU$LOCAL_INIT eveplus_v_begin_select := 0 ENDPROCEDURE !+--------------------------------------------------------------------------------+ !| This procedure searches the list of buffers for the next user buffer. | !| When it finds the user buffer, it maps to it. | !| If this procedure is tied to a keystroke then the user can flip through | !| his buffers by hitting the key. | !+--------------------------------------------------------------------------------+ PROCEDURE next_buffer LOCAL next_buf_name,next_buf,first_buffer, buffer_change_message,my_buffer,buffer_type,flag; first_buffer := get_info(BUFFERS,"first"); my_buffer := get_info(BUFFERS,"current"); LOOP LOOP next_buf := get_info(BUFFERS,"next"); EXITIF next_buf = 0; buffer_type := get_info(next_buf,"system"); next_buf_name := get_info(next_buf,"NAME"); EXITIF (buffer_type = 0) AND (next_buf_name <> '$MAIN'); ENDLOOP; EXITIF next_buf <> 0; IF flag = 1 THEN MESSAGE("No other buffers"); flag := 2; ELSE flag := 1; my_buffer := get_info(BUFFERS,"first"); ENDIF; ENDLOOP; IF flag <> 2 THEN buffer_change_message := FAO('!AS !AS','going to buffer',next_buf_name); MESSAGE(buffer_change_message); MAP(current_window,next_buf); LSE$SET_STATUS_LINE(current_window); ENDIF; ENDPROCEDURE PROCEDURE NEW_WINDOW SPAWN ("@sys$sysvpwfiles:DCLWINDOW"); ENDPROCEDURE DEFINE_KEY('instant_comment',KEY_NAME("C",SHIFT_KEY),'place ! at eol'); ! Gold C - places comment marker DEFINE_KEY ('lse_and_prev_commands',KEY_NAME(KP7,SHIFT_KEY), ! Gold 7 - new LSE Command> procedure 'lse command line & prev. cmds '); DEFINE_KEY ('line_number_paste',F7,'LINE NUMBER PASTE'); DEFINE_KEY ('align_comments',F8,'align comments at column 80'); DEFINE_KEY ('abs_line',F9,'ABSOLUTE LINE'); DEFINE_KEY ('cursor_position',F10,'CURRENT CURSOR POSITION'); DEFINE_KEY ('copy_select',F11,'move select range to paste buffer'); DEFINE_KEY ('ascii_val',F13,'ascii value of current character'); DEFINE_KEY ('VIEW',F17,"Make Escape sequences viewable"); DEFINE_KEY ('DEVIEW',F18,"Restore correct Escape sequences"); DEFINE_KEY ('next_buffer',F19,'NEXT BUFFER'); DEFINE_KEY ('NEW_WINDOW',F20,"Spawn to DCL window"); DEFINE_KEY('shift_window(40)',KEY_NAME('>',SHIFT_KEY),'shift half screen right'); DEFINE_KEY('shift_window(-40)',KEY_NAME('<',SHIFT_KEY),'shift half screen left'); DEFINE_KEY('different_case("UPPER")',KEY_NAME('U',SHIFT_KEY),'upper case'); DEFINE_KEY('different_case("LOWER")',KEY_NAME('L',SHIFT_KEY),'lower case'); DEFINE_KEY('view_tabs',KEY_NAME('T',SHIFT_KEY),'view tabs'); DEFINE_KEY('del_buffer',KEY_NAME('D',SHIFT_KEY),'delete current buffer'); DEFINE_KEY('view_messages ',KEY_NAME('=',SHIFT_KEY),'view messages'); DEFINE_KEY('eve_kms_date',KEY_NAME('Q', SHIFT_KEY), "Insert date"); DEFINE_KEY('LEARN_BEGIN(NO_EXACT)',KEY_NAME('S',SHIFT_KEY),'learn save begin'); DEFINE_KEY('do_learn := LEARN_END',KEY_NAME('E',SHIFT_KEY),'learn save end'); DEFINE_KEY('EXECUTE(do_learn)',KEY_NAME('P',SHIFT_KEY),'do learn'); LSE$DO_COMMAND('SET TAB_INCREMENT 4'); EVEPLUS_V_BEGIN_SELECT := 0; ! set select to off