! !-------------------------------------------------------------------------- ! ! WPELSE - Word Processing Editor ! VERSION 1.1 ! ! !++ ! FACILITY: ! Word Processing Editor / Language Sensitive Editor (WPELSE) ! using..... ! EVE - { Extensible | Easy | Efficient } Vax Editor ! LSE - Language Sensitive Editor ! Text Processing Utility (VAXTPU) ! ! ABSTRACT: ! This is the source program for the WPELSE extension to the ! EVE extension of LSE which, of course is built using TPU. ! WPELSE emulates most of the capabilities of WPS-PLUS (TM), ! and provides all of the LSE functionality plus some extensions. ! ! ENVIRONMENT: ! VAX/VMS Version 4.4 and above. ! EVE Version 1.1-024 ! LSE Version 2.0-37 ! ! Authors: ! Mike Boorman ! Dale E. Coy ! Karl Nielsen ! ! Los Alamos National Laboratory ! MEE-8, MS/J957, PO Box 1663 ! Los Alamos, NM 87545 ! (505) 667-7159 ! ! ! CREATION DATE: January, 1987 ! ! MODIFIED BY: ! ! Mike Boorman (V0.0 --> V1.0 of WPELSE) ! Modified EVE and WPE to function with LSE ! Added LSE function key capability to f9 and f11 - f14 ! Help modified for WPELSE ! Added tab stops to spaces conversion for printing. ! Added one window - two window toggle switch. ! 30-JUN-1987 ! Dale E. Coy (V2.2 --> V2.3 of WPE) ! 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 !-- ! ! WPE.TPU ! ! Table of Contents as of 5-APR-1987 (Version 2.3) ! ! 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 ! wpelse$window_toggle toggles betw. one or two ! ! ! 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 ! wpe_copy_key Copies key def to new key ! wpelse_function_toggle redefines f9 and f11 thru f14 ! wpelse_unexpand redefines unexpand on the fly ! ! ! 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. ! Eve$package_init Replacement for tpu$local_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 = "wpelse move_up") or (what_key = "wpelse 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 !<><><><><><><><><><><><> !<<<<<<<<<<<<<<<<<<<<<<<<< wpelse change >>>>>>>>>>>>>>>>>>>>>>> procedure wpelse$window_toggle ! handles toggling of windows from one window to two windows and ! vice versa. if eve$x_number_of_windows = 2 then ! we must want to go to 1 window eve_one_window; else ! we must want 2 windows eve_two_windows; 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 length (current_line) >= l_margin then loop exitif (current_offset + 1) >= l_margin; move_horizontal (1); endloop; 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 (page_marker); 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 [AT n nn nn..., EVERY n]' to change.)"); endif; if info_type = 2 then message ("Tabs At " + tab_settings + " (use DO, 'SET TABS [AT n nn nn..., EVERY n]' 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 = "WPELSE" 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 = "WPELSE" 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 = "wpelse move_up") or (what_key = "wpelse 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_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 !<<<<<<<<<<<<<<<<<<<<<<<< wpelse change >>>>>>>>>>>>>>>>>>>>>>>>>>> ! procedure wpe_copy_key ! copies a key definition to a new key ( old_key, ! old key was defined here shift_str, ! equals "shift" if we want the shifted old key ! equals "" if not old_key_map, ! key map old key was defined in new_key, ! key we now want to have the old definition new_key_map ) ! where we want the new definition mapped ! This procedure takes a copy of the old key comment and program and maps ! it to a new key and new keymap. looking up the old program and comment ! is accomplished by using the TPU function lookup_key. This information ! is then used by procedure define_key to create the new key definition. local old_comment, ! Temporary Variables old_program; on_error endon_error; if shift_str = "" then old_key_name := key_name(old_key); else old_key_name := key_name(old_key, shift_key); endif; old_comment := lookup_key ( old_key_name, COMMENT, old_key_map); old_program := lookup_key ( old_key_name, PROGRAM, old_key_map); ! now, define the new key define_key (old_program, new_key,"wpelse " + old_comment, new_key_map); ! outta here...... endprocedure procedure wpelse_function_toggle ! toggles the function keys f11 ! thru f14 to wpe or lse functions ! this procedure adds or removes the key map: wpe$function_keys which contains ! the wpelse definitions for f9 and f11 through f14. If key_toggle := 0 then ! the current state of the function keys is WPE defined, if 1, then the keys ! are defined by WPELSE. ! Function keys are defined by WPELSE$function_keys as follows: ! f9 : Go to source code ! f11 : expand gold f11 : unexpand ! f12 : next placeholder gold f12 : last placeholder ! f13 : next error gold f13 : last error ! f14 : erase plholder gold f14 : unerase plholder ! on_error endon_error; if wpelse$function_key_toggle = 0 then wpelse$function_key_toggle := 1; add_key_map ("tpu$key_map_list", "first", wpelse$x_function_keys); message ("Function keys f9 and f11 thru f14 are now WPELSE defined."); else wpelse$function_key_toggle := 0; remove_key_map ("tpu$key_map_list", wpelse$x_function_keys); message ("Function keys f9 and f11 thru 14 are now WPE defined."); endif; ! outta here... endprocedure !>>>>>>>>>>>>>>>>>>>>>>>>>> end wpelse change <<<<<<<<<<<<<<<<<<<<<<< !<><><><><><><><><><><><> ! ! 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, "wpelse 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, "wpelse select_buffer", "wpe_bufkey_e4"); wpe_redefine_key("wpe_select_buffer", period, "wpelse 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, "wpelse buf_return", "wpe_bufkey_ret"); wpe_redefine_key("wpe_select_buffer", ret_key, "wpelse 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 = "wpelse select_buffer" then right_pgm := lookup_key ( e4, program); else if previous_key = "wpelse 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 = "wpelse move_up") or (what_key = "wpelse 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);