! Page 1 ! EVE - { Extensible | Easy | Efficient } Vax Editor ! ! COPYRIGHT © 1983, 1984, 1985 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS ! ALL RIGHTS RESERVED ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! FACILITY: ! Text Processing Utility (VAXTPU) ! ! ABSTRACT: ! This is the source program for the EVE_EDT interface ! ! ENVIRONMENT: ! VAX/VMS ! !Author: Michael Good ! ! CREATION DATE: 27-October-1983 ! ! MODIFIED BY: ! R. Kevin Oberman -- LLNL ! 1-Nov-1985 ! Added EDT keypad ! ! R. Christopher Yoder -- HAC (S&CG) + Harvey Mudd College ! 6-Aug-1986 ! Hack in more EDTisms... (quick, run for cover!!!) ! ! 10-Oct-1986 ! Full EDT keypad compatability reached! (Actually, there are two ! differences, the eve style replace replaces the EDT style replace, ! and GOLD KP3 does and eve_quote, so you type in the character that you ! want inserted instead of mucking about with the ASCII value.) ! Added n-window capability, the code was shamelessly stolen from ! Ned Freed, now of Harvey Mudd College. The n-window capability was ! taken from a EVE based VTEDIT emulator that was written by Ned. ! ! 28-Oct-1986 ! Added a SPELL utility. Spawn now takes an argument. ! ! 24-Feb-1987 ! Added a Sort command. ! ! 25-Feb-1987 ! Many, many minor bug fixes. ! ! 26-Feb-1987 ! Hacked in the commands SET SEARCH END and SET SEARCH BEGINNING. ! !Started hacking in routines from EDTPlus by Portia Shao and friends. !3/4/87 -rcy ! !Added EVE_CURRENT_LINE to show the current line. 3/4/87 -rcy (from EDTPlus) ! !Added EVE_LIST_BUFFERS to show what buffers were being used. If *anything* is !passed as a parameter, then the system buffers will also be shown, otherwise, !just the buffers that you're using will show up. 3/5/87 -rcy (idea from !EDTPlus) ! !Added EVE_SET_READ_ONLY and EVE_SET_WRITE. Now the status line also shows if !the buffer is read_only or read/write. 3/5/87 -rcy ! !Modified EVE_GET_FILE to accept a second parameter. If the parameter is not !null, then the file is read in in READ_ONLY mode. Also modified in this was !EVE$CREATE_BUFFER. Added EVE_READ_FILE to grab the file name and pass it and !a second parameter to EVE_GET_FILE to do the rest of the work. 3/6/87 -rcy ! !Added EVE$PAD_STRING, EVE_PAD_BUFFER, and EVE_PAD_LINE for padding things. !PAD_STRING takes an input string and pads it out to an input number of !characters. If the string is already that long, it doesn't do anything. !PAD_BUFFER pads an entire buffer out to either an input value or to the length !of the longest line in the buffer. It uses PAD_STRING, so if you pad a buffer !to less than the longest line you won't loose any data. 3/6/87 -rcy ! !Added EVE_MARK_CORNER, EVE_EXTRACT_RECTANGLE and EVE_INSERT_RECTANGLE. Use !EVE_MARK_CORNER to mark a corner that you wish to cut out, use !EVE_EXTRACT_RECTANGLE to mark the opposite corner and cut the rectangle into !the Extract buffer, and use EVE_INSERT_RECTANGLE to put the rectangle where you !want it to go (position the cursor in the upper left hand corner of where the !new rectangle should go). Bug report: EVE_INSERT_RECTANGLE inserts an extra !line when you put a rectangle back in that ends either on the last currently !existing line or below... I haven't found out where this came from or figured !out how to deal with it (yet). 3/6/87 -rcy ! !Completed rewrite of EVE$GET_RECTANGLE (support routine for !EVE_EXTRACT_RECTANGLE and EVE_COPY_RECTANGLE) and EVE$PUT_RECTANGLE (support !routine for EVE_INSERT_RECTANGLE and EVE_OVERLAY_RECTANGLE). Cleaned up some !code in EVE$GOTO_LINE_COL and EVE_CURRENT_LINE. 4/7/87 -rcy ! !Cleaned up the interfaces of EVE_GET_FILE and EVE_READ_FILE by having the two !point to EVE$READ_IN_FILE. EVE$READ_IN_FILE is the guts of what used to be !EVE_GET_FILE, with the user interface in the two front end procedures. !4/7/87 -rcy ! !Added EVE_PAD_SELECTED to pad out the selected text. It works just like !EVE_PAD_BUFFER and EVE_PAD_LINE. Now all that I need is a strip spaces... !4/7/87 -rcy ! !Found! EVE$TRIM_BUFFER and EVE$TRIM_LINE already existed, changed these !procedure names to EVE_TRIM_BUFFER and EVE_TRIM_LINE so that we can get at them !as commands. :-) 4/7/87 - rcy ! !Added EVE_RULER. This procedure will tell you the length of what you have !selected (in characters, *NOT SCREEN POSITIONS!!!!*). 4/7/87 - rcy ! !Added EVE_WRITE_MODIFIED. This procedure will write out all modified !Read/Write buffers. 12/1/87 - rcy ! !Added EVE_WRITE_SELECTED. This procedure will write out the currently selcted !region. 12/3/87 - rcy ! !Cleanup of code and completion of Help library. EVE_EDT now ``finished''. -rcy !(At HMC) ! !-- ! ! EVE_EDTINI.TPU ! ! Table of Contents as of 1-Nov-1985 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve$init_variables 2 Utility procedures ! eve$current_word 3 ! eve$at_start_of_word 4 ! eve$start_of_word 5 ! eve$previous_whitespace 5a ! eve$end_of_word 6 ! eve$append_line 7 ! eve$capitalize_string 8 ! eve$alphabetic 9 ! eve$cleanse_string 9 ! eve$pad_string 9 ! eve$lookup_comment 9 ! eve$prompt_key 10 ! eve$prompt_number 11 ! eve$prompt_string 12 ! eve$show_first_line 13 ! eve$position_in_middle 14 ! eve$expand_to_choices 15 ! eve$add_choice 15 ! eve$get_choice 16 ! eve$strip_choices 16 ! eve$format_choices 17 ! eve$display_choices 17 ! eve$letter_wrap 18 ! eve$to_column 19 ! eve$indent_line_to 19 ! eve_trim_line 20 ! eve_trim_buffer 20 ! eve$trim_buffer 20 ! eve$set_status_line 21 ! eve$update_status_lines 22 ! eve_change_direction 23 Keypad commands ! eve_change_mode 23 ! eve_delete 24 ! eve_erase_word 25 ! eve_restore_word 25a ! eve$compress_whitespace 26 ! eve_exit 27 ! eve_write_modified 27a ! write out all modified files -rcy ! eve_find 28 ! eve_findnext 28 ! eve$find 29 ! eve_help 30 ! eve$help_text 31 ! eve$help_keypad 32 ! eve_move_by_line 33 ! eve_new_line 33 ! eve_move_by_bol 33a ! eve_move_down 34 ! eve_move_left 34 ! eve_move_right 34 ! eve_move_up 34 ! plus$vertical 34a ! cursor movement like EDT -rcy ! eve_next_screen 35 ! eve_previous_screen 35 ! eve_screen 35 ! eve_page 35 ! eve$move_by_screen 36 ! eve_return 37 ! eve$split_line 37 ! eve_select 38 ! eve_remove 39 ! eve_append 39 ! eve_insert_here 40 ! eve_space 41 ! eve$fill_line 42 ! eve$backup_over_whitespace 43 ! eve_tab 44 ! eve_bottom 45 Editing commands ! eve_top 45 ! eve_capitalize_word 46 ! eve_change_case 46 ! eve_center_line 47 ! eve_end_of_line 48 ! eve_stable_end_of_line 48 For ^E going to EOL(current_line). ! eve_erase_character 49 ! eve_restore_character 49a ! eve_erase_line 50 ! eve_restore_line 50 ! eve_erase_end_of_line 50 ! eve_erase_previous_word 51 ! eve_erase_start_of_line 52 ! eve_fill_paragraph 53 ! eve_fill 53a ! fill$preserve_blanks 53a ! fill$skip_leading_spaces 53b ! fill$find_whiteline 53b ! fill$skip_lines 53b ! eve$paragraph_break 54 ! eve_forward 55 ! eve_reverse 55 ! eve_go_to 56 ! eve_set_insert_mode 57 ! eve_set_overstrike_mode 57 ! eve_line 58 ! eve_current_line 58a ! eve_lowercase_word 59 ! eve_uppercase_word 59 ! eve_mark 60 ! eve_move_by_word 61 ! eve_move_by_character 61 ! eve_quit 62 ! eve_quote 63 ! eve_replace 64 ! eve_set_left_margin 66 ! eve_set_right_margin 67 ! eve_start_of_line 68 ! eve$check_bad_window 69 File and window commands ! eve_buffer 70 ! eve_get_file 71 ! eve_read_file 71 ! eve$read_in_file 71 ! eve$create_buffer 71 ! eve_set_read_only 72 ! eve_set_write 72 ! eve_include_file 73 ! eve_single_window 74 ! eve_next_window 75 ! eve_previous_window 75 ! eve_split_window 76 ! eve_shrink_window 76 ! eve_expand_window 76 ! eve_write_file 77 ! eve_write_selected 77a ! eve_refresh 78 Additional screen commands ! eve_set_tabs_at 79 ! eve_set_tabs_every 79 ! eve_set_search_end 80 ! eve_set_search_beginning 80 ! eve_set_width 81 ! eve_shift_left 82 ! eve_shift_right 82 ! eve_show 83 ! eve$show_buffer_info 83 ! eve_list_buffers 84 ! eve_attach 85 Advanced commands ! eve_dcl 86 ! eve_background 86a ! eve_define_key 87 ! eve_extend_tpu 88 ! eve_learn 89 ! eve_remember 89 ! eve_repeat 90 ! eve_save_extended_tpu 91 ! eve_set_shift_key 92 ! eve$get_shift_key 92 ! eve_spawn 93 ! eve_tpu 94 ! eve_spell 94a ! eve_sort 94b ! eve_ruler 94c ! eve_mark_corner 94d ! Rectangular cut and paste routines ! eve$get_rectangle 94d ! eve_extract_rectangle 94d ! eve_copy_rectangle 94d ! eve$put_rectangle 94d ! eve_insert_rectangle 94d ! eve_overlay_rectangle 94d ! eve$goto_line_col 94d ! eve_pad_buffer 94e ! eve_pad_selected 94e ! eve_pad_line 94e ! eve_comment_text 94f ! eve$comment_buffer 94f ! eve$enter_command_window 95 Command line parser ! eve$exit_command_window 95 ! eve$process_command 96 ! eve_recall 97 ! eve_do 98 ! eve$index_over_whitespace 99 ! eve$get_token 100 ! eve$complete 101 ! eve$double_quotes 102 ! eve$add_final_string 103 ! eve$parse 104 ! eve$init_key 105 ! eve$clear_key 105 ! eve$standard_keys 106 ! 107 ! 108 ! tpu$local_init 109 ! eve$init_buffer 110 ! tpu$init_procedure 111 ! Page 2 ! ! As documented in the User's Guide to EVE, procedures with names beginning ! with eve_ are EVE commands. The procedures with names beginning with eve$ ! may be useful in extending EVE. However, these procedures are subject to ! change. In the future, Digital may supply new procedures beginning with ! eve$, remove some of the eve$ procedures, or change existing eve$ ! procedures. The same is true for global variables with names beginning ! with eve$. User-written procedures should not begin with eve$. ! Initialize Eve variables ! Global variables should be initialized to eliminate the possible ! confusion of global variables with procedure names procedure eve$init_variables ! Utility procedures ! Global string constants eve$x_version := ! Eve version number "Eve_EDT Version V2.0-000"; eve$x_null := ""; ! Null string eve$x_eol := " "; ! end of line eve$x_eof := ""; ! end of file, ^Z eve$x_tab := " "; ! tab eve$x_spaces := ! Used for padding " "; eve$x_word_separators := ! Word separators: space, horizontal tab, ! form feed, carriage return, vertical tab, ! and line feed (+ "programmer's" word ! separators -rcy) " ._$-+[]{}()%*/\&@,!?;:"; eve$x_whitespace := " "; ! Whitespace characters: space & horizontal tab eve$x_token_separators := ! Token separators: space and horizontal tab " "; eve$x_symbol_characters := ! Symbol characters are alphanumerics plus ! "$" and "_", including multinational ! character set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$_" + "àáâãäåæçèéêëìíîïñòóôõö÷øùúûüýÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖ×ØÙÚÛÜÝß"; eve$x_runoff_characters := ! Characters used to begin Runoff commands "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!;"; eve$x_digit_characters := ! Digits "0123456789"; eve$x_not_alphabetic := ! Non-alphabetic graphic characters "!@#$%^&*()[]{}-_+=~`|\:;""'<,>.?/¡¢£¥§¨©ª«°±²³µ¶·¹º»¼½¿"; eve$x_command_prompt := ! Command prompt for Do key "Command: "; eve$x_comment_string := ">"; ! Global integer constants eve$x_choice_window_length := 6; ! Length of window where choices are displayed ! for ambiguous commands, files, buffers, etc. eve$x_command_prompt_length := 9; ! Length of eve$x_command_prompt eve$x_default_left_margin := 1; ! Left margin for new buffers eve$x_default_right_margin := 1; ! Amount to subtract from window width ! for right margin for new buffers eve$x_hot_zone_size := 3; ! Number of characters before right margin ! where word wrap will occur (changed ! from 8 - rcy eve$x_largest_right_margin := 983; ! Maximum value allowed by set (margins...) eve$x_largest_width := 65535; ! Maximum value allowed by set (width...) eve$x_max_buffer_name_length := 43; ! Buffer names can be any size, but this is ! the largest size that will be shown on ! the status line without being truncated eve$x_max_mark_length := 82; ! 132 - 50 (see execute's in go to and show) eve$x_max_scroll_offset := 4; ! Maximum number of lines above/below the ! final position of a find command ! Global boolean constants true := 1; false := 0; ! Global keyword constants eve$x_highlighting := reverse; ! Highlighting used by select and replace ! Global pattern variables eve$pattern_end_of_word := ! End of a word ! Don't move off current character position ( anchor & ! If on eol,then match that ( (line_end) | ! Leading spaces, on a word delimiter ( (span (eve$x_whitespace)) & (any (eve$x_word_separators) | ''))) | ! No leading spaces, on a word delimiter, move one past it (any (eve$x_word_separators)) | ! No leading spaces, on a real word, go one beyond it (scan (eve$x_word_separators)) | ! No leading spaces, on a last real word of line, match rest of line remain ) & ! After matching, skip over trailing spaces if any, ! except if match occurred at the eol. In this case, don't skip over blanks (line_begin | span (eve$x_whitespace) | '') ; eve$pattern_paragraph_break := ! Blank line or Runoff command line anchor & line_begin & (("." & any (eve$x_runoff_characters)) | ((eve$x_null | span (eve$x_word_separators)) & line_end)); eve$pattern_startprocedure := ! Start of a VAXTPU procedure line_begin & "procedure" & span (eve$x_word_separators); eve$pattern_afterprocname := ! What you can find after a procedure name line_end | any (eve$x_word_separators) | any (";!("); eve$pattern_endprocedure := ! End of a VAXTPU procedure (line_begin & "endprocedure") & (line_end | any (eve$x_word_separators) | any (";!")); eve$pattern_procname := ! VAXTPU procedure name anchor & (span (eve$x_symbol_characters) | remain); eve$pattern_whitespace := anchor & (span (eve$x_whitespace)); eve$pattern_trim := span (" ") & line_end; ! Used for trimming buffer ! Global string variables eve$x_argument_type := eve$x_null; ! Type of argument expected by eve$parse ! Can be "integer" or "string" eve$x_command_line := eve$x_null; ! Command as typed after pressing Do eve$x_do_line := eve$x_null; ! Last line given to do command eve$x_deleted_char := eve$x_null; ! String to be inserted by unerase character eve$x_deleted_word := eve$x_null; ! String to be inserted by unerase word eve$x_deleted_line := eve$x_null; ! String to be inserted by unerase line eve$x_target := eve$x_null; ! Last string given to find command ! Global marker variables eve$x_select_position := 0; ! Marker for start of select range ! Global window variables eve$x_pre_command_window := 0; ! Current window when Do key is pressed eve$x_this_window := 0; ! Current text window using Eve window commands ! Global process variables eve$x_dcl_process := 0; ! DCL subprocess used by DCL command ! Global integer variables eve$x_ambiguous_parse := 0; ! True when choices are being displayed eve$x_buffer_of_mark := 0; ! Used by go to command eve$x_command_index := 1; ! Index into eve$x_command_line while parsing eve$x_command_length := 0; ! Length of eve$x_command_line eve$x_is_number := 0; ! True if current token is a number eve$x_is_symbol := 0; ! True if current token is a symbol eve$x_is_quoted_string := 0; ! True if current token is a quoted string eve$x_is_punctuation := 0; ! True if current token is punctuation eve$x_number_of_windows := 1; ! Number of windows currently being displayed eve$x_repeat_count := 1; ! Number of times to execute current command eve$x_restoring_line := 0; ! True if restore line command needs to do a ! split_line after the copy_text eve$x_restoring_word_line := 0; ! True if restore word command needs to do a ! split_line after the copy_text eve$x_restoring_char_line := 0; ! True if restore char command needs to do a ! split_line after the copy_text eve$x_end_restore_word := 0; ! True if after a restore word the cursor is ! to be placed at the end of the word. eve$x_end_restore_char := 0; ! True if after a restore char the cursor is ! to be placed at the end of the char. eve$x_search_at_end := False; ! True if we do a set search end. eve$x_starting_up := 1; ! True during tpu$init_procedure eve$x_trimming := 0; ! True if lines should be trimmed of ! extra spaces before writing files eve$x_vt200_keypad := 0; ! True if LK201 keyboard is being used ! These were added for plus$vertical eve_x_target_column := 1; ! Column that we are trying to get to. eve_x_prev_column := 1; ! The previous column that we set. ! Error message codes: eve$_nomessage := 0; eve$_success := 1; eve$_invparam := 2; eve$_colnotreached := 4; eve$_tabatcol := 6; eve$_linenotreached := 8; ! Argument information for eve$parse eve$arg1_buffer := "string"; eve$arg1_background := "string"; eve$arg1_comment_text := "string"; eve$arg1_current_line := "integer"; eve$arg1_dcl := "string"; eve$arg1_define_key := "string"; eve$arg1_do := "string"; eve$arg1_extend_tpu := "string"; eve$arg1_find := "string"; eve$arg1_get_file := "string"; eve$arg1_go_to := "string"; eve$arg1_help := "string"; eve$arg1_include_file := "string"; eve$arg1_list_buffers := "string"; eve$arg1_line := "integer"; eve$arg1_mark := "string"; eve$arg1_pad_buffer := "integer"; eve$arg1_pad_selected := "integer"; eve$arg1_pad_line := "integer"; eve$arg1_read_file := "string"; eve$arg1_repeat := "integer"; eve$arg1_replace := "string"; eve$arg2_replace := "string"; eve$arg1_save_extended_tpu := "string"; eve$arg1_set_left_margin := "integer"; eve$arg1_set_right_margin := "integer"; eve$arg1_set_tabs_at := "string"; eve$arg1_set_tabs_every := "integer"; eve$arg1_set_width := "integer"; eve$arg1_shift_left := "integer"; eve$arg1_shift_right := "integer"; eve$arg1_spawn := "string"; eve$arg1_tpu := "string"; eve$arg1_write_file := "string"; eve$arg1_write_selected := "string"; endprocedure; ! Page 3 ! Returns a range for the current word (the next word if between words). ! Cursor moves to end of the word. Returns 0 if no current word. ! Used by change-case commands and others. procedure eve$current_word local start_current_word, ! Marker for start of range end_current_word, ! Marker for end of range this_position; ! Marker for current cursor position this_position := mark (none); if this_position = end_of (current_buffer) then return (0); endif; if current_character = eve$x_null then move_horizontal (1); return (create_range (this_position, this_position, none)); endif; ! If current character is a word separator, go to next word if index (eve$x_word_separators, current_character) <> 0 then eve$end_of_word; endif; ! Go to end of word first - eve$start_of_word goes back a word ! when current cursor is at the start of a word eve$end_of_word; move_horizontal (-1); end_current_word := mark (none); eve$start_of_word; start_current_word := mark (none); return (create_range (start_current_word, end_current_word, none)); endprocedure; ! Page 4 ! Tests for start of word. Returns true or false. procedure eve$at_start_of_word if current_offset = 0 then return (1); endif; if index (eve$x_word_separators, current_character) = 0 then move_horizontal (-1); if index (eve$x_word_separators, current_character) <> 0 then eve$at_start_of_word := 1; else eve$at_start_of_word := 0; endif; move_horizontal (1); else eve$at_start_of_word := 0; endif; endprocedure; ! Page 5 ! Go to the beginning of a word. Return amount moved, or 0 if at ! start of line. procedure eve$start_of_word local temp_length, ! Distance moved temp_char; ! Character to check if current_offset = 0 then return (0); endif; ! Added this if statement to take care of 1 character words. -rcy if index (eve$x_word_separators, current_character) <> 0 then move_horizontal (-1); ! Skip current character temp_length := 1; else temp_length := 0; endif; ! Count any spaces loop exitif current_offset = 0; exitif index (eve$x_word_separators, current_character) = 0; move_horizontal (-1); temp_length := temp_length + 1; endloop; ! If we are on a word terminator count that one character. ! Otherwise scan to the next word terminator. if (index (eve$x_word_separators, current_character) = 0) then loop exitif current_offset = 0; move_horizontal (-1); if (index (eve$x_word_separators, current_character) <> 0) then move_horizontal (1); exitif 1; endif; temp_length := temp_length + 1; endloop; endif; return (temp_length); endprocedure; ! Page 5a ! Go to the next whitespace backwards. Return amount moved, or 0 if at start ! of line. procedure eve$previous_whitespace local temp_length, ! Distance moved temp_char; ! Character to check if current_offset = 0 then return (0); endif; ! Added this if statement to take care of 1 character words. -rcy if index (eve$x_whitespace, current_character) <> 0 then move_horizontal (-1); ! Skip current character temp_length := 1; else temp_length := 0; endif; ! Count any spaces loop exitif current_offset = 0; exitif index (eve$x_whitespace, current_character) = 0; move_horizontal (-1); temp_length := temp_length + 1; endloop; ! If we are on a whitespace count that one character. ! Otherwise scan to the next whitespace. if (index (eve$x_whitespace, current_character) = 0) then loop exitif current_offset = 0; move_horizontal (-1); if (index (eve$x_whitespace, current_character) <> 0) then move_horizontal (1); exitif 1; endif; temp_length := temp_length + 1; endloop; endif; return (temp_length); endprocedure; ! Page 6 ! Find the end of the word procedure eve$end_of_word local temp_length, ! Distance moved temp_range; ! Range from current position to end of word on_error ! Suppress "string not found" error message return (0); endon_error; if current_character = eve$x_null then return (0); endif; temp_range := search (eve$pattern_end_of_word, forward); temp_length := length (temp_range); move_horizontal (temp_length); return (temp_length); endprocedure; ! Page 7 ! Append line, deleting whitespace in left margin procedure eve$append_line local this_position, ! Marker for current cursor position how_many_chars, ! How many characters to erase during append all_spaces, ! True if all spaces in left margin left_margin, ! Current left margin this_line, ! Current line this_line_index, ! Index into this_line this_line_length; ! Length of this_line left_margin := get_info (current_buffer, "left_margin"); this_position := mark (none); if (get_info (current_buffer, "offset_column") > left_margin) or (this_position = beginning_of (current_buffer)) then return (0); endif; if this_position = end_of (current_buffer) then move_horizontal (-1); if (current_offset = 0) then erase_line; endif; return (1); endif; move_horizontal (- current_offset); how_many_chars := 0; all_spaces := 1; ! Check to see if everything in the margin is spaces loop exitif current_character = eve$x_null; exitif get_info (current_buffer, "offset_column") = left_margin; if index (eve$x_word_separators, current_character) > 0 then how_many_chars := how_many_chars + 1; move_horizontal (1); else all_spaces := 0; exitif 1; endif; endloop; if all_spaces then erase_character (- how_many_chars); ! Check for a line of all spaces - primarily for overstrike deletes this_line := current_line; this_line_index := 1; this_line_length := length (this_line); loop exitif this_line_index > this_line_length; exitif substr (this_line, this_line_index, 1) <> " "; this_line_index := this_line_index + 1; endloop; if this_line_index > this_line_length then erase_line; move_horizontal (-1); else append_line; endif; eve$append_line := 1; else ! Otherwise there were characters in the left margin ! If at start of line, delete the leading spaces and ! append the line; else act like the delete key position (this_position); if current_offset = 0 then erase_character (how_many_chars); append_line; eve$append_line := 1; else if get_info (current_buffer, "mode") = overstrike then move_horizontal (-1); copy_text (" "); move_horizontal (-1); else erase_character (-1); endif; eve$append_line := 0; endif; endif; endprocedure; ! Page 8 ! Capitalize a string - like change_case (string, capital) would be ! Ignore leading punctuation, so things like "Hi" and (foo) can be ! capitalized. ! ! Parameters: ! ! cap_string String to be capitalized - input/output procedure eve$capitalize_string (cap_string) local initial_letter, ! Initial substring ending at first letter initial_index, ! Loop index used in search for first letter cap_string_length, ! Length of cap_string parameter rest_of_string; ! Remainder of cap_string after initial_letter initial_index := 1; cap_string_length := length (cap_string); loop initial_letter := substr (cap_string, 1, initial_index); exitif initial_index = cap_string_length; exitif index (eve$x_not_alphabetic, substr (cap_string, initial_index, 1)) = 0; initial_index := initial_index + 1; endloop; rest_of_string := substr (cap_string, initial_index + 1, cap_string_length); change_case (initial_letter, upper); change_case (rest_of_string, lower); cap_string := initial_letter + rest_of_string; endprocedure; ! Page 9 ! Procedure to check if a key is a printing character (in DEC Multinational ! set). Returns the character if alphabetic, else returns the null string. ! ! Parameters: ! ! this_key Keyword of key to check - input procedure eve$alphabetic (this_key) local ascii_key; ! String for this_key ascii_key := ascii (this_key); if ascii_key = ascii (0) then return (eve$x_null); else return (ascii_key); endif; endprocedure; ! Eliminates extra whitespace and trailing punctuation from a string. ! ! Parameters: ! ! this_string String to be modified - input/output procedure eve$cleanse_string (this_string) if index ("\|", substr (this_string, length (this_string), 1)) > 0 then this_string := substr (this_string, 1, length (this_string) - 1); endif; edit (this_string, trim); endprocedure; ! Pad a string out to a specified length. If the string is longer than ! the length specified by pad_length, then just pass it back. 3/6/87 -rcy ! ! Parameters: ! ! this_string String to be modified - input/output ! pad_length Length to pad string out to. procedure eve$pad_string (this_string,pad_length) local temp_fao_string; ! A temp string to hold the result of FAO call if length(this_string) < pad_length then ! Heh, heh, what we do here is be a bit tricky. Just call FAO *twice*! ! The first call creates the proper FAO string to pad a string out to ! pad_length, the second does the actual padding. temp_fao_string := FAO ("!!!SLAS",pad_length); this_string := FAO (temp_fao_string,this_string); endif; ! if string_length < pad_length endprocedure; ! eve$pad_string ! Lookup a comment for a key, trimming any leading spaces which may be ! used by Eve to differentiate between Eve- and user-defined keys. ! Returns the string with the trimmed comment. ! ! Parameters: ! ! this_key ! Keyword of key to lookup - input procedure eve$lookup_comment (this_key) local key_comment; ! String containing key comment to be returned key_comment := lookup_key (this_key, comment); edit (key_comment, trim_leading); return (key_comment); endprocedure; ! Page 10 ! Prompts for a single key; returns the keyword for that key. ! ! Parameters: ! ! prompt Text of prompt - input procedure eve$prompt_key (prompt) local this_key; ! Keyword of key read after prompt map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text (prompt); update (eve$prompt_window); this_key := read_key; if eve$lookup_comment (this_key) = "shift key" then this_key := eve$get_shift_key; endif; unmap (eve$prompt_window); return (this_key); endprocedure; ! Page 11 ! Procedure used by commands which prompt for integers. ! Returns true if prompting worked or was not needed, false otherwise. ! ! Parameters: ! ! old_number Old integer value - input ! new_number New integer value - output ! prompt_string Text of prompt - input ! no_value_message Message printed if user hits Return to ! get out of the command - input procedure eve$prompt_number (old_number, new_number, prompt_string, no_value_message) local read_line_string; ! String read after prompt new_number := old_number; if old_number < 0 then read_line_string := read_line (prompt_string); eve$cleanse_string (read_line_string); if read_line_string = eve$x_null then message (no_value_message); return (0); else translate (read_line_string, "1", "l"); new_number := int (read_line_string); if (new_number = 0) and (read_line_string <> "0") then message (fao ("Don't understand !AS", read_line_string)); return (0); else return (1); endif; endif; else return (1); endif; endprocedure; ! Page 12 ! Procedure used by commands which prompt for strings. ! Returns true if prompting worked or was not needed, false otherwise. ! ! Parameters: ! ! old_string Old string value - input ! new_string New string value - output ! prompt_string Text of prompt - input ! no_value_message Message printed if user hits Return to ! get out of the command - input procedure eve$prompt_string (old_string, new_string, prompt_string, no_value_message) local read_line_string; ! String read after prompt new_string := old_string; if old_string = eve$x_null then new_string := read_line (prompt_string); if new_string = eve$x_null then message (no_value_message); return (0); else return (1); endif; else return (1); endif; endprocedure; ! Page 13 ! Procedure to ensure that a change that inserts text before the ! top of the window displays the last line of the text on the ! first line of the window. procedure eve$show_first_line local old_position, ! Marker of position before scroll new_position; ! Marker of position after scroll update (current_window); if (get_info (current_window, "current_row") = get_info (current_window, "visible_top")) and (current_column = 1) then old_position := mark (none); scroll (current_window, -1); new_position := mark (none); ! Make sure we scrolled before doing the cursor_vertical if new_position <> old_position then cursor_vertical (1); endif; endif; endprocedure; ! Page 14 ! Move to a new position in the current window, putting the new position ! in the middle of the window by temporarily resetting the scrolling region. ! ! Parameters: ! ! new_position New cursor position - input procedure eve$position_in_middle (new_position) local scroll_offset, ! New value for scroll_top and scroll_bottom old_scroll_top, ! Original value of scroll_top old_scroll_bottom, ! Original value of scroll_bottom old_scroll_amount, ! Original value of scroll_amount this_window; ! Current window this_window := current_window; scroll_offset := (get_info (this_window, "visible_length") / 2) - 1; if scroll_offset < 0 then scroll_offset := 0; else if scroll_offset > eve$x_max_scroll_offset then scroll_offset := eve$x_max_scroll_offset; endif; endif; old_scroll_top := get_info (this_window, "scroll_top"); old_scroll_bottom := get_info (this_window, "scroll_bottom"); old_scroll_amount := get_info (this_window, "scroll_amount"); set (scrolling, this_window, on, scroll_offset, scroll_offset, 0); position (new_position); update (this_window); set (scrolling, this_window, on, old_scroll_top, old_scroll_bottom, old_scroll_amount); endprocedure; ! Page 15 ! Procedures to help with choices for ambiguous names ! Take the result of an expand_name command, and put each of the choices on ! a separate line in the choice buffer. Erase any previous choices in the ! choice buffer. Cursor is left at beginning of choice buffer. ! ! Parameters: ! ! expanded_string Result of expand_name - input procedure eve$expand_to_choices (expanded_string) on_error if error = tpu$_strnotfound then position (beginning_of (eve$choice_buffer)); return; endif; endon_error; position (eve$choice_buffer); erase (eve$choice_buffer); if expanded_string = eve$x_null then return; endif; copy_text (expanded_string); position (beginning_of (eve$choice_buffer)); ! Search for spaces, exit when you cannot find any more (through on_error) loop position (search (" ", forward, exact)); erase_character (1); split_line; endloop; endprocedure; ! Add a string on a new line in the choice buffer ! ! Parameters: ! ! choice_string String to add to choice buffer - input procedure eve$add_choice (choice_string) local this_buffer, ! Current buffer this_position; ! Current position in the buffer this_buffer := current_buffer; this_position := mark (none); position (end_of (eve$choice_buffer)); copy_text (choice_string); position (this_buffer); endprocedure; ! Page 16 ! Combines two tests: if there is only one item in the choice buffer, ! return that string as the choice. Otherwise, if the input string is ! an exact choice in the choice buffer, return the input string ! as the choice. If neither test is true, return the null string. ! Assume that cursor is at beginning of choice buffer (procedure is ! called after eve$expand_to_choices). ! ! Parameters: ! ! choice_string String to add to choice buffer - input procedure eve$get_choice (choice_string) on_error if error = tpu$_strnotfound then return (eve$x_null); endif; endon_error; if get_info (eve$choice_buffer, "record_count") <> 1 then position (search (line_begin & choice_string & line_end, forward, no_exact)); endif; return (current_line); endprocedure; ! Procedure to strip the first n characters off of the name of each ! choice in the choice buffer. Used for mark and command names. ! Leaves cursor at end of choice buffer. ! ! Parameters: ! ! how_much_to_strip Number of characters to strip - input procedure eve$strip_choices (how_much_to_strip) position (beginning_of (eve$choice_buffer)); loop exitif mark (none) = end_of (eve$choice_buffer); erase_character (how_much_to_strip); move_vertical (1); endloop; endprocedure; ! Page 17 ! Format the choice buffer (one choice per line) into nicely formatted ! columns. Assume that current position is in the choice buffer. procedure eve$format_choices local total_width, ! Screen width how_many_columns, ! Number of columns in display column_width, ! Width for each column which_column, ! Column index used during formatting leftover, ! Used in computation of column width string_position, ! Index into expanded_string which_item, ! String for current column entry how_many_items; ! How many items need to be formatted position (beginning_of (eve$choice_buffer)); how_many_items := get_info (eve$choice_buffer, "record_count"); if how_many_items = 0 then return; endif; loop exitif mark (none) = end_of (eve$choice_buffer); if column_width < length (current_line) then column_width := length (current_line); endif; move_vertical (1); endloop; total_width := get_info (screen, "width"); column_width := column_width + 2; how_many_columns := (total_width - 1) / column_width; if (how_many_columns * column_width) > total_width then ! rounded up how_many_columns := how_many_columns - 1; endif; if how_many_columns = 0 then how_many_columns := 1; else if how_many_items < how_many_columns then how_many_columns := how_many_items; column_width := (total_width - 1) / how_many_items; if (how_many_columns * column_width) > total_width then ! rounded up column_width := column_width - 1; endif; else loop leftover := (total_width - 1) - (how_many_columns * column_width); exitif leftover < how_many_columns; column_width := column_width + 1; endloop; endif; endif; which_column := 1; string_position := 1; position (beginning_of (eve$choice_buffer)); split_line; loop exitif mark (none) = end_of (eve$choice_buffer); which_item := erase_line; move_horizontal (-1); eve$capitalize_string (which_item); if (which_column = 1) and (column_width <= total_width) then copy_text (" "); endif; copy_text (which_item); if which_column = how_many_columns then if how_many_columns = 1 then eve$letter_wrap (0); endif; split_line; which_column := 1; else copy_text (substr (eve$x_spaces, 1, column_width - length (which_item))); which_column := which_column + 1; endif; move_horizontal (1); endloop; if which_column > 1 then split_line; endif; endprocedure; ! Procedure to enable displaying of choices. ! ! Parameters: ! ! message_to_display ! Error message for message window - input procedure eve$display_choices (message_to_display) local this_buffer, ! Current buffer this_position; ! Marker for current cursor position this_buffer := current_buffer; this_position := mark (none); position (end_of (eve$choice_buffer)); eve$format_choices; eve$x_ambiguous_parse := 1; position (beginning_of (eve$choice_buffer)); position (this_buffer); message (message_to_display); endprocedure; ! Page 18 ! Letter-wrap the current line. ! ! Parameters: ! ! left_indent Number of spaces at start of continued ! line - input procedure eve$letter_wrap (left_indent) local wrap_width, ! Screen width this_position, ! Marker for current cursor position what_column; ! Current column wrap_width := get_info (screen, "width"); this_position := mark (none); loop position (search (line_end, forward)); what_column := get_info (current_buffer, "offset_column"); exitif what_column <= wrap_width; move_horizontal (wrap_width - what_column); split_line; eve$to_column (left_indent); endloop; position (this_position); endprocedure; ! Page 19 ! Insert (not overstrike) spaces from current position until given column. ! If current offset greater than column, do nothing. ! ! Parameters: ! ! which_column Column to go to - input procedure eve$to_column (which_column) local this_buffer, ! Current buffer this_mode, ! Keyword for current mode distance; ! Number of spaces needed this_buffer := current_buffer; this_mode := get_info (this_buffer, "mode"); set (insert, this_buffer); loop distance := which_column - get_info (this_buffer, "offset_column"); exitif distance <= 0; if distance > length (eve$x_spaces) then copy_text (eve$x_spaces); else copy_text (substr (eve$x_spaces, 1, distance)); endif; endloop; set (this_mode, this_buffer); endprocedure; ! Indent this line to the specified column, making using of existing whitespace ! Leave cursor at the specified column. ! ! Parameters: ! ! which_column ! Column to indent to - input procedure eve$indent_line_to (which_column) local this_position, ! Marker for current cursor position this_buffer; ! Current buffer this_buffer := current_buffer; move_horizontal (- current_offset); loop exitif get_info (this_buffer, "offset_column") >= which_column; if (current_character = " ") or (current_character = ascii (9)) then move_horizontal (1); else exitif 1; endif; endloop; eve$to_column (which_column); endprocedure; ! Page 20 ! Procedures for trimming lines of extra whitespace ! Trim this line of extra spaces at end procedure eve_trim_line local eol_position, ! end of current line spaces_to_trim; ! number of spaces eol_position := search (line_end, forward); position (eol_position); loop exitif current_offset = 0; move_horizontal (-1); exitif index (eve$x_whitespace, current_character) = 0; spaces_to_trim := spaces_to_trim + 1; endloop; position (eol_position); erase_character (- spaces_to_trim); endprocedure; ! Trim each line in the current buffer. procedure eve_trim_buffer eve$trim_buffer (current_buffer); endprocedure; ! Trim each line in a buffer. Only trim spaces, not other whitespace. ! ! Parameters: ! ! trim_buffer Buffer to trim - input procedure eve$trim_buffer (trim_buffer) local this_position, ! Marker for current cursor position this_buffer, ! Current buffer trim_range; ! Range with trailing spaces on_error if error = tpu$_strnotfound then trim_range := 0; endif; endon_error; message ("Trimming buffer..."); this_position := mark (none); this_buffer := current_buffer; if trim_buffer = eve$x_null then trim_buffer := current_buffer; endif; position (beginning_of (trim_buffer)); loop trim_range := search (eve$pattern_trim, forward); exitif trim_range = 0; position (beginning_of (trim_range)); erase_character (length (trim_range)); endloop; position (trim_buffer); position (this_position); message ("Trimming completed"); endprocedure; ! Page 21 ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! ! Parameters: ! ! this_window Window whose status line is being set - input procedure eve$set_status_line (this_window) local this_buffer, ! Current buffer mode_string, ! String version of current mode direction_string, ! String version of current direction read_write_string, ! String version of read/write status of buffer buffer_name; ! String containing name of current buffer this_buffer := get_info (this_window, "buffer"); ! Don't add a status line to windows without a status line if (this_buffer = 0) or (get_info (this_window, "status_line") = 0) then return; endif; if get_info (this_buffer, "mode") = insert then mode_string := " Insert "; else mode_string := "Overstrike"; endif; if get_info (this_buffer, "direction") = reverse then direction_string := "Reverse"; else direction_string := "Forward"; endif; if get_info (this_buffer, "no_write") then read_write_string := "Read "; else read_write_string := "Write"; endif; buffer_name := get_info (this_buffer, "name"); if length (buffer_name) > eve$x_max_buffer_name_length then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length); else buffer_name := buffer_name + substr (eve$x_spaces, 1, eve$x_max_buffer_name_length - length (buffer_name)); endif; set (status_line, this_window, reverse, " Buffer " + buffer_name + " " + read_write_string + " " + mode_string + " " + direction_string); endprocedure; ! Page 22 ! Update the status line in all windows mapped to the current buffer procedure eve$update_status_lines local this_buffer, ! Current buffer loop_window; ! Window currently being checked in loop this_buffer := current_buffer; if get_info (this_buffer, "map_count") > 1 then loop_window := get_info (window, "first"); loop exitif loop_window = 0; if get_info (loop_window, "buffer") = this_buffer then eve$set_status_line (loop_window); endif; loop_window := get_info (window, "next"); endloop; else eve$set_status_line (current_window); endif; endprocedure; ! Page 23 ! Toggle direction between forward and reverse procedure eve_change_direction ! Keypad commands if current_direction = forward then set (reverse, current_buffer); else set (forward, current_buffer); endif; eve$update_status_lines; endprocedure; ! Toggle mode between insert and overstrike procedure eve_change_mode if get_info (current_buffer, "mode") = overstrike then set (insert, current_buffer); else set (overstrike, current_buffer); endif; eve$update_status_lines; endprocedure; ! Page 24 ! Delete previous character procedure eve_delete local this_position; ! Marker for current cursor position ! 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, "offset_column") <= (eve$x_command_prompt_length + 1) then return; endif; endif; ! Since we are deleting the previous character, any restore of the word should ! leave the cursor at the end of said character. - rcy eve$x_end_restore_char := 1; if get_info (current_buffer, "offset_column") <= get_info (current_buffer, "left_margin") then eve$append_line; eve$x_deleted_char := eve$x_null; eve$x_restoring_char_line := 1; else if get_info (current_buffer, "mode") = insert then eve$x_deleted_char := erase_character (-1); eve$x_restoring_char_line := 0; else eve$x_deleted_char := erase_character (-1); eve$x_restoring_char_line := 0; if eve$x_deleted_char <> ascii (9) then set (insert, current_buffer); copy_text (" "); set (overstrike, current_buffer); move_horizontal (-1); endif; endif; endif; endprocedure; ! Page 25 ! Erase next word procedure eve_erase_word local this_buffer, ! Current buffer this_mode, ! Keyword for current mode temp_string, ! String used to check for start of line start_erase_word, ! Marker for beginning of previous word end_erase_word, ! Marker for end of previous word spaces_to_erase, ! Number of between-word spaces to erase erase_word_range; ! Range for previous word this_buffer := current_buffer; if mark (none) = end_of (this_buffer) then return; endif; ! Since we are deleting words ahead of the cursor, after the restore we should ! end up at the beginning of the word. -rcy eve$x_end_restore_word := 0; ! Are we on a space between words? If so, delete whitespace to next word and ! exit. (slight modification by rcy, used to compress whitespace and blow away ! the next word, I like to stop at the beginning of the next word.) if index (eve$x_whitespace, current_character) <> 0 then start_erase_word := mark (none); loop move_horizontal (1); if index (eve$x_whitespace, current_character) = 0 then move_horizontal (-1); exitif 1; endif; endloop; ! loop 'till we get to the end of the whitespace end_erase_word := mark (none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_restoring_word_line := 0; eve$x_deleted_word := erase_character (length (erase_word_range)); return; endif; ! Check for end of line if current_character = eve$x_null then if current_offset = 0 then temp_string := ascii (10); else move_horizontal (-1); temp_string := current_character; move_horizontal (1); endif; move_horizontal (1); eve$append_line; if mark (none) <> end_of (this_buffer) then if index (eve$x_word_separators, temp_string) = 0 then this_mode := get_info (this_buffer, "mode"); set (insert, this_buffer); copy_text (" "); set (this_mode, this_buffer); endif; endif; eve$x_restoring_word_line := 1; eve$x_deleted_word := eve$x_null; else start_erase_word := mark (none); eve$end_of_word; move_horizontal (-1); end_erase_word := mark (none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_restoring_word_line := 0; eve$x_deleted_word := erase_character (length (erase_word_range)); endif; endprocedure; ! Page 25a ! Restores last word procedure eve_restore_word local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode at_top, ! boolean variable indicating if we started at ! the top of the buffer. this_position, ! Used to come back to the beginning of the line temp_position; ! Used to check for end of buffer this_buffer := current_buffer; this_mode := get_info (this_buffer, "mode"); temp_position := mark (none); ! check for end of buffer ! Store the current position - 1 character, or BOB if there. if (temp_position <> beginning_of(this_buffer)) then move_horizontal(-1); this_position := mark (none); move_horizontal(1); at_top := false; else at_top := true; endif; set (insert, this_buffer); copy_text (eve$x_deleted_word); if (eve$x_restoring_word_line) and (temp_position <> end_of (this_buffer)) then split_line; endif; set (this_mode, this_buffer); ! Now we put the cursor at the beginning of the insert, but only if ! eve$x_end_restore_word is false. if not eve$x_end_restore_word then if not at_top then position (this_position); move_horizontal (1); else position(beginning_of(this_buffer)); endif; endif; endprocedure; ! Page 26 ! Delete all whitespace surrounding the current character, except for ! the first whitespace character (delete that too if at start of line). ! Position cursor at beginning of next word. No-op if current character ! is not whitespace. Trim spaces if at end of line. procedure eve$compress_whitespace if current_character = eve$x_null then eve_trim_line; return; endif; if index (eve$x_whitespace, current_character) = 0 then return; endif; loop exitif current_offset = 0; move_horizontal (-1); if index (eve$x_whitespace, current_character) = 0 then move_horizontal (2); ! leave first whitespace if not at start of line exitif 1; endif; endloop; if index (eve$x_whitespace, current_character) <> 0 then erase (search (eve$pattern_whitespace, forward)); endif; endprocedure; ! Page 27 ! Exit Eve. Write the current buffer if modified, and ask the user ! about writing out any other modified buffers. procedure eve_exit local exit_buffer, ! Current buffer being checked for writing exit_buffer_name, ! String with name of exit_buffer original_reply, ! String returned by read_line after prompt write_reply; ! Lowercase version of original_reply on_error ! Lots of different errors possible from write_file, doesn't matter here set (success, on); message (fao ("Will not exit; could not write buffer !AS", exit_buffer_name)); return; endon_error; message (eve$x_null); exit_buffer_name := eve$x_null; exit_buffer := current_buffer; if (get_info (exit_buffer, "modified")) and (not (get_info (exit_buffer, "no_write"))) then if eve$x_trimming then eve$trim_buffer (exit_buffer); endif; write_file (exit_buffer); set (no_write, exit_buffer); endif; exit_buffer := get_info (buffers, "first"); loop exitif exit_buffer = 0; if (get_info (exit_buffer, "modified")) and (not (get_info (exit_buffer, "no_write"))) then exit_buffer_name := substr (get_info (exit_buffer, "name"), 1, eve$x_max_buffer_name_length); ! Loop until we get a yes/no reply (or just CR for yes) loop write_reply := read_line (fao ("Write buffer !AS? ", exit_buffer_name)); original_reply := write_reply; change_case (write_reply, lower); if (length (write_reply) = 0) or (write_reply = substr ("yes", 1, length (write_reply))) then if eve$x_trimming then eve$trim_buffer (exit_buffer); endif; write_file (exit_buffer); set (no_write, exit_buffer); exitif 1; else if write_reply = substr ("no", 1, length (write_reply)) then set (no_write, exit_buffer); exitif 1; else message (fao ("Don't understand !AS;", original_reply) + " please answer yes or no"); endif; endif; endloop; endif; exit_buffer := get_info (buffers, "next"); endloop; ! Avoid "editor successfully exiting" message - on_error will restore ! success messages set (success, off); exit; endprocedure; ! Page 27a ! modified write. Write out all modified buffers. -rcy procedure eve_write_modified local modified_buffer, ! Current buffer being checked for writing modified_buffer_name, ! String with name of modified_buffer original_reply, ! String returned by read_line after prompt write_reply; ! Lowercase version of original_reply on_error ! Lots of different errors possible from write_file, doesn't matter here set (success, on); message (fao ("Could not write buffer !AS",modified_buffer_name)); return; endon_error; message (eve$x_null); modified_buffer_name := eve$x_null; modified_buffer := get_info (buffers, "first"); loop exitif modified_buffer = 0; if (get_info (modified_buffer, "modified")) and (not (get_info (modified_buffer, "no_write"))) then modified_buffer_name := substr (get_info (modified_buffer, "name"), 1, eve$x_max_buffer_name_length); if eve$x_trimming then eve$trim_buffer (modified_buffer); endif; write_file (modified_buffer); endif; modified_buffer := get_info (buffers, "next"); endloop; endprocedure; ! write_modified ! Page 28 ! Top-level 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 eve_find (target) eve$find (target, 0, 0); endprocedure; procedure eve_findnext eve$find ('', 0, 1); endprocedure; ! Page 29 ! Search for target in the current direction. If not found in the ! current direction look in the opposite direction, but do not go ! there without prompting the user. Search is case-insensitive if ! target is all lowercase; otherwise is case-sensitive. ! Returns range if target found, otherwise returns false. ! ! Parameters: ! ! target String to find - input ! replacing If true, called by eve_replace; allow a ! match at current cursor position - input procedure eve$find (target, replacing, next) local new_target, ! Local copy of target lowercase_target, ! Lowercase version of eve$x_target start_find_key, ! String describing key used to invoke find stop_find_key, ! String describing key used after prompt target_length, ! Length of the target this_position, ! Marker for current cursor position how_exact, ! Keyword to indicate case-sensitivity find_range, ! Range returned by search other_direction, ! Keyword for opposite direction other_direction_string, ! String for message including other_direction find_reply, ! Reply to inquiry about changing direction change_direction_key; ! Keyword for key used to end find_reply on_error if error = tpu$_strnotfound then find_range := 0; endif; endon_error; if not next then start_find_key := eve$lookup_comment (last_key); if target <> eve$x_null then new_target := target; else if current_direction = forward then new_target := read_line ("Forward Find: "); else new_target := read_line ("Reverse Find: "); endif; endif; stop_find_key := eve$lookup_comment (last_key); else new_target := eve$x_null; start_find_key := "find"; stop_find_key := "find"; endif; if new_target = eve$x_null then if (start_find_key = "find") and (stop_find_key = "find") then if eve$x_target = eve$x_null then message ("No previous target to find"); return (0); else if get_info (eve$x_target, "type") = string then message (fao ("Finding previous target: !AS", eve$x_target)); else message ("Finding previous target: "); endif; endif; else message ("Nothing to find"); return (0); endif; else eve$x_target := new_target; endif; lowercase_target := eve$x_target; if get_info (lowercase_target, "type") = string then change_case (lowercase_target, lower); endif; if lowercase_target = eve$x_target then how_exact := no_exact; else how_exact := exact; endif; this_position := mark (none); target_length := length (eve$x_target); if current_direction = forward then if this_position <> end_of (current_buffer) then if not replacing then if not eve$x_search_at_end then move_horizontal (1); endif; endif; find_range := search (eve$x_target, forward, how_exact); else find_range := 0; endif; else if this_position <> beginning_of (current_buffer) then move_horizontal (-1); if eve$x_search_at_end then move_horizontal (-target_length); endif; find_range := search (eve$x_target, reverse, how_exact); else find_range := 0; endif; endif; if find_range = 0 then if current_direction = forward then other_direction := reverse; other_direction_string := "reverse"; else other_direction := forward; other_direction_string := "forward"; endif; position (this_position); if other_direction = forward then if this_position <> end_of (current_buffer) then if not eve$x_search_at_end then move_horizontal (1); endif; find_range := search (eve$x_target, forward, how_exact); else find_range := 0; endif; else if this_position <> beginning_of (current_buffer) then move_horizontal (-1); if eve$x_search_at_end then move_horizontal (-target_length); endif; find_range := search (eve$x_target, reverse, how_exact); else find_range := 0; endif; endif; if find_range = 0 then if get_info (eve$x_target, "type") = string then message (fao ("Could not find: !AS", eve$x_target)); else message ("Could not find: "); endif; position (this_position); return (0); else find_reply := read_line (fao ("Found in !AS direction. Go there? ", other_direction_string)); ! Hitting return or do means yes; hitting another non-typing ! key is probably a mistake, so interpret as no. if find_reply = eve$x_null then change_direction_key := eve$lookup_comment (last_key); if (change_direction_key = "return") or (change_direction_key = "do") then find_reply := "yes"; else find_reply := "no"; endif; else change_case (find_reply, lower); endif; if substr ("yes", 1, length (find_reply)) = find_reply then set (other_direction, current_buffer); eve$update_status_lines; if eve$x_search_at_end then eve$position_in_middle (end_of (find_range)); move_horizontal(1); else eve$position_in_middle (beginning_of (find_range)); endif; return (find_range); else position (this_position); return (0); endif; endif; else if eve$x_search_at_end then eve$position_in_middle (end_of (find_range)); move_horizontal(1); else eve$position_in_middle (beginning_of (find_range)); endif; return (find_range); endif; endprocedure; ! Page 30 ! Top-level help command. Calls eve$help_keypad for keypad help, ! otherwise provides help on Eve commands. ! ! Parameters: ! ! first_topic String containing topic from command ! line - input procedure eve_help (first_topic) local this_topic, ! Topic name as typed by user lowercase_topic, ! Lowercase version of this_topic last_key_name, ! Keyword for last key after help prompt expand_result, ! String of possible Eve commands this_window, ! Current window showing_commands; ! True if showing Eve command list this_window := current_window; this_topic := first_topic; map (info_window, help_buffer); last_key_name := "return"; message (eve$x_null); loop eve$cleanse_string (this_topic); lowercase_topic := this_topic; change_case (lowercase_topic, lower); if lowercase_topic = "keypad" then eve$help_keypad; exitif 1; endif; if (last_key_name = "screen") or (last_key_name = "next_screen") or (last_key_name = "previous_screen") then execute (lookup_key (last_key, program)); update (info_window); else if (lowercase_topic = eve$x_null) or (lowercase_topic = "?") or (lowercase_topic = "commands") then message (eve$x_null); this_topic := "eve_edt commands"; else expand_result := eve$parse (this_topic); if expand_result = eve$x_null then this_topic := "eve_edt commands"; else if index (expand_result, "(") = 0 then expand_result := substr (expand_result, 5, length (expand_result)); else expand_result := substr (expand_result, 5, index (expand_result, "(") - 5); endif; this_topic := "eve_edt " + expand_result; endif; endif; if this_topic = "eve_edt commands" then set (status_line, info_window, reverse, " Help buffer Press Next Screen or Prev Screen to see other commands"); if not showing_commands then eve$help_text (this_topic); endif; showing_commands := 1; else set (status_line, info_window, reverse, " Help buffer"); eve$help_text (this_topic); showing_commands := 0; endif; endif; if showing_commands then this_topic := read_line ("Type command you want help on (press Return if done): "); else this_topic := read_line ("Type command name, or ? for list (press Return if done): "); endif; eve$cleanse_string (this_topic); if this_topic = eve$x_null then last_key_name := eve$lookup_comment (last_key); if (expand_result = "tpu") and (last_key_name = "do") then help_text ("tpuhelp", "vaxtpu", on, help_buffer); exitif 1; else exitif (last_key_name = "return") or (last_key_name = "do") or (last_key_name = "exit"); endif; else last_key_name := "return"; endif; endloop; unmap (info_window); position (this_window); eve$x_ambiguous_parse := 0; message (eve$x_null); endprocedure; ! Page 31 ! Do help_text for a given topic, stripping librarian header information, ! and update the info_window. ! ! Parameters: ! ! topic String containing topic for VMS ! librarian - input procedure eve$help_text (topic) on_error ! Invalid topic, do our best update (info_window); return; endon_error; help_text ("eve_edthelp", topic, off, help_buffer); position (beginning_of (help_buffer)); move_vertical (5); this_range := search (eve$pattern_whitespace, forward); ! error if not found if length (this_range) > 4 then ! allow indentation if desired move_horizontal (3); else move_horizontal (length (this_range) - 1); endif; erase (create_range (beginning_of (help_buffer), mark (none), none)); update (info_window); endprocedure; ! Page 32 ! Procedure to display keypad-oriented help. Called by eve_help. procedure eve$help_keypad local help_char, ! Keyword of key to provide help on which_topic, ! String with help library subtopic showing_keypad; ! True if currently displaying keypad diagram which_topic := eve$x_null; set (status_line, info_window, reverse, " Help buffer"); eve$help_text ("eve_edt keypad_diagram"); showing_keypad := 1; loop if showing_keypad then help_char := eve$prompt_key ("Press key that you want help on (Return to leave help): "); else help_char := eve$prompt_key ("Press key that you want help on (Help for keypad, Return to leave help): "); endif; which_topic := eve$lookup_comment (help_char); exitif which_topic = "return"; if which_topic = eve$x_null then if eve$alphabetic (help_char) <> eve$x_null then which_topic := "typing"; else which_topic := "unknown"; endif; endif; if (which_topic = "help") and (not showing_keypad) then eve$help_text ("eve_edt keypad_diagram"); showing_keypad := 1; else eve$help_text ("eve_edt " + which_topic); showing_keypad := 0; endif; endloop; endprocedure; ! Page 33 ! Move to start of line if current direction is reverse; ! else move to end of line. If this would be a no-op, go ! to the start of the previous line or the end of the next line. procedure eve_move_by_line local beyond_eol; ! True if cursor beyond end of current line on_error return; endon_error; beyond_eol := get_info (current_window, "beyond_eol"); if current_direction = reverse then if not beyond_eol then if current_offset = 0 then move_vertical (-1); endif; endif; position (search (line_begin, reverse)); ! In command buffer, don't back up beyond prompt if current_buffer = eve$command_buffer then if substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then move_horizontal (eve$x_command_prompt_length); endif; endif; else if beyond_eol then position (search (line_begin, reverse)); update (current_window); move_vertical (1); else if current_character = eve$x_null then move_vertical (1); endif; endif; position (search (line_end, forward)); endif; endprocedure; procedure eve_new_line local remember_this_position; ! Marker for current cursor position eve$split_line; move_vertical (-1); if get_info (current_window, "beyond_eol") then position (search (line_begin, reverse)); endif; if mark (none) <> end_of (current_buffer) then if current_character <> eve$x_null then position (search (line_end, forward)); endif; endif; endprocedure; ! Page 34a ! Next Line !- procedure eve_move_by_bol !kp0 (next line) LOCAL o; ! edt equiv. of Keypad 0 o := current_offset; move_horizontal(- o); if current_direction = forward then move_vertical(1) else if o = 0 then move_vertical(-1) endif; endif; endprocedure; ! Page 34 ! Cursor motion procedures ! Move down one row, staying in the same column. Scroll if necessary. procedure eve_move_down if get_info (current_window, "current_row") = get_info (current_window, "visible_bottom") then scroll (current_window, 1); else cursor_vertical (1); endif; endprocedure; ! Move left one column. Do not wrap at edge of the screen. procedure eve_move_left cursor_horizontal (-1); endprocedure; ! Move right one column. Do not wrap at edge of the screen. procedure eve_move_right cursor_horizontal (1); endprocedure; ! Move up one row, staying in the same column. Scroll if necessary. procedure eve_move_up if get_info (current_window, "current_row") = get_info (current_window, "visible_top") then scroll (current_window, -1); else cursor_vertical (-1); endif; endprocedure; ! Page 34a !+ ! This routine was written on my first pass at an EDT like version of EVE... ! Not sure if I was the original writer or not, I might have stolen this ! from VTEDIT.TPU, a hack of EVE into a VTEDIT emulator written by Ned Freed ! and Kevin Carosso. -rcy ! ! Plus UP/DOWN cursor key motion ! Requires the following globals: ! eve_x_target_column := 1; ! eve_x_prev_column := 1; ! and the following definitions: ! define_key("plus$vertical(1)", down, " down_arrow"); ! down ! define_key("plus$vertical(-1)", up, " up_arrow"); ! up !- PROCEDURE plus$vertical(which_way) LOCAL temp_col, last_col, new_col, eob, buf; buf := current_buffer; EOB := end_of(Buf); last_col := get_info(buf,'offset_column'); IF (last_col <> eve_x_prev_column) THEN eve_x_target_column := last_col; ENDIF; move_vertical(which_way); new_col := get_info(buf,'offset_column'); !+ ! Now get us as close to the target as possible !- IF new_col <> eve_x_target_column THEN IF new_col < eve_x_target_column THEN LOOP EXITIF mark(none) = EOB; EXITIF current_character = ''; EXITIF new_col >= eve_x_target_column; move_horizontal(1); temp_col := get_info(buf,'offset_column'); IF temp_col > eve_x_target_column THEN move_horizontal(-1); EXITIF ELSE new_col := temp_col ENDIF; ENDLOOP; ELSE LOOP EXITIF current_offset = 0; EXITIF new_col <= eve_x_target_column; move_horizontal(-1); new_col := get_info(buf,'offset_column'); ENDLOOP; ENDIF; ENDIF; eve_x_prev_column := new_col; endprocedure; ! plus$vertical ! Page 35 ! Scroll forward one screen procedure eve_next_screen eve$move_by_screen (1); endprocedure; ! Scroll back one screen procedure eve_previous_screen eve$move_by_screen (-1); endprocedure; ! Page 35 procedure eve_screen if current_direction = forward then eve$move_by_screen (1); else eve$move_by_screen (-1); endif; endprocedure; ! Page 36 ! Process the 7 key, PAGE. procedure eve_page !kp7 (move to next page) LOCAL dir , next_page ; on_error if error = tpu$_strnotfound then if dir = REVERSE then position(beginning_of(current_buffer)) else position(end_of(current_buffer)) endif; endif; return endon_error dir := current_direction; if dir = FORWARD then move_horizontal(1) else move_horizontal(-1) endif; next_page := search(ascii(12),dir); position(beginning_of(next_page)); endprocedure; ! Page 36 ! Procedure to move by screen - used by eve_next_screen and eve_previous_screen ! Positive numbers move forward (like next screen), negative numbers backward ! Returns false if an error is encountered; otherwise returns true. ! ! Parameters: ! ! how_many_screens Number of screens to move - input procedure eve$move_by_screen (how_many_screens) local how_much_scroll, ! How many lines to scroll scroll_window, ! Window to be scrolled this_window, ! Current window this_column, ! Current column in scroll_window this_row, ! Current row in scroll_window old_scroll_top, ! Original value of scroll_top old_scroll_bottom, ! Original value of scroll_bottom old_scroll_amount; ! Original value of scroll_amount ! Trap and ignore messages about move beyond buffer boundaries - ! just move to top or bottom line of buffer on_error eve$move_by_screen := 0; ! and continue endon_error; eve$move_by_screen := 1; this_window := current_window; if this_window = eve$command_window then if eve$x_ambiguous_parse then scroll_window := eve$choice_window; else scroll_window := eve$x_pre_command_window; endif; position (scroll_window); else scroll_window := this_window; endif; how_much_scroll := get_info (scroll_window, "visible_length"); if get_info (scroll_window, "status_line") <> eve$x_null then how_much_scroll := how_much_scroll - 3; else how_much_scroll := how_much_scroll - 2; endif; if how_much_scroll <= 0 then how_much_scroll := 1; endif; ! By using a scrolling region and move_vertical, we can move to the first or ! last line on the screen when on the first or last screen in the buffer. Also ! is much faster for scrolling a select range than using the scroll builtin. this_row := get_info (scroll_window, "current_row"); if this_row = 0 then ! Screen info not all updated yet this_row := get_info (scroll_window, "visible_top"); endif; position (search (line_begin, reverse)); if get_info (scroll_window, "beyond_eol") then update (scroll_window); endif; old_scroll_top := get_info (scroll_window, "scroll_top"); old_scroll_bottom := get_info (scroll_window, "scroll_bottom"); old_scroll_amount := get_info (scroll_window, "scroll_amount"); set (scrolling, scroll_window, on, this_row - get_info (scroll_window, "visible_top"), get_info (scroll_window, "visible_bottom") - this_row, 0); move_vertical (how_many_screens * how_much_scroll); set (scrolling, scroll_window, on, old_scroll_top, old_scroll_bottom, old_scroll_amount); eve$position_in_middle (mark(none)); update (scroll_window); if this_window <> current_window then position (this_window); endif; endprocedure; ! Page 37 ! Procedure invoked by the Return key. Split the current line, ! obeying margin settings. procedure eve_return local left_margin; ! Left margin of current buffer if current_window = eve$command_window then eve$exit_command_window; else if get_info (current_buffer, "offset_column") > get_info (current_buffer, "right_margin") then eve$fill_line (0); else eve$split_line; endif; eve$show_first_line; left_margin := get_info (current_buffer, "left_margin"); if left_margin > 1 then eve$to_column (left_margin); endif; endif; endprocedure; ! Provides a hook for user-written procedures such as auto-indent. procedure eve$split_line split_line; endprocedure; ! Page 38 ! Start a select region procedure eve_select if eve$x_select_position <> 0 then eve$x_select_position := 0; message ("Selection cancelled."); else message ("Selection started."); eve$x_select_position := select (eve$x_highlighting); endif; endprocedure; ! Page 39 ! Cut (Remove and Append) and Paste (Insert Here) procedures ! Move the select region to the insert here buffer procedure eve_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, "buffer") <> current_buffer then message ("Remove 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 (paste_buffer); position (paste_buffer); split_line; move_vertical (-1); move_text (remove_range); position (this_position); eve$x_select_position := 0; remove_range := 0; message ("Remove completed."); endif; else message ("Use Select before using Remove."); endif; endprocedure; ! Page 40 ! procedure eve_append local this_position, ! Marker for current cursor position append_range; ! Range being appended this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Append must be used in the same buffer as Select."); else append_range := select_range; ! Select & Append in same spot => erase this character if append_range = 0 then if this_position = end_of (current_buffer) then message ("Nothing to append"); eve$x_select_position := 0; return; else append_range := create_range (mark (none), mark (none), none); endif; endif; position (end_of(paste_buffer)); move_vertical (-1); move_text (append_range); position (this_position); eve$x_select_position := 0; append_range := 0; message ("Append completed."); endif; else message ("Use Select before using Append."); endif; endprocedure; ! Page 40 ! Copy contents of insert here buffer before current cursor position procedure eve_insert_here local this_mode; ! Keyword for current mode if beginning_of (paste_buffer) <> end_of (paste_buffer) then this_mode := get_info (current_buffer, "mode"); set (insert, current_buffer); copy_text (paste_buffer); append_line; ! did a split_line during eve_remove set (this_mode, current_buffer); eve$show_first_line; else if eve$x_select_position <> 0 then message ("Nothing to insert. Use Remove to select a range of text."); else message ("Nothing to insert. Use Select to select a range of text."); endif; endif; endprocedure; ! Page 41 ! Procedure bound to the space bar. Inserts a space and does word wrap ! based on the margin settings. procedure eve_space eve$fill_line (1); endprocedure; ! Page 42 ! Word-wrap procedure. ! ! Parameters: ! ! insert_space If true, insert a space at the end of the ! filled line - input procedure eve$fill_line (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 start_of_line; ! Column at start of new line this_buffer := current_buffer; left_margin := get_info (this_buffer, "left_margin"); right_margin := get_info (this_buffer, "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, "offset_column"); if (this_column <= hot_column) or (this_buffer = eve$command_buffer) then if insert_space then copy_text (" "); endif; return; endif; right_margin := right_margin + 1; line_position := mark (none); loop this_column := get_info (this_buffer, "offset_column"); exitif this_column <= right_margin; line_position := mark (none); spaces := 0; ! changed from eve$start_of_word because we like to keep word_word ! together, but know that they are two separate words... -rcy exitif eve$previous_whitespace = 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, "offset_column"); if this_column = left_margin then position (line_position); endif; erase_character (spaces); eve$split_line; if left_margin > 1 then eve$to_column (left_margin); endif; start_of_line := get_info (this_buffer, "offset_column"); position (space_position); this_column := get_info (this_buffer, "offset_column"); if this_column > right_margin then if words > 1 then eve$fill_line (insert_space); else eve$split_line; if left_margin > 1 then eve$to_column (left_margin); endif; endif; else if insert_space and (this_column <> start_of_line) then copy_text (" "); endif; endif; endprocedure; ! Page 43 ! Backup over whitespace. Return number of spaces. procedure eve$backup_over_whitespace local temp_length; ! Number of characters backed up over if current_offset = 0 then return (0); endif; temp_length := 0; loop ! Back up past whitespace move_horizontal (-1); if index (eve$x_whitespace, current_character) <> 0 then temp_length := temp_length + 1; exitif current_offset = 0; else move_horizontal (1); exitif 1; endif; endloop; return (temp_length); endprocedure; ! Page 44 ! Tab key procedure. Always inserts a tab, even if current mode is overstrike. procedure eve_tab local this_mode; ! Keyword for current mode this_mode := get_info (current_buffer, "mode"); set (insert, current_buffer); copy_text (ascii (9)); set (this_mode, current_buffer); endprocedure; ! Page 45 ! Go to end of the current buffer procedure eve_bottom ! Editing commands if mark (none) = end_of (current_buffer) then message ("Already at bottom"); else position (end_of (current_buffer)); endif; endprocedure; ! Go to beginning of the current buffer procedure eve_top if mark (none) = beginning_of (current_buffer) then message ("Already at top"); else position (beginning_of (current_buffer)); endif; endprocedure; ! Page 46 ! Capitalize first letter, put rest of word in lowercase. procedure eve_capitalize_word local word_range, ! Range for current word word_string, ! String for current word this_position, ! Current position this_mode; ! Current mode for this buffer this_position := mark (NONE); word_range := eve$current_word; if (word_range <> 0) then this_mode := get_info (current_buffer, "mode"); set (overstrike, current_buffer); position (beginning_of(word_range)); eve$capitalize_string (word_range); copy_text (word_range); set (this_mode, current_buffer); endif; position (this_position); endprocedure; ! Page 47 ! Capitalize the current word or select range. procedure eve_change_case !gold kp1 (change case) LOCAL character ; !check for active select if eve$x_select_position <> 0 then change_case(select_range,invert); eve$x_select_position:=0; return; endif; !change case of current character if current_character <> eve$x_null then character :=current_character; change_case(character,invert); if get_info (current_buffer, "mode") = insert then erase_character(1); endif; copy_text(character); if current_direction <> forward then move_horizontal(-2); endif; endif; endprocedure; ! Page 47 ! Center the current line between the margins procedure eve_center_line local this_position, ! Marker for current cursor position count, ! Number of spaces to erase at start of line left_margin, ! Left margin for current buffer right_margin, ! Right margin for current buffer width_of_screen, ! Screen width this_column; ! Current column this_position := mark (none); if this_position = end_of (current_buffer) then return; endif; move_horizontal (- current_offset); loop exitif current_character = eve$x_null; exitif index (eve$x_whitespace, current_character) = 0; count := count + 1; move_horizontal (1); endloop; erase_character (- count); ! Too much pain to keep a count here, just delete a character at a time position (search (line_end, forward)); loop exitif current_offset = 0; move_horizontal (-1); exitif index (eve$x_whitespace, current_character) = 0; erase_character (1); endloop; left_margin := get_info (current_buffer, "left_margin"); right_margin := get_info (current_buffer, "right_margin"); width_of_screen := get_info (screen, "width"); if right_margin > width_of_screen then right_margin := width_of_screen; endif; ! How much whitespace to insert this_column := get_info (current_buffer, "offset_column"); count := (((right_margin - left_margin) - this_column) / 2) + left_margin; eve$indent_line_to (count); position (this_position); endprocedure; ! Page 48 ! Go to the end of the current line. (Emulate ^E in DCL) procedure eve_stable_end_of_line if get_info (current_window, "beyond_eol") then position (search (line_begin, reverse)); endif; if mark (none) <> end_of (current_buffer) then if current_character <> eve$x_null then position (search (line_end, forward)); endif; endif; endprocedure; ! eve_stable_end_of_line ! ! Go to the end of the current line. If we are at the ! end of the line, then goto the end of next line. ! procedure eve_end_of_line if current_direction = forward then if mark(none) <> end_of (current_buffer) then if (current_character = eve$x_null) then move_vertical(1) endif; ! move back if mark(none) <> end_of(current_buffer) then move_horizontal(length(current_line)-current_offset); ! goto EOL endif; endif else move_horizontal(( - current_offset)+(-1)) endif; endprocedure; ! Page 49 ! Delete current character procedure eve_erase_character local this_position; ! Marker for current cursor position this_position := mark (none); if this_position = end_of (current_buffer) then return; else eve$x_end_restore_char := 0; eve$x_deleted_char := erase_character(1); if eve$x_deleted_char = eve$x_null then eve$x_restoring_char_line := 1; move_horizontal (1); if mark (none) = end_of (current_buffer) then move_horizontal (-1); else eve$append_line; endif; else eve$x_restoring_char_line := 0; if get_info (current_buffer, "mode") = overstrike then set (insert, current_buffer); copy_text (" "); set (overstrike, current_buffer); move_horizontal (-1); endif; endif; endif; endprocedure; ! Page 49a ! Restores last character procedure eve_restore_character local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode at_top, ! boolean variable indicating if we started at ! the top of the buffer. this_position, ! Used to come back to the beginning of the line temp_position; ! Used to check for end of buffer this_buffer := current_buffer; temp_position := mark (none); ! check for end of buffer ! Store the current position - 1 character, or BOB if there. if (temp_position <> beginning_of(this_buffer)) then move_horizontal(-1); this_position := mark (none); move_horizontal(1); at_top := false; else at_top := true; endif; copy_text (eve$x_deleted_char); if (eve$x_restoring_char_line) and (temp_position <> end_of (this_buffer)) then this_mode := get_info (this_buffer, "mode"); set (insert, this_buffer); split_line; set (this_mode, this_buffer); endif; ! Now we put the cursor at the beginning of the insert, but only if ! eve$x_end_restore_char is false. if not eve$x_end_restore_char then if not at_top then position (this_position); move_horizontal (1); else position(beginning_of(this_buffer)); endif; endif; endprocedure; ! Page 50 ! Erase from current position through end of line, including eol character procedure eve_erase_line eve$x_restoring_line := 1; if current_offset = 0 then eve$x_deleted_line := erase_line; else ! Erase_character stops deleting at the end of the line eve$x_deleted_line := erase_character (length (current_line)); move_horizontal (- current_offset); move_vertical (1); if mark (none) = end_of (current_buffer) then move_horizontal (-1); else eve$append_line; endif; endif; endprocedure; ! ! Restores last erased line procedure eve_restore_line ! I realize that this looks quite tacky, but this was easiest way that I could ! think of to end up with the cursor at the beginning of the newly undeleted ! line like EDT. - rcy local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode at_top, ! boolean variable indicating if we started at ! the top of the buffer. this_position, ! Used to come back to the beginning of the line temp_position; ! Used to check for end of buffer this_buffer := current_buffer; this_mode := get_info (this_buffer, "mode"); temp_position := mark (none); ! check for end of buffer ! Store the current position -1 character, or BOB if there. if (temp_position <> beginning_of(this_buffer)) then move_horizontal(-1); this_position := mark (none); move_horizontal(1); at_top := false; else at_top := true; endif; set (insert, this_buffer); copy_text (eve$x_deleted_line); if (eve$x_restoring_line) and (temp_position <> end_of (this_buffer)) then split_line; endif; set (this_mode, this_buffer); ! Now we put the cursor at the beginning of the insert... if not at_top then position (this_position); move_horizontal (1); else position(beginning_of(this_buffer)); endif; endprocedure; ! Erase from current position to the end of line, leaving eol character procedure eve_erase_end_of_line eve$x_restoring_line := 0; ! Erase_character stops deleting at the end of the line eve$x_deleted_line := erase_character (length (current_line)); if mark (none) = end_of (current_buffer) then move_horizontal (-1); endif; endprocedure; ! Page 51 ! Erase a word. If at start of word (or preceding character is blank), ! erase preceding word; else erase back to next word separator. procedure eve_erase_previous_word local this_buffer, ! Current buffer this_mode, ! Keyword for current mode temp_string, ! String used to check for start of line start_erase_word, ! Marker for beginning of previous word end_erase_word, ! Marker for end of previous word erase_word_range; ! Range for previous word this_buffer := current_buffer; if current_window = eve$command_window then if get_info (this_buffer, "offset_column") <= (eve$x_command_prompt_length + 1) then return; endif; endif; ! Since we are deleting the previous word, any restore of the word should leave ! the cursor at the end of said word. - rcy eve$x_end_restore_word := 1; if get_info (this_buffer, "offset_column") <= get_info (this_buffer, "left_margin") then if mark (none) <> beginning_of (this_buffer) then if (eve$append_line) then if current_offset = 0 then temp_string := ascii (10); else move_horizontal (-1); temp_string := current_character; move_horizontal (1); endif; if index (eve$x_word_separators, temp_string) = 0 then this_mode := get_info (this_buffer, "mode"); set (insert, this_buffer); copy_text (" "); set (this_mode, this_buffer); endif; eve$x_restoring_word_line := 1; eve$x_deleted_word := eve$x_null; return; endif; else return; endif; endif; if index (eve$x_whitespace, current_character) = 0 then ! move back one so that the character under the cursor stays there but ! only do this if we are not on a space because we *want* to delete the ! space... move_horizontal (-1); endif; end_erase_word := mark (none); eve$start_of_word; start_erase_word := mark (none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_deleted_word := erase_character (length (erase_word_range)); eve$x_restoring_word_line := 0; endprocedure; ! Page 52 ! Erase from current cursor position to start of line. ! For CTRL/U compatability. procedure eve_erase_start_of_line local erase_length; ! How much of current line to erase if mark (none) = end_of (current_buffer) then return; endif; erase_length := current_offset; if current_buffer = eve$command_buffer then if substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then erase_length := current_offset - eve$x_command_prompt_length; endif; if erase_length > 0 then eve$x_deleted_line := erase_character (- erase_length); eve$x_restoring_line := 0; endif; else eve$x_deleted_line := erase_character (- erase_length); eve$x_restoring_line := 0; eve$indent_line_to (get_info (current_buffer, "left_margin")); endif; endprocedure; ! Page 53 ! Fills the current paragraph w/o worrying about the select marker. ! procedure eve_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 fill_range; ! Range for current paragraph ! 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 move_horizontal (- current_offset); loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); if eve$paragraph_break then move_vertical (1); exitif 1; endif; endloop; start_paragraph := mark (none); fill$skip_leading_spaces (start_paragraph); ! I like to leave indents if ! they exist. - rcy position (this_position); move_horizontal (- current_offset); loop exitif mark (none) = end_of (current_buffer); exitif eve$paragraph_break; move_vertical (1); 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_whitespace); ! Don't want to split words on ! programming word separators like ._$ etc. ! but only on whitespace. - rcy (change to ! eve$x_word_separators for orig. behavior) position (this_position); ! changed from (stop_paragraph), I'd rather ! *attempt* to stay where I was than jump ! to the end of the paragraph. - rcy eve$show_first_line; endif; endprocedure; ! Page 53a !+ ! EDT FILL -- A more EDT like fill routine. I like to be able to fill what ! I've selected, but I also allow the user to fill the current ! paragraph if that's what they would like (no select active). ! - rcy !- procedure eve_fill ! gold kp8 (fill) local this_position, ! Marker for current cursor position fill_range; ! Range being filled if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer"); return; endif; this_position := mark (none); fill_range := select_range; fill$preserve_blanks (fill_range); eve$x_select_position := 0; position (this_position); eve$show_first_line; else eve_fill_paragraph; endif; endprocedure; procedure fill$preserve_blanks (fill_range) ! support routine for fill LOCAL original_position, b_mark, e_mark, sub_range, temp_range, all_done, temp_pattern; on_error all_done:=1; ! cause exit endon_error; original_position := mark(none); b_mark := beginning_of(fill_range); ! skip leading spaces on first line only fill$skip_leading_spaces(b_mark); position(original_position); loop ! skip leading blank lines of a paragraph fill$skip_lines(b_mark); ! start looking here all_done:=fill$find_whiteline(b_mark,e_mark,fill_range); exitif all_done; ! now only fill the range created between the blank lines sub_range:=create_range(b_mark,e_mark,none); ! go to line following the range position(e_mark); move_horizontal(1); move_vertical(1); ! pick up search at end of current_range b_mark:=mark(none); ! do the fill operation ! -rcy, changed from eve$x_word_separators fill (sub_range,eve$x_whitespace); exitif all_done; endloop; position(original_position); endprocedure ! Page 53b ! procedure fill$skip_leading_spaces(b_mark) ! support routine for fill local temp_pattern,temp_range; on_error return endon_error; position(b_mark); temp_pattern:=anchor&span(eve$x_whitespace); temp_range:=search(temp_pattern,forward); position(end_of(temp_range)); move_horizontal(1); b_mark:=mark(none); endprocedure procedure fill$find_whiteline(beg_mark,end_mark,fill_range) ! support routine for fill local blank_pattern, bline; on_error position(beg_mark); end_mark:= end_of(fill_range); return 0; endon_error; position(beg_mark); if beg_mark >= end_of(fill_range) then return 1 ! all done endif; blank_pattern := line_begin & (line_end | (span(' ') & line_end))&line_begin; bline := search(blank_pattern,forward); ! get the beginning and end points right if beginning_of(bline) > end_of(fill_range) then end_mark:= end_of(fill_range); return 0 Else end_mark:=end_of(bline); endif; position(end_mark); ! go there move_horizontal(-1); ! back up to previous line end_mark:=mark(none); return 0 endprocedure procedure fill$skip_lines(where) ! support routine for fill !skip multiple blank lines ! once that one blank line is found on_error where:=mark(none); return; endon_error; position(where); loop if current_line <> eve$x_null then exitif; endif; move_vertical(1); move_horizontal(-current_offset); endloop; where:=mark(none); return endprocedure ! Page 54 ! Returns true if current line looks like a runoff command (starts with ! a period followed by an alphabetic character) or a blank line, ! else returns false. Assumes cursor was at start of line. procedure eve$paragraph_break on_error return (0); endon_error; if search (eve$pattern_paragraph_break, forward) <> 0 then return (1); endif; endprocedure; ! Page 55 ! Change direction to forward procedure eve_forward set (forward, current_buffer); eve$update_status_lines; endprocedure; ! Change direction to reverse procedure eve_reverse set (reverse, current_buffer); eve$update_status_lines; endprocedure; ! Page 56 ! Go to a mark. If mark is in a different buffer, map that ! buffer to the screen, and if there are two windows, map ! the new buffer to the other window. ! ! Parameters: ! ! go_to_parameter String containing mark name - input procedure eve_go_to (go_to_parameter) local mark_name, ! Local copy of go_to_parameter full_mark_name, ! Full mark name, including eve$mark_ prefix expanded_string, ! String of all expansions of full_mark_name this_choice, ! Current item in expanded_string possible_mark_names, ! Expanded_string without eve$mark_ prefixes mark_index, ! Index into expanded_string actual_mark, ! Complete name, with prefix, of mark to go to this_buffer, ! Current buffer this_position, ! Marker for current cursor position message_mark; ! Actual_mark without prefix and in lowercase on_error if error = tpu$_nonames then message (fao ("Mark !AS not set", mark_name)); return; endif; endon_error; if not (eve$prompt_string (go_to_parameter, mark_name, "Go to: ", "No mark name given")) then return; endif; eve$cleanse_string (mark_name); full_mark_name := "eve$mark_" + mark_name; change_case (full_mark_name, upper); expanded_string := expand_name (full_mark_name, variables); this_buffer := current_buffer; this_position := mark (none); eve$expand_to_choices (expanded_string); actual_mark := eve$get_choice (full_mark_name); eve$strip_choices (9); position (this_buffer); if actual_mark <> eve$x_null then ! Execute can only handle 132-character strings, so mark can only be ! 82 characters long (41 chars here, + eve$mark_) - same thing in show execute ("eve$x_buffer_of_mark:=get_info(" + actual_mark + ",'buffer')"); if eve$x_buffer_of_mark <> current_buffer then if eve$check_bad_window (current_window) then message ("Cursor has been moved to a text window; try command again"); return; endif; if eve$x_number_of_windows > 1 then eve_next_window; endif; if eve$x_buffer_of_mark <> current_buffer then map (current_window, eve$x_buffer_of_mark); eve$set_status_line (current_window); endif; endif; execute ("eve$position_in_middle (" + actual_mark + ")"); message_mark := substr (actual_mark, 10, length (actual_mark)); change_case (message_mark, lower); message (fao ("Going to mark !AS", message_mark)); else eve$display_choices (fao ("Ambiguous mark name: !AS", mark_name)); endif; endprocedure; ! Page 57 ! Change to insert mode procedure eve_set_insert_mode set (insert, current_buffer); eve$update_status_lines; endprocedure; ! Change to overstrike mode procedure eve_set_overstrike_mode set (overstrike, current_buffer); eve$update_status_lines; endprocedure; ! Page 58 ! Go to start of a certain line in the current buffer ! ! Parameters: ! ! line_parameter Line number to move to - input procedure eve_line (line_parameter) local line_number, ! Local copy of line_parameter this_position, ! Marker for current cursor position last_line; ! Number of lines in buffer, including eob_text on_error message (fao ("Cannot move to line !SL", line_number)); position (this_position); return; endon_error; this_position := mark (none); if not (eve$prompt_number (line_parameter, line_number, "Line number: ", "No line number given")) then return; endif; if line_number <= 0 then message (fao ("Cannot move to line !SL", line_number)); return; endif; last_line := get_info (current_buffer, "record_count") + 1; ! include eob_text if line_number > last_line then if last_line > 0 then message (fao ("Buffer has only !SL line!%S", last_line)); else message ("Buffer is empty"); endif; else position (beginning_of (current_buffer)); move_vertical (line_number - 1); ! already at line 1 eve$position_in_middle (mark (none)); endif; endprocedure; ! Page 58a ! Find out where we are! ! ! Parameters: ! ! display -1 if we want the result displayed to the user, 0 if we ! want the results returned to the calling procedure ! procedure eve_current_line (display) !determine what line at in a file LOCAL this_position, ! Holds the current location num_lines, ! Holds the current line number total_lines; ! Holds the total number of lines in the buffer ! Initialize some variables. this_position := mark (NONE); total_lines:=get_info(current_buffer,"record_count"); num_lines := total_lines + 1; if display = -1 then display := 1; endif; if mark (NONE) <> end_of (current_buffer) then ! Go from here down, counting down lines as we go. move_horizontal (1-current_offset); ! position @ beg of line. loop ! 'till we pass the current position exitif mark(NONE) = end_of(current_buffer); move_vertical (+1); num_lines := num_lines - 1; endloop; position (this_position); endif; if display then message(FAO("You are at line !SL of !SL line!%S.",num_lines,total_lines)); else return num_lines; endif; endProcedure; ! current_line ! Page 59 ! Put word in all lowercase letters procedure eve_lowercase_word local this_position, ! Hold the current position word_range; ! Range for current word this_position := mark (NONE); word_range := eve$current_word; if word_range <> 0 then change_case (word_range, lower); endif; position (this_position); endprocedure; ! Put word in all uppercase letters procedure eve_uppercase_word local this_position, ! Remember the current position word_range; ! Range for current word this_position := mark (NONE); word_range := eve$current_word; if word_range <> 0 then change_case (word_range, upper); endif; position (this_position); endprocedure; ! Page 60 ! Set a mark for later use by go to command. ! ! Parameters: ! ! mark_parameter String to use as a mark name - input procedure eve_mark (mark_parameter) local mark_name; ! Local copy of mark_parameter, on_error message (fao ("Cannot use !AS as a mark name", mark_name)); return; endon_error; if not (eve$prompt_string (mark_parameter, mark_name, "Mark name: ", "Current position not marked")) then return; endif; eve$cleanse_string (mark_name); if length (mark_name) > eve$x_max_mark_length then mark_name := substr (mark_name, 1, eve$x_max_mark_length); endif; execute ("eve$mark_" + mark_name + " := mark (none)"); message (fao ("Current position marked as !AS", mark_name)); endprocedure; ! Page 61 ! Move to start of next/previous word, depending on current direction. ! Newlines act like words. procedure eve_move_by_word local ok; ! True if not at line boundary if current_direction = reverse then ok := eve$start_of_word; if (ok = 0) and (mark (none) <> beginning_of (current_buffer)) then move_horizontal (-1); ok := eve$start_of_word; endif; else ok := eve$end_of_word; if (not ok) and (mark (none) <> end_of (current_buffer)) then move_horizontal (1); endif; endif; endprocedure; ! eve_move_by_word ! Move to start of next/previous character, depending on current direction. ! This is to implement KP3 for those who want a "true" EDT keypad. procedure eve_move_by_character if current_direction = reverse then move_horizontal (-1); else move_horizontal (1); endif; endprocedure; ! Page 62 ! Quit Eve. If any buffers are modified, asks if you really want to ! quit. If you do quit, none of the buffers are written out before ! leaving Eve. procedure eve_quit message (eve$x_null); set (success, off); quit; set (success, on); endprocedure; ! Page 63 ! Don't use the binding of the next key, just type the character. ! Types the entire escape sequence for a given key. Inserts or ! overstrikes depending on current mode. procedure eve_quote local quoted_char; ! 1-character string returned by read_char map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text ("Press the key to be added: "); update (eve$prompt_window); quoted_char := read_char; ! don't parse the escape sequence unmap (eve$prompt_window); copy_text (quoted_char); ! rest of an escape sequence will follow endprocedure; ! Page 64 ! Search and replace procedure. Case-sensitivity of search is ! same as for the find command. If case-insensitive, replacements ! are done to match case of current occurrence. ! ! Parameters: ! ! replace_parameter_1 Old string - input ! replace_parameter_2 New string - input procedure eve_replace (replace_parameter_1, replace_parameter_2) local target, ! Local copy of replace_parameter_1 replacement, ! Local copy of replace_parameter_2 hold_search_type, ! Copy of eve$x_search_at_end this_buffer, ! Current buffer this_mode, ! Keyword for current mode lowercase_target, ! Lowercase version of target string lowercase_replacement, ! Lowercase version of replacement string uppercase_target, ! Uppercase version of target string uppercase_replacement, ! Uppercase version of replacement string capital_target, ! Capitalized version of target string capital_replacement, ! Capitalized version of replacement string how_exact, ! Keyword to indicate case-sensitivity replace_range, ! Range of current occurrence highlight_range, ! Reverse-video version of replace_range replace_action, ! String reply to prompt action_length, ! Length of replace_action asking, ! True unless "all" option has been chosen this_occurrence, ! String of replace_range occurrences; ! Number of replacements made so far ! ! Save eve$x_search_at_end, and then force it to False. This is so that we ! don't get all messed up by this addition when we are getting a save range. ! hold_search_type := eve$x_search_at_end; eve$x_search_at_end := False; this_buffer := current_buffer; this_mode := get_info (current_buffer, "mode"); set (insert, this_buffer); asking := 1; if not (eve$prompt_string (replace_parameter_1, target, "Old string: ", "No string to replace")) then return; endif; replacement := replace_parameter_2; if replacement = eve$x_null then replacement := read_line ("New string: "); ! empty string is ok here endif; lowercase_target := target; if get_info (lowercase_target, "type") = string then change_case (lowercase_target, lower); endif; lowercase_replacement := replacement; change_case (lowercase_replacement, lower); if (lowercase_target = target) and (lowercase_replacement = replacement) then how_exact := no_exact; uppercase_target := target; if get_info (uppercase_target, "type") = string then change_case (uppercase_target, upper); endif; capital_target := target; if get_info (capital_target, "type") = string then eve$capitalize_string (capital_target); endif; uppercase_replacement := replacement; change_case (uppercase_replacement, upper); capital_replacement := replacement; eve$capitalize_string (capital_replacement); else how_exact := exact; endif; loop replace_range := eve$find (target, 1, 0); exitif replace_range = 0; highlight_range := create_range (beginning_of (replace_range), end_of (replace_range), eve$x_highlighting); position (beginning_of (replace_range)); update (current_window); loop if asking then replace_action := read_line ("Replace? Type yes, no, all, last, or quit: "); change_case (replace_action, lower); else replace_action := "yes"; endif; action_length := length (replace_action); if (replace_action = substr ("yes", 1, action_length)) or (replace_action = substr ("all", 1, action_length)) or (replace_action = substr ("last", 1, action_length)) or (action_length = 0) then highlight_range := 0; this_occurrence := erase_character (length (replace_range)); if how_exact = exact then copy_text (replacement); else ! Make sure non-alphabetic target is replaced by lowercase if this_occurrence = lowercase_target then copy_text (lowercase_replacement); else if this_occurrence = uppercase_target then copy_text (uppercase_replacement); else if this_occurrence = capital_target then copy_text (capital_replacement); else copy_text (lowercase_replacement); endif; endif; endif; endif; if current_direction = reverse then move_horizontal (- length (replacement)); endif; occurrences := occurrences + 1; update (current_window); if (replace_action = substr ("all", 1, action_length)) and (action_length > 0) then asking := 0; message ("Replacing all occurrences..."); set (screen_update, off); endif; exitif 1; else if (replace_action = substr ("no", 1, action_length)) or (replace_action = substr ("quit", 1, action_length)) then highlight_range := 0; if current_direction = forward then position (end_of (replace_range)); move_horizontal (1); endif; update (current_window); exitif 1; endif; endif; endloop; exitif (action_length > 0) and ((replace_action = substr ("quit", 1, action_length)) or (replace_action = substr ("last", 1, action_length))); endloop; eve$x_search_at_end := hold_search_type; set (screen_update, on); message (fao ("Replaced !SL occurrence!%S", occurrences)); set (this_mode, this_buffer); endprocedure; ! Page 65 ! Page 66 ! Set margins ! Set left margin without changing right margin ! ! Parameters: ! ! set_parameter New left margin - input procedure eve_set_left_margin (set_parameter) local new_left_margin, ! Local copy of set_parameter current_right_margin; ! Right margin for current buffer if not (eve$prompt_number (set_parameter, new_left_margin, "Set left margin to: ", "Left margin unchanged")) then return; endif; if new_left_margin <= 0 then message ("Left margin must be at least 1"); else current_right_margin := get_info (current_buffer, "right_margin"); if new_left_margin >= current_right_margin then message ("Left margin must be smaller than right margin " + fao ("(currently set to !SL)", current_right_margin)); else set (margins, current_buffer, new_left_margin, current_right_margin); message (fao ("Left margin set to !SL", new_left_margin)); endif; endif; endprocedure; ! Page 67 ! Set right margin without changing left margin ! ! Parameters: ! ! set_parameter New right margin - input procedure eve_set_right_margin (set_parameter) local new_right_margin, ! Local copy of set_parameter current_left_margin; ! Left margin of current buffer if not (eve$prompt_number (set_parameter, new_right_margin, "Set right margin to: ", "Right margin unchanged")) then return; endif; current_left_margin := get_info (current_buffer, "left_margin"); if new_right_margin <= current_left_margin then message ("Right margin must be greater than left margin " + fao ("(currently set to !SL) ", current_left_margin)); else if new_right_margin > eve$x_largest_right_margin then new_right_margin := eve$x_largest_right_margin; endif; set (margins, current_buffer, current_left_margin, new_right_margin); message (fao ("Right margin set to !SL", new_right_margin)); endif; endprocedure; ! Page 68 ! Go to the start of the current line. ! Display a message if already at the start of this line. procedure eve_start_of_line if get_info (current_window, "beyond_eol") then position (search (line_begin, reverse)); else if current_offset = 0 then message ("Already at start of line"); return; else move_horizontal (- current_offset); endif; endif; ! In command buffer, don't back up beyond prompt if current_buffer = eve$command_buffer then if substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then move_horizontal (eve$x_command_prompt_length); endif; endif; endprocedure; ! Page 69 ! Used before issuing window/buffer manipulation commands. Returns true if ! current window is message window, info window, or command window, in ! which case we may not want to do the command. In these cases, the ! cursor is repositioned to either the main window or the top window, ! depending on the value of eve$x_number_of_windows. This helps people ! who accidentally get stuck in one of these windows. The calling procedure ! determines the error message or other action. In other cases, ! returns false. procedure eve$check_bad_window (window_to_test) ! File and window commands if (window_to_test = message_window) or (window_to_test = eve$command_window) or (window_to_test = info_window) or (window_to_test = eve$choice_window) or (window_to_test = eve$prompt_window) then if current_window = window_to_test then if current_window = info_window then unmap (info_window); endif; position (eve$x_this_window); endif; return (1); else return (0); endif; endprocedure; ! Page 70 ! Map a buffer to the current window. If the buffer doesn't already ! exist, create a new buffer. ! ! Parameters: ! ! buffer_parameter String containing buffer name - input procedure eve_buffer (buffer_parameter) local buffer_name, ! Local copy of buffer_parameter this_buffer, ! Current buffer loop_buffer, ! Current buffer being checked in loop loop_buffer_name, ! String containing name of loop_buffer found_a_buffer, ! True if buffer found with same exact name possible_buffer_name, ! Most recent string entered in possible_names possible_buffer, ! Buffer whose name is possible_buffer_names how_many_buffers, ! Number of buffers listed in possible_names new_buffer; ! New buffer created when there is no match if eve$check_bad_window (current_window) then message ("Cursor has been moved to a text window; try command again"); return; endif; if not (eve$prompt_string (buffer_parameter, buffer_name, "Buffer name: ", "Buffer not switched")) then return; endif; eve$cleanse_string (buffer_name); ! See if we already have a buffer by that name this_buffer := current_buffer; loop_buffer := get_info (buffers, "first"); change_case (buffer_name, upper); ! buffer names are uppercase erase (eve$choice_buffer); loop exitif loop_buffer = 0; loop_buffer_name := get_info (loop_buffer, "name"); if buffer_name = loop_buffer_name then found_a_buffer := 1; how_many_buffers := 1; exitif 1; else if buffer_name = substr (loop_buffer_name, 1, length (buffer_name)) then eve$add_choice (loop_buffer_name); possible_buffer := loop_buffer; possible_buffer_name := loop_buffer_name; how_many_buffers := how_many_buffers + 1; endif; endif; loop_buffer := get_info (buffers, "next"); endloop; change_case (buffer_name, lower); ! for messages if found_a_buffer then if loop_buffer = this_buffer then message (fao ("Already in buffer !AS", loop_buffer_name)); else map (current_window, loop_buffer); endif; else if get_info (eve$choice_buffer, "record_count") > 0 then if how_many_buffers = 1 then if possible_buffer = this_buffer then message (fao ("Already in buffer !AS", possible_buffer_name)); else map (current_window, possible_buffer); endif; else change_case (buffer_name, lower); eve$display_choices (fao ("Ambiguous buffer name: !AS", buffer_name)); endif; else new_buffer := create_buffer (buffer_name); map (current_window, new_buffer); set (eob_text, new_buffer, "[End of file]"); set (margins, new_buffer, eve$x_default_left_margin, get_info (current_window, "width") - eve$x_default_right_margin); endif; endif; eve$set_status_line (current_window); endprocedure; ! Page 71 ! Get a file to edit. Actually all that we do here is set up ! the parameters and call eve$read_in_file. -rcy 4/7/87 ! ! Parameters: ! ! get_file_parameter String containing file name - input procedure eve_get_file (get_file_parameter) local get_file_name; ! Local copy of get_file_parameter if not (eve$prompt_string (get_file_parameter, get_file_name, "File to get: ", "No file specified")) then return; endif; eve$read_in_file (get_file_name,0); endprocedure; ! eve_get_file ! Page 71 ! Do an eve_get_file in readonly mode. Actually all that we do here is set up ! the parameters and call eve_read_in_file. -rcy 3/6/87 ! ! Parameters: ! ! read_file_parameter String containing file name - input procedure eve_read_file (read_file_parameter) local read_file_name; ! Local copy of get_file_parameter if not (eve$prompt_string (read_file_parameter, read_file_name, "File to read: ", "No file specified")) then return; endif; eve$read_in_file (read_file_name,1); endprocedure; ! eve_read_file ! 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. (Support routine for ! eve_get_file and eve_read_file.) ! ! Parameters: ! ! get_file_parameter String containing file name - input ! get_in_read_only true if we are getting this file readonly procedure eve$read_in_file (get_file_name,get_in_read_only) local 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 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 (current_window) then message ("Cursor has been moved to a text window; try command again"); return; endif; ! Protect against earlier file_search with same file name. file_search_result := file_search (eve$x_null); temp_file_name := eve$x_null; erase (eve$choice_buffer); loop file_search_result := file_search (get_file_name); exitif file_search_result = eve$x_null; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; if get_info (eve$choice_buffer, "record_count") > 1 then ! If get_file is called from tpu$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; ! See if we already have a buffer by that name if temp_file_name = eve$x_null then temp_buffer_name := file_parse (get_file_name, eve$x_null, eve$x_null, name) + file_parse (get_file_name, eve$x_null, eve$x_null, type); else temp_buffer_name := file_parse (temp_file_name, eve$x_null, eve$x_null, name) + file_parse (temp_file_name, eve$x_null, eve$x_null, type); endif; get_file_name := file_parse (get_file_name); loop_buffer := get_info (buffers, "first"); loop exitif loop_buffer = 0; if temp_buffer_name = get_info (loop_buffer, "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$x_null then ! No file on disk if get_file_name = get_info (loop_buffer, "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, "output_file")) or (temp_file_name = get_info (loop_buffer, "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$x_null then message ("No new buffer created"); else new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name, get_in_read_only); 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, get_in_read_only); 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, "width") - eve$x_default_right_margin); endif; ! Correct the status line in any event eve$set_status_line (current_window); endprocedure; ! Page 71 ! Procedure called by eve_get_file to create a new buffer and map it ! to the current window. Returns the created buffer, or zero if error. ! ! Parameters: ! ! buffer_name Name of new buffer - input ! requested_file_name Full VMS filespec to use - input ! actual_file_name From file_search; "" if not on disk - input ! read_only True if we want to get the file read_only procedure eve$create_buffer (buffer_name, requested_file_name, actual_file_name, read_only) local new_buffer; ! Buffer created on_error if error = tpu$_dupbufname then message (fao ("Buffer !AS already exists", substr (buffer_name, 1, eve$x_max_buffer_name_length))); return (0); endif; endon_error; if actual_file_name = eve$x_null then if eve$x_starting_up and (get_info (command_line, "create") = 0) then message (fao ("Input file does not exist: !AS", requested_file_name)); exit; endif; new_buffer := create_buffer (buffer_name); message (fao ("Editing new file; could not find !AS", requested_file_name)); set (output_file, new_buffer, requested_file_name); else new_buffer := create_buffer (buffer_name, actual_file_name); set (output_file, new_buffer, actual_file_name); endif; map (current_window, new_buffer); if (eve$x_starting_up and get_info (command_line, "read_only")) or read_only then set (no_write, new_buffer); endif; return (new_buffer); endprocedure; ! Page 72 ! Set the current buffer to be read only ! procedure eve_set_read_only set (NO_WRITE, current_buffer, ON); eve$update_status_lines; endprocedure; ! eve_set_read_only ! Page 72 ! Set the current buffer to be read/write ! procedure eve_set_write set (NO_WRITE, current_buffer, OFF); eve$update_status_lines; endprocedure; ! eve_set_write ! Page 73 ! Like read_only built-in, but positions the cursor at the start of ! the inserted file. Handles wildcarding in file name. ! ! Parameters: ! ! include_file_parameter String containing file name - input procedure eve_include_file (include_file_parameter) local include_file_name, ! Local copy of include_file_parameter started_at_bof, ! True if current position at start of file include_position, ! Marker for where cursor should end up temp_file_name, ! First file name string - from file_parse file_search_result; ! Latest string returned by file_search on_error if error = tpu$_parsefail then message (fao ("Don't understand file name: !AS", include_file_name)); return; endif; endon_error; if eve$check_bad_window (current_window) then message ("Cursor has been moved to a text window; try command again"); return; endif; if not (eve$prompt_string (include_file_parameter, include_file_name, "File to include: ", "No file included")) then return; endif; if mark (none) = beginning_of (current_buffer) then started_at_bof := 1; else started_at_bof := 0; endif; if started_at_bof then include_position := mark (none); else move_horizontal (-1); include_position := mark (none); move_horizontal (1); endif; ! Initialize to null string and protect against earlier file_search ! with same file name. temp_file_name := file_search (eve$x_null); temp_file_name := file_parse (include_file_name); erase (eve$choice_buffer); loop file_search_result := file_search (include_file_name); exitif file_search_result = eve$x_null; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; case get_info (eve$choice_buffer, "record_count") from 0 to 1 [0] : message (fao ("Could not include file: !AS", include_file_name)); [1] : read_file (temp_file_name); if started_at_bof then position (beginning_of (current_buffer)); else position (include_position); move_horizontal (1); endif; [outrange] : eve$display_choices (fao ("Ambiguous file name: !AS", include_file_name)); endcase; endprocedure; ! Page 74 ! Go from n windows to one window. Do nothing if only one window on screen. procedure eve_single_window local this_position, ! Marker for current cursor position this_window, ! Current window this_status_line, ! Current status line this_buffer, ! Current buffer next_window, ! Next window in sequence new_window; ! New window if eve$check_bad_window (current_window) then message ("Cannot reduce windows while in system window"); else if eve$x_number_of_windows = 1 then message ("Only one window on screen"); else this_position := mark (none); ! ensure VAXTPU knows current position this_window := current_window; this_buffer := current_buffer; this_status_line := get_info (this_window, "status_line"); if this_status_line <> 0 then new_window := create_window (1, eve$main_window_length, ON); set (STATUS_LINE, new_window, REVERSE, this_status_line); else new_window := create_window (1, eve$main_window_length, OFF); endif; set (SCROLLING, new_window, ON, get_info (this_window, "scroll_top"), get_info (this_window, "scroll_bottom"), get_info (this_window, "scroll_amount")); set (TEXT, new_window, get_info (this_window, "text")); set (WIDTH, new_window, get_info (this_window, "width")); shift (new_window, get_info (this_window, "shift_amount")); map (new_window, this_buffer); position (this_position); position (new_window); eve$x_this_window := new_window; this_window := get_info (WINDOW, "first"); loop next_window := get_info (this_window, "next"); if (not eve$check_bad_window (this_window)) and (this_window <> new_window) then delete (this_window); endif; exitif next_window = 0; this_window := next_window; endloop; eve$x_number_of_windows := 1; eve$position_in_middle (mark(none)); endif endif endprocedure; ! Page 75 ! Window switching support procedure eve$next_window (this_window, loopback) local next_window; ! Candidate for target window next_window := this_window; loop next_window := get_info (next_window, "next"); if next_window = 0 then exitif not loopback; next_window := get_info (WINDOWS, "first"); endif; exitif not eve$check_bad_window (next_window); endloop; return next_window; endprocedure; procedure eve$previous_window (this_window, loopback) local previous_window; ! Candidate for target window previous_window := this_window; loop previous_window := get_info (previous_window, "previous"); if previous_window = 0 then exitif not loopback; previous_window := get_info (WINDOWS, "last"); endif; exitif not eve$check_bad_window (previous_window); endloop; return previous_window; endprocedure; procedure eve_next_window local remember_this_position, ! Marker for current cursor position next_window; ! Candidate for target window if eve$check_bad_window (current_window) then message ("Cannot switch windows while in system window"); return; endif; if eve$x_number_of_windows = 1 then message ("Only one window on screen"); return; endif; remember_this_position := mark (none); next_window := eve$next_window (current_window, true); position (next_window); eve$x_this_window := current_window; endprocedure; procedure eve_previous_window local remember_this_position, ! Marker for current cursor position next_window; ! Candidate for target window if eve$check_bad_window (current_window) then message ("Cannot switch windows while in system window"); return; endif; if eve$x_number_of_windows = 1 then message ("Only one window on screen"); return; endif; remember_this_position := mark (none); next_window := eve$previous_window (current_window, true); position (next_window); eve$x_this_window := current_window; endprocedure; ! Page 76 ! Split current window into two windows, both pointing to the same buffer. ! Move to whichever window the cursor was originally in. procedure eve_split_window local this_position, ! Marker for current cursor position this_window, ! Current window this_status_line, ! Current window's status line this_length, ! Current window's length this_top, ! Current window's top line number this_buffer, ! Current buffer new_top, ! New top window new_bottom, ! New bottom window old_column; ! Column where cursor used to be if eve$check_bad_window (current_window) then message ("Cannot split a system window"); else this_window := current_window; this_status_line := get_info (this_window, "status_line"); this_length := get_info (this_window, "original_length"); if (this_length < 2) or ((this_status_line <> 0) and (this_length < 4)) then message ("This window is too small to split"); else this_position := mark (none); ! ensure VAXTPU knows current position this_buffer := current_buffer; this_top := get_info (this_window, "original_top"); old_column := get_info (this_window, "current_column"); if this_status_line <> 0 then new_top := create_window (this_top, this_length/2, ON); new_bottom := create_window (this_top + this_length/2, this_length - this_length/2, ON); set (STATUS_LINE, new_top, REVERSE, this_status_line); set (STATUS_LINE, new_bottom, REVERSE, this_status_line); else new_top := create_window (this_top, this_length/2, OFF); new_bottom := create_window (this_top + this_length/2, this_length - this_length/2, OFF); endif; set (SCROLLING, new_top, ON, get_info (this_window, "scroll_top"), get_info (this_window, "scroll_bottom"), get_info (this_window, "scroll_amount")); set (TEXT, new_top, get_info (this_window, "text")); set (WIDTH, new_top, get_info (this_window, "width")); shift (new_top, get_info (this_window, "shift_amount")); set (SCROLLING, new_bottom, ON, get_info (this_window, "scroll_top"), get_info (this_window, "scroll_bottom"), get_info (this_window, "scroll_amount")); set (TEXT, new_bottom, get_info (this_window, "text")); set (WIDTH, new_bottom, get_info (this_window, "width")); shift (new_bottom, get_info (this_window, "shift_amount")); map (new_top, this_buffer); update (new_top); map (new_bottom, this_buffer); update (new_bottom); delete (this_window); eve$x_number_of_windows := eve$x_number_of_windows + 1; eve$position_in_middle (this_position); if old_column > this_length/2 then position (new_bottom); else position (new_top); endif; eve$x_this_window := current_window; eve$position_in_middle (this_position); endif endif endprocedure; procedure eve_shrink_window local this_position, shrinking_window, expanding_window; if eve$x_number_of_windows = 1 then message ("Only one window on screen"); return; endif; this_position := mark (none); ! ensure VAXTPU knows current position shrinking_window := current_window; if get_info (shrinking_window, "visible_length") < 3 then message ('Window is too small to shrink'); return; endif; expanding_window := eve$next_window (shrinking_window, false); if expanding_window <> 0 then position (expanding_window); adjust_window (shrinking_window, 0, -1); adjust_window (expanding_window, -1, 0); else expanding_window := eve$previous_window (shrinking_window, false); position (expanding_window); adjust_window (shrinking_window, 1, 0); adjust_window (expanding_window, 0, 1); endif; position (shrinking_window); position (this_position); endprocedure; procedure eve_expand_window local this_position, shrinking_window, expanding_window; if eve$x_number_of_windows = 1 then message ("Only one window on screen"); return; endif; this_position := mark (none); ! ensure VAXTPU knows current position expanding_window := current_window; shrinking_window := eve$next_window (expanding_window, false); if shrinking_window <> 0 then if get_info (shrinking_window, "visible_length") >= 3 then adjust_window (shrinking_window, 1, 0); adjust_window (expanding_window, 0, 1); position (this_position); return; endif; endif; shrinking_window := eve$previous_window (expanding_window, false); if shrinking_window = 0 then message ('No place for window to expand'); return; endif; if get_info (shrinking_window, "visible_length") < 3 then message ('No place for window to expand'); return; endif; adjust_window (shrinking_window, 0, -1); adjust_window (expanding_window, -1, 0); position (this_position); endprocedure; ! Page 77 ! Write the current buffer to a specified file. If no file specified, ! use the default file name. ! ! Parameters: ! ! write_file_name ! String containing file name - input procedure eve_write_file (write_file_name) local write_result; ! File name string returned by write_file if eve$x_trimming then eve$trim_buffer (current_buffer); endif; if write_file_name = eve$x_null then write_result := write_file (current_buffer); else write_result := write_file (current_buffer, write_file_name); endif; set (output_file, current_buffer, write_result); endprocedure; ! Page 77a ! Write the selected region to a specified file. If no file specified, ! ask. ! ! Parameters: ! ! write_file_name ! String containing file name - input procedure eve_write_selected (write_file_name) local this_position, ! save current position write_file_name_copy, ! local copy of write_file_name write_range; ! range to write out write_file_name_copy := write_file_name; if eve$x_trimming then eve$trim_buffer (current_buffer); endif; if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer"); return; endif; this_position := mark (none); write_range := select_range; else message ('No range selected!'); return (0); endif; if (length (write_file_name_copy) <= 0) then write_file_name_copy := read_line ('File name for selected region: '); if (length (write_file_name_copy) <= 0) then message ('No file name provided.'); return; endif; endif; write_file (write_range,write_file_name_copy); eve$x_select_position := 0; position (this_position); endprocedure; ! Page 78 ! Refresh screen and clear message window procedure eve_refresh ! Additional screen commands message (eve$x_null); ! clear message window without deleting messages refresh; endprocedure; ! Page 79 ! Set tabs at specified positions ! ! Parameters: ! ! set_parameter String that contains tab settings - input procedure eve_set_tabs_at (set_parameter) local tab_settings; ! Local copy of set_parameter on_error message ("Could not change tab stops as specified"); return; endon_error; if eve$prompt_string (set_parameter, tab_settings, "Set tabs at: ", "Tab settings not changed") then set (tab_stops, current_buffer, tab_settings); message ("Tab stops set"); endif; endprocedure; ! ! Set tabs at constant increments - every n columns ! ! Parameters: ! ! set_parameter Integer increment for tab stops - input procedure eve_set_tabs_every (set_parameter) local tab_increment; ! Local copy of set_parameter on_error message ("Could not change tab stops as specified"); return; endon_error; if eve$prompt_number (set_parameter, tab_increment, "Set tabs every: ", "Tab settings not changed") then if tab_increment <= 0 then message ("Tabs must be set at least 1 space apart"); else set (tab_stops, current_buffer, tab_increment); message ("Tab stops set"); endif; endif; endprocedure; ! Page 80 ! Set where the cursor ends up after a search. ! ! Set the search variable so that we end up with the cursor at the end of the ! search string. ! procedure eve_set_search_end eve$x_search_at_end := True; endprocedure; ! ! Set the search variable so that we end up with the cursor at the start of ! the search string. ! procedure eve_set_search_beginning eve$x_search_at_end := False; endprocedure; ! eve_set_search_beginning ! Page 81 ! Set width for all windows ! ! Parameters: ! ! set_parameter ! Number of columns per line - input procedure eve_set_width (set_parameter) local new_width, ! Local copy of set parameter loop_window, ! Window currently being checked in loop last_window; ! Last VAXTPU window if not (eve$prompt_number (set_parameter, new_width, "Set width to: ", "Width not changed")) then return; endif; if new_width <= 0 then message (fao ("Cannot set width to !SL", new_width)); return; else if new_width > eve$x_largest_width then new_width := eve$x_largest_width; endif; endif; last_window := get_info (windows, "last"); loop_window := get_info (windows, "first"); loop set (width, loop_window, new_width); exitif loop_window = last_window; loop_window := get_info (windows, "next"); endloop; message (fao ("Width set to !SL", new_width)); endprocedure; ! Page 82 ! Shift procedures (horizontal scrolling) ! Shift left to reverse effects of shift right. ! ! Parameters: ! ! shift_parameter Number of columns to shift left - input procedure eve_shift_left (shift_parameter) local shift_amount; ! Local copy of shift_parameter if eve$prompt_number (shift_parameter, shift_amount, "Number of columns to shift left: ", "No columns shifted") then if shift_amount < 0 then message ("Cannot shift left by a negative amount"); else message (fao ("Window is now shifted right !SL column!%S", shift (current_window, - shift_amount))); endif; endif; endprocedure; ! Shift right to see rest of line beyond right-hand screen boundary. ! ! Parameters: ! ! shift_parameter Number of columns to shift right - input procedure eve_shift_right (shift_parameter) local shift_amount; ! Local copy of shift_parameter if eve$prompt_number (shift_parameter, shift_amount, "Number of columns to shift right: ", "No columns shifted") then if shift_amount < 0 then message ("Cannot shift right by a negative amount"); else message (fao ("Window is now shifted right !SL column!%S", shift (current_window, shift_amount))); endif; endif; endprocedure; ! Page 83 ! Show information about all non-system buffers, one at a time. ! Ask if user wants more information after each buffer. procedure eve_show local this_position, ! Marker for current cursor position this_window, ! Current window this_buffer, ! Current buffer buffer_to_show, ! Buffer passed to eve$show_buffer_info window_to_show, ! Window passed to eve$show_buffer_info next_buffer, ! Next candidate buffer show_key, ! String associated with key read after prompt throw_away; ! Result of eve$prompt_key - to resume editing this_position := mark (none); this_buffer := current_buffer; this_window := current_window; buffer_to_show := current_buffer; window_to_show := current_window; next_buffer := get_info (buffers, "last"); map (info_window, show_buffer); set (status_line, info_window, reverse, " Show buffer (" + eve$x_version + ")"); loop exitif next_buffer = 0; if (next_buffer <> this_buffer) and (get_info (next_buffer, "system") = 0) then erase (show_buffer); eve$show_buffer_info (buffer_to_show, window_to_show); if buffer_to_show = this_buffer then window_to_show := 0; endif; update (info_window); show_key := eve$lookup_comment (eve$prompt_key ("Press Do for more information, Return to resume editing: ")); if show_key = "do" then buffer_to_show := next_buffer; else unmap (info_window); position (this_window); return; endif; endif; next_buffer := get_info (buffers, "previous"); endloop; erase (show_buffer); eve$show_buffer_info (buffer_to_show, window_to_show); update (info_window); throw_away := eve$prompt_key ("Press any key to resume editing: "); unmap (info_window); position (this_window); endprocedure; ! Page 83a ! Main routine called by show command. Append information about the given ! buffer to the end of the show_buffer. Mapping, erasing, etc. are ! handled in eve_show. ! ! Parameters: ! ! this_buffer Buffer being inquired about - input ! this_window Window being inquired about - input procedure eve$show_buffer_info (this_buffer, this_window) local input_file_name, ! String with input file name for this_buffer output_file_name, ! String with output file name for this_buffer how_many_records, ! Number of records in this_buffer record_text, ! String for display of how_many_records this_window_shift, ! Shift amount for this_window what_tab_stops; ! String or integer with tab stop settings on_error ! Trap messages with tpu$_nonames and tpu$_multiplenames endon_error; position (end_of (show_buffer)); set (insert, show_buffer); ! should be insert anyway, but just in case... copy_text (fao (" Information about buffer !AS", get_info (this_buffer, "name"))); eve$letter_wrap (27); split_line; split_line; copy_text (" Input file: "); input_file_name := get_info (this_buffer, "file_name"); if input_file_name = eve$x_null then copy_text ("none"); else copy_text (input_file_name); eve$letter_wrap (15); endif; split_line; copy_text (" Output file: "); output_file_name := get_info (this_buffer, "output_file"); if (output_file_name = 0) or (get_info (this_buffer, "no_write")) then copy_text ("none"); else copy_text (output_file_name); eve$letter_wrap (15); endif; split_line; split_line; if get_info (this_buffer, "modified") then copy_text (" Modified ") else copy_text (" Not modified "); endif; copy_text (fao ("Left margin set to !SL", get_info (this_buffer, "left_margin"))); split_line; if get_info (current_buffer, "mode") = insert then copy_text (" Insert mode "); else copy_text (" Overstrike mode "); endif; copy_text (fao ("Right margin set to !SL", get_info (this_buffer, "right_margin"))); split_line; if get_info (this_buffer, "direction") = forward then copy_text (" Forward direction "); else copy_text (" Reverse direction "); endif; if this_window <> 0 then copy_text (fao ("Window width set to !SL", get_info (this_window, "width"))); endif; split_line; how_many_records := get_info (this_buffer, "record_count"); if how_many_records > 0 then record_text := fao (" !SL line!%S", how_many_records); else record_text := " No lines"; endif; copy_text (record_text); if length (record_text) >= 32 then copy_text (" "); else copy_text (substr (eve$x_spaces, 1, 32 - length (record_text))); endif; if this_window <> 0 then this_window_shift := get_info (this_window, "shift_amount"); if this_window_shift > 0 then copy_text (fao ("Window shifted right by !SL columns", this_window_shift)); endif; endif; split_line; split_line; what_tab_stops := get_info (this_buffer, "tab_stops"); if get_info (what_tab_stops, "type") = integer then copy_text (fao (" Tab stops set every !SL columns", what_tab_stops)); else copy_text (fao (" Tab stops set at columns !AS", what_tab_stops)); eve$letter_wrap (27); endif; split_line; ! Move to choice buffer to work with mark names eve$expand_to_choices (expand_name ("eve$mark_", variables)); loop exitif mark (none) = end_of (eve$choice_buffer); execute ("eve$x_buffer_of_mark:=get_info(" + current_line + ",'buffer')"); if eve$x_buffer_of_mark = this_buffer then erase_character (9); move_vertical (1); else erase_line; endif; endloop; if get_info (eve$choice_buffer, "record_count") = 0 then position (end_of (show_buffer)); copy_text (" No marks"); else eve$format_choices; position (end_of (show_buffer)); copy_text (" Marks: "); split_line; split_line; copy_text (eve$choice_buffer); endif; if current_offset > 0 then split_line; endif; endprocedure; ! Page 84 ! Show the buffers in EDT style format. Idea on how to do from EDTPlus ! list_buffers and eve_show. ! Procedure eve_list_buffers (opt_arg) ! if parameter is non-empty, show system ! buffers along with the rest. LOCAL buf, ! buffer that we're getting info on now system_buffer, ! hold value of get_info (buf,'system') show_system_buffers, ! boolean version of parameter throw_away, ! get a key, then throw it away! this_position, ! Marker for current cursor position this_window, ! Current window this_buffer; ! Current buffer ! initialize stuff this_position := mark (none); this_window := current_window; this_buffer := current_buffer; if opt_arg = eve$x_null then show_system_buffers := False; else show_system_buffers := True; endif; ! Map the info_window over the current display, we'll unmap later and ! magically everything reappears the way that it was. map (info_window, show_buffer); set (status_line, info_window, reverse, " Show buffer (" + eve$x_version + ")"); ! write the header erase(show_buffer); position(show_buffer); copy_text(' Buffer Name Status Length Filename'); split_line; copy_text('--------------------------------------------------------------------------------'); split_line; buf:=get_info(buffers,'first'); loop exitif buf=0; system_buffer := get_info(buf,'system'); if (system_buffer and show_system_buffers) or not system_buffer then if system_buffer then copy_text('S'); else copy_text(' '); endif; if buf = this_buffer then copy_text('='); else copy_text(' '); endif; copy_text(fao("!20AS ",get_info(buf,'name'))); if get_info(buf,'mode') = insert then copy_text('Ins '); else copy_text('Ovr '); endif; if get_info(buf,'no_write') then copy_text('R '); else copy_text('R/W '); endif; if get_info(buf,'modified') then copy_text('Mod '); else copy_text(' '); endif; copy_text(fao("!6SL ",get_info(buf,'record_count'))); ! Let the file name run on as long as it wants. copy_text(get_info(buf,'file_name')); split_line; endif; ! is this is a system buffer? Display info iff wanted. buf:=get_info(buffers,'next'); endloop; copy_text('--------------------------------------------------------------------------------'); split_line; copy_text(' Buffer Name Status Length Filename'); update(info_window); throw_away := eve$prompt_key ("Press any key to resume editing: "); unmap(info_window); position(this_window); endProcedure; !list_buffers ! Page 85 ! Attach back to the parent process. Used when Eve is spawned from DCL ! and run in a subprocess ("kept Eve"). The VAXTPU attach command can ! be used for more flexible process control. procedure eve_attach ! Advanced commands on_error if error = tpu$_noparent then message ("You are not running EVE in a subprocess"); return; endif; endon_error; message (eve$x_null); ! Clear out old message attach; endprocedure; ! Page 86 ! Run a DCL command and put the output in a second window on the screen. ! This is the only command to automatically create a second window if ! needed, but the user is left in the current buffer at the end of the ! command (reduce trap-door risk). Returns true if successful, false ! if no dcl command was issued. ! ! Parameters: ! ! dcl_parameter String containing DCL command - input procedure eve_dcl (dcl_parameter) local dcl_string, ! Local copy of dcl_parameter this_position, ! Marker for current cursor position this_window, ! Current window this_buffer; ! Current buffer on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; endon_error; if not (eve$prompt_string (dcl_parameter, dcl_string, "DCL command: ", "No DCL command given")) then return; endif; if (get_info (eve$x_dcl_process, "type") = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon"); endif; this_position := mark (none); if current_buffer <> eve$dcl_buffer then if eve$x_number_of_windows = 1 then eve_split_window; endif; this_window := current_window; this_buffer := current_buffer; eve_next_window; if current_buffer <> eve$dcl_buffer then map (current_window, eve$dcl_buffer); endif; endif; set (status_line, current_window, REVERSE, " DCL buffer"); position (end_of (eve$dcl_buffer)); ! Process the DCL string - need to include the $ split_line; copy_text (dcl_string); update (current_window); send (dcl_string, eve$x_dcl_process); position (end_of (eve$dcl_buffer)); update (current_window); map (this_window,this_buffer); ! Make sure that we're in the right window... eve$position_in_middle (this_position); ! Pop back to the original buffer... return (1); endprocedure; ! Page 86a ! Run a DCL command, but keep the output quitely hidden away. This is for ! spawning off background commands that you don't care about seeing the output ! for. Most of this was stolen from eve_dcl... -rcy 2/24/87 ! ! Parameters: ! background_parameter String containing DCL command - input ! procedure eve_background (background_parameter) local dcl_string, ! Local copy of background_parameter this_position, ! Marker for current cursor position this_buffer; ! Current buffer on_error if error = tpu$_createfail then message ("DCL background subprocess could not be created"); return (0); endif; endon_error; if not (eve$prompt_string (background_parameter, dcl_string, "Background command: ", "No background command given")) then return; endif; if (get_info (eve$x_dcl_process, "type") = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer,"$ set noon"); else ! send an eof to make sure that we EXIT whatever program we might be in send (eve$x_eof, eve$x_dcl_process); endif; this_position := mark (none); position (end_of (eve$dcl_buffer)); split_line; copy_text (dcl_string); ! Send the DCL string to the subprocess. send (dcl_string, eve$x_dcl_process); position (this_position); return (1); endprocedure; ! Page 87 ! Associate a key with an Eve command. Prompts for the key. ! Defined keys can be identified by a leading space in the comment field. ! Need this to be able to differentiate during keypad initialization. ! ! Parameters: ! ! define_parameter String containing command name - input procedure eve_define_key (define_parameter) local command_name, ! Local copy of define_parameter full_command_name, ! Full command string returned by eve$parse eve_edt_defined_key, ! Keyword for key to be defined paren_index, ! Index into full_command_name to end name define_comment; ! String (with leading space) to associate ! with eve_edt_defined_key on_error if error = tpu$_notdefinable then message ("No key defined"); return; endif; endon_error; if not (eve$prompt_string (define_parameter, command_name, "Eve command: ", "No key defined")) then return; endif; full_command_name := eve$parse (command_name); ! Eve$Parse will display messages and handle ambiguities if full_command_name = eve$x_null then return; endif; eve_edt_defined_key := eve$prompt_key ("Press the key that you want to define: "); paren_index := index (full_command_name, "("); if paren_index = 0 then define_comment := substr (full_command_name, 5, length (full_command_name)); else define_comment := substr (full_command_name, 5, paren_index - 5); endif; ! Return gets you out without redefining a key if eve_edt_defined_key = ret_key then message ("No key defined"); else if eve$lookup_comment (eve_edt_defined_key) = "do" then message ("You cannot bind another command to the DO key"); else if eve$alphabetic (eve_edt_defined_key) = eve$x_null then define_key (full_command_name, eve_edt_defined_key, define_comment); message ("Key defined"); else message ("You cannot bind another command to a typing key"); endif; endif; endif; endprocedure; ! Page 88 ! Compile the procedure in the current buffer. If name = "*", compile ! the entire buffer. Otherwise, compile procedure with this name. ! Procedure and endprocedure statements must start in column 1. ! ! Parameters: ! ! extend_parameter String containing procedure name or * - input procedure eve_extend_tpu (extend_parameter) local procedure_name, ! Local copy of extend_parameter this_position, ! Marker for current cursor position this_informational, ! Keyword for display of informational messages search_pattern, ! Pattern used to search for start of procedure search_range, ! Temporary range for start of/end of procedure start_procedure, ! Marker at beginning of "procedure" partial_range, ! Range including "procedure" and whitespace procedure_range, ! Range including procedure name identifier this_name, ! Procedure name string from procedure_range whole_procedure_range, ! Range including entire procedure definition found_a_procedure; ! True if procedure is found on_error if error = tpu$_compilefail then ! VAXTPU will produce message message ("Error in compiling; TPU not extended"); position (this_position); set (informational, this_informational); return; endif; if error = tpu$_strnotfound then search_range := 0; endif; endon_error; if not (eve$prompt_string (extend_parameter, procedure_name, "Procedure name: ", "TPU not extended")) then return; endif; eve$cleanse_string (procedure_name); this_position := mark (none); if get_info (system, "informational") then this_informational := on; else this_informational := off; endif; if procedure_name = "*" then message ("Extending TPU..."); set (informational, on); compile (current_buffer); set (informational, this_informational); message ("TPU extended"); return; endif; erase (eve$choice_buffer); message (fao ("Searching for procedure !AS...", procedure_name)); position (end_of (current_buffer)); possible_names := eve$x_null; search_pattern := line_begin & "procedure" & span (eve$x_word_separators) @ partial_range & procedure_name; loop search_range := search (search_pattern, reverse); exitif search_range = 0; position (beginning_of (search_range)); ! Get entire name of this procedure start_procedure := mark (none); position (end_of (partial_range)); move_horizontal (1); procedure_range := search (eve$pattern_procname, forward); ! Find corresponding endprocedure search_range := search (eve$pattern_endprocedure, forward); if search_range = 0 then found_a_procedure := 0; else position (end_of (search_range)); whole_procedure_range := create_range (start_procedure, mark (none), none); found_a_procedure := 1; endif; ! If we have a whole procedure, check for exact match etc. if found_a_procedure then this_name := substr (procedure_range, 1, length (procedure_range)); if this_name = procedure_name then erase (eve$choice_buffer); eve$add_choice (this_name); exitif 1; else eve$add_choice (this_name); endif; endif; position (start_procedure); exitif mark (none) = beginning_of (current_buffer); move_horizontal (-1); endloop; case get_info (eve$choice_buffer, "record_count") from 0 to 1 [0] : message (fao ("Could not find procedure: !AS", procedure_name)); [1] : message ("Extending TPU..."); set (informational, on); compile (whole_procedure_range); set (informational, this_informational); message ("TPU extended"); [outrange] : eve$display_choices (fao ("Ambiguous procedure name: !AS", procedure_name)); endcase; position (this_position); endprocedure; ! Page 89 ! Learn mode procedures ! Begin learn sequence procedure eve_learn message ("Press keystrokes to be learned. Press CTRL/R to remember these keystrokes."); learn_begin (exact); endprocedure; ! Remember a learn sequence. Must be bound to a key in order to work; ! cannot be used from command line procedure eve_remember local learn_sequence, ! Learn sequence returned by end_learn builtin learn_key, ! Keyword for key to bind sequence to define_error; ! Integer - true if recursive key definition on_error if error = tpu$_notlearning then message ("Nothing to remember"); return; else if error = tpu$_recurlearn then define_error := 1; endif; endif; endon_error; learn_sequence := learn_end; loop learn_key := eve$prompt_key ("Press the key that you want to use to do what was just learned: "); ! Return gets you out without redefining a key if learn_key = ret_key then message ("Key sequence not remembered"); return; endif; if eve$lookup_comment (learn_key) = "do" then message ("You cannot use the DO key for a learn sequence"); else if eve$alphabetic (learn_key) = eve$x_null then define_key (learn_sequence, learn_key, "sequence"); if define_error then message ("That key was already used in the learn sequence"); define_error := 0; else ! clear LEARN message if still there message ("Key sequence remembered"); exitif 1; endif; else message ("You cannot use a typing key for a learn sequence"); endif; endif; endloop; endprocedure; ! Page 90 ! Repeat next command n times ! ! Parameters: ! ! repeat_parameter Number of times to repeat next command - input procedure eve_repeat (repeat_parameter) local count, ! Local copy of repeat_parameter next_key, ! Keyword of next key following repeat command ascii_next_key, ! String of next_key key_program, ! Program associated with next_key repeat_key; ! String associated with next_key if not (eve$prompt_number (repeat_parameter, count, "Number of times to repeat: ", "Will not repeat next command")) then return; endif; if count <= 1 then message ("Will not repeat next command"); else message (fao ("Will repeat next command !SL times", count)); update (message_window); next_key := read_key; if eve$lookup_comment (next_key) = "shift key" then next_key := eve$get_shift_key; endif; message (eve$x_null); ascii_next_key := eve$alphabetic (next_key); if ascii_next_key <> eve$x_null then loop exitif count = 0; copy_text (ascii_next_key); count := count - 1; endloop; else ! Check for do key repeat_key := eve$lookup_comment (next_key); if repeat_key = "do" then eve$x_repeat_count := count; eve$enter_command_window; else key_program := lookup_key (next_key, program); if key_program <> 0 then loop exitif count = 0; execute (key_program); count := count - 1; endloop; else message ("Cannot repeat that key"); endif; endif; endif; update (current_window); endif; endprocedure; ! Page 91 ! Save the current environment using the VAXTPU save command ! ! Parameters: ! ! save_parameter String containing name of section file - input procedure eve_save_extended_tpu (save_parameter) local save_file; ! Local copy of save_parameter if eve$prompt_string (save_parameter, save_file, "File to save in: ", "Status not saved") then save (save_file); endif; endprocedure; ! Page 92 ! Allow users to define a shift key (like EDT gold key) ! Eve command to let the user set the shift key. ! If changing the shift key, must do a TPU UNDEFINE_KEY () of ! the current shift key before using this command. Otherwise, ! the user will wind up with multiple shift keys. procedure eve_set_shift_key local eve_edt_defined_key; ! Keyword for key to be used as shift key eve_edt_defined_key := eve$prompt_key ("Press the key that you want to use as the shift key: "); if eve_edt_defined_key = ret_key then message ("No shift key set"); else if eve$lookup_comment (eve_edt_defined_key) = "do" then message ("You cannot make the DO key the shift key"); else if eve$alphabetic (eve_edt_defined_key) = eve$x_null then set (shift_key, eve_edt_defined_key); define_key ("execute (lookup_key (eve$get_shift_key, program))", eve_edt_defined_key, "shift key"); message ("Shift key set"); else message ("You cannot make a typing key the shift key"); endif; endif; endif; endprocedure; ! VAXTPU does not save the shift key across sessions, so we have to ! be tricky to make it work. When Eve's set shift key command is used, ! it sets the shift key, but also does a define_key to this procedure. ! The define_key, unlike the shift setting, is saved across sessions. ! This procedure sets the shift key to the last (i.e. current) key, ! reads in the next key, and returns the shifted key. procedure eve$get_shift_key local key_to_shift; ! Keyword for key pressed after shift key set (shift_key, last_key); key_to_shift := key_name (read_key, shift_key); return (key_to_shift); endprocedure; ! Page 93 ! Spawn a new DCL subprocess and go to that subprocess. Logging out of ! the subprocess will resume the Eve session. Useful for running ! screen-oriented programs that can't go through VMS mailboxes. procedure eve_spawn (opt_arg) local hold_key, ! to hold a key... temp_pos, ! hold a position temp_window; ! hold the current window on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return; endif; endon_error; message (eve$x_null); ! Clear out old message if opt_arg = eve$x_null then spawn; else temp_pos := mark (NONE); temp_window := current_window; position (eve$command_window); position (end_of (eve$command_buffer)); update (eve$command_window); set (screen_update, off); spawn (opt_arg); hold_key := read_key; ! Wait until the user hits a key (any key) set (screen_update, on); position (temp_window); position (temp_pos); refresh; endif; endprocedure; ! Page 94 ! Execute a VAXTPU command line ! ! Parameters: ! ! tpu_parameter VAXTPU command string - input procedure eve_tpu (tpu_parameter) local tpu_command, ! Local copy of tpu_parameter this_informational; ! Keyword for display of informational messages if eve$prompt_string (tpu_parameter, tpu_command, "TPU command: ", "No TPU command given") then if get_info (system, "informational") then this_informational := on; else this_informational := off; endif; set (informational, on); execute (tpu_command); set (informational, this_informational); if current_window = info_window then set (status_line, info_window, reverse, " " + get_info (current_buffer, "name") + " buffer"); endif; endif; endprocedure; ! Page 94a ! ! Run spell on the current buffer. Useful for making certain that MAIL ! is sent out w/o spelling errors... NOTE: This assumes that the ! command SPELL will run your spelling checker on the input ! filename. -rcy ! ! After playing with the sort routines, I decided that spell might ! also want to have the capability to use a select range as well! Now ! it's all hacked in. -rcy 2/24/87 ! procedure eve_spell local this_position, ! Marker for current cursor position spell_range, ! Range being spelled File_Name, ! Name of the file that we are spelling String_Start, ! Starting position of the string (temp) String_Length; ! Length of string while we play with it if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer"); return; endif; this_position := mark (none); spell_range := select_range; else this_position := mark (none); spell_range := create_range (beginning_of (current_buffer), end_of (current_buffer), none); endif; File_Name := GET_INFO (current_buffer,'file_name'); String_Start := INDEX (File_Name,']') + 1; String_Length := INDEX (File_Name,';') - String_Start; File_Name := SUBSTR (File_Name,String_Start,String_Length); String_Start := INDEX (File_Name,'.') + 1; String_Length := LENGTH (File_Name); File_Name := 'SYS$SCRATCH:EVE_SPELL_TMP.' + SUBSTR (File_Name,String_Start,String_Length); write_file (spell_range,File_Name); spawn ('spell ' + File_Name); erase (spell_range); eve_include_file (File_Name); eve_background ('delete ' + File_Name + ';*'); eve$x_select_position := 0; position (this_position); eve$show_first_line; endprocedure; ! eve_spell ! Page 94b ! ! Sort whatever is selected, or if nothing is selected, the entire ! current buffer, this is useful for all sorts of things that I haven't ! thought up yet, as well as the obvious. Basically we check to see if ! anything is selected, if nothing then select the entire buffer, write ! the select range out to a file, run sort on it, and then read it back ! in. - rcy ! procedure eve_sort local this_position, ! Marker for current cursor position sort_range; ! Range being sorted if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer"); return; endif; this_position := mark (none); sort_range := select_range; else this_position := mark (none); sort_range := create_range (beginning_of (current_buffer), end_of (current_buffer), none); endif; write_file (sort_range,'sys$scratch:eve_edt_sort.tmp'); eve_background ('sort sys$scratch:eve_edt_sort.tmp sys$scratch:eve_edt_sort.tmp'); erase (sort_range); eve_include_file ('sys$scratch:eve_edt_sort.tmp'); eve_background ('delete sys$scratch:eve_edt_sort.tmp;*'); eve$x_select_position := 0; position (this_position); eve$show_first_line; endprocedure; ! Page 94c ! ! This procedure will tell you how many characters you've selected. ! This is useful for figuring out how long a particular string is. ! ! Please note that a tab only ever takes up one character, and this ! procedure will only give it a value of one character, and not how many ! spaces it takes up. ! Procedure eve_ruler local range_ruler; ! Hold the length of the select range. if eve$x_select_position = 0 then message ("You have not selected a region to rule."); return; endif; if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer."); return; endif; range_ruler := length (select_range); message (fao("You have selected !SL character!%S.",range_ruler)); endprocedure; ! eve_ruler ! Page 94d ! ! Page 94d contains rectangular cut and paste routines. The ideas ! were shamelessly stolen from EDTPlus, but the routines were completely ! rewritten for clarity, speed, and so that they would actually work in ! the EVE environment. - rcy 3/13/87 - 4/7/87 ! ! This routine will mark the corner of a rectangle. Use ! eve_extract_rectangle to cut it. ! Procedure eve_mark_corner corner_mark_1 := mark(reverse); corner_col_1 := current_column; corner_line_1 := eve_current_line (0); endprocedure; ! mark_corner ! Page 94d ! ! This procedure will print out the appropriate error message when one ! occurs while we are selecting a rectangle. It will also attempt to ! replace what we've taken out then it will clear the extract buffer. ! ! Parameters: ! error_status ---- The error that occurred ! keep_status ----- Keep_status of calling routine. ! top_edge -------- Top edge of the rectangle where the error occurred ! left_edge ------- Left edge of the rectangle where the error occurred ! Procedure rect$get_error (error_status,keep_status,top_edge,left_edge) if error_status = eve$_tabatcol then message ("A tab is interfering with selecting the rectangle."); else message ("An error has occurred selecting the rectangle."); endif; if not keep_status then eve$goto_line_col (top_edge,left_edge); eve$put_rectangle (1); endif; erase (extract_buffer); position (corner_mark_2); delete(corner_mark_1); delete(corner_mark_2); endprocedure; ! Page 94d ! ! This routine will get a rectangle iff the user marked the ! opposite corner already. ! ! Parameters: ! ! keep_rectangle True if we want to keep the selected rectangle where ! it is as well as extract it. ! Procedure eve$get_rectangle (keep_rectangle) LOCAL ret_status, ! Hold the return status from a routine corner_col_2, ! The second corner column corner_line_2, ! The second corner line top_edge, ! The line number of the top edge bottom_edge, ! The line number of the bottom edge left_edge, ! The column number of the left edge right_edge, ! The column number of the right edge curr_line, ! The line that we are currently working on left_line_mark, ! Left edge of the range to put into the Extract buffer right_line_mark,! Right edge of the range to put into the Extract buffer this_buffer, ! The current buffer buffer_length, ! The length of the current buffer ext_range; ! range to put into extract buffer on_error message ("Error in Get Rectangle routine."); return; endon_error if not(corner_mark_1) then if keep_rectangle then message("Please Mark the opposite Corner before Copying a Rectangle."); else message("Please Mark the opposite Corner before Extracting a Rectangle."); endif; else if get_info (corner_mark_1, "buffer") <> current_buffer then message ("Corner marked not in current buffer."); return; endif; if current_offset = length(current_line) then ! We are hanging off of the end of the line, move back a character. move_horizontal (-1); update (current_window); endif; this_buffer := current_buffer; corner_mark_2 := mark(none); corner_col_2 := current_column; corner_line_2 := eve_current_line (0); if (corner_mark_1<>corner_mark_2) then ! find the upper right corner ! figure out the right, left, top and bottom edges of the rectangle if corner_col_1 < corner_col_2 then right_edge := corner_col_1; left_edge := corner_col_2; else right_edge := corner_col_2; left_edge := corner_col_1; endif; if corner_line_1 < corner_line_2 then top_edge := corner_line_1; bottom_edge := corner_line_2; else top_edge := corner_line_2; bottom_edge := corner_line_1; endif; ! Start at the top left corner of the rectangle and work down to the ! bottom. erase(extract_buffer); position(corner_mark_2); curr_line := top_edge; ! Find out the length of the current buffer so that we know if any ! lines disappear from it. buffer_length := get_info (this_buffer, "record_count"); loop ! Through the lines in the rectangle exitif curr_line > bottom_edge; ret_status := eve$goto_line_col (curr_line,left_edge); if (ret_status <> eve$_success) then ! Check for a short line. if ret_status = eve$_colnotreached then ! Pad out the line to grab it eve_pad_line (right_edge); eve$goto_line_col (curr_line,left_edge); else ! die gracefully rect$get_error(ret_status,keep_rectangle,top_edge,left_edge); position (this_buffer); position (this_position); return; endif; endif; left_line_mark := mark (NONE); ret_status := eve$goto_line_col (curr_line,right_edge); if (ret_status <> eve$_success) and (ret_status <> eve$_colnotreached) then ! die gracefully rect$get_error(ret_status,keep_rectangle,top_edge,left_edge); return; endif; right_line_mark := mark (NONE); ext_range := create_range(left_line_mark,right_line_mark,NONE); position(end_of(extract_buffer)); if keep_rectangle then copy_text (ext_range); else move_text (ext_range); if get_info (this_buffer, "record_count") < buffer_length then ! The move text took a line out of the buffer, compensate for ! the fact by "moving" the bottom edge and current line up and ! reseting buffer_length. buffer_length := get_info (this_buffer, "record_count"); bottom_edge := bottom_edge - 1; curr_line := curr_line - 1; endif; endif; position(corner_mark_2); ! go back to the buffer that we started in. curr_line := curr_line + 1; ! go to the next line endloop; !end looping through the lines in the rectangle position(beginning_of(extract_buffer)); eve_pad_buffer(right_edge-left_edge); ! pad the rectangle out position(corner_mark_2); ! go back to where we started cutting from... else ! One character rectangle, just copy or move it to the extract buffer. ext_range := create_range (corner_mark_1,corner_mark_2,NONE); erase(extract_buffer); position(beginning_of(extract_buffer)); if keep_rectangle then copy_text (ext_range); else move_text (ext_range); endif; endif; ! if corner_mark_1<>corner_mark_2 ! do some house-keeping. delete(corner_mark_1); delete(corner_mark_2); endif; ! if corner_mark_1 exists endProcedure; ! eve$get_rectangle ! Page 94d ! ! This procedure will extract a rectangle and place it in the EXTRACT ! buffer. ! ! Procedure eve_extract_rectangle eve$get_rectangle (0); endprocedure; ! eve_extract_rectangle ! Page 94d ! ! This procedure will make a copy of the extracted rectangle and ! place it in the EXTRACT buffer. The old rectangle will be left alone. ! Procedure eve_copy_rectangle eve$get_rectangle (1); endprocedure; ! eve_copy_rectangle ! Page 94d ! ! After hacking the EDTPlus version of extract_rectangle and ! copy_rectangle into clean code, I decided that eve_insert_rectangle ! was worthy of the same treatment (and like extract_rectangle, it takes ! a flag to toggle insert/overstrike mode so that the code doesn't have ! to be duplicated for overlay_rectangle. ! ! Parameters: ! ! insert_rect True if we want to insert this rectangle, False ! if we want to overlay this rectangle. ! Procedure eve$put_rectangle (insert_rect) LOCAL ret_status, ! Status of a call. top_edge, ! The line number of the top edge inserted_lines, ! The number of lines that we've inserted so far line_on, ! The line that we're working on num_lines, ! The number of lines in the extract buffer pad_line, ! Hold a line while we pad it out left_edge, ! The column number of the left edge start_mark, ! A mark to mark the start of a range copy_range, ! The range that we are transferring into this buffer this_buffer, ! The current buffer this_mode, ! The current buffer mode this_position; ! Hold the current position on_error message ("Error in Put Rectangle routine."); return; endon_error; ! Sanity check: find out if we have a rectangle to put... num_lines:=get_info(extract_buffer,"record_count"); if (num_lines=0) then message("EXTRACT buffer empty"); return; endif; ! initialize a bunch of stuff. this_position := mark(NONE); this_buffer := current_buffer; top_edge := eve_current_line (0); left_edge := current_column; inserted_lines := 0; pad_line := ''; ! OK, now we set the current buffer into Insert or Overstrike mode as ! requested, but save the current state so that we can reset later on. this_mode := get_info (this_buffer, "mode"); if insert_rect then set (insert, this_buffer); else set (overstrike, this_buffer); endif; loop ! until inserted_lines >= num_lines exitif inserted_lines >= num_lines; line_on := top_edge + inserted_lines; ! Sanity check: find out if we're trying to put this rectangle past the end ! of the buffer. if line_on > get_info (current_buffer,"record_count") then position (end_of (current_buffer)); split_line; endif; ! Now we go grab the current line of the rectangle and put it here. position (beginning_of(extract_buffer)); move_vertical (inserted_lines); start_mark := mark (NONE); position (search (line_end, forward)); move_horizontal (-1); copy_range := create_range (start_mark,mark(NONE),NONE); position (this_position); ret_status := eve$goto_line_col (line_on,left_edge); if ret_status = eve$_success then copy_text (copy_range); else if ret_status = eve$_colnotreached then if left_edge > 0 then eve$pad_string (pad_line,left_edge-1); copy_text (pad_line); ! hang off of the edge of the line move_horizontal ((left_edge-1)-current_offset); endif; copy_text (copy_range); else if ret_status = eve$_tabatcol then message ("Error writing rectangle, tab in the way."); else message (fao("Error was !SL.",ret_status)); message ("Internal error in eve$put_rectangle. Contact Chris Yoder."); endif; endif; endif; inserted_lines := inserted_lines + 1; endloop; ! until inserted_lines >= num_lines position (this_position); set (this_mode, this_buffer); endProcedure; ! eve$put_rectangle ! Page 94d ! ! This procedure will insert the rectangle in the Extract buffer ! into the current buffer using the current position as the upper left ! hand corner of the inserted rectangle. ! Procedure eve_insert_rectangle eve$put_rectangle (1); endprocedure; ! eve_insert_rectangle ! Page 94d ! ! This procedure will overlay the rectangle in the Extract buffer ! into the current buffer using the current position as the upper left ! hand corner of the inserted rectangle. ! Procedure eve_overlay_rectangle eve$put_rectangle (0); endprocedure; ! eve_overlay_rectangle ! Page 94d ! ! This procedure will set the current position to be line, column. It will ! return one of the following status messages: ! ! 0 = eve$_nomessage ------- No message, random error status. The current ! position is where we started. ! 1 = eve$_success --------- The success message. ! 2 = eve$_invparam -------- An invalid parameter was specified. ! 4 = eve$_colnotreached --- The column could not be reached because the line ! was too short. The current position is at the ! end of the line specified. ! 6 = eve$_tabatcol -------- The column specified ended up in the middle of ! a tab. The current position is at the end of ! the tab. ! 8 = eve$_linenotreached -- The line specified could not be reached because ! there aren't enough lines in the file. The ! current position is where we started. ! ! Parameters: ! target_line The line that we want to go to. ! target_col The column that we want to end up on. ! procedure eve$goto_line_col (target_line,target_col) local this_position, ! Marker for current position last_line, ! Number of lines in buffer last_col, ! The last column that we were at has_tabs, ! The line has tabs in it next_tab_col, ! The column where the next tab ends what_tab_stops, ! What tab stops are there cur_col, ! The current column we are working on. place, ! Hold a place in a string hold_len, ! Hold a string length start_line, ! A mark to hold the starting edge of the line line_range, ! A range to hold the line in line_length, ! The length of the line i, ! looping variable EOB; ! Marker for end of buffer on_error message (fao ("Cannot move to line !SL, column !SL.", target_line, target_col)); position (this_position); return eve$_nomessage; endon_error; ! Do some initializing and a reasonableness test on Target_Line and Target_Col this_position := mark (NONE); EOB := end_of (current_buffer); if target_line <=0 then message (fao ("Cannot move to line !SL", target_line)); position (this_position); return eve$_invparam; endif; last_line := get_info (current_buffer, "record_count"); if target_line > last_line then message (fao("Only !SL line!%S in buffer, cannot go to line !SL.", last_line, target_line)); position (this_position); return eve$_linenotreached; endif; if target_col < 0 then message (fao ("Cannot move to column !SL", target_col)); position (this_position); return eve$_invparm; endif; ! Now we try to move to target_line, target_col position (beginning_of (current_buffer)); move_vertical (target_line - 1); ! We started at line 1 ! now see if target_col is beyond EOL, check for tabs and detab if necessary ! While we're here, might as well correct for 0 length lines. line_length := length (current_line); if line_length = 0 then return eve$_colnotreached; endif; move_horizontal (-current_offset); ! position at beginning of line start_line := mark(NONE); position (search (line_end, forward)); ! goto the end of the line line_range := create_range (start_line, mark (NONE), NONE); position (start_line); has_tabs := False; i := 1; loop ! until i > line_length exitif has_tabs; exitif i > line_length; if current_character = ascii(9) then has_tabs := True; endif; move_horizontal (1); i := i + 1; endloop; position (start_line); if has_tabs then ! we move to the specified column, checking for tabs what_tab_stops := get_info (current_buffer, "tab_stops"); cur_col := 1; ! initialize next_tab_col if get_info (what_tab_stops,"type") = integer then ! easy case next_tab_col := what_tab_stops; else place := index (what_tab_stops,' '); if place = 0 then next_tab_col := int(what_tab_stops) - 1; what_tab_stops := ''; else hold_len := place - 1; next_tab_col := int(substr(what_tab_stops,1,hold_len)) - 1; what_tab_stops := substr(what_tab_stops,place+1, length(what_tab_stops)-place); endif; ! if place = 0 then else endif; ! if get_info (what_tab_stops,"type") = "integer" then else loop ! until we get to or past the column that we're looking for or to EOL exitif cur_col >= target_col; exitif current_offset = line_length; if current_character = ascii (9) then ! we have to worry about the tab cur_col := next_tab_col + 1; ! move to the end of the current tab. ! find out where the end of the next tab is. if get_info (what_tab_stops,"type") = integer then ! easy case next_tab_col := next_tab_col + what_tab_stops; else if length(what_tab_stops) > 0 then ! we don't have an empty string place := index (what_tab_stops,' '); if place = 0 then next_tab_col := int(what_tab_stops) - 1; what_tab_stops := ''; else hold_len := place - 1; next_tab_col := int(substr(what_tab_stops,1,hold_len)) - 1; what_tab_stops := substr(what_tab_stops,place+1, length(what_tab_stops)-place); endif; ! if place = 0 then else else next_tab_col := next_tab_col + 1; endif; ! if length(what_tab_stops) > 0 then else endif; ! if get_info (what_tab_stops,"type") = "integer" then else else ! no tab, easy case cur_col := cur_col + 1; endif; ! if current_character is a tab move_horizontal (1); endloop; ! return a status to the user if cur_col = target_col then ! we're fine, say so return eve$_success; else ! return an error if cur_col > target_col then ! we're over... return eve$_tabatcol; else ! short line return eve$_colnotreached; endif; endif; else ! we don't have tabs, this one's easy! if line_length >= target_col then move_horizontal (target_col - 1); return eve$_success; else move_horizontal (line_length - 1); ! go to the end of the line anyway. return eve$_colnotreached; endif; endif; ! if has_tabs else endprocedure; ! Page 94e ! ! Procedure to pad a buffer out to a specific column. If a 0 or less is ! passed then we pad the buffer out to match the longest line in the buffer. ! procedure eve_pad_buffer (right_column_parameter) local this_direction, ! Save our current direction this_position, ! Save our current position i, ! Looping variable num_lines, ! Number of lines in the buffer temp_pattern, ! Hold a temporary pattern to find EOL hold_range, ! The range of the current line hold_line, ! The current line max_line_length, ! Local copy of right_column_parameter hold_line_length; ! Find out the current line length. this_position := mark (none); num_lines := get_info(current_buffer,'record_count'); this_direction := current_direction; set (forward, current_buffer); if right_column_parameter <= 0 then max_line_length := 0; position (beginning_of(current_buffer)); temp_pattern := (anchor & remain);; loop ! all the way through the buffer exitif mark(none) = end_of(current_buffer); hold_range := search (temp_pattern, forward); hold_line_length := length (hold_range); if max_line_length < hold_line_length then max_line_length := hold_line_length; endif; eve_move_by_bol; endloop; ! loop to figure out the length of the longest line. else max_line_length := right_column_parameter; endif; ! right_column_parameter <= 0 i.e. figure out how far to pad. ! Loop through the whole buffer, deleting a line, calling EVE$PAD_STRING ! and reinserting the line. i := 0; position (beginning_of(current_buffer)); loop ! all the way through the buffer exitif i >= num_lines; hold_line := erase_line; eve$pad_string (hold_line,max_line_length); copy_text (hold_line); split_line; i := i + 1; endloop; ! loop to do the actual padding hold_line := erase_line; ! blow away the extra split_line set (this_direction,current_buffer); position(this_position); endprocedure; ! eve_pad_buffer ! Page 94e ! ! Procedure to pad the selected area (calls eve_pad_buffer). ! Procedure eve_pad_selected (right_column_parameter) local pad_range, ! Range to pad this_position; ! Save our current position if eve$x_select_position = 0 then message ("You have not selected a region to pad."); return; endif; if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer."); return; endif; ! setup this_position := mark (NONE); ! move the selected text to the scratch buffer pad_range := select_range; erase (scratch_buffer); position (beginning_of(scratch_buffer)); move_text (pad_range); ! pass the buck to do the work eve_pad_buffer (right_column_parameter); ! bring it back pad_range := create_range (beginning_of(scratch_buffer), end_of(scratch_buffer), NONE); position (this_position); move_text (pad_range); ! cleanup eve$x_select_position := 0; pad_range := 0; endprocedure; ! eve_pad_selected ! Page 94e ! ! Procedure to pad a line out to a specific column. ! procedure eve_pad_line (right_column_parameter) local this_offset, ! Save our current position hold_line, ! The current line max_line_length; ! Local copy of right_column_parameter if not (eve$prompt_string (right_column_parameter, max_line_length, "Length to pad line to: ", "Line not padded.")) then return; endif; this_offset := current_offset; hold_line := erase_line; eve$pad_string (hold_line,max_line_length); copy_text (hold_line); split_line; ! and now we go back to where we were move_vertical (-1); position(search(line_begin,reverse)); move_horizontal (this_offset); endprocedure; ! eve_pad_line ! Page 94f ! ! Procedure to insert a string (default = '>') at the beginning of ! every line in the selected area or in the current buffer. This is only ! the default interface routine. The actual work is done in ! EVE$COMMENT_BUFFER. ! ! Parameters: ! ! comment_string_parameter ! procedure eve_comment_text (comment_string_parameter) local comment_string, ! Local copy of comment_string_parameter comment_range, ! Range of text that we are commenting prompt_string, ! String that we prompt with for the comment ! character this_position; ! Current position prompt_string := "String to comment with: [" + eve$x_comment_string + "] "; if not (eve$prompt_string (comment_string_parameter, comment_string, "String to comment with: [>] ", "Using Default")) then comment_string := eve$x_comment_string; endif; ! select the appropriate text if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Select marker not in current buffer"); return; endif; this_position := mark (none); comment_range := select_range; else this_position := mark (none); comment_range := create_range (beginning_of (current_buffer), end_of (current_buffer), none); endif; ! move the selected text to the scratch buffer erase (scratch_buffer); position (beginning_of(scratch_buffer)); move_text (comment_range); ! pass the buck to do the work eve$comment_buffer (scratch_buffer,comment_string); ! bring the modified text back comment_range := create_range (beginning_of(scratch_buffer), end_of(scratch_buffer), NONE); position (this_position); move_text (comment_range); ! cleanup position (this_position); eve$x_select_position := 0; comment_range := 0; endprocedure; ! eve_comment_text ! Page 94f ! ! This procedure moves to the buffer specified and inserts the string ! specified at the beginning of each and every line in the buffer. ! ! Parameters: ! buffer_to_comment The buffer that we are commenting ! comment_string The string to comment with ! procedure eve$comment_buffer (buffer_to_comment,comment_string) local this_position, ! The current position this_direction, ! The current direction for the buffer this_buffer, ! The current buffer this_mode; ! The current buffer mode ! save info so that we don't screw up the user. this_position := mark (NONE); this_direction := current_direction; this_buffer := current_buffer; this_mode := get_info (this_buffer, "mode"); ! start at the beginning of the buffer... position (beginning_of(buffer_to_comment)); set (insert, current_buffer); set (forward, current_buffer); ! and loop through the entire buffer 'till we get to the end of it. loop copy_text (comment_string); eve_move_by_bol; exitif mark (NONE) = end_of(current_buffer); endloop; ! set everything back to where and how it used to be. position (this_position); set (this_mode, this_buffer); set (this_direction, this_buffer); endprocedure; ! Page 95 ! Procedures to support command-line editor ! Set up command line editor procedure eve$enter_command_window ! Command line parser local this_position; ! Marker for current cursor position if not eve$x_starting_up then eve$start_do_key := eve$lookup_comment (last_key); endif; if current_window = info_window then unmap (info_window); position (eve$x_this_window); endif; this_position := mark (none); eve$x_pre_command_window := current_window; position (eve$command_window); position (end_of (eve$command_buffer)); copy_text (eve$x_command_prompt); endprocedure; ! Leave command line editor. ! Does not leave if there is an ambiguity, with choices in the ! choice window. procedure eve$exit_command_window local current_command_line, ! String containing current command buffer line temp_position; ! Marker for cursor position in command buffer if current_window <> eve$command_window then message ("Not in command window"); else if not eve$x_starting_up then eve$stop_do_key := eve$lookup_comment (last_key); endif; ! Test for end of buffer to avoid move_vertical errors temp_position := mark (none); if temp_position <> end_of (eve$command_buffer) then current_command_line := current_line; move_horizontal (- current_offset); move_vertical (1); temp_position := mark (none); if temp_position <> end_of (eve$command_buffer) then position (end_of (eve$command_buffer)); move_vertical (-1); erase_line; copy_text (current_command_line); endif; else current_command_line := eve$x_null; endif; if substr (current_command_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then current_command_line := substr (current_command_line, eve$x_command_prompt_length + 1, length (current_command_line)); endif; position (eve$x_pre_command_window); message (eve$x_null); ! clear out message window without deleting messages eve$process_command (current_command_line); endif; endprocedure; ! Page 96 ! Process command selected in command line editor ! ! Parameters: ! ! new_do_line String containing Eve command - input procedure eve$process_command (new_do_line) local repetitions, ! Number of times to execute this command this_position, ! Marker for current cursor position this_window; ! Current window ! Make sure we do not repeat the current repeat command repetitions := eve$x_repeat_count; eve$x_repeat_count := 1; if new_do_line <> eve$x_null then eve$x_do_line := new_do_line; eve$parsed_do_line := eve$parse (eve$x_do_line); if eve$parsed_do_line = eve$x_null then ! message sent during parse error eve$x_do_line := eve$x_null; else ! Unmap choice window before executing the command if get_info (eve$choice_window, "buffer") <> 0 then unmap (eve$choice_window); endif; loop exitif repetitions = 0; execute (eve$parsed_do_line); repetitions := repetitions - 1; endloop; endif; else eve$x_ambiguous_parse := 0; ! need this since eve$parse is not called here if (eve$start_do_key = "do") and (eve$stop_do_key = "do") then if eve$x_do_line = eve$x_null then message ("No previous command given"); else message (fao ("Doing previous command: !AS", eve$x_do_line)); loop exitif repetitions = 0; execute (eve$parsed_do_line); repetitions := repetitions - 1; endloop; endif; else message ("No command given"); endif; endif; if eve$x_ambiguous_parse then if get_info (eve$choice_window, "buffer") = 0 then map (eve$choice_window, eve$choice_buffer); endif; if get_info (eve$choice_buffer, "record_count") >= eve$x_choice_window_length then set (status_line, eve$choice_window, reverse, " Choices Press Next Screen or Prev Screen to see other choices"); else set (status_line, eve$choice_window, reverse, " Choices"); endif; update (eve$choice_window); position (eve$command_window); position (end_of (eve$command_buffer)); move_horizontal (-1); else ! Unmap choice window if not done previously if get_info (eve$choice_window, "buffer") <> 0 then unmap (eve$choice_window); endif; this_position := mark (none); this_window := current_window; position (eve$command_window); position (end_of (eve$command_buffer)); if new_do_line = eve$x_null then move_vertical (-1); erase_line; endif; update (eve$command_window); position (this_window); position (this_position); endif; endprocedure; ! Page 97 ! VMS V4-style recall command procedure eve_recall local recall_line; ! String containing command line to be recalled on_error message ("No more commands to recall"); move_vertical (1); move_horizontal (-1); return; endon_error; if current_buffer <> eve$command_buffer then eve$enter_command_window; endif; move_horizontal (- (current_offset + 1)); endprocedure; ! Page 98 ! Command line interpreter ! ! Parameters: ! ! do_parameter String containing Eve command - input procedure eve_do (do_parameter) local do_line; ! Local copy of do_parameter do_line := do_parameter; if (length (do_line) > 0) then eve$process_command (do_line); else if current_window = eve$command_window then eve$exit_command_window; else eve$enter_command_window; endif; endif; endprocedure; ! Page 99 ! Procedures to do command line parsing ! These procedures use the following global variables: ! ! eve$x_command_line Result of read_line ! eve$x_command_index Index into eve$x_command_line while parsing ! eve$x_command_length Length of eve$x_command_line ! eve$x_is_symbol | ! eve$x_is_quoted_string | Used to indicate token type ! eve$x_is_punctuation | ! eve$x_is_number | ! ! Move eve$x_command_index over whitespace. Stay put if not on whitespace ! when starting. procedure eve$index_over_whitespace local c; ! Current character in command line loop exitif eve$x_command_index > eve$x_command_length; c := substr (eve$x_command_line, eve$x_command_index, 1); exitif index (eve$x_token_separators, c) = 0; eve$x_command_index := eve$x_command_index + 1; endloop; endprocedure; ! Page 100 ! Eve$get_token returns the next token in the command line. ! Returns a null string if no more tokens. ! ! Tokens include symbols, quoted strings, and punctuation, and strings ! that are "none of the above." A quoted string at the end of a line ! does not have to have a final close quote. procedure eve$get_token local original_index, ! Original index into command line quote_char, ! Quote character being used for quoted string c, ! Current character in command line closed_quote, ! True if quote_char ends quoted string work_token; ! Temporary string for building current token quote_char := eve$x_null; c := eve$x_null; closed_quote := 0; work_token := eve$x_null; eve$x_is_symbol := 0; eve$x_is_quoted_string := 0; eve$x_is_punctuation := 0; eve$x_is_number := 1; eve$index_over_whitespace; original_index := eve$x_command_index; if eve$x_command_index > eve$x_command_length then eve$x_is_number := 0; eve$get_token := eve$x_null; return; endif; c := substr (eve$x_command_line, eve$x_command_index, 1); if index (eve$x_symbol_characters, c) > 0 then eve$x_is_symbol := 1; loop eve$x_is_number := eve$x_is_number and (index (eve$x_digit_characters, c) > 0); eve$x_is_symbol := eve$x_is_symbol and (index (eve$x_symbol_characters, c) > 0); eve$x_command_index := eve$x_command_index + 1; exitif eve$x_command_index > eve$x_command_length; c := substr (eve$x_command_line, eve$x_command_index, 1); exitif index (eve$x_token_separators, c) > 0; endloop; eve$get_token := substr (eve$x_command_line, original_index, eve$x_command_index - original_index); return; endif; eve$x_is_number := 0; if (c = "'") or (c = '"') then eve$x_is_quoted_string := 1; quote_char := c; loop eve$x_command_index := eve$x_command_index + 1; exitif eve$x_command_index > eve$x_command_length; c := substr (eve$x_command_line, eve$x_command_index, 1); if c = quote_char then ! Check for doubled quotes eve$x_command_index := eve$x_command_index + 1; if eve$x_command_index > eve$x_command_length then closed_quote := 1; exitif 1; endif; c := substr (eve$x_command_line, eve$x_command_index, 1); if c <> quote_char then closed_quote := 1; exitif 1; endif; endif; endloop; work_token := substr (eve$x_command_line, original_index, eve$x_command_index - original_index); ! Add close quote if there wasn't one due to end of line. if closed_quote then eve$get_token := work_token; else eve$get_token := work_token + quote_char; endif; return; endif; ! Not a symbol, not a quoted string, so just return the single character and ! set eve$punctuation. eve$punctuation := 1; eve$x_command_index := eve$x_command_index + 1; eve$get_token := substr (eve$x_command_line, original_index, 1); endprocedure; ! Page 101 ! Procedure which helps in recognizing multi-word commands. ! If initial_token is an initial substring of full_token, ! return the largest substring of full_token which contains no ! more underscores than initial_token. Otherwise return the null string. ! ! Parameters: ! ! initial_token Prefix string - input ! full_token Entire string - input procedure eve$complete (initial_token, full_token) local underscore_index; ! Index of next underscore in full_token ! that is not found in initial_token if initial_token <> substr (full_token, 1, length (initial_token)) then return (eve$x_null); endif; if initial_token = full_token then return (initial_token); endif; underscore_index := index (substr (full_token, length (initial_token) + 1, length (full_token)), "_"); if underscore_index = 0 then eve$complete := full_token; else eve$complete := substr (full_token, 1, length (initial_token) + underscore_index - 1); endif; return; endprocedure; ! Page 102 ! Procedure for handling quoted string. Takes the argument, doubles ! all quotation marks, and return the resulting string. ! ! Parameters: ! ! string_with_quotes String being processed - input procedure eve$double_quotes (string_with_quotes) local result_string, ! Portion of string with quotes doubled rest_of_string, ! Remainder of string yet to be processed quote_index; ! Index of double-quote in rest_of_string result_string := eve$x_null; rest_of_string := string_with_quotes; loop quote_index := index (rest_of_string, '"'); if quote_index = 0 then result_string := result_string + rest_of_string; exitif 1; else result_string := result_string + substr (rest_of_string, 1, quote_index) + '"'; exitif quote_index = length (rest_of_string); rest_of_string := substr (rest_of_string, quote_index + 1, length (rest_of_string)); endif; endloop; return (result_string); endprocedure; ! Page 103 ! Procedure for handling the last string argument in a command line ! when it is not a quoted string. Returns result of parse after ! handling the string. ! ! Parameters: ! ! result_so_far String containing parse to date - input ! current_token String containing current token - input procedure eve$add_final_string (result_so_far, current_token) local parse_result, ! Result of parsing complete command line rest_of_line, ! Remainder of command line including this token quote_mark; ! Quote mark to be used in parse_result parse_result := result_so_far; rest_of_line := current_token + substr (eve$x_command_line, eve$x_command_index, (eve$x_command_length - eve$x_command_index) + 1); if index (rest_of_line, '"') = 0 then quote_mark := '"'; else if index (rest_of_line, "'") = 0 then quote_mark := "'"; else ! double the quote marks in string quote_mark := '"'; rest_of_line := eve$double_quotes (rest_of_line); endif; endif; parse_result := parse_result + quote_mark + rest_of_line + quote_mark + ")"; return (parse_result); endprocedure; ! Page 104 ! The main command line parsing procedure. Returns a VAXTPU command string. ! Parses Eve commands, which call procedures whose names start with "eve_". ! Commands can be typed with or without parentheses and quotation marks. ! Multi-word commands like fill_paragraph may be typed with a space instead ! of an underscore. Defaults are provided so that procedures will prompt ! for missing arguments (prompting varies too much for effective ! centralization). ! ! Parameters: ! ! line_to_parse Eve command string - input procedure eve$parse (line_to_parse) local parse_result, ! String containing VAXTPU command to execute current_token, ! String currently being processed uppercase_token, ! Uppercase version of current_token expanded_token, ! String with all candidate commands choice_token, ! Current item from expanded_token command_token, ! Eve command name, with underscores command_name, ! Eve command name, without underscores choices, ! Subset of expanded_token that match how_many_choices, ! How many items in choices possible_completion, ! String containing first n words of command completion, ! First possible_completion ambiguous_completion, ! True if possible_completion is not unique no_more_words, ! True when all words in command name parsed reusing_token, ! True if lookahead found an argument instead ! of part of a command name this_buffer, ! Current buffer arguments, ! Number of arguments expected for this command which_argument; ! Number of argument currently being processed on_error ! Trap messages with tpu$_nonames and tpu$_multiplenames endon_error; eve$x_command_line := line_to_parse; eve$x_command_index := 1; eve$x_command_length := length (eve$x_command_line); eve$x_ambiguous_parse := 0; eve$x_argument_type := eve$x_null; parse_result := eve$x_null; command_token := eve$x_null; command_name := eve$x_null; expanded_token := eve$x_null; uppercase_token := eve$x_null; erase (eve$choice_buffer); ! Get command name - since commands may have spaces, this can ! involve parsing several tokens ! Handle first token separately, outside the loop, for easier diagnostics ! and handling eve_ prefix current_token := eve$get_token; if current_token = eve$x_null then message ("No command given"); return (eve$x_null); endif; if not eve$x_is_symbol then message (fao ("Unrecognized command: !AS", current_token)); return (eve$x_null); endif; uppercase_token := current_token; change_case (uppercase_token, upper); if substr (uppercase_token, 1, 4) <> "EVE_" then uppercase_token := "EVE_" + uppercase_token; endif; this_buffer := current_buffer; ! Loop for parsing command token loop expanded_token := expand_name (uppercase_token, procedures); if expanded_token = eve$x_null then if parse_result <> eve$x_null then reusing_token := 1; exitif 1; else ! Usually will get leading space due to "Command: " prompt message (fao ("Don't understand command: !AS", substr (eve$x_command_line, 1, eve$x_command_index - 1))); return (eve$x_null); endif; endif; how_many_choices := 0; ambiguous_completion := 0; completion := eve$x_null; choices := eve$x_null; ! Move to choice buffer and loop through the choices. eve$expand_to_choices (expanded_token); loop exitif mark (none) = end_of (eve$choice_buffer); choice_token := current_line; how_many_choices := how_many_choices + 1; if uppercase_token = choice_token then ! found an exact match parse_result := choice_token; endif; possible_completion := eve$complete (uppercase_token, choice_token); if possible_completion = choice_token then no_more_words := 1; endif; if how_many_choices = 1 then completion := possible_completion; else if completion <> possible_completion then ambiguous_completion := 1; endif; endif; move_vertical (1); endloop; eve$strip_choices (4); position (this_buffer); translate (eve$choice_buffer, " ", "_"); if parse_result = uppercase_token then reusing_token := 0; exitif 1; else if how_many_choices = 1 then parse_result := expanded_token; else if ambiguous_completion then eve$display_choices (fao ("Ambiguous command name: !AS", substr (eve$x_command_line, 1, eve$x_command_index - 1))); return (eve$x_null); else if no_more_words then parse_result := completion; reusing_token := 0; exitif 1; endif; endif; endif; endif; ! Get next token and try to build command current_token := eve$get_token; if current_token = eve$x_null then if parse_result <> eve$x_null then reusing_token := 1; exitif 1; else eve$display_choices (fao ("Ambiguous command name: !AS", substr (eve$x_command_line, 1, eve$x_command_index - 1))); return (eve$x_null); endif; else uppercase_token := completion + "_" + current_token; change_case (uppercase_token, upper); endif; endloop; command_token := substr (parse_result, 5, 1); change_case (parse_result, lower); command_token := command_token + substr (parse_result, 6, length (parse_result) - 5); command_name := command_token; translate (command_name, " ", "_"); ! Check for arguments that this command expects arguments := 1; loop exitif expand_name ("eve$arg" + str (arguments) + "_" + command_token, variables) = eve$x_null; arguments := arguments + 1; endloop; arguments := arguments - 1; ! Since execute can only take 132 character strings, Eve command ! names can only be (132 - 30) = 102 characters long. ! If arguments = 0 or eve$arg* is uninitialized, eve$x_argument_type ! has already been initialized to the null string. if arguments > 0 then execute ("eve$x_argument_type:=eve$arg1_" + command_token); endif; ! Get second token - if it's an open paren, get the next token. ! Parsing command name may have stopped on real 2nd token, so check. if not reusing_token then current_token := eve$get_token; endif; which_argument := 0; if arguments > 0 then parse_result := parse_result + "("; endif; ! Loop to handle arguments, in 4 steps: ! 1) If last argument, check for closing punctuation and return ! 2) If last token, handle defaults for remaining arguments ! 3) Handle the argument ! 4) Get the next token loop ! If last argument, handle closing punctuation and return if which_argument = arguments then if (current_token = "\") or (current_token = "|") then current_token := eve$get_token; endif; if current_token = eve$x_null then if arguments > 0 then parse_result := parse_result + ")"; endif; return (parse_result); else if arguments = 0 then message (fao ("!AS does not take any arguments", command_name)); else message (fao ("!AS takes only !SL argument!%S", command_name, arguments)); endif; return (eve$x_null); endif; endif; ! If there are no more tokens, handle default arguments. ! All Eve functions will prompt appropriately when they get the ! null string or negative numbers as arguments if current_token = eve$x_null then loop exitif which_argument = arguments; which_argument := which_argument + 1; execute ("eve$x_argument_type:=eve$arg" + str (which_argument) + "_" + command_token); change_case (eve$x_argument_type, lower); if eve$x_argument_type = "string" then parse_result := parse_result + '""'; else if eve$x_argument_type = "integer" then parse_result := parse_result + '-1'; else message (fao ("Argument type !AS must be integer or string", eve$x_argument_type)); return (eve$x_null); endif; endif; if which_argument < arguments then parse_result := parse_result + ","; endif; endloop; parse_result := parse_result + ")"; return (parse_result); endif; ! Handle current argument which_argument := which_argument + 1; execute ("eve$x_argument_type:=eve$arg" + str (which_argument) + "_" + command_token); change_case (eve$x_argument_type, lower); if eve$x_argument_type = "string" then if eve$x_is_quoted_string then parse_result := parse_result + current_token; else if which_argument = arguments then parse_result := eve$add_final_string (parse_result, current_token); return (parse_result); else loop exitif eve$x_command_index > eve$x_command_length; exitif index (eve$x_token_separators, substr (eve$x_command_line, eve$x_command_index, 1)) > 0; current_token := current_token + eve$get_token; endloop; current_token := eve$double_quotes (current_token); parse_result := parse_result + '"' + current_token + '"'; endif; endif; else if eve$x_argument_type = "integer" then if eve$x_is_number then translate (current_token, "1", "l"); parse_result := parse_result + current_token; else message (fao ("!AS expects a number for argument !SL", command_name, which_argument)); return (eve$x_null); endif; else message (fao ("Argument type !AS must be integer or string", eve$x_argument_type)); return (eve$x_null); endif; endif; ! Get next token current_token := eve$get_token; if current_token = "," then current_token := eve$get_token; parse_result := parse_result + ","; else if which_argument < arguments then parse_result := parse_result + ","; endif; endif; endloop; endprocedure; ! Page 105 ! Procedure which defines a key to a command if the key has not already been ! redefined by the user. Parameters are the same as for the define_key ! built-in. Users with their own command/section files should generally ! use the define_key built-in rather than this procedure (which is used by ! Eve's keypad initialization procedures). ! ! Parameters: ! ! program_string VAXTPU command string - input ! which_key Keyword containing key to define - input ! comment_string Comment string for key definition - input procedure eve$init_key (program_string, which_key, comment_string) if (lookup_key (which_key, program) = 0) or (substr (lookup_key (which_key, comment), 1, 1) = " ") then define_key (program_string, which_key, comment_string); endif; endprocedure; ! Procedure to undefine a key if it has not been redefined by the user. ! Used by keypad initialization procedures. ! ! Parameters: ! ! which_key Keyword for key to clear - input procedure eve$clear_key (which_key) if (lookup_key (which_key, program) <> 0) and (substr (lookup_key (which_key, comment), 1, 1) = " ") then undefine_key (which_key); endif; endprocedure; ! Page 106 ! Define standard key definitions - control keys, arrow keys, e- and f- keys. ! This procedure is not available from the Eve after initialization. procedure eve$standard_keys ! Leading spaces in comment field are used to indicate Eve-supplied key ! definitions - do not use in user-written key definitions ! Arrow keys eve$init_key ("move_horizontal(-1)", left, "left_arrow"); ! left eve$init_key ("move_horizontal(1)", right, "right_arrow"); ! right eve$init_key ("plus$vertical(1)", down, " down_arrow"); ! down eve$init_key ("plus$vertical(-1)", up, " up_arrow"); ! up ! VT200 editing keypad keys eve$init_key ("eve_find ('')", e1, " find"); eve$init_key ("eve_insert_here", e2, " insert_here"); eve$init_key ("eve_remove", e3, " remove"); eve$init_key ("eve_select", e4, " select"); eve$init_key ("eve_previous_screen", e5, " previous_screen"); eve$init_key ("eve_next_screen", e6, " next_screen"); ! Top row function keys eve$init_key ("eve_exit", f10, " exit"); eve$init_key ("eve_change_direction", f11, " change_direction"); ! Changed F12 to emulate a backspace -rcy eve$init_key ("eve_start_of_line", f12, " start_of_line"); eve$init_key ("eve_erase_previous_word", f13, " erase_previous_word"); eve$init_key ("eve_change_mode", f14, " change_mode"); eve$init_key ("eve_help ('keypad')", help, " help"); define_key ("eve_do ('')", do, " do"); eve$init_key ("eve_attach", f17, " attach"); eve$init_key ("eve_write_modified", f19, " write_modified"); eve$init_key ("eve_write_file('')", f20, " write_file"); ! Keys on main typing array eve$init_key ("eve_delete", del_key, " delete"); eve$init_key ("eve_tab", tab_key, " tab"); eve$init_key ("eve_return", ret_key, " return"); eve$init_key ("eve_change_mode", ctrl_a_key, " change_mode"); ! Just like DCL! eve$init_key ("eve_recall", ctrl_b_key, " recall"); ! Just like DCL! eve$init_key ("eve_stable_end_of_line", ctrl_e_key, " stable_end_of_line"); ! make ctrl_f_key be get a file ! make gold ctrl_f_key be get a file in read-only mode eve$init_key ("eve_start_of_line", ctrl_h_key, " start_of_line"); eve$init_key ("eve_erase_previous_word", ctrl_j_key, " erase_previous_word"); eve$init_key ("eve_remember", ctrl_r_key, " remember"); eve$init_key ("eve_erase_start_of_line", ctrl_u_key, " erase_start_of_line"); eve$init_key ("eve_quote", ctrl_v_key, " quote"); eve$init_key ("eve_refresh", ctrl_w_key, " refresh"); eve$init_key ("eve_do ('')", ctrl_z_key, " do"); eve$init_key ("eve_space", key_name (' '), " space"); ! disable if you don't ! want auto wrap turned on. ! Additions to above -rcy ! Window commands. eve$init_key ("eve_split_window", key_name ('=', shift_key), " split_window"); eve$init_key ("eve_single_window", key_name ('1', shift_key), " single_window"); eve$init_key ("eve_shrink_window", key_name ('-', shift_key), " shrink_window"); eve$init_key ("eve_expand_window", key_name ('+', shift_key), " expand_window"); eve$init_key ("eve_previous_window", key_name(up, shift_key), " previous_window"); eve$init_key ("eve_next_window", key_name(down, shift_key), " next_window"); ! Random others. eve$init_key ("eve_attach", key_name('a', shift_key), " attach"); eve$init_key ("eve_buffer('')", key_name('b', shift_key), " buffer"); eve$init_key ("eve_line(-1)", key_name('#', shift_key), " line"); ! rectangle cut/paste operations. eve$init_key ("eve_mark_corner", key_name('.', shift_key), " mark_corner"); eve$init_key ("eve_extract_rectangle", key_name('<', shift_key), " extract_rectangle"); eve$init_key ("eve_insert_rectangle", key_name('>', shift_key), " insert_rectangle"); eve$init_key ("eve_overlay_rectangle", key_name(')', shift_key), " overlay_rectangle"); eve$init_key ("eve_copy_rectangle", key_name('(', shift_key), " copy_rectangle"); ! Numeric keypad definitions for EDT like keypad set (shift_key, pf1); eve$init_key("eve_shift_right (8)", key_name(right, shift_key), " shift_right"); eve$init_key("eve_shift_left (8)", key_name(left, shift_key), " shift_left"); define_key ("execute (lookup_key (eve$get_shift_key, program))", pf1, "shift key"); eve$init_key("eve_help ('keypad')", pf2, " help"); eve$init_key("eve_repeat (-1)", key_name(pf2, shift_key), " repeat"); eve$init_key("eve_findnext", pf3, " findnext"); eve$init_key("eve_find ('')", key_name(pf3, shift_key), " find"); eve$init_key("eve_erase_line", pf4, " erase_line"); eve$init_key("eve_restore_line", key_name(pf4, shift_key), " restore_line"); eve$init_key("eve_page", kp7, " page"); eve$init_key("eve_do ('')", key_name(kp7, shift_key), " do"); eve$init_key("eve_screen", kp8, " screen"); eve$init_key("eve_fill", key_name(kp8, shift_key)," fill"); eve$init_key("eve_append", kp9, " append"); eve$init_key("eve_replace ('','')", key_name(kp9, shift_key), " replace"); eve$init_key("eve_erase_word", minus, " erase_word"); eve$init_key("eve_restore_word", key_name(minus, shift_key), " restore_word"); eve$init_key("eve_forward", kp4, " forward"); eve$init_key("eve_bottom", key_name(kp4, shift_key), " bottom"); eve$init_key("eve_reverse", kp5, " reverse"); eve$init_key("eve_top", key_name(kp5, shift_key), " top"); eve$init_key("eve_remove", kp6, " remove"); eve$init_key("eve_insert_here", key_name(kp6, shift_key), " insert_here"); eve$init_key("eve_erase_character", comma, " erase_character"); eve$init_key("eve_restore_character", key_name(comma, shift_key), "restore_character"); eve$init_key("eve_move_by_word", kp1, " move_by_word"); eve$init_key("eve_change_case", key_name(kp1, shift_key), " change_case"); eve$init_key("eve_end_of_line", kp2, " end_of_line"); eve$init_key("eve_erase_end_of_line", key_name(kp2, shift_key), " erase_end_of_line"); !eve$init_key("eve_change_mode", kp3, " change_mode"); ! I like ^A better, !and this isn't EDT compatible. -rcy eve$init_key("eve_move_by_character", kp3, " move_by_character"); eve$init_key("eve_quote", key_name(kp3, shift_key), " quote"); eve$init_key("eve_move_by_bol", kp0, " move_by_bol"); eve$init_key("eve_new_line", key_name(kp0, shift_key), " new_line"); eve$init_key("eve_select", period, " select"); eve$init_key("eve_select", key_name(period, shift_key), " select"); eve$init_key("eve_return", enter, " return"); eve$init_key("eve_learn", key_name(enter, shift_key), " learn"); endprocedure; ! Page 107 ! Page 108 ! Page 109 ! Initialization procedures ! Initialization for user's own variables procedure tpu$local_init endprocedure; ! Page 110 ! Procedure used to create an Eve system buffer. Returns the new buffer. ! ! Parameters: ! ! new_buffer_name String for name of new buffer - input ! new_eob_text String for eob_text of new buffer - input procedure eve$init_buffer (new_buffer_name, new_eob_text) local new_buffer; ! New buffer new_buffer := create_buffer (new_buffer_name); set (eob_text, new_buffer, new_eob_text); set (no_write, new_buffer); set (system, new_buffer); return (new_buffer); endprocedure; ! Page 111 ! INITIALIZATION PROCEDURE ! ! Invoked to initialize the editing session. The windows and buffers are ! created here. procedure tpu$init_procedure local default_journal_name, ! Default journal name 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 journal_error; ! True if can't parse journal file name on_error if error = tpu$_parsefail then if default_journal_name = 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; ! Initialize our variables eve$init_variables; ! Turn off message headers (facility, severity, id) set (message_flags, 1); ! Create all the necessary default buffers and windows ! Create the prompt area - this will go over the command window screen_length := get_info (screen, "visible_length"); set (prompt_area, screen_length - 1, 1, reverse); ! Message buffer/window - turn on bell for broadcast messages message_buffer := eve$init_buffer ("Messages", eve$x_null); message_window := create_window (screen_length, 1, off); if message_window <> 0 then map (message_window, message_buffer); endif; set (bell, broadcast, on); ! Command buffer/window eve$command_buffer := eve$init_buffer ("Commands", eve$x_null); set (permanent, eve$command_buffer); ! The next line *was* overstrike, but I prefer insert mode - rcy set (insert, eve$command_buffer); ! for VMS V4 line-editing compatability set (reverse, eve$command_buffer); ! for VMS V4 line-editing compatability eve$command_window := create_window (screen_length - 1, 1, off); if eve$command_window <> 0 then map (eve$command_window, eve$command_buffer); endif; ! Prompt buffer/window eve$prompt_buffer := eve$init_buffer ("Prompts", eve$x_null); eve$prompt_window := create_window (screen_length - 1, 1, off); if eve$prompt_window <> 0 then set (video, eve$prompt_window, reverse); endif; ! Get the help buffer, show buffer, and info window help_buffer := eve$init_buffer ("Help", eve$x_null); show_buffer := eve$init_buffer ("Show", eve$x_null); info_window := create_window (1, screen_length - 2, on); ! Get the dcl buffer eve$dcl_buffer := eve$init_buffer ("DCL", eve$x_null); ! Create windows for top and bottom halves of the screen ! Top window may be one line longer than bottom window. eve$main_window_length := screen_length - 2; eve$main_window := create_window (1, eve$main_window_length, on); ! Buffer and window used by parser to display choices when a name is ambiguous eve$choice_buffer := eve$init_buffer ("Choices", eve$x_null); set (permanent, eve$choice_buffer); eve$choice_window := create_window (eve$main_window_length + 1 - eve$x_choice_window_length, eve$x_choice_window_length, on); ! Now do the paste and extract buffers paste_buffer := eve$init_buffer ("Insert Here", "[End of Insert Here buffer]"); extract_buffer := eve$init_buffer ("Extract", "[End of Extract buffer]"); ! And finally a pair of scratch buffers scratch_buffer := eve$init_buffer ("Scratch", "[End of Scratch buffer]"); scratch2_buffer := eve$init_buffer ("Scratch2", "[End of Second Scratch buffer]"); ! Create a buffer using get_file main_buffer := create_buffer ("Main"); if eve$main_window <> 0 then map (eve$main_window, main_buffer); position (eve$main_window); set (margins, main_buffer, eve$x_default_left_margin, get_info (eve$main_window, "width") - eve$x_default_right_margin); else position (main_buffer); endif; eve$x_this_window := eve$main_window; set (eob_text, main_buffer, "[End of file]"); input_file := get_info (command_line, "file_name"); if eve$main_window <> 0 then if input_file = eve$x_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; 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 need to use sys$disk:[] as the default file specification so that ! the output file won't be written to the same directory as the input ! file if an input file directory is explicitly specified on the command line. ! 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, "output_file"); if output_file_name <> eve$x_null then input_file_name_only := file_parse (input_file, eve$x_null, eve$x_null, name) + file_parse (input_file, eve$x_null, eve$x_null, type); parsed_output_file_name := file_parse (output_file_name, "sys$disk:[]", input_file_name_only); if parsed_output_file_name <> eve$x_null then 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; ! Start journaling if (get_info (command_line, "journal") = 1) and (get_info (command_line, "read_only") <> 1) then default_journal_name := "sys$disk:[]"; journal_file := get_info (command_line, "journal_file"); input_file_name_only := file_parse (get_info (current_buffer, "file_name"), eve$x_null, eve$x_null, name); if input_file_name_only = eve$x_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, default_journal_name, input_file_name_only); if journal_file = eve$x_null then journal_file := file_parse (eve$x_null, default_journal_name, input_file_name_only); endif; if journal_error then message (fao ("Don't understand journal file name: !AS", journal_file)); message ("Editing session is not being journaled"); else journal_open (journal_file); endif; else ! Simulate VAXTPU error message message ("Editing session is not being journaled"); endif; ! Get rid of shift key - VAXTPU doesn't save result of a set (shift_key) set (shift_key, key_name (pf1, shift_key)); ! Try to determine if terminal is VT100 or VT200 on VMS V3 and V4. ! If terminal is eight-bit, edit-mode, ansi crt, then assume it ! is a VT200 series terminal. All keypad bindings except for the ! numeric keypad are saved in the section file by default. The ! following determines the layout of the numeric keypad. if get_info (screen, "vt200") then ! works only on VMS V4 eve$x_vt200_keypad := 1; else if get_info (screen, "vk100") then eve$x_vt200_keypad := 1; else if (get_info (screen, "eightbit")) and (get_info (screen, "ansi_crt")) and (get_info (screen, "edit_mode")) then eve$x_vt200_keypad := 1; else eve$x_vt200_keypad := 1; endif; endif; endif; ! Call user's own initialization procedure, for initializing variables etc. tpu$local_init; eve$x_starting_up := 0; endprocedure; ! Page 112 ! Define the keys, save the section, and quit. eve$standard_keys; compile ("procedure eve$standard_keys endprocedure"); save ("eve_edtsecini.tpu$section"); quit;