! ! WPE - Word Processing Editor ! VERSION 2.4 ! ! !++ ! FACILITY: ! Word Processing Editor (WPE) ! using..... ! EVE - { Extensible | Easy | Efficient } Vax Editor ! Text Processing Utility (VAXTPU) ! ! ABSTRACT: ! This is the source program for the WPE extension to the EVE interface ! of TPU. WPE emulates most of the capabilities of WPS-PLUS (TM), ! and provides some extensions. ! ! ENVIRONMENT: ! VAX/VMS Version 4.4 and above. ! EVE Version 1.1-024 ! ! Authors: ! Dale E. Coy ! Karl Nielsen ! ! Los Alamos National Laboratory ! MEE-8, MS/J572, PO Box 1663 ! Los Alamos, NM 87545 ! (505) 667-3270/4277 ! ! ! CREATION DATE: January, 1987 ! ! MODIFIED BY: ! ! Dale E. Coy (V2.2 --> V2.3) ! Added Buffer recall capability. ! Cleaned up Help. ! Changed the way keys are redefined. ! Added capability to display characters (Gold ?). ! Added line number display (Gold |). ! Added capability to print files with controls. ! Added capability to fix files with CR & LF ! Added capability to match () (Gold X). ! Added Ctrl_F to return to editing. ! Bug fixes. ! 5-APR-1987 ! ! Application / Numeric Keypad Switch ! Karl Nielsen 11-APR-1987 ! ! Dale E. Coy (V2.3 --> V2.4) 18-NOV-1987 ! Added : F18 toggles between 2 & 1 window (WPE_TOGGLE_WINDOWS) ! Added : @ inserts SYS$LOGIN:SIGNATURE.WPE (WPE_SIGNATURE) ! Minor bug fix. !-- ! ! WPE.TPU ! ! Table of Contents as of 18-NOV-1987 (Version 2.4) ! ! Procedure name Description ! -------------- ------------ ! ! wpe_select Start select region ! wpe_remove Cut text (into paste buffer). ! wpe_copy Gold Cut text. ! wpe_write_file Write buffer to file. ! wpe_get_a_file Make new buffer from file. ! wpe_move_by_line ! wpe_next_screen Down a screen. ! wpe_previous_screen Up a screen. ! wpe_cont_search Find previous target. ! wpe_cont_search_sel ! wpe_lower_case Make range lower case. ! wpe_upper_case Make range upper case. ! wpe_advance Advance key. ! wpe_back_up Back Up key. ! wpe_start_of_line Gold left_arrow. ! wpe_swap Swap key. ! wpe_delete_to_end_of_line F20 ! wpe_gold_down Scroll down to bottom ! wpe_gold_up Scroll up to top ! wpe_top Go to top of file ! wpe_para Go to next paragraph. ! wpe_backup_to_before_sent ! wpe_advance_to_end_sent ! wpe_find_start_of_sent ! wpe_sentence Go to next sentence. ! wpe_new_page Insert Form-feed. ! wpe_find_page Go to next page. ! wpe_view Show HTs ! wpe_tab_pos Go to next HT ! wpe_delete Del_key ! wpe_delete_word ! wpe_delete_char ! wpe_undelete_char ! wpe_ruler Display tab settings ! wpe_replace ! wpe_rub_sentence ! wpe_delete_line Take out whole line ! wpe_undelete_line Put it back ! wpe_enter Find next > character ! wpe_fill_paragraphs Wrap selected paragraphs ! wpe_fill_paragraph Wrap single paragraph ! wpe_paginate Put FF at CT lines ! wpe_special_files Check for language-sens WPE ! wpe_find_long_line On entry, check for >80 ! wpe_getout Exit or Quit ! wpe_quit Quit function, if WPE ! wpe_show Pre-processor for eve_show ! wpe_remember Pre-processor for eve_remember ! wpe_find Pre-processor for eve_find ! wpe_eve_replace Pre-processor for eve_replace ! wpe_get_command_string Simulate command recall ! wpe_return Tailored Return Key ! wpe_gold_return Gold return (comment) ! wpe_display_character Gold ? (what char is this) ! wpe_translate_char Translate 0-31 to ! wpe_what_line Count & GoTo line ! wpe_find_matching Find ) matching ( ! wpe_find_matching_paren Support routine ! wpe_toggle_windows F18 - toggle between 1 & 2 ! wpe_signature Insert sys$login:signature.wpe ! ! ! PROCEDURES FOR REDEFINING KEYS ON-THE-FLY ! wpe_redefine_key Temporary key redef. ! wpe_restore_key Put 'em back like they were. ! eve_numeric Put keypad in numeric ! eve_application Put keypad in application ! ! ! PROCEDURES FOR BUFFER RECALL ! wpe_list_buffers The recall display. ! wpe_select_buffer Action for SEL & Return ! wpe_get_the_buffer Go to it. ! wpe_get_buffer_command Intercepts Gold F19 ! wpe_bufkey_restore Cleanup everything. ! ! ! TAILORING FOR .COM FILES ! wpe_dcl_return Return key in .COM mode ! wpe_dcl_space Space key in .COM mode ! wpe_dcl_delete Del key for .COM ! wpe_dcl_delete_word Delete word for DCL ! wpe_dcl_gold_return Gold return (comment) ! ! ! HELP PROCEDURES ! wpe_help Intercepts Help key ! wpe$help_keypad Help for WPE ! wpe_help_select_keyboard First WPE help menu ! ! ! REPLACEMENTS FOR EVE PROCEDURES ! wpe$init_files Our eve$init_files ! wpe_get_file Our eve_get_file ! ! ! WPE DEFINES THESE USER-CALLABLE PROCEDURES ! eve_ct Set Page Length ! eve_print_translated Print file w/controls ! wpe$translate_controls Support routine for above ! eve_fix_mem Remove CRLFs ! wpe_get_fix_line Support routine for above ! ! ! INTERCEPTOR ROUTINES (CALL WPE_xxx) ! eve$init_do_key Replaces Eve procedure ! eve$help_keypad Replaces Eve procedure ! eve$init_files Replaces Eve procedure ! eve_get_file Replaces Eve procedure ! ! ! MODIFICATION TO PARSER DISPATCH TO FIX KEYS ! eve$parser_dispatch Needed to rationalize keys ! wpe_eve_key_restore Redefinition of keys ! wpe_wpe_key_restore Unredefinition of keys ! ! ! INITIALIZATION ! tpu$local_init Initialization of Globals ! wpe$local_init Dummy init. ! ! wpe_init_key_map_lists Init proc for key map lists ! ! ! DEFINITIONS (NON-PROCEDURAL) ! WPE Key Map Definitions Key map defs (not a procedure) ! WPE Key Definitions Key defs (not a procedure) ! !<><><><><><><><><><><><> ! Start a select region procedure wpe_select if eve$x_select_position <> 0 then eve$x_select_position := 0; message ("Selection cancelled."); else message ("Selection started. Press Cut or Remove when finished."); eve$x_select_position := select (eve$x_highlighting); endif; endprocedure; !<><><><><><><><><><><><> ! Cut (Remove) ! Move the select region to the insert here buffer procedure wpe_remove local this_position, ! Marker for current cursor position remove_range; ! Range being removed this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Cut must be used in " + "the same buffer as Select."); else remove_range := select_range; erase (paste_buffer); if remove_range = 0 then ! Select & Remove in same spot => erase the paste buffer message ("Clearing Paste buffer."); eve$x_select_position := 0; else position (paste_buffer); split_line; move_vertical (-1); move_text (remove_range); position (this_position); eve$x_select_position := 0; remove_range := 0; message ("Cut completed."); endif; endif; else message ("Use Select before using Cut."); endif; endprocedure; !<><><><><><><><><><><><> procedure wpe_copy ! Gold Cut ! Copy selected text into paste buffer local this_position, !Marker for current cursor position copy_range; !Range being copied this_position := mark(none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Gold Cut must be used in " + "the same buffer as Select."); else copy_range := select_range; erase (paste_buffer); if copy_range = 0 then ! Select & Remove in same spot => erase the paste buffer message ("Clearing Paste buffer."); eve$x_select_position := 0; else position(paste_buffer); split_line; move_vertical (-1); copy_text(copy_range); position (this_position); eve$x_select_position := 0; copy_range := 0; message ("Gold Cut completed."); endif; endif; else message ("Use Select before using Gold Cut."); endif; endprocedure; !<><><><><><><><><><><><> procedure wpe_write_file ! Write selected region if there is one, write whole buffer if not. local wpe_write_file_name, what_key, question_answer, parsed_name; ! Used to detect errors. if eve$x_trimming then message ("Trimming buffer..."); eve$trim_buffer (current_buffer); message ("Trimming completed."); endif; wpe_write_file_name := read_line ("File to write to: "); if wpe_write_file_name = eve$kt_null then what_key := eve$lookup_comment (last_key); if (what_key = "wpe move_up") or (what_key = "wpe recall" ) then ! Take a stab at recall, IFF this isn't a select_range if eve$x_select_position <> 0 then !Select range active message ("Recall is not available for Select Range. No file written."); return; endif; wpe_write_file_name := get_info (current_buffer,"output_file"); if (get_info (wpe_write_file_name, "type") <> string) or (wpe_write_file_name = "") then ! No file name message ("No information available for output file. No file written."); return; else parsed_name := file_parse (wpe_write_file_name, "", "", NODE) + file_parse (wpe_write_file_name, "", "", DEVICE) + file_parse (wpe_write_file_name, "", "", DIRECTORY) + file_parse (wpe_write_file_name, "", "", NAME) + file_parse (wpe_write_file_name, "", "", TYPE); question_answer := eve$insist_y_n (FAO (" Write file to !AS ? [Yes] ", parsed_name)); if question_answer then wpe_write_file_name := parsed_name; else message ("No file written."); return; endif; endif; else message ("No file written."); return; endif; endif; if eve$x_select_position <> 0 then !Select range active message (fao ("Writing selected text to !AS", wpe_write_file_name)); parsed_name := file_parse (wpe_write_file_name); ! Don't try if the file name is bad - & don't kill select range if parsed_name <> "" then write_file (select_range, wpe_write_file_name); eve$x_select_position := 0; else message ("Bad file name " + wpe_write_file_name + " - No file written."); endif; else !No select range message (fao ("Writing buffer to !AS", wpe_write_file_name)); write_file (current_buffer, wpe_write_file_name); endif; endprocedure; !<><><><><><><><><><><><> procedure wpe_get_a_file ! Gold-F19. Gets a file into a new buffer, and adjusts buffer width ! if needed. If screen width is already 132, we just check for long lines ! and adjust buffer width if needed. Otherwise, we check to see if this ! file causes us to go to 132. local entry_mark, present_width, present_buffer_name, new_buffer_name, long_line; on_error ! allow search to fail endon_error; ! First, get the file. present_buffer_name := get_info (current_buffer, "file_name"); wpe_get_file (''); ! Make sure we got a new buffer, then... new_buffer_name := get_info (current_buffer, "file_name"); if present_buffer_name <> new_buffer_name then present_width := get_info (screen,"width"); if present_width > 80 then ! This is not first long-line buffer. if wpe_special_files(1) <> 1 then ! Prompting mode ! No special files long_line := search (wpe$x_long_line, forward); if long_line <> 0 then set (margins, current_buffer,1,131); else ! It was set 131 by eve_get_file. ! Reset it to 79 for sanity. set (margins, current_buffer,1,79); endif; endif; else ! See if this is first long-line buffer. wpe_special_files(1); wpe_find_long_line; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_move_by_line ! Move to start of line if current direction is reverse; ! else move to start of next line. If reverse and at BOL, ! go to the start of the previous line. local l_offset, l_margin; on_error return; endon_error; if current_buffer = eve$command_buffer then return; ! too complex to worry with endif; if current_direction = forward then move_horizontal (-current_offset); if mark(none) <> end_of (current_buffer) then move_vertical (1); endif; else l_margin := get_info (current_buffer, "left_margin"); l_offset := get_info (screen, "current_column"); if l_offset <= l_margin then move_horizontal (- current_offset ); if mark(none) <> beginning_of (current_buffer) then move_vertical (-1); endif; else move_horizontal (- current_offset ); if length (current_line) >= l_margin then loop exitif (current_offset + 1) >= l_margin; move_horizontal (1); endloop; endif; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_next_screen local this_row, ! Where we are should_be, ! Where we should be wpe_scroll_top, ! Top correct line wpe_scroll_bottom, ! Bottom correct line wpe_scroll_amount, ! Correction window_top, ! Top visible line window_bottom; ! Bottom visible line on_error wpe_next_screen := 0; set (screen_update, on); endon_error; wpe_next_screen := 1; this_row := get_info (current_window, "current_row" ); !wpe_scroll_top := get_info (current_window, "scroll_top" ); wpe_scroll_bottom := get_info (current_window, "scroll_bottom" ); wpe_scroll_amount := get_info (current_window, "scroll_amount" ); !window_top := get_info (current_window, "visible_top" ); window_bottom := get_info (current_window, "visible_bottom"); should_be := window_bottom - wpe_scroll_bottom - wpe_scroll_amount ; move_horizontal (-current_offset); move_vertical (should_be - this_row); set (screen_update, off); update (current_window); eve$move_by_screen (1); move_vertical (1); ! eve_forward; set (screen_update, on); endprocedure !<><><><><><><><><><><><> procedure wpe_previous_screen local this_row, ! Where we are should_be, ! Where we should be off_bottom, ! Save entry position wpe_scroll_top, ! Top correct line wpe_scroll_bottom, ! Bottom correct line wpe_scroll_amount, ! Correction window_top, ! Top visible line window_bottom; ! Bottom visible line on_error wpe_previous_screen := 0; set (screen_update, on); endon_error; wpe_previous_screen := 1; this_row := get_info (current_window, "current_row" ); wpe_scroll_top := get_info (current_window, "scroll_top" ); !wpe_scroll_bottom := get_info (current_window, "scroll_bottom" ); wpe_scroll_amount := get_info (current_window, "scroll_amount" ); window_top := get_info (current_window, "visible_top" ); !window_bottom := get_info (current_window, "visible_bottom"); should_be := window_top + wpe_scroll_top + wpe_scroll_amount ; off_bottom := ( mark (none) <> end_of (current_buffer) ); move_horizontal (-current_offset); move_vertical (should_be - this_row); set (screen_update, off); update (current_window); eve$move_by_screen (-1); if off_bottom then move_vertical (-1); ! Condition compensates for EOB marker endif; set (screen_update, on); endprocedure !<><><><><><><><><><><><> procedure wpe_cont_search if eve$x_target <> eve$kt_null then if get_info (eve$x_target, eve$kt_type) = string then message (fao ("Finding previous target: !AS", eve$x_target)); else message ("Finding previous target: "); endif; endif; wpe_cont_search := eve$find (eve$x_target,0); endprocedure !<><><><><><><><><><><><> procedure wpe_cont_search_sel local s_range, target_length; !on_error !endon_error if eve$x_select_position <> 0 then ! Fix for repeated cont_search_sel eve$x_select_position := 0; target_length := length (eve$x_target); move_horizontal (-target_length ); s_range := search ( anchor & eve$x_target, forward, no_exact); if s_range = 0 then move_horizontal (target_length ); endif; endif; s_range := wpe_cont_search; if s_range <> 0 then eve$x_select_position := 0; position (beginning_of (s_range)); eve$x_select_position := select (eve$x_highlighting); position (end_of (s_range)); move_horizontal (1); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_lower_case local character, ! Current character this_position, ! Marker for current position this_mode; ! Current mode for this buffer if eve$x_select_position <> 0 then change_case (select_range, lower); eve$x_select_position := 0; else this_position := mark (none); character := erase_character (1); change_case ( character, lower); this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); copy_text (character); set (this_mode, current_buffer); if current_direction = forward then if current_offset = length (current_line) then move_horizontal (1) endif; else move_horizontal (-1); if this_position <> beginning_of (current_buffer) then move_horizontal (-1); endif; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_upper_case local character, ! Current character this_position, ! Marker for current position this_mode; ! Current mode for this buffer if eve$x_select_position <> 0 then change_case (select_range, upper); eve$x_select_position := 0; else this_position := mark (none); character := erase_character (1); change_case ( character, upper); this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); copy_text (character); set (this_mode, current_buffer); if current_direction = forward then if current_offset = length (current_line) then move_horizontal (1) endif; else move_horizontal (-1); if this_position <> beginning_of (current_buffer) then move_horizontal (-1); endif; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_advance ! Emulate WPS advance key if get_info (current_buffer, "direction") = reverse then eve_forward; endif; if mark(none) <> end_of (current_buffer) then move_horizontal (1); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_back_up ! Emulate WPS back up key if get_info (current_buffer, "direction") = forward then eve_reverse; endif; if mark(none) <> beginning_of (current_buffer) then move_horizontal (-1); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_start_of_line ! Handles start of line, with left margin <> 1 local l_margin; l_margin := get_info (current_buffer, "left_margin"); eve_start_of_line; if mark(none) <> end_of (current_buffer) then if length (current_line) >= l_margin then loop exitif (current_offset + 1) >= l_margin; move_horizontal (1); endloop; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_swap ! Emulate WPS swap (Gold Enter) local old_mode, character; old_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); character := current_character; erase_character (1); move_horizontal (1); copy_text (character); set (old_mode, current_buffer); endprocedure !<><><><><><><><><><><><> procedure wpe_delete_to_end_of_line ! Erase to end of line ! This procedure works because erase_character doesn't cross line boundaries if current_offset = length (current_line) then return; else eve$x_restore_text := erase_character (length (current_line)); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_gold_down local wpe$line; on_error return; endon_error move_horizontal (-current_offset); loop move_vertical (1); update (current_window); endloop; endprocedure !<><><><><><><><><><><><> procedure wpe_gold_up local wpe$line; on_error eve_forward; return; endon_error move_horizontal (-current_offset); loop move_vertical (-1); update (current_window); endloop; endprocedure !<><><><><><><><><><><><> procedure wpe_top ! eve_top, and then make sure direction is forward eve_top; eve_forward; endprocedure !<><><><><><><><><><><><> procedure wpe_para local form_feed; on_error ! return; endon_error move_horizontal (- current_offset); if current_direction = forward then if not eve$paragraph_break then loop exitif mark (none) = end_of (current_buffer); move_vertical (1); form_feed := search (wpe$pattern_ff, forward); if form_feed <> 0 then move_vertical (-1); exitif 1; else exitif eve$paragraph_break; endif; endloop; endif; loop exitif mark (none) = end_of (current_buffer); move_vertical (1); form_feed := search (wpe$pattern_ff, forward); exitif form_feed <> 0; exitif not eve$paragraph_break; endloop; else loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); exitif not eve$paragraph_break; form_feed := search (wpe$pattern_ff, forward); exitif form_feed <> 0; endloop; loop exitif mark (none) = beginning_of (current_buffer); form_feed := search (wpe$pattern_ff, forward); exitif form_feed <> 0; move_vertical (-1); exitif eve$paragraph_break; endloop; if mark (none) <> beginning_of (current_buffer) then if form_feed = 0 then move_vertical (1); endif; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_backup_to_before_sent local wpe_period_range, ! Location of end. wpe_period_marker, empty_line_range, empty_line_marker, skipped_white, between_space; on_error ! return; endon_error ! For reverse, we need to do two operations - first we back up ! one character (in case we're on the first character of the ! sentence) & then jump over all white space. Then we look ! backward for one terminator. ! ! Do first search ! move_horizontal (-1); loop skipped_white := 0; exitif mark (none) = beginning_of (current_buffer); loop ! Skip empty lines & one line end if length (current_line) <> 0 then exitif mark (none) = beginning_of (current_buffer); exitif current_offset <> length (current_line); move_horizontal (-1); exitif 1; else move_horizontal (-1); endif; endloop; ! OK - we're not on a line_end loop exitif index (eve$x_fill_separators, current_character) = 0; exitif mark (none) = beginning_of (current_buffer); move_horizontal (-1); skipped_white := 1; endloop; exitif skipped_white = 0; endloop; ! This put us either just at the preceeding period, a ! preceeding character in the case of empty lines, ! or at beginning of buffer. Now, we do it again. ! This time, position to end of range (+1). if mark (none) <> beginning_of (current_buffer) then move_horizontal (-1); wpe_period_range := search ( span(wpe$x_sentence_ends), reverse, no_exact); empty_line_range := search ( wpe$x_empty_line, reverse, no_exact); if wpe_period_range <> 0 then wpe_period_marker := end_of (wpe_period_range); if empty_line_range <> 0 then empty_line_marker := end_of (empty_line_range); if wpe_period_marker > empty_line_marker then position (wpe_period_marker); move_horizontal (1); else position (empty_line_marker); move_horizontal (1); endif; else position (wpe_period_marker); move_horizontal (1); endif; else if empty_line_range <> 0 then empty_line_marker := end_of (empty_line_range); position (empty_line_marker); move_horizontal (1); else position (beginning_of(current_buffer)); endif; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_advance_to_end_sent local wpe_period_range, ! Location of end. wpe_period_marker, empty_line_range, empty_line_marker; on_error ! return; endon_error wpe_period_range := search ( span(wpe$x_sentence_ends), forward, no_exact); empty_line_range := search ( wpe$x_empty_line, forward, no_exact); if wpe_period_range <> 0 then wpe_period_marker := end_of (wpe_period_range); if empty_line_range <> 0 then empty_line_marker := end_of (empty_line_range); if wpe_period_marker < empty_line_marker then position (wpe_period_marker); else position (empty_line_marker); endif; else position (wpe_period_marker); endif; else if empty_line_range <> 0 then empty_line_marker := end_of (empty_line_range); position (empty_line_marker); else position (end_of(current_buffer)); endif; endif; move_horizontal (1); endprocedure !<><><><><><><><><><><><> procedure wpe_find_start_of_sent local did_something, between_space; on_error ! return; endon_error ! We are either at the start of a "sentence", or just before the start ! a sentence. Of course, we could have some white space, one or more empty ! lines, etc. ! Loop through this until we don't do anything: loop exitif mark (none) = end_of (current_buffer); did_something := 0; ! If we change lines, set this to 1 ! White space before word loop exitif index (eve$x_whitespace, current_character) = 0; move_horizontal (1); endloop; ! This is not a "did_something". if current_offset = length (current_line) then move_horizontal (-current_offset); move_vertical (1); ! start of next line did_something := 1; endif; exitif mark (none) = end_of (current_buffer); if current_offset = 0 then ! More checks if start of line. ! Take out empty lines loop between_space := search ( wpe$pattern_empty_line, forward, no_exact); exitif between_space = 0; move_vertical (1); exitif mark (none) = end_of (current_buffer); did_something := 1; endloop; endif; exitif did_something = 0; ! If we didn't do anything, we're through. endloop; endprocedure !<><><><><><><><><><><><> procedure wpe_sentence on_error ! return; endon_error if current_direction = forward then wpe_advance_to_end_sent; else ! Direction is Reverse wpe_backup_to_before_sent; endif; ! We are now either at the start of a "sentence", or just before the start ! a sentence. Of course, we could have some white space, one or more empty ! lines, etc. wpe_find_start_of_sent; endprocedure !<><><><><><><><><><><><> procedure wpe_new_page local this_mode; on_error return; endon_error this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); if current_offset <> 0 then if current_offset = length(current_line) then if mark (none) = end_of (current_buffer) then return; else move_horizontal (-current_offset); move_vertical (1); endif; else eve_return; endif; endif; copy_text ( ascii(12)); set (this_mode, current_buffer); endprocedure !<><><><><><><><><><><><> procedure wpe_find_page local page_marker, ! Define FF previous_target; ! Used to preserve target on_error return; endon_error page_marker := ascii(12); previous_target := eve$x_target; ! eve$find writes a "Could not find: " message which, with FF, scrolls ! the screen. We repaint to avoid having the screen "out of sync". if not eve$find (page_marker, 0) then eve_refresh; message ("No page marker was found."); endif; eve$x_target := previous_target; endprocedure !<><><><><><><><><><><><> procedure wpe_view local text_type; ! 14 for Blank_Tabs, 24 for Graphic_Tabs on_error return; endon_error text_type := get_info ( current_window, "text"); if text_type = blank_tabs then ! it's now blank_tabs (normal) set ( text, current_window, graphic_tabs ); else if text_type = graphic_tabs then ! it's now graphic_tabs (view) set ( text, current_window, blank_tabs ); ! For reference, NO_TRANSLATE = 35 else ! if it's something else, set blank set ( text, current_window, blank_tabs ); endif; ! (lets us get out of no_translate easily) endif; endprocedure !<><><><><><><><><><><><> procedure wpe_tab_pos local found_ht; on_error ! return; endon_error if current_direction = forward then found_ht := 0; loop exitif current_offset = length (current_line); if current_character = ' ' then ! horizontal tab found_ht := 1; move_horizontal (1); exitif 1; else move_horizontal (1); endif; endloop; if found_ht = 0 then move_horizontal (-current_offset); move_vertical (1); endif; else ! Reverse move_horizontal (-1); if current_offset <> 0 then ! Otherwise, stop here regardless if current_character = ' ' then ! horizontal tab move_horizontal (-1); endif; loop if current_character = ' ' then ! horizontal tab move_horizontal (1); exitif 1; else exitif current_offset = 0; move_horizontal (-1); endif; endloop; endif; endif; endprocedure !<><><><><><><><><><><><> ! Delete previous character. If in insert mode, and if previous character ! is a tab, then replace tab with ! n-1 spaces. procedure wpe_delete local this_position, ! Marker for current cursor position this_column, ! Current column that_column, ! Just to left (look out for tabs) num_spaces; ! Slack for tabs ! If we don't mark this position now we'll get funny results later ! if cursor is beyond end of line this_position := mark (none); if current_window = eve$command_window then if get_info (current_buffer, eve$kt_offset_column) <= (eve$x_command_prompt_length + 1) then return; endif; endif; if get_info (current_buffer, eve$kt_offset_column) <= get_info (current_buffer, eve$kt_left_margin) then eve$append_line; else if get_info (current_buffer, eve$kt_mode) = insert then this_column := get_info (current_window, "current_column"); move_horizontal (-1); update (current_window); that_column := get_info (current_window, "current_column"); num_spaces := this_column - that_column - 1; if num_spaces > 0 then ! Tab erase_character (1); wpe$x_char_buffer := " "; ! Put in n-1 spaces copy_text (substr ( " ",1,num_spaces)); else wpe$x_char_buffer := erase_character (1); endif; else if current_character = eve$kt_null then wpe$x_char_buffer := erase_character (-1); else move_horizontal (-1); if current_character <> ascii (9) then copy_text (" "); move_horizontal (-1); else wpe$x_char_buffer := erase_character (1); endif; endif; endif; endif; endprocedure; !<><><><><><><><><><><><> procedure wpe_delete_word ! Method: ! Partially tailored for documentation files, etc. ! Delete current character & all characters to the right through ! end of white space (if on white space, delete only white space). ! Stop at end of line, and do not wrap (unless at end of line). ! Stop if _, ) or ] are encountered, and do not erase them. ! Put erased stuff in restore buffer. local start_delete_word, ! Marker for beginning of word end_delete_word, ! Marker for end of word begin_char, ! Character at entry to this procedure pair_index, ! Position of paired character on_space, ! Indication that term. is space white_space, ! Between-word spaces to erase delete_word_range; ! Range for word if current_window = eve$command_window then move_horizontal (1); if mark (none) = end_of (current_buffer) then move_horizontal (-1); return else move_horizontal (-1); endif; endif; if mark (none) = end_of (current_buffer) then return; endif; if current_offset <> length (current_line) then ! save current character if it's paired - ({['" pair_index := index(wpe$x_paired_regular_term_char, current_character); if pair_index <> 0 then begin_char := substr (wpe$x_regular_term_char, pair_index, 1); else begin_char := ''; endif; start_delete_word := mark (none); if index (eve$x_whitespace, current_character) <> 0 then on_space := 1; else on_space := 0; endif; ! Go from here to terminator: loop move_horizontal (1); exitif on_space = 1; exitif mark(none) = end_of (current_buffer); if index (eve$x_whitespace, current_character) <> 0 then on_space := 1; exitif 1; endif; exitif index (wpe$x_regular_term_char, current_character) <> 0; endloop; if on_space = 1 then loop exitif mark(none) = end_of (current_buffer); exitif index (eve$x_whitespace, current_character) = 0; move_horizontal (1); exitif current_offset = length (current_line); endloop; endif; ! If there is something, then back up - unless we are "paired" ! with the initial character. (e.g., we want to delete all of ! things like [xxxxx] if we start at the [ ). if mark(none) <> end_of (current_buffer) then if current_character <> begin_char then if length (current_line) <> 0 then move_horizontal (-1); endif; endif; else move_horizontal (-1); endif; end_delete_word := mark (none); delete_word_range := create_range (start_delete_word, end_delete_word, none); position (start_delete_word); eve$x_restore_text := erase_character (length (delete_word_range)); eve$x_restoring_line := 0; else move_horizontal (-current_offset); move_vertical (1); append_line; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_delete_char wpe$x_char_buffer := current_character; eve_erase_character; endprocedure !<><><><><><><><><><><><> procedure wpe_undelete_char local this_mode; this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); copy_text (wpe$x_char_buffer); set (this_mode, current_buffer); endprocedure !<><><><><><><><><><><><> procedure wpe_ruler local info_type, ! 1 if integer, 2 if string tab_settings; on_error return; endon_error tab_settings := get_info (current_buffer, 'tab_stops'); info_type := get_info (tab_settings, 'type'); if info_type = 1 then message ("Tabs Every " + str(tab_settings) + " [use DO, 'SET TABS EVERY n' to change.]"); endif; if info_type = 2 then message ("Tabs At " + tab_settings + " [use DO, 'SET TABS AT n nn nn' to change.]"); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_replace local this_position, ! Marker for current cursor position remove_range; ! Range being removed this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Replace must be used in " + "the same buffer as Select."); else remove_range := select_range; ! Select & Remove in same spot => erase this character if remove_range = 0 then if this_position = end_of (current_buffer) then message ("Nothing to remove"); eve$x_select_position := 0; return; else remove_range := create_range (mark (none), mark (none), none); endif; endif; erase (remove_range); eve$x_select_position := 0; remove_range := 0; ! message ("Remove completed."); if beginning_of (paste_buffer) <> end_of (paste_buffer) then eve_insert_here; endif; endif; else message ("Use Select before using Replace."); endif; endprocedure !<><><><><><><><><><><><> procedure wpe_rub_sentence local last_position, ! Marker for current cursor position first_position, ! Marker for start of sentence remove_range; ! Range being removed move_horizontal (-1); last_position := mark (reverse); wpe_backup_to_before_sent; first_position := mark (reverse); remove_range := create_range (first_position, last_position, none); eve$x_restore_text := substr (remove_range, 1, length (remove_range)); erase (remove_range); remove_range := 0; message ("Sentence removed."); endprocedure !<><><><><><><><><><><><> procedure wpe_delete_line if current_buffer = eve$command_buffer then if substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then move_horizontal (-current_offset); move_horizontal (eve$x_command_prompt_length); wpe_delete_to_end_of_line; wpe$x_line_buffer := eve$x_restore_text; endif; else wpe$x_line_buffer := erase_line; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_undelete_line on_error return; endon_error copy_text (wpe$x_line_buffer); split_line; endprocedure !<><><><><><><><><><><><> procedure wpe_enter eve_find ('>'); endprocedure !<><><><><><><><><><><><> procedure wpe_fill_paragraphs local this_position, ! Marker for current cursor position working_position, ! Marker for working position reverse_incoming, ! Indicator for entry direction select_incoming; ! Select starting position on_error set (screen_update,on); endon_error this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Wrap must be used in " + "the same buffer as Select."); else ! Set the select region off set (screen_update,off); position (eve$x_select_position); eve$x_select_position := 0; ! Otherwise, select stays on ! update (current_window); select_incoming := mark (none); ! No, we can't just say ! Select_Incoming := eve$x_select... if current_direction = reverse then reverse_incoming := 1; set (forward, current_buffer); else reverse_incoming := 0; endif; if select_incoming < this_position then ! Select was done in forward direction position (select_incoming); loop wpe_fill_paragraph; working_position := mark (none); exitif working_position >= this_position; ! wpe_para; endloop; else ! Select was done in reverse direction position (this_position); ! Top of select range loop wpe_fill_paragraph; working_position := mark (none); exitif working_position >= select_incoming; ! wpe_para; endloop; position (this_position); ! Original place endif; if reverse_incoming = 1 then set (reverse, current_buffer); endif; message ("Paragraph fill completed."); set (screen_update,on); endif; else wpe_fill_paragraph; endif; endprocedure !<><><><><><><><><><><><> ! Fills the current paragraph. This differs slightly from the eve ! implementation, in that the ending position is at the start ! of the next paragraph. This was done so that repeated executions ! of para would fill succeeding paragraphs. ! Also, this handles cases (e.g., .HLP files) where the left margin is ! not 1, but something is left of the left margin. procedure wpe_fill_paragraph local this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph left_space, ! Space for left margin, if not 1. form_feed, ! Range for form feed, if found. fill_range; ! Range for current paragraph on_error endon_error ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then message ("Nothing to fill"); return; endif; this_position := mark (none); ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph ! Find Beginning move_horizontal (- current_offset); form_feed := search (wpe$pattern_ff, forward); if form_feed = 0 then loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); if eve$paragraph_break then move_vertical (1); exitif 1; endif; form_feed := search (wpe$pattern_ff, forward); exitif form_feed <> 0; endloop; endif; start_paragraph := mark (none); left_space := get_info (current_buffer, "left_margin") - 1; if left_space > 0 then if index (eve$x_symbol_characters, current_character) = 0 then left_space := 0; ! Not a character, so forget it. endif; endif; ! Find End position (this_position); move_horizontal (- current_offset); loop exitif mark (none) = end_of (current_buffer); exitif eve$paragraph_break; move_vertical (1); form_feed := search (wpe$pattern_ff, forward); exitif form_feed <> 0; endloop; if start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); else move_horizontal (-1); stop_paragraph := mark (none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); fill (fill_range, eve$x_fill_separators); if left_space > 0 then ! Adjust first line left to col. 1 position (start_paragraph); move_horizontal (- current_offset); erase_character (left_space); endif; position (stop_paragraph); wpe_para; ! Start of next para, so we can repeat. eve$show_first_line; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_paginate local prev_ff_range, prev_ff_mark, next_ff_range, next_ff_mark, eob_mark, entry_mark, temporary_mark, proposed_ff_mark, question_answer; on_error ! return; endon_error ct_old_length := ct_length; ! Mark end of buffer entry_mark := mark (none); ! Save present position position (end_of (current_buffer)); move_horizontal (-1); eob_mark := mark (none); position (entry_mark); ! Original position move_horizontal (1); ! Just to the right ! Find next FF after original position next_ff_range := search (" ",forward); if next_ff_range <> 0 then position (next_ff_range); else position (end_of (current_buffer)); move_horizontal (-1); endif; next_ff_mark := mark (none); ! Find FF before (or at) original position position (entry_mark); ! Original position prev_ff_range := search (" ",reverse); if prev_ff_range <> 0 then position (prev_ff_range); else position (beginning_of(current_buffer)); endif; prev_ff_mark := mark (none); ! This leaves us at the previous FF, which is where we want. ! Start of this line. This is OK even if prev. is within this line. if current_offset <> 0 then move_horizontal ( - current_offset); endif; temporary_mark := mark (none); ! Try moving down to the correct position move_vertical (ct_length); proposed_ff_mark := mark(none); ! We could have an error (too far), or be at EOB. if proposed_ff_mark = temporary_mark then position (eob_mark); else if proposed_ff_mark > eob_mark then position (eob_mark); endif; endif; proposed_ff_mark := mark(none); ! Now check the position, and stop somewhere loop if proposed_ff_mark > next_ff_mark then position (next_ff_mark); next_ff_mark := mark (reverse); update (current_window); question_answer := eve$insist_y_n (FAO (" This New Page Mark is before !SL lines. Remove it? [Yes] ", ct_length)); next_ff_mark := mark (none); update (current_window); if question_answer then erase_character (1); ! Find next FF after original position next_ff_range := search (" ",forward); if next_ff_range <> 0 then position (next_ff_range); else position (end_of (current_buffer)); move_horizontal (-1); endif; next_ff_mark := mark (none); ! And repeat the loop else message (" Stopping at this existing New Page Mark."); exitif 1; endif; else if proposed_ff_mark < next_ff_mark then wpe_new_page; move_horizontal (-1); ! position to ff mark message (FAO (" New Page Mark inserted. " + "Page length is !SL lines.", ct_length)); exitif 1; else ! This also handles the case for end-of-buffer. if proposed_ff_mark = eob_mark then message (FAO (" End of text before !SL lines.",ct_length)); else message (FAO ( " Using correctly-positioned New Page Mark. " + "Page length is !SL lines.", ct_length)); endif; exitif 1; ! FF already there. Use it. endif; endif; endloop; endprocedure !<><><><><><><><><><><><> ! Handle special file types. Assumes current buffer is the correct ! one. ! If prompt_flag = 1, then prompt the user for permission to ! make changes - otherwise, don't prompt. ! Returns 1 if special-case mod was made, 0 if not. procedure wpe_special_files (prompt_mode) local prompt_flag, ! Local copy file_extension, buffer_name, question_answer; on_error ! return; endon_error ! Note: use the buffer name, not the file name. ! New (created) files or buffers don't have file_name. buffer_name := get_info (current_buffer, "name"); file_extension := file_parse (buffer_name, eve$kt_null, eve$kt_null, type); if wpe$x_facility_name = "WPE" then prompt_flag := prompt_mode; ! As incoming else prompt_flag := 0; ! for MORE, don't prompt endif; ! .HLP file section if file_extension = ".HLP" then if prompt_flag = 1 then message (" File " + buffer_name + ""); question_answer := eve$insist_y_n (" Do you want " + wpe$x_facility_name + " to tailor this buffer for " + "editing HELP files? [Yes] "); else message (" Tailoring " + wpe$x_facility_name + " to edit .HLP file "); question_answer := 1; endif; if question_answer = 1 then if mark(none) = end_of (current_buffer) then copy_text ("1 "); endif; set (margins, current_buffer,2,66); if mark(none) = end_of (current_buffer) then copy_text ("1 "); endif; return (1); endif; endif; ! .COM file section if file_extension = ".COM" then ! NOTE: Prompting is currently patched out by... PROMPT_FLAG := 0; if prompt_flag = 1 then message (" File " + buffer_name + ""); question_answer := eve$insist_y_n (" Do you want " + wpe$x_facility_name + " to tailor this buffer for " + "editing .COM files? [Yes] "); else message (" Tailoring " + wpe$x_facility_name + " to edit .COM file "); question_answer := 1; endif; if question_answer = 1 then set (key_map_list, wpe$x_dcl_key_map_list ); return (1); endif; endif; ! .FOR file section if file_extension = ".FOR" then if mark(none) = end_of (current_buffer) then copy_text ("C "); return (0); endif; endif; ! If we don't find anything, return 0 return (0); endprocedure !<><><><><><><><><><><><> ! Find out if there are lines longer than 80. ! This is efficient, but it effectively counts characters. Since ! a tab counts for 1 character, it will not find "long lines" which ! are long because they contain tabs. ! If it's important to really find long lines, then look at ! using a loop, ! position(search(line_end,forward) ! get_info(current_buffer,"offset_column") ! etc. ! but.... this would take a comparatively long time to run. ! procedure wpe_find_long_line local long_line, entry_mark, set_left, set_right, top_range, buffer_name, question_answer, present_width; on_error ! return; endon_error present_width := get_info (screen,"width"); if present_width < 81 then buffer_name := get_info (current_buffer, "name"); set_right := get_info (current_buffer, "right_margin"); set_left := get_info (current_buffer, "left_margin"); entry_mark := mark (none); position ( beginning_of( current_buffer)); long_line := search (wpe$x_long_line, forward); position (entry_mark); if long_line <> 0 then Message (" File " + buffer_name + ""); question_answer := eve$insist_y_n (" You have lines longer than 80 characters. " + "Go to 132-column screen? [Yes] "); if question_answer = 1 then set (width, eve$main_window, 132); set (width, eve$top_window, 132); set (width, eve$bottom_window, 132); ! If somebody (wpe_special_files) has already changed ! the right margin, don't reset anything. if set_right = 79 then set (margins, current_buffer, set_left, 131); endif; endif; endif; endif; endprocedure !<><><><><><><><><><><><> ! Either EXIT or QUIT, depending on the Journal setting of the ! command line running WPE procedure wpe_getout ! If the command line is /NoJournal (used for the MORE command), ! we do a QUIT. Note that the read_only parameter is NOT usually ! used, as this allows us to use Gold W to save the results ! anyway. local b_modified, ! Info from get_info b_no_write, b_permanent, b_system, this_buffer, x_index, this_short_name, next_short_name, present_width, long_line, question_answer; on_error ! eve_exit; endon_error if wpe$x_facility_name = "WPE" then ! Yes eve_exit; else if wpe$x_wild_file = 0 then ! Not a wildcard eve_quit; ! NoJournal else ! Protect against earlier file_search with same file name. wpe$x_next_file_name := file_search (eve$kt_null); if wpe$x_reallywild_file = 1 then ! This is fairly simple loop wpe$x_next_file_name := file_search (wpe$x_entry_file_name); exitif wpe$x_next_file_name = ""; exitif wpe$x_next_file_name = wpe$x_this_file_name; endloop; else ! We have to account for the fact that a Write_File may ! have been done, which would result in a higher version. ! NOTE: Pathologically, the really wild search will fail ! if the file limit is set to one version - but we're ! going to live with that..... x_index := index (wpe$x_this_file_name, ';'); this_short_name := substr (wpe$x_this_file_name, 1, x_index -1); loop wpe$x_next_file_name := file_search (wpe$x_entry_file_name); exitif wpe$x_next_file_name = ""; x_index := index (wpe$x_next_file_name, ';'); next_short_name := substr (wpe$x_next_file_name, 1, x_index -1); exitif next_short_name = this_short_name; endloop; endif; ! We either match, or ran out of files if wpe$x_next_file_name <> "" then ! Set up to do another one. wpe$x_next_file_name := file_search (wpe$x_entry_file_name); endif; if wpe$x_next_file_name <> "" then ! Set up to do another one. ! Can we write the current buffer? ! If so, give them one more chance. b_modified := get_info (current_buffer, "modified"); b_no_write := get_info (current_buffer, "no_write"); if (b_modified = 1) and (b_no_write = 0) then ! May write question_answer := eve$insist_y_n (" Buffer modifications will not be saved," + " continue quitting (Y or N)? "); if question_answer <> 1 then return (0); endif; endif; ! How about unmapping it? ! If we're doing 2 windows, etc., assume we want to keep it. if current_window = eve$main_window then b_permanent := get_info (current_buffer, "permanent"); b_system := get_info (current_buffer, "system"); if (b_permanent + b_system) = 0 then ! OK to delete ! Only the "editing" buffers will fit this criterion this_buffer := current_buffer; ! We gotta be somewhere position (eve$choice_buffer); erase (eve$choice_buffer); map (current_window, eve$choice_buffer); delete (this_buffer); endif; endif; ! Now, get the next file wpe$x_previous_file_name := wpe$x_this_file_name; wpe$x_this_file_name := wpe$x_next_file_name; wpe_get_file (wpe$x_this_file_name); ! Now check for long lines present_width := get_info (screen,"width"); if present_width > 80 then ! This is not first long-line buffer. if wpe_special_files(1) <> 1 then ! Prompting mode ! No special files long_line := search (wpe$x_long_line, forward); if long_line <> 0 then set (margins, current_buffer,1,131); else ! It was set 131 by wpe_get_file. ! Reset it to 79 for sanity. set (margins, current_buffer,1,79); endif; endif; else ! See if this is first long-line buffer. wpe_special_files(1); ! Prompting mode wpe_find_long_line; endif; else eve_quit; ! NoJournal endif; endif; endif; endprocedure !<><><><><><><><><><><><> ! Either EXIT or QUIT, depending on the Journal setting of the ! command line running WPE. We need this to take care of ! the Gold K key when running WPE. procedure wpe_quit ! If we are doing WPE, just Quit. Otherwise, we need to go thru ! the wpe_getout routine to decide what to do. if wpe$x_facility_name = "WPE" then ! Yes eve_quit; else wpe_getout; endif; endprocedure !<><><><><><><><><><><><> ! Show buffers (redefine DO key first) ! ! procedure wpe_show wpe_redefine_key("eve_do ('')", do, " do", "wpe_showkey_do1"); wpe_redefine_key("eve_do ('')", key_name ('[', shift_key), " do", "wpe_showkey_do2"); eve_show; wpe_restore_key("wpe_showkey_do1"); wpe_restore_key("wpe_showkey_do2"); eve$check_bad_window; endprocedure !<><><><><><><><><><><><> ! Remember (redefine DO key first) ! (Ctrl_R key for EVE Learn sequence) ! procedure wpe_remember wpe_redefine_key("eve_do ('')", do, " do", "wpe_remkey_do1"); wpe_redefine_key("eve_do ('')", key_name ('[', shift_key), " do", "wpe_remkey_do2"); eve_remember; wpe_restore_key("wpe_remkey_do1"); wpe_restore_key("wpe_remkey_do2"); endprocedure !<><><><><><><><><><><><> ! ! Top-level WPE find command. Calls eve_find, as does the replace command. ! The two commands have slightly different requirements, so they both ! call eve$find and pass it a parameter to indicate the caller. ! ! Parameters: ! ! target String to find - input procedure wpe_find (target) local find_command, local_target; local_target := target; ! Define the comment for find keys, so eve_find will work. wpe_redefine_key("wpe_find ('')", key_name (',', shift_key), " find", "wpe_fndkey_srch"); wpe_redefine_key("wpe_find ('')", e1, " find", "wpe_fndkey_e1"); if local_target = eve$kt_null then if current_direction = forward then find_command := "Forward Find: "; else find_command := "Reverse Find: "; endif; wpe_get_command_string (find_command, "find", eve$x_target, local_target); endif; if local_target <> eve$kt_null then eve_find (local_target); endif; ! Restore the comment for these keys wpe_restore_key("wpe_fndkey_srch"); wpe_restore_key("wpe_fndkey_e1"); endprocedure; !<><><><><><><><><><><><> ! ! Top-level WPE global replace command. ! call eve$find and pass it a parameter to indicate the caller. ! ! Parameters: ! ! target String to find - input ! substitution - dummy parameter procedure wpe_eve_replace (target, substitution) local find_command, this_position, quoted_position, quoted_target, local_target; on_error endon_error; local_target := target; ! Take a stab at getting quotes right if index (eve$x_target, " ") <> 0 then ! Must quote due to space if index (eve$x_target, '"') <> 0 then quoted_target := "'" + eve$double_quotes(eve$x_target) + "' "; else quoted_target := '"' + eve$x_target + '" '; endif; else ! Ths should do it (except pathological cases) if index (eve$x_target, '"') <> 0 then quoted_target := "'" + eve$double_quotes(eve$x_target) + "' "; else if index (eve$x_target, "'") <> 0 then quoted_target := '"' + eve$x_target + '" '; else quoted_target := eve$x_target; endif; endif; endif; ! Now, see if we can find a match in the command buffer: this_position := mark(none); position (beginning_of (eve$command_buffer)); quoted_position := search (quoted_target, forward, exact); if quoted_position <> 0 then position (quoted_position); quoted_target := substr (current_line, (current_offset + 1), (length(current_line) - current_offset)); endif; position (this_position); find_command := "Old string: "; wpe_get_command_string (find_command,"replace", quoted_target, local_target); if local_target = eve$kt_null then return; else eve_replace (local_target,""); endif; endprocedure; !<><><><><><><><><><><><> ! ! Fakes out the command handler to prompt for something else. ! Parameters: prompt_string, ! command_string (the real EVE command) ! recall_string (response to "move_up" key), ! result_string. ! Designed to handle "find" and "replace", but will ! work for other stuff. procedure wpe_get_command_string (prompt_string, command_string, recall_string, result_string) local what_key, temp_position, new_string; loop new_string := read_line (prompt_string); message (eve$kt_null); ! Clear previous message. if new_string = eve$kt_null then what_key := eve$lookup_comment (last_key); if (what_key = "wpe move_up") or (what_key = "wpe recall" ) then if get_info (recall_string, eve$kt_type) = string then if recall_string <> eve$kt_null then ! Do the recall temp_position := mark (none); eve$enter_command_window; copy_text (command_string + " " + recall_string); position (end_of (eve$command_buffer)); eve_recall; message (eve$kt_null); ! clear out message window exitif 1; ! else message ("Nothing to recall"); endif; else message ("Nothing to recall"); endif; else if what_key = "find" then if get_info (recall_string, eve$kt_type) = string then if recall_string <> eve$kt_null then new_string := recall_string; exitif 1; else message ("Nothing to recall"); endif; else message ("Nothing to recall"); endif; else exitif 1; endif; endif; else exitif 1; endif; endloop; result_string := new_string; endprocedure !<><><><><><><><><><><><> ! Procedure invoked by the Return key. If we recognize the file ! type, split the line (obeying margin settings) and put in an appropriate ! line beginning. ! NOTE: Currently recognizes only .FOR files. ! .COM files are handled by WPE_DCL_RETURN. procedure wpe_return local file_extension, ! Type of file. starting_col, ! Where did we start? left_margin; ! Left margin of current buffer ! Disregard end-of-buffer errors, etc. on_error endon_error; if current_window = eve$command_window then eve$exit_command_window; else starting_col := current_offset + 1; if starting_col > length(current_line) then ! Lock it out starting_col := 99999; endif; eve_return; ! Regardless left_margin := get_info (current_buffer, "left_margin"); if left_margin = 1 then ! Otherwise, don't mess with it. ! Note: use the buffer name, not the file name. ! New (created) files or buffers don't have file_name. file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); if file_extension = ".FOR" then if starting_col = 1 then move_horizontal (-1); endif; copy_text (" "); ! Tab endif; else if left_margin = 2 then ! It's a .HLP file (maybe) if starting_col = 1 then move_horizontal (-1); erase_character (1); ! EVE put in one space move_horizontal (-1); copy_text (" "); ! One space endif; endif; endif; endif; endprocedure; !<><><><><><><><><><><><> ! Procedure invoked by the Return key. If we recognize the file ! type, split the line (obeying margin settings) and put in an appropriate ! comment line beginning. Otherwise, put out a message. procedure wpe_gold_return local file_extension, ! Type of file. comment_char, ! not null if we're doing a comment. starting_col, ! Where did we start? left_margin; ! Left margin of current buffer ! Disregard end-of-buffer errors, etc. on_error endon_error if current_window = eve$command_window then eve$exit_command_window; else comment_char := ""; ! Note: use the buffer name, not the file name. ! New (created) files or buffers don't have file_name. file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); if (file_extension = ".TPU") or (file_extension = ".HLP") then comment_char := "! "; else if file_extension = ".FOR" then comment_char := "C "; endif; endif; if comment_char <> "" then starting_col := current_offset + 1; if starting_col > length(current_line) then ! Lock it out starting_col := 99999; endif; eve_return; left_margin := get_info (current_buffer, "left_margin"); if left_margin <> 1 then move_horizontal (- current_offset); if starting_col = 1 then ! EVE put in spaces for margin erase_character (left_margin - 1); endif; endif; if starting_col = 1 then move_horizontal (-1); else if starting_col = left_margin then ! It's probably a .HLP file move_vertical (-1); if current_character = " " then erase_character(1); else move_vertical (1); endif; endif; endif; copy_text (comment_char); else message ("Para Marker is not implemented in WPE"); endif; 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. ! ! Borrowed and modified from EVEPlus ! procedure wpe_display_character local a_index, this_character, ! Copy of current_character control_character; ! Control string if warranted ! Handle end-of-buffer condition if mark( none ) = end_of( current_buffer ) then message( 'At end of buffer, no current character.' ); return; endif; this_character := current_character; ! Convert the character to an integer the hard way (no builtin yet) a_index := 0; loop exitif a_index > 255; exitif this_character = ascii(a_index); a_index := a_index + 1; endloop; if a_index > 255 then a_index := 0; ! on overflow, reset to null endif; ! Translate the character this_character := '' + wpe_translate_char (this_character) + ''; ! Provide ^ notation for ascii control characters if a_index < 32 then control_character := '^' + ascii(a_index+64) + ''; else control_character := ''; endif; ! Format and output the results message( fao( "Current character is !AS " + "Decimal = !UB, " + "Octal = !-!OB, " + "Hex = !-!XB !AS", this_character, a_index, control_character ) ); endprocedure; ! wpe_display_character !<><><><><><><><><><><><> ! ! This procedure translates control characters to readable characters. ! The output (return code only) is either the single-character ! input (unchanged), or a several-char symbol. Note that the ! character is not changed. ! ! The characters handled are 0-32, 127-159. ! 33 thru 126 and 160 thru 255 are passed through unchanged. ! ! Borrowed and modified from EVEPlus ! procedure wpe_translate_char (char) local t_char; ! Translated character ! The backwards questions mark is the placeholder for control characters ! from ASCII(0) thru ASCII(31) on the VT2xx series of terminals case char from '' to '' ! 0 to 159 ! 0 thru 7 [''] : t_char := '{NUL}'; [''] : t_char := '{SOH}'; [''] : t_char := '{STX}'; [''] : t_char := '{ETX}'; [''] : t_char := '{EOT}'; [''] : t_char := '{ENQ}'; [''] : t_char := '{ACK}'; [''] : t_char := '{BEL}'; ! 8 thru 15 [''] : t_char := '{BS}'; [' '] : t_char := '{HT}'; [' '] : t_char := '{LF}'; [' '] : t_char := '{VT}'; [' '] : t_char := '{FF}'; [' '] : t_char := '{CR}'; [''] : t_char := '{SO }'; [''] : t_char := '{SI }'; ! 16 thru 23 [''] : t_char := '{DLE}'; [''] : t_char := '{DC1 }'; [''] : t_char := '{DC2}'; [''] : t_char := '{DC3 }'; [''] : t_char := '{DC4}'; [''] : t_char := '{NAK}'; [''] : t_char := '{SYN}'; [''] : t_char := '{ETB}'; ! 24 thru 31 [''] : t_char := '{CAN}'; [''] : t_char := '{EM}'; [''] : t_char := '{SUB}'; [''] : t_char := '{ESC}'; [''] : t_char := '{FS}'; [''] : t_char := '{GS}'; [''] : t_char := '{RS}'; [''] : t_char := '{US}'; ! 32 (space) [' '] : t_char := '{SPace}'; ! 127 [''] : t_char := '{DEL}'; ! 128 thru 135 [''] : t_char := '{128}'; [''] : t_char := '{129}'; [''] : t_char := '{130}'; [''] : t_char := '{131}'; [''] : t_char := '{IND}'; [''] : t_char := '{NEL}'; [''] : t_char := '{SSA}'; [''] : t_char := '{ESA}'; ! 136 thru 143 [''] : t_char := '{HTS}'; [''] : t_char := '{HTJ}'; [''] : t_char := '{VTS}'; [''] : t_char := '{PLD}'; [''] : t_char := '{PLU}'; [''] : t_char := '{RI}'; [''] : t_char := '{SS2}'; [''] : t_char := '{SS3}'; ! 144 thru 151 [''] : t_char := '{DCS}'; [''] : t_char := '{PU1}'; [''] : t_char := '{PU2}'; ! WARNING: SENDING CHARACTER 147 (STS) MAY BE DANGEROUS ! YOUR SESSION ON THE COMPUTER. [''] : t_char := '{STS}'; [''] : t_char := '{CCH}'; [''] : t_char := '{MW}'; [''] : t_char := '{SPA}'; [''] : t_char := '{EPA}'; ! 152 and 159 [''] : t_char := '{152}'; [''] : t_char := '{153}'; [''] : t_char := '{154}'; [''] : t_char := '{CSI}'; [''] : t_char := '{ST}'; [''] : t_char := '{OSC}'; [''] : t_char := '{PM}'; [''] : t_char := '{APC}'; [INRANGE] : t_char := char; [OUTRANGE] : t_char := char ; endcase; return (t_char); endprocedure; !<><><><><><><><><><><><> ! WPE_WHAT_LINE - Displays a message with the current line number, ! total number of lines in the file, and the percentage. ! ! Idea (and some code) borrowed from EVEPlus ! procedure wpe_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 read_line_string; ! String read after prompt ! Initialization start_of_buffer := beginning_of (current_buffer); total_lines := get_info (current_buffer, "record_count") + 1; high_line := total_lines; if total_lines > 0 then this_position := mark (reverse); update (current_window); endif; 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; ! Display message and return to original position message (fao ("This is line !SL. " + "There are !SL lines in this buffer.", low_line, total_lines )); if total_lines > 0 then position (this_position); ! Now prompt for change of line. read_line_string := read_line (fao (" Go to Line [!SL]: ", low_line)); eve$cleanse_string (read_line_string); if read_line_string <> eve$kt_null then translate (read_line_string, "1", "l"); this_line := int (read_line_string); if (this_line = 0) and (read_line_string <> "0") then message (fao ("Don't understand !AS", read_line_string)); else if this_line <= 0 then message (fao ("Cannot move to line !SL", this_line)); else if this_line > total_lines then message (fao ( "Buffer has only !SL line!%S. Moving to line !-!SL.", total_lines)); position (beginning_of (current_buffer)); move_vertical (total_lines - 1); ! already at line 1 eve$position_in_middle (mark (none)); else position (beginning_of (current_buffer)); move_vertical (this_line - 1); ! already at line 1 eve$position_in_middle (mark (none)); message (eve$kt_null); endif; endif; endif; endif; delete (this_position); ! Get rid of marker endif; endprocedure; !<><><><><><><><><><><><> ! Finds matching token for the token at current_character ! Currently for () only ! procedure wpe_find_matching local key_pressed, end_offset, target_line; !globals: ! wpe$x_starting_token, ! Where we started ! wpe$x_ending_token; ! Where we finally quit if get_info (wpe$x_ending_token, "type") = marker then delete (wpe$x_ending_token); endif; if current_character <> "(" then message (" You must start at a '(' character"); if get_info (wpe$x_starting_token, "type") = marker then delete (wpe$x_starting_token); endif; return; else message (eve$kt_null); wpe$x_starting_token := mark(reverse); endif; if wpe_find_matching_paren then wpe$x_ending_token := mark(reverse); end_offset := current_offset; else delete (wpe$x_starting_token); message (" No matching ')' found"); return; endif; target_line := substr(current_line, 1, end_offset) + "" + substr(current_line, (end_offset + 1), 1) + "" + substr(current_line, (end_offset + 2), length(current_line)); message (target_line); position (wpe$x_starting_token); update (current_window); key_pressed := eve$prompt_key ("'X' erases marks, SELect moves to end mark, " + "any other key returns to editing"); if ((key_pressed = period) or (key_pressed = e4)) then position (wpe$x_ending_token); else if ((key_pressed = key_name("x")) or (key_pressed = key_name("X"))) then delete (wpe$x_ending_token); delete (wpe$x_starting_token); endif; endif; endprocedure; !<><><><><><><><><><><><> ! Finds matching ) for the ( at current_character ! procedure wpe_find_matching_paren local next_close, ! Marks next closing paren next_open, ! Marks next open paren next_close_mark, next_open_mark, temp_mark; on_error ! Ignore search fails endon_error; loop move_horizontal (1); next_close := search (")",forward); if next_close = 0 then ! message (" No matching ')' found"); return (0); else temp_mark := mark(none); position (next_close); next_close_mark := mark(none); position (temp_mark); endif; next_open := search ("(",forward); if next_open <> 0 then position (next_open); next_open_mark := mark(none); if next_open_mark < next_close_mark then ! Do wpe_find_matching_paren (recursively). If it succeeds, ! continue with the loop. Otherwise, return error. if (not wpe_find_matching_paren) then return (0); endif; else position (next_close); exitif 1; endif; else position (next_close); exitif 1; endif; endloop; return (1); endprocedure; !<><><><><><><><><><><><> ! procedure wpe_toggle_windows ! F18 toggles between 1 & 2 windows if eve$x_number_of_windows = 1 then eve_two_windows; else eve_one_window; endif; endprocedure; !<><><><><><><><><><><><> ! procedure wpe_signature ! @ inserts signature file ! ! Insert sys$login:signature.wpe at current location in text. ! local l_offset, l_margin, put_here; on_error return; endon_error; if current_buffer = eve$command_buffer then return; ! too complex to worry with endif; l_margin := get_info (current_buffer, "left_margin"); l_offset := get_info (screen, "current_column"); if l_offset > l_margin then move_horizontal (-current_offset); move_vertical (1); endif; put_here := mark (none); eve_include_file ('sys$login:signature.wpe'); position (put_here); endprocedure; !<><><><><><><><><><><><> ! procedure wpe_redefine_key ! Redefine a key, saving old definition ( new_pgm, ! Valid 1st argument (program) for define_key builtin default_key, ! Default key number (keyname - e.g., E4, ret_key) new_doc, ! Valid 3rd argument (help ptr) for define_key builtin key_string ) ! Global Name under which to store the old key, if nec. ! Plagiarized happily from EVEPlus, and bugs fixed by D.E.C. ! This procedure now depends on EVE$USER_KEYS being at the ! top of each key map list (the "right" way). ! ! 1) Determine if we have a user specified key; if not, use default. ! 2) Save the present definition & doc. of the user specified key. ! IFF the key is defined in EVE$User_Keys. ! 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!) ! ! The variable named 'key_string' will be set to the keynumber (name). ! The variable named 'key_string'_doc will be set as follows: ! ! Condition Contents of _doc ! Key not previously defined ~none~ ! Key defined, not in EVE$USER_KEYS ~none~ ! Key defined in EVE$USER_KEYS Comment or null local old_pgm, ! Temporary old_keymap; on_error endon_error; wpe$x_dk := default_key; ! Make argument local wpe$x_savnm := key_string; ! Make argument local old_keymap := lookup_key (wpe$x_dk, KEY_MAP); if old_keymap = eve$x_user_keys then ! Previously defined in EVE$USER_KEYS ! Determine if we have a user specified key; if not, use default. if expand_name ( wpe$x_savnm, variables ) <> eve$kt_null then ! Previously known save area. execute ( 'if(get_info('+wpe$x_savnm+',"type")=integer)then ' +'wpe$x_dk:='+wpe$x_savnm+';' +'else ' +wpe$x_savnm+':=wpe$x_dk;' +'endif;' ); else ! First time through this routine for this save area. execute ( wpe$x_savnm+ ':= wpe$x_dk;' ); endif; ! The variable 'key_string' will contain the keyname (number) at this point. ! ! Save the present definition & doc. of the user specified key ! one exists. ! Key was defined as something (in EVE$USER_KEYS because of ! the if-statement at the top). execute( wpe$x_savnm +'_doc := lookup_key ( wpe$x_dk, comment);' +wpe$x_savnm +'_pgm := lookup_key ( wpe$x_dk, program);'); else ! Key was not defined in EVE$USER_KEYS - therefore, no sweat. execute ( wpe$x_savnm+ ':= wpe$x_dk;' ); execute( wpe$x_savnm +'_doc := "~none~";'); endif; ! Do a define key on the new key information define_key ( new_pgm, wpe$x_dk, new_doc, eve$x_user_keys); endprocedure !<><><><><><><><><><><><> ! procedure wpe_restore_key ( the_key ) ! Restore a saved key definition. ! Plagiarized happily from EVEPlus, and bugs fixed by D.E.C. ! ! This is the companion procedure to wpe_redefine_key, and restores the previous ! definition of a key saved during wpe_redefine_key. See wpe_redefine_key for ! more info. ! wpe$x_savnm ! Copy of name the key was saved under. ! wpe$x_dk ! used for keyname (number). on_error endon_error; wpe$x_savnm := the_key; ! Name of the save area execute ('wpe$x_dk := ' + wpe$x_savnm); ! Keyname (number) was saved there undefine_key (wpe$x_dk, eve$x_user_keys); if expand_name ( wpe$x_savnm+'_pgm', variables) <> eve$kt_null then execute ( 'if ' + wpe$x_savnm + '_doc<>"~none~" then define_key(' + wpe$x_savnm + '_pgm,wpe$x_dk,' + wpe$x_savnm + '_doc,eve$x_user_keys);endif;' ); endif; endprocedure !<><><><><><><><><><><><> ! ! The following procedure will put the keypad in numeric mode. ! eve_application must be used to put it back. ! ! Must begin with 'eve_' so the command parser will find it. ! procedure eve_numeric if wpe$x_num_keys_on = 1 then message ("The Keypad is already in numeric mode."); else wpe_redefine_key ("copy_text ('1')", kp1, " typing", "wpe_num_kp1"); wpe_redefine_key ("copy_text ('2')", kp2, " typing", "wpe_num_kp2"); wpe_redefine_key ("copy_text ('3')", kp3, " typing", "wpe_num_kp3"); wpe_redefine_key ("copy_text ('4')", kp4, " typing", "wpe_num_kp4"); wpe_redefine_key ("copy_text ('5')", kp5, " typing", "wpe_num_kp5"); wpe_redefine_key ("copy_text ('6')", kp6, " typing", "wpe_num_kp6"); wpe_redefine_key ("copy_text ('7')", kp7, " typing", "wpe_num_kp7"); wpe_redefine_key ("copy_text ('8')", kp8, " typing", "wpe_num_kp8"); wpe_redefine_key ("copy_text ('9')", kp9, " typing", "wpe_num_kp9"); wpe_redefine_key ("copy_text ('0')", kp0, " typing", "wpe_num_kp0"); wpe_redefine_key ("copy_text ('-')", minus, " typing", "wpe_num_minus"); wpe_redefine_key ("copy_text (',')", comma, " typing", "wpe_num_comma"); wpe_redefine_key ("copy_text ('.')", period, " typing", "wpe_num_period"); wpe_redefine_key ("wpe_return", enter, "wpe return", "wpe_num_enter"); wpe$x_num_keys_on := 1; message ("The Keypad is now in numeric mode"); endif; endprocedure; !<><><><><><><><><><><><> ! ! The following procedure cancels the effect of eve_numeric. ! ! it must start with 'eve_' so the command parser will find it. ! procedure eve_application if wpe$x_num_keys_on = 0 then message ("The Keypad is already in application mode."); else wpe_restore_key ("wpe_num_kp1"); wpe_restore_key ("wpe_num_kp2"); wpe_restore_key ("wpe_num_kp3"); wpe_restore_key ("wpe_num_kp4"); wpe_restore_key ("wpe_num_kp5"); wpe_restore_key ("wpe_num_kp6"); wpe_restore_key ("wpe_num_kp7"); wpe_restore_key ("wpe_num_kp8"); wpe_restore_key ("wpe_num_kp9"); wpe_restore_key ("wpe_num_kp0"); wpe_restore_key ("wpe_num_minus"); wpe_restore_key ("wpe_num_comma"); wpe_restore_key ("wpe_num_period"); wpe_restore_key ("wpe_num_enter"); wpe$x_num_keys_on := 0; message ("The Keypad is now in application mode"); endif; endprocedure; !<><><><><><><><><><><><> ! ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! procedure wpe_list_buffers ! Build the buffer list local last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed mess_buffer, ! Pointer to MESSAGES entry_buffer, ! Name of buffer at entry temp; ! Used to build the record count as a string on_error ! Ignore "string not found" from search endon_error; entry_buffer := get_info(current_buffer, "name"); if entry_buffer <> "CHOOSE A BUFFER" then eve$check_bad_window; eve_buffer("CHOOSE A BUFFER"); endif; if (not (get_info (current_buffer, "system"))) then ! Just created it set(INSERT, current_buffer); set(system, current_buffer); set(no_write, current_buffer); set(eob_text, current_buffer, eve$kt_null); endif; erase(current_buffer); ! message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); mess_buffer := 0; loop exitif (the_buffer = 0); ! Get data for all non-system buffers if get_info (the_buffer, "system") = 0 then split_line; copy_text(" "); copy_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then copy_text(""); else loop exitif (current_offset > 33); copy_text(" "); endloop; endif; copy_text(temp); if (get_info(the_buffer, "modified")) then copy_text("Modified "); else copy_text(" "); endif; if (get_info(the_buffer, "no_write")) then copy_text("No-write "); else copy_text(" "); endif; if (get_info(the_buffer, "system")) then copy_text("System "); else copy_text(" "); endif; if (get_info(the_buffer, "permanent")) then copy_text("Permanent"); else copy_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); else if get_info (the_buffer, "name") = "MESSAGES" then mess_buffer := the_buffer; endif; endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; ! Add an entry for the Message buffer (last on the list) if mess_buffer <> 0 then split_line; copy_text(" "); copy_text("MESSAGES"); temp := fao("!6UL ", get_info(mess_buffer, "record_count")); loop exitif (current_offset > 33); copy_text(" "); endloop; copy_text(temp); copy_text(" System"); endif; ! Find split lines (if any) position(beginning_of(current_buffer)); loop temp := search ("", FORWARD); exitif (temp = 0); position(temp); erase(temp); copy_text(" -"); split_line; copy_text(" "); endloop; ! Do headings position(beginning_of(current_buffer)); copy_text(" Buffer name Lines Attributes"); split_line; ! ! Point to entry buffer (or first buffer in list) temp := search (entry_buffer, FORWARD); if temp <> 0 then ! It exists position(temp); else ! Position to first buffer in list. position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); endif; if (not wpe$buf_active) then ! set(informational,off); wpe_redefine_key("wpe_select_buffer", e4, "wpe select_buffer", "wpe_bufkey_e4"); wpe_redefine_key("wpe_select_buffer", period, "wpe select_buffer", "wpe_bufkey_period"); ! Both of the following are defined in case someone ! defines them otherwise in eve$user_keys. wpe_redefine_key("wpe_select_buffer", ret_key, "wpe buf_return", "wpe_bufkey_ret"); wpe_redefine_key("wpe_select_buffer", ret_key, "wpe buf_return", "wpe_bufkey_dclret"); ! set(informational,on); endif; wpe$buf_active := TRUE; message(" Move the cursor to the desired buffer." + " Then press SELECT or RETURN"); 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 keys. It only works in the ! "CHOOSE A BUFFER" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT keys, ! and executes the code originally associated with SELECT. ! ! Plagiarized happily from EVEPlus, and bugs fixed by D.E.C. ! ! procedure wpe_select_buffer ! Goto the buffer pointed to local the_name, ! Name of the buffer as a string previous_key, ! Last key pressed right_pgm, ! Program for the real key the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "CHOOSE A BUFFER") then ! message("You are not in the CHOOSE A BUFFER buffer"); previous_key := eve$lookup_comment (last_key); wpe_bufkey_restore; right_pgm := 0; if previous_key = "wpe select_buffer" then right_pgm := lookup_key ( e4, program); else if previous_key = "wpe buf_return" then right_pgm := lookup_key ( ret_key, program); endif; endif; if (get_info ( right_pgm, "type") = program) then execute( right_pgm); else message("You are not in the CHOOSE A BUFFER buffer"); endif; else if (wpe_get_the_buffer (the_name) <> 0) then eve_buffer(the_name); wpe_bufkey_restore; message (eve$kt_null); else message(" Move the cursor to the desired buffer." + " Then press SELECT or RETURN"); 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 reurns both the name of ! the buffer and a pointer to it. ! ! Plagiarized happily from EVEPlus, and bugs fixed by D.E.C. ! procedure wpe_get_the_buffer (the_name) ! Scan a buffer line local the_start, ! A mark pointing to the buffer name. the_buffer, ! Working buffer pointer. question_answer; the_name := ""; the_buffer := 0; if (get_info(current_buffer, "name") <> "CHOOSE A BUFFER") then ! We think it's impossible to get here, but just in case, ! provide a message for debugging. message("You are not in the CHOOSE A BUFFER buffer. " + "Can you remember how you got here?"); 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); ! From EVEPlus, ..the_buffer := wpe_find_buffer(the_name); ! This routine translates a buffer name to a buffer pointer 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; if (the_buffer = 0) then question_answer := eve$insist_y_n ("Buffer " + the_name + " does not exist. Create it? [Yes] "); if question_answer then the_buffer := (-1); ! Signal endif; endif; move_horizontal(2-current_offset); endif; endif; wpe_get_the_buffer := the_buffer; endprocedure; !<><><><><><><><><><><><> ! ! Fakes out the BUFFER handler to prompt for something else. procedure wpe_get_buffer_command local what_key, new_string; new_string := read_line ("Buffer name: "); message (eve$kt_null); ! Clear previous message. if new_string = eve$kt_null then what_key := eve$lookup_comment (last_key); if (what_key = "wpe move_up") or (what_key = "wpe recall" ) then wpe_list_buffers; else message ("Buffer not switched"); if wpe$buf_active then if (get_info(current_buffer, "name") <> "CHOOSE A BUFFER") then wpe_bufkey_restore; message (eve$kt_null); else ! Re-do the choose buffer display for sanity. wpe_list_buffers; endif; endif; endif; else if wpe$buf_active then ! Turn off buffer special keys wpe_bufkey_restore; message (eve$kt_null); endif; eve$check_bad_window; eve_buffer (new_string); if (get_info(current_buffer, "name") = "CHOOSE A BUFFER") then wpe_list_buffers; ! Operation failed. Turn it on again. endif; endif; endprocedure !<><><><><><><><><><><><> ! ! Collection of steps used by several routines to restore keys. ! procedure wpe_bufkey_restore ! set(informational,off); wpe_restore_key("wpe_bufkey_e4"); wpe_restore_key("wpe_bufkey_period"); wpe_restore_key("wpe_bufkey_ret"); wpe_restore_key("wpe_bufkey_dclret"); ! set(informational,on); wpe$buf_active := FALSE; endprocedure procedure wpe_dcl_return local top_exception, ! If we start at the top of the file comment_line, ! 1 if this is a comment line continuation_line; ! 1 if this is a continuation on_error endon_error; ! Disregard EOB errors, etc. if current_window = eve$command_window then eve$exit_command_window; else ! Recognize continuation only if not comment line continuation_line := 0; if substr ( current_line, 3, 1) <> "!" then if current_character = "-" then ! Continuation line is next continuation_line := 1; move_horizontal (1); else if current_offset <> 0 then move_horizontal (-1); if current_character = "-" then ! Continuation line is next continuation_line := 1; endif; move_horizontal (1); endif; endif; endif; if current_offset = 0 then ! Handle start-of-line if mark(none) = beginning_of(current_buffer) then top_exception := 1; else top_exception := 0; move_horizontal (-1); endif; endif; if get_info (current_buffer, eve$kt_offset_column) > get_info (current_buffer, eve$kt_right_margin) then ! We have a too-long line if continuation_line then eve$fill_line (0); copy_text (" "); ! HT space space else wpe_dcl_space (0); ! This will insert a continuation ! mark and HT space space or... wpe_dcl_return; ! Recursion endif; else ! Normal condition split_line; if top_exception = 1 then move_horizontal (-1); endif; if continuation_line = 1 then copy_text (" "); ! HT space space else copy_text ("$ "); ! $ HT endif; endif; eve$show_first_line; endif; endprocedure; !<><><><><><><><><><><><> ! Space key for .COM editor ! ! Procedure bound to the space bar. Inserts a space and does continuation ! word wrap based on the margin settings. ! ! Plagiarized from procedure eve$fill_line (insert_space) ! ! Parameters: ! ! insert_space If true, insert a space at the end of the ! filled line - normally 1, but 0 is used ! by wpe_dcl_return. ! procedure wpe_dcl_space (insert_space) local this_buffer, ! Current buffer left_margin, ! Left margin of this_buffer right_margin, ! Right margin of this_buffer space_position, ! Marker for current cursor position this_column, ! Current column hot_column, ! Column at start of hot zone words, ! Number of words in hot zone line_position, ! Previous position in current line spaces, ! Number of spaces between words comment_line, ! True if this is a comment line start_of_line; ! Column at start of new line this_buffer := current_buffer; left_margin := get_info (this_buffer, eve$kt_left_margin); right_margin := get_info (this_buffer, eve$kt_right_margin); if (right_margin - left_margin) <= eve$x_hot_zone_size then hot_column := right_margin; else hot_column := right_margin - eve$x_hot_zone_size; endif; space_position := mark (none); this_column := get_info (this_buffer, eve$kt_offset_column); ! Just do like a space bar, if appropriate if (this_column <= hot_column) or (this_buffer = eve$command_buffer) then if insert_space then copy_text (" "); endif; return; endif; ! Otherwise, we may need to do something if substr ( current_line, 3, 1) = "!" then comment_line := 1; else comment_line := 0; endif; right_margin := right_margin + 1; line_position := mark (none); loop this_column := get_info (this_buffer, eve$kt_offset_column); exitif this_column <= right_margin; line_position := mark (none); spaces := 0; exitif eve$start_of_word = 0; spaces := eve$backup_over_whitespace; words := words + 1; endloop; ! No sense splitting at the beginning of the line this_column := get_info (this_buffer, eve$kt_offset_column); if this_column = left_margin then position (line_position); endif; erase_character (spaces); if comment_line then split_line; if insert_space then copy_text ("$ ! "); ! If continued due to a space else copy_text ("$ ! "); ! If return was pressed endif; else copy_text (" -"); split_line; if left_margin > 1 then eve$to_column (left_margin); endif; copy_text (" "); ! HT, 2 spaces endif; start_of_line := get_info (this_buffer, eve$kt_offset_column); position (space_position); this_column := get_info (this_buffer, eve$kt_offset_column); if this_column > right_margin then if words > 1 then wpe_dcl_space (insert_space); ! Recursion else if comment_line then split_line; copy_text ("$ ! "); else copy_text (" -"); split_line; if left_margin > 1 then eve$to_column (left_margin); endif; copy_text (" "); ! HT, 2 spaces endif; endif; endif; endprocedure; !<><><><><><><><><><><><> ! Delete key for .COM editor ! If on FIRST tab, then delete it and put in 1 space. ! Allows for backing up to put in a label. procedure wpe_dcl_delete local this_position, ! Marker for current cursor position this_column, ! Current column info_type, ! 1 if integer, 2 if string tab_settings; ! If we don't mark this position now we'll get funny results later ! if cursor is beyond end of line this_position := mark (none); if current_window = eve$command_window then if get_info (current_buffer, eve$kt_offset_column) <= (eve$x_command_prompt_length + 1) then return; endif; endif; this_column := get_info (current_window, "current_column"); tab_settings := get_info (current_buffer, 'tab_stops'); info_type := get_info (tab_settings, 'type'); if info_type = 1 then ! Integer - Tabs every n if this_column = (tab_settings + 1) then move_horizontal (-1); if current_character = " " then ! HT erase_character (1); copy_text (" "); else move_horizontal (1); wpe_delete; endif; else wpe_delete; endif; endif; if info_type = 2 then ! String - tabs at nn nn if substr(tab_settings, 2, 1) = " " then tab_settings := int( substr(tab_settings, 1, 1)); else tab_settings := int( substr(tab_settings, 1, 2)); endif; if this_column = tab_settings then move_horizontal (-1); if current_character = " " then ! HT erase_character (1); copy_text (" "); else move_horizontal (1); wpe_delete; endif; else wpe_delete; endif; endif; endprocedure !<><><><><><><><><><><><> procedure wpe_dcl_delete_word ! This might be called "delete DCL token". ! Method: ! Fully tailored for .COM files, etc. ! Delete current character & all characters to the right through ! end of white space (if on white space, delete only white space). ! Stop at end of line, and do not wrap (unless at end of line). ! Stop if special characters are encountered, and do not erase them. ! Put erased stuff in restore buffer. local start_delete_word, ! Marker for beginning of word end_delete_word, ! Marker for end of word begin_char, ! Character at entry to this procedure pair_index, ! Position of paired character on_space, ! Indication that term. is space white_space, ! Between-word spaces to erase delete_word_range; ! Range for word if current_window = eve$command_window then move_horizontal (1); if mark (none) = end_of (current_buffer) then move_horizontal (-1); return else move_horizontal (-1); endif; endif; if mark (none) = end_of (current_buffer) then return; endif; if current_offset <> length (current_line) then ! save current character if it's paired - ({['" pair_index := index(wpe$x_paired_dcl_term_char, current_character); if pair_index <> 0 then begin_char := substr (wpe$x_dcl_term_char, pair_index, 1); else begin_char := ''; endif; start_delete_word := mark (none); if index (eve$x_whitespace, current_character) <> 0 then on_space := 1; else on_space := 0; endif; ! Go from here to terminator: loop move_horizontal (1); exitif on_space = 1; exitif mark(none) = end_of (current_buffer); if index (eve$x_whitespace, current_character) <> 0 then on_space := 1; exitif 1; endif; exitif index (wpe$x_dcl_term_char, current_character) <> 0; endloop; if on_space = 1 then loop exitif mark(none) = end_of (current_buffer); exitif index (eve$x_whitespace, current_character) = 0; move_horizontal (1); exitif current_offset = length (current_line); endloop; endif; ! If there is something, the back up - unless we are "paired" ! with the initial character. (e.g., we want to delete all of ! things like [xxxxx] if we start at the [ ). if mark(none) <> end_of (current_buffer) then if current_character <> begin_char then if length (current_line) <> 0 then move_horizontal (-1); endif; endif; else move_horizontal (-1); endif; end_delete_word := mark (none); delete_word_range := create_range (start_delete_word, end_delete_word, none); position (start_delete_word); eve$x_restore_text := erase_character (length (delete_word_range)); eve$x_restoring_line := 0; else move_horizontal (-current_offset); move_vertical (1); append_line; endif; endprocedure !<><><><><><><><><><><><> ! Gold-Return for .COM editor. ! Start comment line: dollar sign, space, !, space ! procedure wpe_dcl_gold_return wpe_dcl_return; erase_character (-1); copy_text (" ! "); endprocedure !<><><><><><><><><><><><> ! We need to intercept the HELP key, so that we can make sure the ! key_map_list and keys are correct. ! procedure wpe_help (topic) local current_keymap, help_keymap; current_keymap := get_info (current_buffer, "key_map_list"); help_keymap := get_info (help_buffer, "key_map_list"); if current_keymap <> help_keymap then set (key_map_list, current_keymap, help_buffer); wpe_eve_key_restore; eve_help (topic); wpe_wpe_key_restore; set (key_map_list, help_keymap, help_buffer); else wpe_eve_key_restore; eve_help (topic); wpe_wpe_key_restore; endif; endprocedure !<><><><><><><><><><><><> ! Procedure to display keypad-oriented help. Called by eve_help. ! The call passes through eve$help_keypad (in wpe.tpu), which ! supersedes the one in EVE. procedure wpe$help_keypad local help_char, ! Keyword of key to provide help on which_topic, ! String with help library subtopic which_diagram, ! Which one to_be_ignored; ! Key-name of the stroke to be ignored ! Globals used: ! wpe$x_showing_diagram, ! 1 if currently displaying keypad diagram ! wpe$x_which_diagram, ! Which one ("main" or "a",...) ! wpe$x_diagram_topic, ! Set text mode so we can do line-drawings and text enhancements set (text, current_window, no_translate); set (timer, on, wpe$x_facility_name); set (status_line, info_window, reverse, " Help buffer"); ! Un-redefine the keys so we know what we're doing ! wpe_wpe_key_restore; ! ! Display the main diagram, and get a key wpe_help_select_keyboard (help_char, which_topic); loop ! What do we display? if substr (which_topic, 1, 3) = "wpe" then if substr (which_topic, 1, 5) <> "wpe _" then ! Not diagram wpe$x_showing_diagram := 0; else wpe$x_showing_diagram := 1; endif; eve$help_text (which_topic); else if which_topic = '?' then wpe_eve_key_restore; eve_help ("commands"); ! eve_help (called recursively) will have unmapped the ! info window. Put things back the way they were. erase (help_buffer); map (info_window, help_buffer); set (status_line, info_window, reverse, " Help buffer "); update (info_window); wpe_wpe_key_restore; wpe$x_showing_diagram := 0; else eve$help_text ("eve " + which_topic); wpe$x_showing_diagram := 0; endif; endif; ! Prompt for next thing help_char := eve$prompt_key ("Press key that you want help on " + "(Help for diagram, Return to leave help): "); if help_char = to_be_ignored then to_be_ignored := FALSE; else which_topic := eve$lookup_comment (help_char); exitif which_topic = "wpe return"; exitif which_topic = "return"; exitif which_topic = "wpe dcl_return"; exitif which_topic = "wpe buf_return"; if which_topic = "wpe help" then if wpe$x_which_diagram = "main" then ! Can't be showing diagram wpe_help_select_keyboard (help_char, which_topic); else if wpe$x_showing_diagram = 1 then ! Want to see keyboard wpe_help_select_keyboard (help_char, which_topic); else which_topic := wpe$x_diagram_topic; ! To display sub-menu endif; endif; endif; endif; if which_topic = eve$kt_null then if eve$alphabetic (help_char) <> eve$kt_null then which_topic := "typing"; else which_topic := "unknown"; endif; endif; endloop; set (timer, on, wpe$x_facility_name + " Working"); set (text, current_window, blank_tabs); wpe_eve_key_restore; endprocedure; !<><><><><><><><><><><><> ! Procedure to display keyboard, and get a selection from the user. ! This allows a selection of keypad diagrams, etc. ! ! Entered ONLY when we want to unconditionally paint the main keyboard ! select menu, and exits with menu displayed, etc.) ! procedure wpe_help_select_keyboard (help_char, which_topic) local help_char, ! Keyword of key to provide help on which_topic, ! String with help library subtopic to_be_ignored; ! Key-name of the stroke to be ignored ! Globals used: ! wpe$x_showing_diagram, ! 1 if currently displaying keypad diagram ! wpe$x_which_diagram, ! Which one ("main" or "a",...) ! wpe$x_diagram_topic ! The string to sent to HELP ! The user has valid choices of A, K, F, G, C, E, W, and S. ! A - Arrow keypad (choice displayed only for VT200) ! K - Keypad (VT100 or VT200) ! F - Function Keys (choice displayed only for VT200) ! G - Gold Key commands ! C - Ctrl_ commands ! E - EVE commands ! W - WPE special commands (choice displayed only for VT200) ! S - Special commands (choice displayed only for VT100) on_error endon_error wpe$x_showing_diagram := 1; wpe$x_which_diagram := "main"; if eve$x_vt200_keypad then wpe$x_diagram_topic := "wpe __ VT200_MENU"; else wpe$x_diagram_topic := "wpe _, VT100_MENU"; endif; eve$help_text (wpe$x_diagram_topic); ! Now, we are displaying the main menu diagram. ! Prompt for a key help_char := eve$prompt_key ("Press the key you want help on: "); ! Decide what action is required: ! If a,k,f,g,e,w, or s, then we know about a screen ! Otherwise, we don't handle it - just pass it on. if help_char = to_be_ignored then to_be_ignored := FALSE; else which_topic := eve$lookup_comment (help_char); if which_topic = eve$kt_null then if eve$alphabetic (help_char) <> eve$kt_null then which_topic := "typing"; ! If we don't change it if (help_char = key_name("a")) or (help_char = key_name("A")) then which_topic := "wpe _`"; ! A = Arrow wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "a"; else if (help_char = key_name("k")) or (help_char = key_name("K")) then ! ! K = Keypad if eve$x_vt200_keypad then which_topic := "wpe __"; else which_topic := "wpe _,"; endif; wpe$x_which_diagram := "k"; wpe$x_diagram_topic := which_topic; else if (help_char = key_name("f")) or (help_char = key_name("F")) then which_topic := "wpe _."; ! F = Function wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "f"; else if (help_char = key_name("g")) or (help_char = key_name("G")) then which_topic := "wpe _-"; ! G = Gold wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "g"; else if (help_char = key_name("s")) or (help_char = key_name("S")) then which_topic := "wpe _'"; ! S = Special wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "s"; else if (help_char = key_name("w")) or (help_char = key_name("W")) then which_topic := "wpe _~"; ! W = WPE spec wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "w"; else if (help_char = key_name("c")) or (help_char = key_name("C")) then which_topic := "wpe _="; ! C = Ctrl_ wpe$x_diagram_topic := which_topic; wpe$x_which_diagram := "c"; else if (help_char = key_name("e")) or (help_char = key_name("E")) then which_topic := "?"; ! E = EVE cmds wpe$x_which_diagram := "main"; ! Signal endif; endif; endif; endif; endif; endif; endif; endif; else which_topic := "unknown"; endif; else if which_topic = "help" then which_topic := "wpe help"; endif; endif; endif; endprocedure; !<><><><><><><><><><><><> ! This procedure is a small modification of eve$init_files. We do this ! to allow handling wildcard files, because otherwise they are ! intercepted and rejected. ! Our changes to the original are bracketed by: ! -------- START MODIFICATION ! -------- END MODIFICATION ! -------- START MODIFICATION !! procedure eve$init_files procedure wpe$init_files ! -------- END MODIFICATION local output_file_name, ! Original output file name parsed_output_file_name, ! Full filespec for output file input_file_name_only, ! No node, disk, directory, or version ! -------- START MODIFICATION x_index, ! Index for ; x_string, ! Substring after ; w_index, ! Index for wildcard ! -------- END MODIFICATION opening_journal, ! True when we get to the journal stuff journal_error; ! True if can't parse journal file name on_error if error = tpu$_parsefail then if opening_journal = 0 then ! error in parsing output file message (fao ("Don't understand output file name: !AS", output_file_name)); else ! error in parsing journal file journal_error := 1; endif; endif; endon_error; ! Create a buffer using get_file ! -------- START MODIFICATION ! The following 3 lines are part of "global initialization", ! and are done for safety and sanity. In fact, they will be ! changed fairly quickly. wpe$x_wild_file := 0; wpe$x_reallywild_file := 0; wpe$x_this_file_name := ""; ! This is done here, rather than in tpu$local_init, because if we ! wait until later the message_window is repainted. At this point, ! it's empty. set (text, message_window, NO_TRANSLATE ); wpe$x_entry_file_name := get_info (command_line, "file_name"); ! Protect against earlier file_search with same file name. wpe$x_next_file_name := file_search (eve$kt_null); ! Check for Wildcard File Spec if eve$is_wildcard (wpe$x_entry_file_name) then wpe$x_wild_file := 1; wpe$x_this_file_name := file_search (wpe$x_entry_file_name); x_index := index (wpe$x_entry_file_name, ';'); if x_index > 0 then ! Possibly wild version ! Check for REALLY wild file spec (x.x;*) x_string := file_parse (wpe$x_entry_file_name, eve$kt_null, eve$kt_null, version); w_index := index (x_string, '*'); if w_index > 0 then wpe$x_reallywild_file := 1; else w_index := index (x_string, '%'); if w_index > 0 then wpe$x_reallywild_file := 1; else wpe$x_reallywild_file := 0; endif; endif; endif; else wpe$x_wild_file := 0; wpe$x_reallywild_file := 0; wpe$x_this_file_name := wpe$x_entry_file_name; endif; if get_info (command_line,"journal") = 1 then ! Yes ! Do it the way Eve originally had it (effectively no change) input_file := get_info (command_line, eve$kt_file_name); else input_file := wpe$x_this_file_name; ! Make wildcards legal endif; ! -------- END MODIFICATION eve$x_this_window := eve$main_window; if eve$main_window <> 0 then position(eve$main_window); if input_file = eve$kt_null then eve$set_status_line (current_window); else eve$enter_command_window; copy_text ("get file " + input_file); eve$exit_command_window; if (current_buffer <> main_buffer) and (current_window = eve$main_window) then delete (main_buffer); endif; endif; else position (main_buffer); endif; ! The output file should be written to the current directory by default ! unless there is another directory specified in the output_file_name. ! We also DON'T want the node, device or directory of the input file, just ! the name. if get_info (command_line, "output") <> 1 then set (no_write, current_buffer); else output_file_name := get_info (command_line, eve$kt_output_file); if output_file_name <> eve$kt_null then input_file_name_only := file_parse (input_file, eve$kt_null, eve$kt_null, name) + file_parse (input_file, eve$kt_null, eve$kt_null, type); parsed_output_file_name := file_parse (output_file_name, input_file_name_only); if parsed_output_file_name <> eve$kt_null then if eve$is_wildcard (parsed_output_file_name) then message (fao ("Can't create file: !AS", parsed_output_file_name)); else set (output_file, current_buffer, parsed_output_file_name); ! Want this buffer to be considered modified so it will ! be written on exit - for use especially with mail/edit split_line; append_line; endif; endif; endif; endif; ! Start journalling opening_journal := 1; if (get_info (command_line, "journal") = 1) and (get_info (command_line, "read_only") <> 1) then journal_file := get_info (command_line, "journal_file"); input_file_name_only := file_parse (get_info (current_buffer, eve$kt_file_name), eve$kt_null, eve$kt_null, name); if input_file_name_only = eve$kt_null then input_file_name_only := "tpu.tjl"; else input_file_name_only := input_file_name_only + ".tjl"; endif; journal_file := file_parse (journal_file, input_file_name_only); if journal_file = eve$kt_null then journal_file := file_parse (eve$kt_null, input_file_name_only); endif; if journal_error then message (fao ("Don't understand journal file name: !AS", journal_file)); else journal_open (journal_file); endif; endif; endprocedure !<><><><><><><><><><><><> ! Page 71 ! Edit a file in the current window. If the file is already in a buffer, ! use the old buffer. If not, create a new buffer. ! ! Parameters: ! ! get_file_parameter String containing file name - input ! This procedure is a small modification of eve_get_file. We do this ! to allow handling wildcard files, because otherwise they are ! not displayed on the status line with file version, and ! buffer changes sometimes fail ! Our changes to the original are bracketed by: ! -------- START MODIFICATION ! -------- END MODIFICATION ! -------- START MODIFICATION !! procedure eve_get_file (get_file_parameter) procedure wpe_get_file (get_file_parameter) ! -------- END MODIFICATION local get_file_name, ! Local copy of get_file_parameter temp_buffer_name, ! String for buffer name based on get_file_name file_search_result, ! Latest string returned by file_search temp_file_name, ! First file name string returned by file_search loop_buffer, ! Buffer currently being checked in loop file_count, ! Number of files matching the spec temp_answer, ! Answer to "Create file?" new_buffer, ! New buffer created if needed found_a_buffer, ! True if buffer found with same name want_new_buffer; ! True if file should go into a new buffer on_error if error = tpu$_parsefail then message (fao ("Don't understand file name: !AS", get_file_name)); if eve$x_starting_up then eve$set_status_line (current_window); endif; return; endif; endon_error; if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return; endif; if not (eve$prompt_string (get_file_parameter, get_file_name, "File to get: ", "No file specified")) then return; endif; ! Protect against earlier file_search with same file name. file_search_result := file_search (eve$kt_null); temp_file_name := eve$kt_null; erase (eve$choice_buffer); file_count := 0; loop file_search_result := file_search (get_file_name); exitif file_search_result = eve$kt_null; file_count := file_count + 1; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; if file_count > 1 then ! If get_file is called from eve$init_procedure, can't handle ! multiple choices, so set status line on main window and return if eve$x_starting_up then eve$set_status_line (current_window); endif; eve$display_choices (fao ("Ambiguous file name: !AS", get_file_name)); return; endif; ! Set-up to see if we already have a buffer by that name if temp_file_name = eve$kt_null then temp_buffer_name := file_parse (get_file_name, eve$kt_null, eve$kt_null, name) + file_parse (get_file_name, eve$kt_null, eve$kt_null, type); else ! -------- START MODIFICATION if wpe$x_reallywild_file <> 1 then ! Not wildcard version number ! -------- END MODIFICATION temp_buffer_name := file_parse (temp_file_name, eve$kt_null, eve$kt_null, name) + file_parse (temp_file_name, eve$kt_null, eve$kt_null, type); ! -------- START MODIFICATION else temp_buffer_name := file_parse (temp_file_name, eve$kt_null, eve$kt_null, name) + file_parse (temp_file_name, eve$kt_null, eve$kt_null, type) + file_parse (temp_file_name, eve$kt_null, eve$kt_null, version); endif; ! -------- END MODIFICATION endif; get_file_name := file_parse (get_file_name); ! Make sure we don't try to use a wildcard file-spec to create a new file. if file_count = 0 then if eve$is_wildcard (get_file_name) then message(fao("No files matching: !AS", get_file_name)); if eve$x_starting_up then eve$set_status_line (current_window); endif; return; endif; endif; loop_buffer := get_info (buffers, eve$kt_first); loop exitif loop_buffer = 0; if temp_buffer_name = get_info (loop_buffer, eve$kt_name) then found_a_buffer := 1; exitif 1; endif; loop_buffer := get_info (buffers, "next"); endloop; ! If there is a buffer by that name, is it the exact same file? ! If so, switch to that buffer. Otherwise use a new buffer, ! asking for a new buffer name (null new name will abort). if found_a_buffer then ! Have a buffer with the same name if temp_file_name = eve$kt_null then ! No file on disk if get_file_name = get_info (loop_buffer, eve$kt_output_file) then want_new_buffer := 0; else want_new_buffer := 1; endif; else ! Check to see if the same file if (temp_file_name = get_info (loop_buffer, eve$kt_output_file)) or (temp_file_name = get_info (loop_buffer, eve$kt_file_name)) then want_new_buffer := 0; else want_new_buffer := 1; endif; endif; if want_new_buffer then message (fao ("Buffer name !AS is in use", temp_buffer_name)); temp_buffer_name := read_line ("Type a new buffer name or press Return to cancel: "); if temp_buffer_name = eve$kt_null then message ("No new buffer created"); else new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); endif; else if current_buffer = loop_buffer then message (fao ("Already editing file !AS", get_file_name)); else map (current_window, loop_buffer); endif; endif; else ! No buffer with the same name, so create a new buffer new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); endif; if new_buffer <> 0 then set (eob_text, new_buffer, "[End of file]"); set (margins, new_buffer, eve$x_default_left_margin, get_info (current_window, eve$kt_width) - eve$x_default_right_margin); endif; ! Correct the status line in any event eve$set_status_line (current_window); endprocedure; !<><><><><><><><><><><><> ! Set current text lines per page parameter (CT) ! Note: this is named eve_ct so the command_line parser can ! handle it. procedure eve_ct (ct_old_length) local ct_requested; ! Local copy of ct parameter if not (eve$prompt_number (ct_old_length, ct_requested, "Enter Text Lines per Page (CT): ", "Current value of CT not changed.")) then return; endif; if ct_requested <= 0 then message ("CT must be greater than 0."); else message (fao ("Setting length to !SL lines per page", ct_requested)); update (message_window); ct_length := ct_requested; endif; endprocedure !<><><><><><><><><><><><> ! ! Print the current select range (if active), or the entire buffer. ! Translate control characters before printing. ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! ! Note: must begin with 'eve_' so the command parser can find it ! procedure eve_print_translated local this_position, this_buffer, copy_range, buffer_name, file_name, file_temp, unique, ! Unique add-on for saving file print_command, print_process; on_error if error = tpu$_createfail then message ("Subprocess could not be created"); set (success,on); return; endif; endon_error; set (success,off); this_position := mark (none); this_buffer := current_buffer; if get_info (wpe$x_translate_buffer,"type") = UNSPECIFIED then wpe$x_translate_buffer := create_buffer ('translation'); set (eob_text, wpe$x_translate_buffer, "End of file"); set (no_write, wpe$x_translate_buffer); endif; if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Print must be used in " + "the same buffer as Select."); return; else copy_range := select_range; position (wpe$x_translate_buffer); erase (wpe$x_translate_buffer); message ("Translating a copy of the Selected Range for printing..."); copy_text (copy_range); ! Make a copy of the select range endif; else !No select range position (wpe$x_translate_buffer); erase (wpe$x_translate_buffer); message ("Translating a copy of this Buffer for printing..."); copy_text (this_buffer); ! Make a copy of the buffer endif; ! Now translate the control characters wpe$translate_controls (wpe$x_translate_buffer); ! Translate control characters. ! Get the output file from the original buffer and use it to write the ! translated buffer (after making it unique). ! ! This procedure does not do a lot of error checking. It is assumed that ! the user knows what he/she is doing, if smart enough to get here. ! buffer_name := get_info (this_buffer,"name"); file_name := get_info (this_buffer,"file_name"); if (get_info (file_name, "type") <> string) or (file_name = "") then ! No file name file_name := read_line (fao ("Enter a name for new buffer !AS Press RETURN to cancel: ", buffer_name)); if file_name = "" then set (success,on); return; endif; else ! Make a unique file name in SYS$LOGIN unique := fao ("!%D",0); ! Get time string, e.g., 30-MAR-1987 21:35:14.82 ! Pack out blank, -:., - replace by underscore. translate (unique, "____", " -:."); file_temp := file_parse (file_name, "", "", NAME) + file_parse (file_name, "", "", TYPE); if file_temp = "" then ! Bad file name return endif; file_temp := file_temp + unique; file_name := "SYS$LOGIN:" + file_temp; endif; print_process := create_process (message_buffer, "$set noon"); set (output_file, wpe$x_translate_buffer, file_name); write_file (wpe$x_translate_buffer); print_command := read_line ("Print command [Print/Delete]: "); if print_command = "" then print_command := "PRINT/DELETE"; endif; change_case (print_command, upper); print_command := print_command + " "; message (fao ("Printing !AS using command !AS", file_temp, print_command)); send (print_command + file_name, print_process); delete (print_process); set (success,on); update (message_window); position (this_position); if eve$x_select_position <> 0 then !Select range active eve$x_select_position := 0; copy_range := 0; endif; endprocedure; !<><><><><><><><><><><><> ! Translate control characters for printing ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! ! This procedure controls the outer loop search for the special ! control characters that we want to view ! ! NOTE: You always end up in "this_buffer" ! procedure wpe$translate_controls (this_buffer) local wpe$x_translate_pattern, 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 (this_buffer); return; endon_error; ! 0 thru 31 + 127 thru 159 wpe$x_translate_pattern := any (' '); position (beginning_of (wpe$x_translate_buffer)); loop ! Find all occurrences control_char := search (wpe$x_translate_pattern, forward); position (control_char); char_to_translate := current_character; ! Save the character erase (control_char); ! then erase it ! & Substitute the new text copy_text (wpe_translate_char (char_to_translate)); endloop; endprocedure; !<><><><><><><><><><><><> ! FIX_MEM - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs ! ! Frequently used with .MEM files - hence the name ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! This procedure does not do a lot of error checking. It is assumed that ! the user knows what he/she is doing, if smart enough to get here. ! ! ! Note: must begin with 'eve_' so the command parser can find it ! procedure eve_fix_mem Local first_line, ! First of "overstrike" lines (bare CRs) second_line, ! Next line left_end, ! Marks left end of bold region right_end, ! bold_on, ! Escape sequence to turn bolding on bold_off, ! bolding, ! Logical to control if we're bolding bold_requested, ! Logical to control if we have asked copy_filename, ! Name for new buffer/file this_buffer, ! Buffer of origin this_buffer_name, ! Name of original buffer fix_buffer, ! Buffer to create (NOTE: Global) fix_buffer_name, ! Name of FIX buffer file_temp, question_answer, this_mode, ! Used to save the editing mode the_range; ! ! global wpe$x_fix_buffer - same as fix_buffer, due to error handling on_error if (ERROR <> tpu$_STRNOTFOUND) then if (ERROR <> tpu$_DUPBUFNAME) then ! message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE)); set (success,on); return; else message (fao("Erasing existing buffer !AS ", fix_buffer_name )); eve_buffer (fix_buffer_name); wpe$x_fix_buffer := current_buffer; erase (wpe$x_fix_buffer); eve_buffer (this_buffer_name); endif; endif; endon_error; if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("FIX must be used in " + "the same buffer as Select."); return; endif; endif; bold_on := ""; bold_off := ""; bold_requested := FALSE; set (success,off); this_mode := get_info (current_buffer, eve$kt_mode); this_buffer := current_buffer; this_buffer_name := get_info (this_buffer,"name"); ! Get the output file from the original buffer and use it to write a ! translated buffer (after making it different). ! copy_filename := get_info (this_buffer,"output_file"); if (get_info (copy_filename, "type") <> string) or (copy_filename = "") then ! No file name copy_filename := read_line ("Enter a name for the FIX buffer. " + "Press RETURN to cancel: "); if copy_filename = "" then set (success,on); return; endif; fix_buffer_name := file_parse (copy_filename, "", "", NAME) + file_parse (copy_filename, "", "", TYPE); else ! Make a unique file name. file_temp := file_parse (copy_filename, "", "", TYPE); if file_temp = ".LIS" then file_temp := ".TXT"; else file_temp := ".LIS"; ! Preferred endif; fix_buffer_name := file_parse (copy_filename, "", "", NAME) + file_temp; copy_filename := file_parse (copy_filename, "", "", NODE) + file_parse (copy_filename, "", "", DEVICE) + file_parse (copy_filename, "", "", DIRECTORY) + fix_buffer_name; endif; fix_buffer := create_buffer (fix_buffer_name); if get_info (fix_buffer, "type") <> buffer then ! failed - see on_error fix_buffer := wpe$x_fix_buffer; else wpe$x_fix_buffer := fix_buffer; endif; set (output_file, wpe$x_fix_buffer, copy_filename); set (eob_text, wpe$x_fix_buffer, "End of file"); ! ! Copy the contents to the new buffer, positioning in the new buffer. ! if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("FIX must be used in " + "the same buffer as Select."); return; else copy_range := select_range; position (wpe$x_fix_buffer); message ("Copying the Selected Range to new buffer !AS ", fix_buffer_name ); copy_text (copy_range); ! Make a copy of the select range endif; else !No select range position (wpe$x_fix_buffer); message (fao ("Copying buffer !AS to new buffer !AS ", this_buffer_name, fix_buffer_name)); copy_text (this_buffer); ! Make a copy of the buffer endif; position (beginning_of(current_buffer)); map (current_window, wpe$x_fix_buffer); eve$update_status_lines; update (current_window); ! NOW TO CONVERT THE NEW BUFFER. ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! message (fao ("Removing CRLFs from buffer !AS ", fix_buffer_name)); position(beginning_of(current_buffer)); 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)); update (current_window); message (fao ("Removing naked LFs from buffer !AS ", fix_buffer_name)); 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. ! These lines are "overstrikes" - for more modern printers, we would ! like to do this by bolding or shadow printing. Since we are trying ! to be "general", this gets a little complex. It must take care ! of situations where only a part of the line is overstruck. ! Assumptions: ! 1. The overstruck part is the FIRST line, ! 2. This may only be a substring of subsequent lines, ! 3. If it isn't a substring then we REALLY want to leave ! the naked CR - because we're doing composite chars. ! However, for most printers, we also need to tab up, ! so we use {CR}{ESC}[k ! position(beginning_of(current_buffer)); update (current_window); message (fao ("Removing naked CRs from buffer !AS ", fix_buffer_name)); loop the_range := search( " ", FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then if (current_offset <> (length(current_line) - 1)) then ! Mid-line split_line; erase(the_range); else ! CR is at the end of the line erase(the_range); ! Get rid of CR exitif mark(none) = end_of (current_buffer); wpe_get_fix_line (first_line, right_end, left_end); ! ! We got rid of one copy. Now for the next line... loop ! Until we don't find CR on a line if mark(none) = end_of (current_buffer) then copy_text (first_line); exitif 1; endif; the_range := search ( (anchor & scan(" ")), forward); if the_range <> 0 then ! Found CR in line position (end_of(the_range)); move_horizontal (1); erase_character (1); ! Get rid of CR move_horizontal (-current_offset); the_range := index (current_line, first_line); if the_range = 0 then ! First line didn't match copy_text (first_line + " "); ! Put it back in split_line; ! and pick up a new first line ! else ! Found a substring match. Pick up new line endif; exitif mark(none) = end_of (current_buffer); wpe_get_fix_line (first_line, right_end, left_end); else ! Didn't find CR on line if length (current_line) <> 0 then the_range := index (current_line, first_line); else the_range := 0; endif; if the_range = 0 then ! First line didn't match copy_text (first_line + " "); ! Put it back in split_line; exitif 1; ! Go out to main loop else ! First line did match if (not bold_requested) then ! Prompt once only. ! Put it in so we can see it copy_text (first_line); ! Put it back in split_line; update (current_window); question_answer := eve$insist_y_n ("Overstruck lines exist in this file. " + "Insert BOLD codes? [Yes] "); bold_requested := TRUE; ! update (EVE$PROMPT_WINDOW); if question_answer then bolding := TRUE; else bolding := FALSE; endif; ! Take out the line we put in. move_vertical (-1); erase_line; update (current_window); endif; move_horizontal (right_end); if bolding then copy_text (bold_off); move_horizontal (- current_offset); move_horizontal (left_end); copy_text (bold_on); endif; exitif 1; ! Out to main loop endif; endif; endloop; endif; else ! Current_offset = 0, therefore null line. erase(the_range); endif; endloop; message (eve$kt_null); ! Clear message space set (this_mode, wpe$x_fix_buffer); ! fix_buffer same mode as original eve$update_status_lines; position (beginning_of(current_buffer)); set (success,on); endprocedure; !<><><><><><><><><><><><> ! Support procedure for eve_fix_mem ! ! procedure wpe_get_fix_line (first_line, right_end, left_end) first_line := current_line; if length(first_line) > 0 then edit (first_line, trim_trailing, off); right_end := length (first_line); move_horizontal (-current_offset); loop exitif index (eve$x_whitespace, current_character) = 0; exitif current_offset >= length(current_line); move_horizontal (1); endloop; left_end := current_offset; if left_end > right_end then left_end := right_end; endif; move_horizontal (-current_offset); erase_line; else right_end := 0; left_end := 0; endif; endprocedure; !<><><><><><><><><><><><> ! Replaces Eve procedure. This prevents EVE from asking us to re-define ! PF4 as DO (on VT100 terminals only). Note that the user still ! has access to the DO function by using [ procedure eve$init_do_key endprocedure; !<><><><><><><><><><><><> ! Replaces Eve procedure. This prevents EVE from being able to do ! keypad help, and lets us intercept to handle the special ! WPE commands. procedure eve$help_keypad wpe$help_keypad; endprocedure; !<><><><><><><><><><><><> ! Replaces Eve procedure. This prevents EVE from being able to intercept ! wildcard file specs, and lets us handle them if we are in MORE. ! procedure eve$init_files wpe$init_files; endprocedure; !<><><><><><><><><><><><> ! Replaces Eve procedure. This prevents EVE from being able to intercept ! wildcard file specs, and lets us handle them if we are in MORE. ! procedure eve_get_file (get_file_parameter) wpe_get_file (get_file_parameter); endprocedure; !<><><><><><><><><><><><> ! ! This is "lifted" from EVESECINI.TPU so that we can add the two ! 'wpe_???_key_restore' lines to it. They assure that EVE will understand ! the regular keys (return, etc.) when it needs to. ! ! There is one confusion factor in doing this: If you DO a command ! "tpu show (key_map_lists)", you will always see that EVE$USER_KEYS ! has some keys in it (the same number - nine as of 27-MAR-1987 - which ! are redefined in wpe_eve_key_redef). ! ! Dispatch to package specific parsers, should there be any EVE-layered ! products built in. ! procedure eve$parser_dispatch(the_command) wpe_eve_key_restore; eve$process_command(the_command); wpe_wpe_key_restore; endprocedure; !<><><><><><><><><><><><> ! Redefinition of keys to support EVE procedures, in general. ! Note that in some cases, only the comment field is really redefined. ! ! This procedure MUST be coordinated with wpe_wpe_key_restore ! procedure wpe_eve_key_restore if (not wpe$x_eve_keys_normal) then wpe_redefine_key("eve_return", ret_key, " return", "wpe_bufkey_wperet"); wpe_redefine_key("eve_do ('')", do, " do", "wpe_bufkey_wpedo"); wpe_redefine_key("eve_do ('')", key_name (';', shift_key), " do", "wpe_bufkey_wpedo1"); wpe_redefine_key("eve_exit", f10, " exit", "wpe_bufkey_wpef10"); wpe_redefine_key("eve_exit", ctrl_z_key, " exit", "wpe_bufkey_wpecz"); wpe_redefine_key("wpe_previous_screen", e5, " previous_screen", "wpe_bufkey_wpee5"); wpe_redefine_key("wpe_next_screen", e6, " next_screen", "wpe_bufkey_wpee6"); wpe_redefine_key("wpe_previous_screen", key_name ('<', shift_key), " previous_screen", "wpe_bufkey_wpela"); wpe_redefine_key("wpe_next_screen", key_name ('>', shift_key), " next_screen", "wpe_bufkey_wpera"); wpe$x_eve_keys_normal := 1; endif; endprocedure; !<><><><><><><><><><><><> ! Cancel the special definition of keys for EVE use ! ! This procedure MUST be coordinated with wpe_eve_key_restore ! procedure wpe_wpe_key_restore if wpe$x_eve_keys_normal then ! set(informational,off); wpe_restore_key ("wpe_bufkey_wperet"); wpe_restore_key ("wpe_bufkey_wpedo"); wpe_restore_key ("wpe_bufkey_wpedo1"); wpe_restore_key ("wpe_bufkey_wpef10"); wpe_restore_key ("wpe_bufkey_wpecz"); wpe_restore_key ("wpe_bufkey_wpee5"); wpe_restore_key ("wpe_bufkey_wpee6"); wpe_restore_key ("wpe_bufkey_wpela"); wpe_restore_key ("wpe_bufkey_wpera"); ! set(informational,on); wpe$x_eve_keys_normal := 0; endif; endprocedure; !<><><><><><><><><><><><> procedure tpu$local_init ! This procedure contains the "sets" and the "global definitions". ! It is wise to take the time to initialize this stuff at ! startup. This procedure is called by EVE startup. Note that ! it calls a "dummy" procedure WPE$Local_INIT which can be ! re-defined in a lower layer product (the same trick used ! by EVE for tpu$local_init). ! local has_display, has_command; has_command := get_info (command_line, "command"); has_display := get_info (system, "display"); ! ! Define facility name to be WPE. (or MORE) ! If journal, we're WPE - otherwise, we're MORE if get_info (command_line,"journal") = 1 then ! Yes wpe$x_facility_name := "WPE"; else wpe$x_facility_name := "MORE"; endif; set (facility_name, wpe$x_facility_name); wpe$x_version_number := "2.4" + " <> TPU V" + str(get_info(system,"version")) + "-" + str(version); ! set (message_flags, 1); eve$kt_version := eve$kt_version + " <> " + wpe$x_facility_name + " Version " + wpe$x_version_number; if has_display then set (timer, on, wpe$x_facility_name + " Startup"); endif; ! ! Global constants wpe$x_dcl_key_map_list := "WPE$DCL_KEY_MAP_LIST"; wpe$x_standard_keys := "wpe$standard_keys"; wpe$x_dcl_keys := "wpe$dcl_keys"; ! Global variables ! Define the state of keys. Note that this MUST be defined in a manner ! that is zero by default, otherwise we get lots of errors on ! startup. wpe$x_eve_keys_normal := 0; ! Define the state of the keypad wpe$x_num_keys_on := 0; ! Shorten journaling interval, etc. set (journaling,1); ! Define initial page length for Page ct_length := 60; ct_old_length := 60; eve$arg1_ct := "integer"; ! Set up scrolling for EVE buffers. ! - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - ! If you don't like the way WPE scrolls, try commenting out these 4 lines ! set (scrolling, eve$main_window, ON, 4,4,4); set (scrolling, eve$top_window, ON, 2,2,2); set (scrolling, eve$bottom_window, ON, 2,2,2); set (scrolling, info_window, ON, 4,4,4); ! - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - ! Set up message-type windows to accept text enhancements if desired. ! Message window (Message () statements) may have text enhancements. ! This is used frequently by WPE ! The following is done in wpe$init_files, to prevent repaint. ! set (text, message_window, NO_TRANSLATE ); ! Reset direction & mode for command-line editing set (forward, eve$command_buffer); set (insert, eve$command_buffer); ! Global string variables wpe$x_long_line := line_begin & arb(81); ! terminators for delete_word in regular and DCL modes ! NOTE: pairs must match position of paired character wpe$x_regular_term_char := ')]}_'; wpe$x_paired_regular_term_char := '([{'; wpe$x_dcl_term_char := ')]}"''_/;:.,-'; wpe$x_paired_dcl_term_char := '([{"'''; wpe$x_char_buffer := ''; ! Initially empty wpe$x_empty_line := ! Blank line line_begin & ( ( span (eve$x_word_separators) | eve$kt_null ) & line_end); wpe$pattern_empty_line := ! Blank line (anchored) anchor & line_begin & ( ( span (eve$x_word_separators) | eve$kt_null ) & line_end); wpe$pattern_ff := ! Form feed (anchored) anchor & line_begin & " "; wpe$x_sentence_ends := ! Sentence ends: .?!, horizontal tab, ! form feed, carriage return, vertical tab, ! and line feed ".?! "; wpe$pattern_anchored_white := anchor & span (eve$x_word_separators); ! We could do the following, but it's handled another way. ! set (shift_key, pf1); ! Next, set up the editing environment, constants, etc. wpe$x_line_buffer := " "; wpe$buf_active := FALSE; if get_info(screen, "line_editing") <> 0 then if has_display and (not has_command) then message ("Line_Editing inhibits the Delete Line function"); endif; endif; ! Then, arrange the wpe key map lists wpe_init_key_map_lists; ! Last, handle conditions if we have lines longer than 80, or special ! file types (.COM, .HLP) wpe_special_files(1); ! 1 = prompting mode wpe_find_long_line; ! Now, call something to allow lower level procedures to initialize: WPE$Local_INIT; if has_display then set (timer, on, wpe$x_facility_name + " Working"); endif; endprocedure !<><><><><><><><><><><><> procedure wpe$local_init ! This can be over-ridden by a real procedure in a lower level interface. endprocedure !<><><><><><><><><><><><> ! Set up the key map lists in the ordering we want. procedure wpe_init_key_map_lists local other_key_map_name; ! To save a name on_error endon_error; ! The tpu$key_map will be in the wrong order unless we do this: remove_key_map (eve$x_key_map_list, eve$x_user_keys, ALL); remove_key_map (eve$x_key_map_list, wpe$x_standard_keys, ALL); add_key_map (eve$x_key_map_list, "first", wpe$x_standard_keys); add_key_map (eve$x_key_map_list, "first", eve$x_user_keys); ! The wpe$dcl_key_map_list will be in the wrong order unless we do this: ! First, init to VT100/VT200 other_key_map_name := eve$x_key_map_list; eve$x_key_map_list := wpe$x_dcl_key_map_list; if eve$x_vt200_keypad then eve$vt200_keys; else eve$vt100_keys; endif; eve$x_key_map_list := other_key_map_name; endprocedure !<><><><><><><><><><><><> ! WPE KEY MAP DEFINITIONS wpe$x_standard_keys := create_key_map ("wpe$standard_keys"); wpe$x_dcl_keys := create_key_map ("wpe$dcl_keys"); ! Create a key map list for DCL special editing (.COM files) ! This is the desired final ordering, but we'll have ! to re-arrange it a couple of times in init, in order ! to get either the vt100 or vt200 keys (only). wpe$x_dcl_key_map_list := create_key_map_list ( "WPE$DCL_KEY_MAP_LIST", eve$x_user_keys, wpe$x_dcl_keys, wpe$x_standard_keys, eve$x_vt200_keys, eve$x_vt100_keys, eve$x_standard_keys ); !<><><><><><><><><><><><> ! WPE Key Definitions ! The following trick is used to carry PF1 through the .tpu$section as ! the "shift" key. The first time PF1 is pressed, eve$get_shift_key ! does a define_key to make it the shift key for this session. define_key ("execute (lookup_key (eve$get_shift_key, program))", PF1, "shift key", wpe$x_standard_keys); ! Now, remap existing EVE functions to the proper keys. ! - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - ! The following keys are defined differently from WPS+ ! If you want to be closer to WPS+, then make the changes indicated... ! KP3 - is defined as Exit. This was done for compatibility with DM ! (KP3 goes "up" and KP. goes "down"). To preserve capability, the ! Bold key (KP6) was defined to do the Upper Case function. The commented ! definitions below will define KP3 the same as KP6. define_key ("wpe_getout", kp3, "wpe exit", wpe$x_standard_keys); !define_key ("wpe_upper_case", kp3, "wpe upper_case", wpe$x_standard_keys); !define_key ("wpe_lower_case", key_name(kp3, shift_key), "wpe lower_case", ! wpe$x_standard_keys); ! PF3 - is defined as a special function, wpe_delete_word. It is designed ! to facilitate documentation statement editing. If you wish to use the ! more standard function, exchange the commented line below. define_key ("wpe_delete_word", pf3, "wpe delete_word", wpe$x_standard_keys); !define_key ("eve_erase_word", pf3, "erase_word", wpe$x_standard_keys); ! - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - ! Regular keys define_key ("wpe_delete", del_key, "wpe delete", wpe$x_standard_keys); define_key ("eve_erase_word", lf_key, "wpe erase_word", wpe$x_standard_keys); define_key ("eve_recall", ctrl_b_key, "wpe recall", wpe$x_standard_keys); define_key ("eve$check_bad_window", ctrl_f_key, "wpe return_to_edit", wpe$x_standard_keys); define_key ("wpe_remember", ctrl_r_key, " remember", wpe$x_standard_keys); define_key ("eve_quote", ctrl_v_key, "wpe quote", wpe$x_standard_keys); define_key ("wpe_getout", ctrl_z_key, "wpe exit", wpe$x_standard_keys); define_key ("wpe_return", ret_key , "wpe return", wpe$x_standard_keys); ! Function keys define_key ("wpe_delete_line", f6, "wpe delete_line", wpe$x_standard_keys); define_key ("eve_quote", f7, "wpe quote", wpe$x_standard_keys); define_key ("eve_capitalize_word", f8, "wpe capitalize_word", wpe$x_standard_keys); define_key ("wpe_getout", f10, "wpe exit", wpe$x_standard_keys); define_key ("wpe_help ('keypad')", help, "wpe help", wpe$x_standard_keys); ! Do is for documentation only define_key ("eve_do ('')", do, "wpe do", wpe$x_standard_keys); define_key ("eve_one_window", f17, "wpe one_window", wpe$x_standard_keys); define_key ("wpe_toggle_windows", f18, "wpe two_windows", wpe$x_standard_keys); define_key ("eve_other_window", f19, "wpe other_window", wpe$x_standard_keys); ! Editing keypad keys ! - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - LOCAL - ! Note: if a "free" cursor is desired, change these to ! eve_move_up, eve_move_down, eve_move_left, and eve_move_right. define_key ("move_vertical (-1)", up, "wpe move_up", wpe$x_standard_keys); define_key ("move_vertical (1)", down, "wpe move_down", wpe$x_standard_keys); define_key ("move_horizontal (-1)", left, "wpe move_left", wpe$x_standard_keys); define_key ("move_horizontal (1)", right, "wpe move_right", wpe$x_standard_keys); ! ! define_key ("eve_move_up", up, "wpe move_up", wpe$x_standard_keys); ! define_key ("eve_move_down", down, "wpe move_down", wpe$x_standard_keys); ! define_key ("eve_move_left", left, "wpe move_left", wpe$x_standard_keys); ! define_key ("eve_move_right", right, "wpe move_right", wpe$x_standard_keys); ! ! - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - END LOCAL - ! Auxiliary keypad keys define_key ("wpe_delete_char", pf4, "wpe delete_character", wpe$x_standard_keys); define_key ("eve_move_by_word", kp4, "wpe move_by_word", wpe$x_standard_keys); define_key ("wpe_remove", minus, "wpe cut", wpe$x_standard_keys); define_key ("eve_insert_here", comma, "wpe paste", wpe$x_standard_keys); define_key ("wpe_select", period, "wpe select", wpe$x_standard_keys); define_key ("wpe_enter", enter, "wpe find_>", wpe$x_standard_keys); ! Gold Regular Keys define_key ("eve_bottom", key_name ('b', shift_key), "wpe to_bottom", wpe$x_standard_keys); define_key ("eve_center_line", key_name ('c', shift_key), "wpe center_line", wpe$x_standard_keys); define_key ("wpe_getout", key_name ('f', shift_key), "wpe exit", wpe$x_standard_keys); define_key ("eve_include_file ('')", key_name ('g', shift_key), "wpe include_file", wpe$x_standard_keys); define_key ("wpe_help('keypad')", key_name ('h', shift_key), "wpe help", wpe$x_standard_keys); define_key ("eve_dcl ('')", key_name ('i', shift_key), "wpe dcl", wpe$x_standard_keys); define_key ("wpe_quit", key_name ('k', shift_key), "wpe quit", wpe$x_standard_keys); define_key ("wpe_ruler", key_name ('r', shift_key), "wpe ruler", wpe$x_standard_keys); define_key ("wpe_top", key_name ('t', shift_key), "wpe to_top", wpe$x_standard_keys); define_key ("wpe_show", key_name ('z', shift_key), "wpe show", wpe$x_standard_keys); define_key ("wpe_show", key_name ('~', shift_key), "wpe show", wpe$x_standard_keys); define_key ("wpe_signature", key_name ('@', shift_key), "wpe signature", wpe$x_standard_keys); define_key ("eve_spawn", key_name ('$', shift_key), "wpe spawn", wpe$x_standard_keys); define_key ("eve_do ('')", key_name ('[', shift_key), "wpe do", wpe$x_standard_keys); define_key ("wpe_eve_replace ('','')", key_name (';', shift_key), "wpe global_replace", wpe$x_standard_keys); define_key ("wpe_find ('')", key_name (',', shift_key), "wpe find", wpe$x_standard_keys); define_key ("wpe_display_character", key_name ('?', shift_key), "wpe display_character", wpe$x_standard_keys); define_key ("wpe_what_line", key_name ('|', shift_key), "wpe what_line", wpe$x_standard_keys); define_key ("eve_erase_start_of_line", key_name (del_key, shift_key), "wpe erase_start_of_line", wpe$x_standard_keys); define_key ("wpe_gold_return", key_name (ret_key, shift_key), "wpe gold_return", wpe$x_standard_keys); ! Gold function keys define_key ("eve_uppercase_word", key_name (f8, shift_key), "wpe uppercase", wpe$x_standard_keys); define_key ("wpe_get_a_file", key_name (f18, shift_key), "wpe get_file", wpe$x_standard_keys); define_key ("wpe_get_buffer_command", key_name (f19, shift_key), "wpe buffer", wpe$x_standard_keys); ! Gold editing keypad keys define_key ("wpe_start_of_line", key_name (left, shift_key), "wpe start_of_line", wpe$x_standard_keys); define_key ("eve_end_of_line", key_name (right, shift_key), "wpe end_of_line", wpe$x_standard_keys); ! Gold auxiliary keypad keys define_key ("wpe_paginate", key_name (pf2, shift_key), "wpe paginate", wpe$x_standard_keys); define_key ("eve_restore", key_name (pf3, shift_key), "wpe undelete_word", wpe$x_standard_keys); define_key ("wpe_undelete_char", key_name (pf4, shift_key), "wpe undelete_char", wpe$x_standard_keys); define_key ("wpe_fill_paragraphs", key_name (kp5, shift_key), "wpe fill_paragraphs", wpe$x_standard_keys); define_key ("eve_go_to('')", key_name (kp9, shift_key), "wpe go_to", wpe$x_standard_keys); define_key ("eve_insert_here", key_name (comma, shift_key), "wpe paste", wpe$x_standard_keys); ! Gold "Token" keys - put in double parens, brackets, etc. define_key ("copy_text ('()'); move_horizontal (-1);", key_name ('(', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('()'); move_horizontal (-1);", key_name (')', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('[]'); move_horizontal (-1);", key_name ('{', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('[]'); move_horizontal (-1);", key_name ('}', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text('""'); move_horizontal(-1); copy_text('""'); ", key_name ('"', shift_key), "wpe token", wpe$x_standard_keys); ! Set up WPS keys that will not be done in WPE ! Regular keys define_key ( "message ('Ctrl-A (Create Multinational) is not implemented in WPE')", ctrl_a_key, "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Ctrl-D (External Application) is not implemented in WPE')", ctrl_d_key, "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Ctrl-E (Technical Character Set) is not implemented in WPE')", ctrl_e_key, "wpe not_implemented", wpe$x_standard_keys); ! Auxiliary keypad keys ! Gold Regular Keys define_key ("message ('Subscripts are not implemented in WPE')", key_name ('a', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Dead key is not implemented in WPE')", key_name ('d', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Linguistic Aids are not implemented in WPE')", key_name ('j', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Library is not implemented in WPE')", key_name ('l', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Editing menu is not implemented in WPE')", key_name ('m', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Superscripts are not implemented in WPE')", key_name ('q', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Spelling check is not implemented in WPE')", key_name ('s', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('UDPs are not implemented in WPE')", key_name ('u', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Footnotes are not implemented in WPE')", key_name ('y', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Nonbreaking Space is not implemented in WPE')", key_name (' ', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Desk Calculator is planned but not yet implemented in WPE')", key_name ('#', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Print hyphens are not implemented in WPE')", key_name ('-', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Invisible print hyphens are not implemented in WPE')", key_name ('_', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Abbreviation documents are not implemented in WPE')", key_name ('=', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Abbreviation documents are not implemented in WPE')", key_name ('+', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Two Dimensional Editor is not implemented in WPE')", key_name (']', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Gold Tab is not implemented in WPE')", key_name (tab_key, shift_key), "wpe not_implemented", wpe$x_standard_keys); ! Gold Function Keys define_key ("message ('Technical Character Set is not implemented in WPE')", key_name (F11, shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Hyphen Pull is not implemented in WPE')", key_name (F12, shift_key), "wpe not_implemented", wpe$x_standard_keys); ! Gold auxiliary keypad keys define_key ("message ('Highlighting is not implemented in WPE')", key_name (kp2, shift_key), "wpe not_implemented", wpe$x_standard_keys); ! Now set up special WPE commands ! Function keys define_key ("wpe_move_by_line", f12, "wpe move_by_line", wpe$x_standard_keys); define_key ("wpe_delete_to_end_of_line", f20, "wpe delete_to_end_of_line", wpe$x_standard_keys); ! Function keys defined for documentation (HELP) only define_key ("eve_change_direction", f11, "wpe change_direction", wpe$x_standard_keys); define_key ("eve_change_mode", f14, "wpe change_mode", wpe$x_standard_keys); define_key ("eve_erase_word", f13, "wpe erase_word", wpe$x_standard_keys); define_key ("eve_insert_here", e2, "wpe paste", wpe$x_standard_keys); ! Editing keypad keys define_key ("wpe_find ('')", e1, "wpe find", wpe$x_standard_keys); define_key ("wpe_remove", e3, "wpe cut", wpe$x_standard_keys); define_key ("wpe_select", e4, "wpe select", wpe$x_standard_keys); define_key ("wpe_previous_screen", e5, "wpe previous_screen", wpe$x_standard_keys); define_key ("wpe_next_screen", e6, "wpe next_screen", wpe$x_standard_keys); ! Auxiliary keypad keys define_key ("wpe_find_page", pf2, "wpe page", wpe$x_standard_keys); define_key ("wpe_advance", kp0, "wpe advance", wpe$x_standard_keys); define_key ("wpe_back_up", kp1, "wpe back_up", wpe$x_standard_keys); define_key ("wpe_move_by_line", kp2, "wpe move_by_line", wpe$x_standard_keys); define_key ("wpe_para", kp5, "wpe para", wpe$x_standard_keys); define_key ("wpe_upper_case", kp6, "wpe upper_case", wpe$x_standard_keys); define_key ("wpe_sentence", kp7, "wpe sentence", wpe$x_standard_keys); define_key ("wpe_tab_pos", kp8, "wpe tab_pos", wpe$x_standard_keys); define_key ("eve_mark('')", kp9, "wpe mark", wpe$x_standard_keys); ! Gold Regular keys define_key ("wpe_new_page", key_name ('n', shift_key), "wpe new_page", wpe$x_standard_keys); define_key ("wpe_new_page", key_name ('p', shift_key), "wpe new_page", wpe$x_standard_keys); ! Differs from WPS+ define_key ("wpe_view",key_name ('v', shift_key), "wpe view", wpe$x_standard_keys); define_key ("wpe_write_file", key_name ('w', shift_key), "wpe write_file", wpe$x_standard_keys); define_key ("wpe_find_matching", key_name ('x', shift_key), "wpe find_matching", wpe$x_standard_keys); define_key ("eve$insert_text (substr (FAO ('!%D',0), 1, 17))", key_name ('\', shift_key), "wpe date", wpe$x_standard_keys); define_key ("wpe_replace", key_name ("'", shift_key), "wpe replace", wpe$x_standard_keys); define_key ("wpe_cont_search", key_name ('.', shift_key), "wpe cont_search", wpe$x_standard_keys); define_key ("wpe_cont_search_sel", key_name ('/', shift_key), "wpe cont_srch_sel", wpe$x_standard_keys); ! Gold Shifted-Regular keys (provide functions for VT-100 terminals) define_key ("wpe_previous_screen", key_name ('<', shift_key), "wpe previous_screen", wpe$x_standard_keys); define_key ("wpe_next_screen", key_name ('>', shift_key), "wpe next_screen", wpe$x_standard_keys); ! Gold Function keys define_key ("wpe_undelete_line", key_name (f6, shift_key), "wpe undelete_line", wpe$x_standard_keys); define_key ("eve$insert_text (ascii (27))", key_name (f7, shift_key), "wpe escape", wpe$x_standard_keys); define_key ("wpe_rub_sentence", key_name (f13, shift_key), "wpe rub_sentence", wpe$x_standard_keys); ! Gold editing keypad keys define_key ("wpe_cont_search", key_name (e1, shift_key), "wpe cont_search", wpe$x_standard_keys); define_key ("eve_insert_here", key_name (e2, shift_key), "wpe paste", wpe$x_standard_keys); define_key ("wpe_copy", key_name (e3, shift_key), "wpe copy", wpe$x_standard_keys); define_key ("wpe_select", key_name (e4, shift_key), "wpe select", wpe$x_standard_keys); define_key ("wpe_top", key_name (e5, shift_key), "wpe to_top", wpe$x_standard_keys); define_key ("eve_bottom", key_name (e6, shift_key), "wpe to_bottom", wpe$x_standard_keys); define_key ("wpe_gold_up", key_name (up, shift_key), "wpe top_of_file", wpe$x_standard_keys); define_key ("wpe_gold_down", key_name (down, shift_key), "wpe bottom_of_file", wpe$x_standard_keys); ! Gold auxiliary keypad keys define_key ("wpe_gold_down", key_name (kp0, shift_key), "wpe bottom_of_file", wpe$x_standard_keys); define_key ("wpe_gold_up", key_name (kp1, shift_key), "wpe top_of_file", wpe$x_standard_keys); define_key ("wpe_lower_case", key_name(kp6, shift_key), "wpe lower_case", wpe$x_standard_keys); define_key ("wpe_copy", key_name (minus, shift_key), "wpe copy", wpe$x_standard_keys); define_key ("wpe_swap", key_name (enter, shift_key), "wpe swap", wpe$x_standard_keys); define_key ("wpe_select", key_name (period, shift_key), "wpe select", wpe$x_standard_keys); ! Define WPE standard keys above this statement---------------- ! Define WPE DCL keys below this statement--------------------- define_key ("wpe_dcl_return", ret_key, "wpe dcl_return", wpe$x_dcl_keys); define_key ("wpe_dcl_space(1)", key_name (' '), "wpe dcl_space", wpe$x_dcl_keys); define_key ("wpe_dcl_gold_return", key_name (ret_key, shift_key) , "wpe dcl_gold_return", wpe$x_dcl_keys); define_key ("wpe_dcl_delete", del_key, "wpe dcl_delete", wpe$x_dcl_keys); define_key ("wpe_dcl_delete_word", pf3, "wpe dcl_del_word", wpe$x_dcl_keys); define_key ("message ('Paragraph Wrap doesn''t make sense in a .COM file')", key_name (kp5, shift_key), "wpe fill_paragraphs", wpe$x_dcl_keys); ! Define WPE DCL keys above this statement--------------------- !!!! endprocedure (WPE Define Keys non-procedure)