! ! EVEX (EVE-Extended) written by H. Howe, Oak Ridge National Laboratory, ! Oak Ridge, TN 37830 ! ! eve_version Display EVEX version number ! tpu$local_init Initialization for user's own variables and keys ! evx_initialize_keys Define keys and load key maps and key map list ! eve$init_do_key Blank do intialization to override eve version ! evx_help Show numerical diagram on a VT200/Graphon terminal ! ! eve_find Find command which returns true/false ! eve_branch Conditionally abort learn-remember sequence ! eve_run Run TEX or the FORTRAN compiler on a copy of the current buffer ! evx_write_select Write select-range of Latex file ! evx_file_extension Determine the file-name extension for the current buffer ! evx_error_line Find error line number from TEX in RUN buffer ! eve_copy Copy the select region to the insert here buffer ! eve_open_line Split line at cursor and leave cursor position unchanged ! eve_duplicate Duplicate the current line ! evx_bline Move cursor to beginning of next line ! eve_erase_end_of_line Erase from current position to end of line ! evx_linefeed Simulate action of DCL linefeed-key ! eve_shift_window Shift the window horizontally by the number of columns given by user ! eve_change_case Change case of select range or current character ! eve_scroll_windows Scroll both windows one screenful in direction set for window with cursor ! evx_toggle_window Toggle between one and two windows ! evx_window_top Move cursor to top line of window, same column ! evx_window_bottom Move cursor to bottom line of window, same column ! evx_two_get Create two windows, prompt for file to get ! eve_column_number Write cursor column and line numbers in message window ! evx_line_number Determine cursor line number ! eve_match_delimiter Match delimiter under cursor ! eve_pset_mark Set or go-to automatic position mark ! eve_pdelete_mark Delete auto_mark without going to it ! eve_path Map next, previous, or original buffer to window ! evx_buffer_choices Write previous-buffer choices to message window ! evx_set_path Set previous buffer names ! eve_translate_buffer Translate control characters in current buffer ! evx_translate_controls Translate a control character ! eve_set_visible_tabs Set horizontal tabs visible ! eve_set_novisible_tabs Set horizontal tabs invisible ! eve_block Main routine for cut/paste operation on block of text ! evx_block_1 Mark upper-left corner of text block ! evx_block_2 Mark lower-right corner of text block ! evx_block_move Move a marked block to current cursor position ! evx_block_load Copy or move marked block into block_buffer ! evx_block_unload Copy text block from block_buffer to editing buffer ! evx_block_pad Move eol to line_length within block ! evx_block_undo Undo last overstrike-paste ! eve_end_of_word Move to next end of word ! eve_trim_buffer Trim all trailing spaces from current buffer ! eve_tabs_to_spaces Convert all tabs to spaces ! Eve_ASCII_Character Enter character specified by ascii numberr ! eve_list_files List files in DCL buffer ! eve_gfile Get file specified under cursor ! eve_fetch Fetch an element from default CMS library ! ! eve_set_nofortran_mode Set EVE mode to normal ! eve_set_fortran_mode Set EVE mode to fortran ! evx_set_fortran_parameters Set initial fortran-mode parameters ! eve_convert_tabs Change tab-formatted Fortran file to space-formatted ! eve_modify Modify lines within the select range ! eve_indent_column Set indent column ! evx_fortran_tab Tab to indent column by adding spaces ! evx_gold_tab Add continuation character in column 5 then space to ! indent column ! eve_put Main routine for putting fortran text into buffer ! evx_put_header Put a header for separation ! evx_put_do_end Put a do-end do loop ! evx_put_do_cont Put a do-continue loop ! evx_put_read_format Put a read with format ! evx_put_write_format Put a write with format ! evx_put_if_block Put an if-then-else block ! evx_put_subroutine Put a subroutine ! evx_put_function Put a function ! evx_enter_copy Read user input characters, store in string, copy to statement label ! evx_next_mark Position cursor at put-mark (next logical typing position) ! ! eve_inline Add local-font braces around a string ! ! eve$set_status_line Set status line of a window to include buffer name and mode indications. ! evx_update_status_lines Update all status lines currently on the screen ! ! eve_template Read first file in filelist.evex as template ! eve_play Play learn sequence on files in filelist.evex ! evx_line_file Convert the current line into a file spec ! eve_alternate_key Alternate key definitions for TeX and LaTeX ! evx_put_bibtex_entry Put a blank bibtex entry ! evx_put_environment Put an environment ! evx_put_eqalign Put an eqalign ! evx_insert_section Insert a LaTeX sectioning command on a separate line ! eve_mismatch Find unmatched brace or \begin in TeX or LaTeX file ! evx_mismatch Find unmatched brace in TeX or LaTeX file ! evx_begin_end Search for \begin without a corresponding \end ! evx_environment_name Return name of environment ! eve_look Preview section of LaTeX file on screen or printer ! !EVEPLUS routines: !eveplus_insert_text Copy_text in insert mode !eveplus_search_quietly Search w/o "String not found" !eveplus_find_buffer Find a buffer by name !eve_list_buffers List non-system buffers !eve_list_all_buffers List system and non-system buffers !bufed_list_buffers Build the buffer list (modified) !bufed_remove_buffer Delete the buffer pointed to (modified) !bufed_destroy_buffer Delete a buffer !bufed_select_buffer Goto the buffer pointed to (modified) !bufed_get_the_buffer Scan a buffer line !eve_release_buffers Write and delete modified buffers !eveplus_write_file Write a buffer to associated file !eve_display_character Display ascii number and abbreviations (modified) !eve_describe_key Write key function in message window !eve_sort_buffer Sort the buffer !eveplus$$string_compare Compare two strings !eveplus$$shell_sort Do a shell sort on the buffer !eve_search Wildcard search (modified from EVEPLUS) !evx_execute_search Execute a pattern search !evx_build_search_buffer Build search program !evx_build_pattern Translate wildcard characters (modified ! from EVEPLUS ! Programming Conventions for EVEX Extension ! Global-variable names begin with evx$x_ or eveplus$x_ ! Global variables are initialized when needed, not in TPU$LOCAL_INIT ! Procedures names begin with eve_ or evx_ (except routines from EVEPLUS) ! Procedures beginning with evx_ are either support procedures or ! are meant to be used only when bound to a key ! Display the EVEX version number procedure eve_version message("EVEX version 1.6; November 21, 1987"); endprocedure; ! Initialization for user's own variables and keys procedure tpu$local_init local initial_mode; ! Initial tab mode for empty .for file on_error ! trap warning message from search endon_error ! Procedure arguements eve$arg1_alternate_key := "string"; eve$arg1_branch := "string"; eve$arg1_block := "string"; eve$arg2_block := "string"; eve$arg1_inline := "string"; eve$arg1_shift_window := "string"; eve$arg1_modify := "string"; eve$arg2_modify := "string"; eve$arg1_put := "string"; eve$arg1_run := "string"; eve$arg1_change_case := "string"; eve$arg1_path := "string"; eve$arg1_search := "string"; eve$arg1_sort_buffer := "string"; eve$arg1_ascii_character := "string"; eve$arg1_fetch := "string"; ! Initialize keymap variables evx$x_keypad_keys := "evx$keypad_keys"; evx$x_standard_keys := "evx$standard_keys"; ! Set initial mode for Fortran file eve_set_nofortran_mode; if (evx_file_extension = ".FOR") then initial_mode := 's'; if get_info(current_buffer,"record_count") = 0 then message("Enter (t)ab or (s)pace formatting"); initial_mode := eve$alphabetic(eve$prompt_key("Press Option: ")); edit (initial_mode, lower); endif; if ((search(ascii(9),forward) = 0) and (initial_mode = 's')) then eve_set_fortran_mode; endif; endif; evx_update_status_lines; evx_set_path; !Initialize path variables evx_local_init; ! Individual definitions endprocedure; ! Local initialization procedure evx_local_init endprocedure; ! Define keys (not available after creation of section file) procedure evx_initialize_keys; evx$x_keypad_keys := create_key_map ("evx$keypad_keys"); evx$x_standard_keys := create_key_map ("evx$standard_keys"); ! Define control keys on the main keyboard define_key ("eve_change_mode", ctrl_a_key, "change_mode", evx$x_standard_keys); define_key ("eve_block('','')", key_name(ctrl_b_key), "block", evx$x_standard_keys); define_key ("eve_end_of_word", key_name(ctrl_f_key), "end_of_word", evx$x_standard_keys); define_key ("eve_duplicate", key_name(ctrl_h_key,shift_key), "duplicate", evx$x_standard_keys); define_key ("evx_linefeed", key_name(ctrl_j_key), "linefeed", evx$x_standard_keys); define_key ("evx_next_mark", ctrl_n_key, "next_mark", evx$x_standard_keys); define_key ("eve_pset_mark", key_name(ctrl_p_key), "pset_mark", evx$x_standard_keys); define_key ("eve_pdelete_mark", key_name(ctrl_p_key,shift_key), "pdelete_mark", evx$x_standard_keys); define_key ("eve_quit", key_name(ctrl_z_key,shift_key), "quit", evx$x_standard_keys); ! Define GOLD-main-keyboard keys define_key ("evx_window_top", key_name(up,shift_key), "window_top", evx$x_standard_keys); define_key ("evx_window_bottom", key_name(down,shift_key), "window_bottom", evx$x_standard_keys); define_key ("eve_shift_left(40)", key_name(left,shift_key), "half_left", evx$x_standard_keys); define_key ("eve_shift_right(40)", key_name(right,shift_key), "half_right", evx$x_standard_keys); define_key ("eve_match_delimiter", key_name("=",shift_key), "match_delimiter", evx$x_standard_keys); define_key ("eve_indent_column", key_name("\",shift_key), "indent_column", evx$x_standard_keys); define_key ("eve_inline('')", key_name("-",shift_key), "inline", evx$x_standard_keys); ! Define function keys define_key ("eve_inline('')", key_name(f7), "inline", evx$x_standard_keys); define_key ("eve_match_delimiter", key_name(f8), "match_delimiter", evx$x_standard_keys); define_key ("eve_alternate_key('')", key_name(f9), "alternate_key", evx$x_standard_keys); define_key ("eve_quit", key_name(f10,shift_key), "quit", evx$x_standard_keys); define_key ("eve_restore", key_name(f13,shift_key), "restore", evx$x_standard_keys); define_key ("eve_indent_column", key_name(f17), "indent_column", evx$x_standard_keys); define_key("eve_gfile",f20, "gfile", evx$x_standard_keys); define_key("eve_list_files",key_name(f20,shift_key), "list_files", evx$x_standard_keys); ! Define EVE keypad define_key ("eve_replace('','')", key_name(e1,shift_key), "replace", evx$x_standard_keys); define_key ("eve_duplicate", key_name(e2,shift_key), "duplicate", evx$x_standard_keys); define_key ("eve_copy", key_name(e3,shift_key), "copy", evx$x_standard_keys); define_key("eve_list_buffers", key_name(e4,shift_key), "list_buffers", evx$x_standard_keys); ! Define numerical keypad set (shift_key, pf1); define_key ("execute (lookup_key (eve$get_shift_key, program))", pf1, "shift key", evx$x_keypad_keys); define_key("eve_search('')",pf2, "search", evx$x_keypad_keys); define_key ("evx_help", key_name(pf2,shift_key), "help", evx$x_keypad_keys); define_key ("eve_find ('')", pf3, "find", evx$x_keypad_keys); define_key ("eve_learn", key_name(pf3,shift_key), "learn", evx$x_keypad_keys); define_key ("eve_erase_line", pf4, "erase_line", evx$x_keypad_keys); define_key ("eve_restore", key_name(pf4,shift_key), "restore", evx$x_keypad_keys); define_key ("eve_do ('')", kp7, "do", evx$x_keypad_keys); define_key ("eve_path('')", key_name(kp7,shift_key), "path", evx$x_keypad_keys); define_key ("eve_next_screen", kp8, "next_screen", evx$x_keypad_keys); define_key ("eve_previous_screen", key_name(kp8,shift_key), "previous_screen", evx$x_keypad_keys); define_key ("eve_copy", kp9, "copy", evx$x_keypad_keys); define_key ("eve_replace('','')", key_name(kp9,shift_key), "replace", evx$x_keypad_keys); define_key ("eve_erase_word", minus, "erase_word", evx$x_keypad_keys); define_key ("evx_toggle_window", key_name(minus,shift_key), "toggle_window", evx$x_keypad_keys); define_key ("eve_forward", kp4, "forward", evx$x_keypad_keys); define_key ("eve_bottom", key_name(kp4,shift_key), "bottom", evx$x_keypad_keys); define_key ("eve_reverse", kp5, "reverse", evx$x_keypad_keys); define_key ("eve_top", key_name(kp5,shift_key), "top", evx$x_keypad_keys); define_key ("eve_remove", kp6, "remove", evx$x_keypad_keys); define_key ("eve_insert_here", key_name(kp6,shift_key), "insert_here", evx$x_keypad_keys); define_key ("eve_erase_character", comma, "erase_character", evx$x_keypad_keys); define_key ("eve_repeat('')", key_name(comma,shift_key), "repeat", evx$x_keypad_keys); define_key ("eve_move_by_word", kp1, "move_by_word", evx$x_keypad_keys); define_key ("eve_change_case('')", key_name(kp1,shift_key), "change_case", evx$x_keypad_keys); define_key ("eve_other_window", kp0, "other_window", evx$x_keypad_keys); define_key ("eve_open_line", key_name(kp0,shift_key), "open_line", evx$x_keypad_keys); define_key ("eve_move_by_line", kp2, "move_by_line", evx$x_keypad_keys); define_key ("eve_erase_end_of_line", key_name(kp2, shift_key), "erase_end_of_line", evx$x_keypad_keys); define_key ("eve_scroll_windows", kp3, "scroll_windows", evx$x_keypad_keys); define_key ("eve_shift_window('')", key_name(kp3,shift_key), "shift_window", evx$x_keypad_keys); define_key ("eve_select", period, "select", evx$x_keypad_keys); define_key("eve_list_buffers", key_name(period,shift_key), "list_buffers", evx$x_keypad_keys); define_key ("evx_bline", key_name(enter), " ", evx$x_keypad_keys); define_key ("evx_two_get", key_name(enter, shift_key), "two_get", evx$x_keypad_keys); remove_key_map(eve$x_key_map_list, eve$x_vt100_keys, ALL); remove_key_map(eve$x_key_map_list, eve$x_vt200_keys, ALL); remove_key_map(eve$x_key_map_list, eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, evx$x_keypad_keys); add_key_map(eve$x_key_map_list, eve$kt_last, evx$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); endprocedure; ! Blank do intialization to override eve version procedure eve$init_do_key endprocedure; ! Set up GOLD-PF2 to show keypad diagram on a VT200 or graphon terminal procedure evx_help local terminal_type; ! Keyboard parameter if eve$x_vt200_keypad then terminal_type := eve$x_vt200_keypad; eve$x_vt200_keypad := FALSE; eve_help ('keypad'); eve$x_vt200_keypad := terminal_type; else eve_help ('keypad'); endif; endprocedure; ! 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. ! Modified to return TRUE/FALSE to EVEX for use by BRANCH command. ! ! Parameters: ! ! target String to find - input procedure eve_find (target) evx$x_find_successful := eve$find (target, 0); if evx$x_find_successful <> FALSE then evx$x_find_successful := TRUE; endif; endprocedure; ! Abort learn-remember sequence if previous FIND or FPATTERN failed ! or if end-of-buffer is reached. For use in LEARN sequences. procedure eve_branch(branch_parameter) local which_branch; ! Local copy of branch_parameter if get_info(evx$x_find_successful,"type") = unspecified then evx$x_find_successful := TRUE; endif; which_branch := branch_parameter; if which_branch = '' then which_branch := 'f'; endif; if which_branch = 'f' then if evx$x_find_successful = FALSE then message("Find failed; aborting"); abort; endif; endif; if which_branch = 'e' then if mark(none) = end_of(current_buffer) then message("At end of buffer; aborting"); abort; endif; endif; endprocedure; ! ! Run the Fortran compiler, TeX, or LaTeX on the current buffer or select ! range. The output is automatically shown in the second window for TeX ! and LaTeX and the cursor is positioned on the line containing the error, ! if any. The .lis file is shown for Fortran if compilation errors are ! encountered. This is a modification of the Eve DCL routine. ! ! Parameters: ! run_arguement String containing process to run - input procedure eve_run (run_arguement) local run_string, ! Which process to run run_parameter, ! Copy of run_string this_position, ! Marker for current cursor position this_buffer, ! Current buffer file_ext, ! File extension of current buffer name file_modified, ! Modify status of buffer before write run_successful, ! True if successful run error_pos, ! Location of "%FORT" error_message, ! Message giving number of errors error_line; ! Line number of TEX error on_error if error = tpu$_createfail then message ("Subprocess could not be created"); return (0); endif; endon_error; this_buffer := current_buffer; this_position := mark (none); if get_info(evx$x_looking,"type") = unspecified then evx$x_looking := FALSE; endif; if get_info(evx$x_run_buffer,"type") = unspecified then evx$x_run_buffer := eve$init_buffer ("RUN", "[End of buffer]"); endif; erase (evx$x_run_buffer); if (this_buffer = evx$x_run_buffer) then message ("Cannot run from RUN buffer"); return(0); endif; file_ext := evx_file_extension; run_string := run_arguement; change_case (run_string, lower); run_string := substr(run_string,1,1); if (file_ext <> 0) then if (file_ext = ".FOR") then run_string := "f"; endif; if ((file_ext = ".TEX") and (run_string = "")) then message ("(l)atex or (t)ex"); run_string := eve$alphabetic(eve$prompt_key("Press Option: ")); if run_string = '' then message("No command given"); return(0); endif; endif; endif; if (run_string = "") then message ("(f)ortran, (l)atex or (t)ex"); run_string := eve$alphabetic(eve$prompt_key("Press Option: ")); if run_string = '' then message("No command given"); return(0); endif; endif; change_case(run_string,lower); if ((run_string <> "f") and (run_string <> "t") and (run_string <> "l")) then message ("Cannot run " + run_string); return(0); endif; if (get_info (evx$x_run_process, eve$kt_type) = unspecified) or (evx$x_run_process = 0) then message ("Creating subprocess..."); evx$x_run_process := create_process (evx$x_run_buffer, "$ set noon"); evx$x_latex_range := 0; endif; ! Write and run the buffer; reset the modify status if file modified file_modified := get_info (current_buffer, "modified"); case run_string from "f" to "t" ["f"] : if (eve$x_select_position <> 0) then write_file (select_range, "eve$run_temp_file.for"); eve$x_select_position := 0; message ("Running Fortran compiler on select range..."); else write_file (current_buffer, "eve$run_temp_file.for"); message ("Running Fortran compiler on buffer..."); endif; ["l"] : if ((eve$x_select_position <> 0) or (evx$x_latex_range <> 0)) then if not evx_write_select then message("Cannot run select range"); return(0); endif; else write_file (current_buffer, "eve$run_temp_file.tex"); evx$x_error_line0 := 0; endif; ["t"] : write_file (current_buffer, "eve$run_temp_file.tex"); evx$x_error_line0 := 0; endcase; if file_modified then copy_text(" "); erase_character(-1); endif; erase (evx$x_run_buffer); case run_string from "f" to "t" ["f"] : set(timer,on,"Compiling"); send ("fortran/noobj/list/show=nomap eve$run_temp_file.for", evx$x_run_process); set(timer,off); if (get_info(evx$x_run_buffer,"record_count") = 0) then run_successful := true; send ("delete/nolog eve$run_temp_file.*.*", evx$x_run_process); message ("Compiled successfully"); return(run_successful); else run_successful := false; position (end_of(evx$x_run_buffer)); error_pos := search(line_begin&"%FORT",reverse); error_message := " "; if error_pos <> 0 then position(error_pos); error_message := substr(current_line,1,index(current_line,",")+1) + substr(current_line,index(current_line,"comp"),200); endif; erase (evx$x_run_buffer); read_file ("eve$run_temp_file.lis"); send ("delete/nolog eve$run_temp_file.*.*", evx$x_run_process); message(error_message); position (beginning_of(evx$x_run_buffer)); error_pos := search(line_begin&"%FORT",forward); if error_pos <> 0 then position(error_pos); move_vertical(-3); endif; endif; ["l"] : message ("Running LaTeX..."); set(timer,on,"Running"); send ("latex eve$run_temp_file.tex", evx$x_run_process); set(timer,off); ["t"] : message ("Running TeX..."); set(timer,on,"Running"); send ("tex eve$run_temp_file.tex", evx$x_run_process); set(timer,off); endcase; if eve$x_number_of_windows = 2 then eve_other_window; if current_buffer <> evx$x_run_buffer then map (current_window, evx$x_run_buffer); endif; else unmap (eve$main_window); map (eve$top_window, this_buffer); eve$set_status_line (eve$top_window); update (eve$top_window); map (eve$bottom_window, evx$x_run_buffer); eve$x_number_of_windows := 2; eve$x_this_window := eve$bottom_window; endif; eve$set_status_line(current_window); update (current_window); eve_other_window; if ((run_string = "l") or (run_string = "t")) then eve_other_window; position (end_of (evx$x_run_buffer)); move_horizontal(-1); position (search (notany(" "), reverse)) ; if index(current_line, "EVE$RUN_TEMP_FILE.LIS") <> 0 then run_successful := true; error_line := 0; else run_successful := false; send ("x", evx$x_run_process); position (end_of (evx$x_run_buffer)); move_horizontal(-1); position (search (notany(" "), reverse)) ; if current_character = "*" then if run_string = "l" then send ("\stop", evx$x_run_process); else send ("\bye", evx$x_run_process); endif; error_line := -1; else error_line := evx_error_line; endif; endif; position (end_of(current_buffer)); update (current_window); move_vertical(-8); update (current_window); if evx$x_looking then if not run_successful then send ("delete/nolog eve$run_temp_file.*.*", evx$x_run_process); endif; else send ("delete/nolog eve$run_temp_file.*.*", evx$x_run_process); if run_successful then evx$x_latex_range := 0; endif; endif; eve_other_window; if error_line = 0 then if run_string = "t" then message ("End of TeX run"); else message ("End of LaTeX run"); endif; else if (error_line = -1) then if run_string = "t" then message("End of TeX run - \bye may be missing"); else message("End of LaTeX run - \end{document} may be missing"); endif; else error_line := error_line + evx$x_error_line0; eve_line (error_line); if run_string = "t" then message ("End of TeX run - cursor positioned on line " + str(error_line)); else message ("End of LaTeX run - cursor positioned on line " + str(error_line)); endif; endif; endif; endif; return (run_successful); endprocedure; ! Write select-range of Latex file including header and \end procedure evx_write_select local this_position, ! Initial position mod_range, ! Selected range mark_1,mark_2, ! Marks at end points of file header copy_range; ! Header on_error position(this_position); return(0); endon_error; if get_info(evx$x_data_buffer,"type") = unspecified then evx$x_data_buffer := eve$init_buffer("DATA","[End of buffer]"); endif; this_position := mark(none); if eve$x_select_position <> 0 then mod_range := select_range; evx$x_latex_range := create_range(beginning_of(select_range), end_of(select_range),reverse); eve$x_select_position := 0; else mod_range := evx$x_latex_range; endif; position(beginning_of(mod_range)); evx$x_error_line0 := evx_line_number; position(beginning_of(current_buffer)); if substr(current_line,1,4) <> "\doc" then return(0); endif; mark_1 := mark(none); position(search("\begin{doc",forward)); eve_end_of_line; mark_2 := mark(none); evx$x_error_line0 := evx$x_error_line0 - evx_line_number - 1; copy_range := create_range(mark_1,mark_2,none); position(evx$x_data_buffer); erase(evx$x_data_buffer); copy_text(copy_range); copy_text(mod_range); copy_text("\end{document}"); write_file(current_buffer,"eve$run_temp_file.tex"); position(this_position); return(1); endprocedure; ! Determine the file-name extension for the current buffer procedure evx_file_extension local file_ext; ! Name of the current buffer file_ext := file_parse (get_info(current_buffer,"name"),"","",type); if (file_ext <> "") then return (file_ext); else return (0); endif; endprocedure; ! Find error line number from TEX in RUN buffer procedure evx_error_line local error_line, error_position, number_length; on_error ! trap search message endon_error; position (beginning_of(evx$x_run_buffer)); error_position := search (line_begin&"l.", forward); if error_position = 0 then return(0); endif; position (error_position); move_horizontal(2); number_length := length(search (scan(" "),forward)); error_line := int(substr(current_line, current_offset+1, number_length)); return(error_line); endprocedure; ! Copy the select region to the insert here buffer procedure eve_copy 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 copy"); 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); copy_text (remove_range); position (this_position); eve$x_select_position := 0; remove_range := 0; message ("Copy completed."); endif; else message ("Use Select before using Copy"); endif; endprocedure; ! Split line at cursor and leave cursor position unchanged procedure eve_open_line if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return; endif; eve_return; eve_move_up; if current_character <> eve$kt_null then eve_end_of_line; endif; endprocedure; ! Duplicate current line procedure eve_duplicate if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return; endif; if current_offset > 0 then eve_start_of_line; endif; eve_erase_line; eve_restore; if current_offset > 0 then eve_return; endif; eve_restore; eve_move_up; endprocedure; ! Move cursor to beginning of next line procedure evx_bline if current_offset <> 0 then eve_start_of_line; endif; eve_move_down; endprocedure; ! Erase from current position to end of line ! Modification of eve_erase_line procedure eve_erase_end_of_line ! Erase_character stops deleting at the end of the line eve$x_restore_text := erase_character (length (current_line)); endprocedure; ! Simulate DCL LINEFEED-KEY action (erase previous part-of-word) ! Independent of buffer mode (erase/overstrike) ! Action is confined to current line; independent of left-margin setting ! Treat asterisk as punctuation, not as regular character procedure evx_linefeed local this_buffer, ! Current buffer this_column, ! Initial column this_char,prev_char, ! False if not punctuation character lf_sep1,lf_sep2, ! Punctuation characters start_erase_word, ! Marker for beginning of erase-range end_erase_word, ! Marker for end of erase-range erase_word_range; ! Range to erase lf_sep1 := " []<>(){}.,;:'`""\|/?!@#$&*-=+ "; lf_sep2 := "[{<@#)/*"; this_buffer := current_buffer; this_column := get_info (this_buffer, "offset_column"); if current_window = eve$command_window then if this_column <= (eve$x_command_prompt_length + 1) then return; endif; endif; if this_column = 1 then return; endif; move_horizontal(-1); this_char := index(lf_sep2,current_character); if this_char <> 0 then eve$x_restore_text := erase_character(1); eve$x_restoring_line := 0; return; endif; end_erase_word := mark(none); this_char := index(lf_sep1,current_character); loop exitif get_info (this_buffer, "offset_column") = 1; prev_char := this_char; move_horizontal(-1); this_char := index(lf_sep1,current_character); if ((this_char <> 0) and (prev_char = 0)) then move_horizontal(1); exitif 1; endif; endloop; start_erase_word := mark(none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_restore_text := erase_character (length (erase_word_range)); eve$x_restoring_line := 0; endprocedure; ! Shift the window horizontally by the number of columns given by user procedure eve_shift_window (shift_parameter) local shift_string; if not (eve$prompt_string (shift_parameter, shift_string, "Number of columns: ", "Window shift unchanged")) then return; endif; edit (shift_string, trim); shift_string := int(shift_string); if (shift_string < 0) then eve_shift_left(-shift_string); else eve_shift_right(shift_string); endif; endprocedure; ! Change case of select range ! Change case of current character if no select range active, procedure eve_change_case (case_parameter) local case_string, ! User choice of case this_character, ! Current character this_buffer, ! Marker for current cursor position this_mode; ! Keyword for current mode if eve$x_select_position = 0 then ! just change current character if mark(none) = end_of (current_buffer) then return; endif; if current_character = eve$kt_null then return; endif; this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); this_character := erase_character(1); change_case (this_character, invert); copy_text(this_character); move_horizontal(-1); set (this_mode, this_buffer); else ! Set case of select range if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Modification must be made in the same buffer as Select."); return; endif; case_string := case_parameter; if (case_string = "") then message ("Change case to (u)pper or (l)ower or (i)nvert."); case_string := eve$alphabetic(eve$prompt_key("Press Option: ")); if case_string = '' then message("No change"); eve$x_select_position := 0; return; endif; endif; message (" "); change_case(case_string,lower); case case_string from "a" to "z" ["i"] : change_case (select_range, invert); ["l"] : change_case (select_range, lower); ["u"] : change_case (select_range, upper); [inrange, outrange] : message ("No change"); endcase; eve$x_select_position := 0; endif; endprocedure; ! Scroll both windows one screenful in direction set for window with cursor procedure eve_scroll_windows local this_direction; ! direction for window initial window this_direction := current_direction; if (this_direction = forward) then eve_next_screen; else eve_previous_screen; endif; if eve$x_number_of_windows = 2 then eve_other_window; if (this_direction = forward) then eve_next_screen; else eve_previous_screen; endif; eve_other_window; endif; endprocedure; ! Toggle between one and two windows procedure evx_toggle_window if eve$x_number_of_windows = 2 then eve_one_window; else eve_two_windows; endif; endprocedure; ! Move cursor to top line of window, same column procedure evx_window_top local this_row, top_row; this_row := current_row; top_row := get_info (current_window,"visible_top"); if this_row <> top_row then cursor_vertical (top_row - this_row); endif; endprocedure; ! Move cursor to bottom line of window, same column procedure evx_window_bottom local this_row, bottom_row; this_row := current_row; bottom_row := get_info (current_window,"visible_bottom"); if this_row <> bottom_row then cursor_vertical (bottom_row - this_row); endif; endprocedure; ! If one window on screen, create two windows, get file in second window ! If two or three windows on screen, get file in current window procedure evx_two_get if (eve$x_number_of_windows = 1) then eve_two_windows; eve_other_window; endif; eve_get_file(''); ! update buffer list for path command evx_set_path; endprocedure; ! Write cursor column and line numbers in message window procedure eve_column_number local column_string, ! String to write to message window column_number, initial_position, ! Cursor position line_length; ! Length of current line if (mark(none) = end_of(current_buffer)) then column_number := "1"; line_length := 1; else if get_info (current_window, eve$kt_beyond_eol) then position (search (line_begin, reverse)); if current_character <> eve$kt_null then position (search (line_end, forward)); endif; endif; column_number := str(get_info(current_buffer,"offset_column")); initial_position := mark(none); if current_character <> eve$kt_null then position (search (line_end, forward)); endif; line_length := get_info(current_buffer,"offset_column"); position(initial_position); initial_position := 0; endif; column_string := "Column = " + column_number + " / " + str(line_length) + ", line = " + str(evx_line_number) + " / " + str(1+get_info (current_buffer,"record_count")); message (column_string); endprocedure; procedure evx_line_number ! What line am I on (from EVEPLUS)? local this_position, ! marker - current position start_of_buffer, ! marker - beginning of current buffer this_line_position, ! marker - position at start of this_line total_lines, ! integer - total lines in buffer high_line, ! integer - high line limit for binary search low_line, ! integer - low line limit for binary search this_line; ! integer - line number of current guess ! Initialization this_position := mark (none); start_of_buffer := beginning_of (current_buffer); total_lines := get_info (current_buffer, "record_count") + 1; high_line := total_lines; if this_position = end_of (current_buffer) then low_line := total_lines; else low_line := 1; endif; ! Binary search loop exitif high_line - low_line <= 1; this_line := low_line + ((high_line - low_line) / 2); position (start_of_buffer); move_vertical (this_line - 1); if mark (none) > this_position then high_line := this_line; else low_line := this_line; if mark (none) = this_position then high_line := this_line; endif; endif; endloop; position (this_position); return(low_line); endprocedure; ! Match delimiter under cursor procedure eve_match_delimiter local initial_char, ! Character under cursor initially match_char, ! Matching delimiter this_char, ! Character during search this_position, ! Initial cursor position search_dir, ! Direction to search for match inter_num, ! Number of intervening matching pairs match_line; ! Line number of matched delimiter on_error ! trap searches that leave the buffer position (this_position); this_position := 0; message ("No matching delimiter"); return; endon_error; evx$x_mark_match_delim := 0; evx$x_mark_initial_delim := 0; initial_char := current_character; this_position := mark(none); case initial_char from "(" to "}" ["{"] : search_dir := 1; match_char := "}"; ["}"] : search_dir := -1; match_char := "{"; ["("] : search_dir := 1; match_char := ")"; [")"] : search_dir := -1; match_char := "("; ["["] : search_dir := 1; match_char := "]"; ["]"] : search_dir := -1; match_char := "["; ["<"] : search_dir := 1; match_char := ">"; [">"] : search_dir := -1; match_char := "<"; [inrange,outrange] : message ("Not a delimiter"); return; endcase; inter_num := 0; loop move_horizontal(search_dir); this_char := current_character; if (this_char = match_char) then exitif (inter_num = 0); inter_num := inter_num - 1; endif; if (this_char = initial_char) then inter_num := inter_num + 1; endif; endloop; evx$x_mark_match_delim := mark(reverse); match_line := str(evx_line_number); position (this_position); evx$x_mark_initial_delim := mark(reverse); message ("Delimiter matched at line " + match_line); endprocedure; ! Set or go-to automatic position mark procedure eve_pset_mark local mark_name; ! Local name of automatic mark if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return; endif; if get_info(evx$x_mark_status,"type") = unspecified then evx$x_mark_status := "N"; endif; mark_name := "auto_mark"; if (evx$x_mark_status = "N") then eve_mark (mark_name); evx$x_mark_visible := mark(reverse); evx$x_mark_status := "Y"; else eve_go_to (mark_name); delete (evx$x_mark_visible); evx$x_mark_status := "N"; endif; evx_update_status_lines; endprocedure; ! Delete auto_mark without going to it procedure eve_pdelete_mark if get_info(evx$x_mark_status,"type") = unspecified then evx$x_mark_status := "N"; endif; if (evx$x_mark_status = "Y") then delete (evx$x_mark_visible); evx$x_mark_status := "N"; message ("Auto_mark deleted"); endif; evx_update_status_lines; endprocedure; ! Map next, previous, or original buffer to the current window. ! ! Parameters: ! ! path_parameter String containing buffer name or character procedure eve_path (path_parameter) local path_name, ! Local copy of path_parameter start_buffer, ! Starting buffer when eve_path invoked next_buffer; ! Buffer to map to current window evx_set_path; if path_parameter = "" then evx_buffer_choices endif; if not (eve$prompt_string (path_parameter, path_name, "Buffer name: ", "Buffer not switched")) then return; endif; edit (path_name, trim); message (" "); next_buffer := path_name; if path_name = "\" then if evx$x_previous_buffer <> "" then next_buffer := evx$x_previous_buffer; else message ("No previous buffer"); return; endif; endif; if path_name = "\\" then if evx$x_ancient_buffer <> "" then next_buffer := evx$x_ancient_buffer; else message ("No previous-previous buffer"); return; endif; endif; if ((path_name = ".") or (path_name = "^") or (path_name = "-")) then next_buffer := evx$x_original_buffer; endif; eve_buffer (next_buffer); evx_set_path; endprocedure; ! Write previous-buffer choices to message window procedure evx_buffer_choices local buffer_choice_1, buffer_choice_2, buffer_choice_3, name_length; buffer_choice_1 := evx$x_previous_buffer; name_length := length(buffer_choice_1) ; if name_length > 23 then buffer_choice_1 := substr(buffer_choice_1, 1, 23); else buffer_choice_1 := buffer_choice_1 + substr(eve$kt_spaces, 1, 23-name_length); endif; buffer_choice_2 := evx$x_ancient_buffer; name_length := length(buffer_choice_2) ; if name_length > 23 then buffer_choice_2 := substr(buffer_choice_2, 1, 23); else buffer_choice_2 := buffer_choice_2 + substr(eve$kt_spaces, 1, 23-name_length); endif; buffer_choice_3 := evx$x_original_buffer; name_length := length(buffer_choice_3) ; if name_length > 23 then buffer_choice_3 := substr(buffer_choice_3, 1, 23); else buffer_choice_3 := buffer_choice_3 + substr(eve$kt_spaces, 1, 23-name_length); endif; message ("\ " + buffer_choice_1 + " \\ " + buffer_choice_2 + " ^ " + buffer_choice_3); endprocedure; ! Set previous-buffer names procedure evx_set_path local start_buffer; if get_info(evx$x_original_buffer,"type") = unspecified then evx$x_original_buffer := get_info (current_buffer,"name"); evx$x_latest_buffer := evx$x_original_buffer; evx$x_previous_buffer := ""; !Previous buffer evx$x_ancient_buffer := ""; !Previous-previous buffer return; endif; start_buffer := get_info (current_buffer,"name"); if start_buffer <> evx$x_latest_buffer then evx$x_ancient_buffer := evx$x_previous_buffer; evx$x_previous_buffer := evx$x_latest_buffer; evx$x_latest_buffer := start_buffer; endif; endprocedure; ! Display a copy of the current buffer in the second window with all ! control characters (ascii(0) to ascii(31)) translated procedure eve_translate_buffer local this_buffer, ! Current buffer this_line, ! Line number in current buffer window_line, ! Screen line in initial window control_char, ! Control character to find control_char_pat, ! Control character pattern to find char_to_translate, ! Control character to translate translated_char; ! Translated control character on_error ! trap search error message endon_error; if get_info(evx$x_translate_buffer,"type") = unspecified then evx$x_translate_buffer := eve$init_buffer ("TRANSLATION", "[End of buffer]"); endif; this_buffer := current_buffer; this_line := evx_line_number; window_line := 0; if eve$x_number_of_windows = 2 then window_line := get_info(current_window,"current_row") - get_info(current_window,"visible_top"); endif; position (evx$x_translate_buffer); erase (evx$x_translate_buffer); copy_text (this_buffer); position (beginning_of (evx$x_translate_buffer)); control_char_pat := any(''); loop control_char := search (control_char_pat, forward); exitif control_char = 0; position (control_char); char_to_translate := current_character; erase (control_char); evx_translate_controls (char_to_translate, translated_char); copy_text(translated_char); endloop; position (beginning_of(evx$x_translate_buffer)); move_vertical (this_line - window_line - 1); if eve$x_number_of_windows = 2 then eve_other_window; if current_buffer <> evx$x_translate_buffer then map (current_window, evx$x_translate_buffer); endif; else unmap (eve$main_window); map (eve$top_window, this_buffer); eve$set_status_line (eve$top_window); update (eve$top_window); map (eve$bottom_window, evx$x_translate_buffer); eve$x_number_of_windows := 2; eve$x_this_window := eve$bottom_window; endif; set (status_line, current_window, reverse, " Translation"); eve_other_window; endprocedure; ! Translate a control character procedure evx_translate_controls(char,trans) case char from '' to '' [''] : trans := ''; ! 0 ctrl-spacebar [''] : trans := ''; ! 1 ctrl-A [''] : trans := ''; ! 2 ctrl-B [''] : trans := ''; ! 3 ctrl-C [''] : trans := ''; ! 4 ctrl-D [''] : trans := ''; ! 5 ctrl-E [''] : trans := ''; ! 6 ctrl-F [''] : trans := ''; ! 7 ctrl-G [''] : trans := ''; ! 8 ctrl-H ! HT ! 9 ctrl-I ! LF ! 10 ctrl-J ! VT ! 11 ctrl-K ! FF ! 12 ctrl-L ! CR ! 13 ctrl-M [''] : trans := ''; ! 14 ctrl-N [''] : trans := ''; ! 15 ctrl-O [''] : trans := ''; ! 16 ctrl-P [''] : trans := ''; ! 17 ctrl-Q [''] : trans := ''; ! 18 ctrl-R [''] : trans := ''; ! 19 ctrl-S [''] : trans := ''; ! 20 ctrl-T [''] : trans := ''; ! 21 ctrl-U [''] : trans := ''; ! 22 ctrl-V [''] : trans := ''; ! 23 ctrl-W [''] : trans := ''; ! 24 ctrl-X [''] : trans := ''; ! 25 ctrl-Y [''] : trans := ''; ! 26 ctrl-Z [''] : trans := ''; ! 27 ctrl-[ [''] : trans := ''; ! 28 ctrl-\ [''] : trans := ''; ! 29 ctrl-] [''] : trans := ''; ! 30 ctrl-~ [''] : trans := ''; ! 31 ctrl-? [''] : trans := ''; ! 127 [''] : trans := ''; ! 132 [''] : trans := ''; ! 133 [''] : trans := ''; ! 134 [''] : trans := ''; ! 135 [''] : trans := ''; ! 136 [''] : trans := ''; ! 137 [''] : trans := ''; ! 138 [''] : trans := ''; ! 139 [''] : trans := ''; ! 140 [''] : trans := ''; ! 141 [''] : trans := ''; ! 142 [''] : trans := ''; ! 143 [''] : trans := ''; ! 144 [''] : trans := ''; ! 145 [''] : trans := ''; ! 146 [''] : trans := ''; ! 147 [''] : trans := ''; ! 148 [''] : trans := ''; ! 149 [''] : trans := ''; ! 150 [''] : trans := ''; ! 151 [''] : trans := ''; ! 155 [''] : trans := ''; ! 156 [''] : trans := ''; ! 157 [''] : trans := ''; ! 158 [''] : trans := ''; ! 159 [inrange,outrange] : trans := char; endcase; endprocedure; ! Set horizontal tabs visible procedure eve_set_visible_tabs if get_info (current_window, "text") = blank_tabs then set (text, current_window, graphic_tabs); message ("Tabs visible"); endif; endprocedure; ! Set horizontal tabs invisible procedure eve_set_novisible_tabs if get_info (current_window, "text") = graphic_tabs then set (text, current_window, blank_tabs); message ("Tabs invisible"); endif; endprocedure; ! Main routine for cut/paste operation on block of text procedure eve_block(action_parameter, option_parameter) local which_action, ! Which action to perform which_option, ! Which cut or paste option tabs_in_file; on_error ! trap search message endon_error; if get_info(evx$x_block_buffer,"type") = unspecified then evx$x_block_buffer := eve$init_buffer ("BLOCK", eve$kt_null); evx$x_undo_buffer := eve$init_buffer ("UNDO", eve$kt_null); evx$x_mark_corn1 := 0; !Mark for upper-left corner of block evx$x_mark_corn2 := 0; !Mark for lower-right corner of block evx$x_mark_undo := 0; !Mark for upper-left corner of overstrike paste endif; if ((search (ascii(9), forward) <> 0) or (search (ascii(9), reverse) <> 0)) then tabs_in_file := 1; else tabs_in_file := 0; endif; if ((get_info (current_window, "text") <> graphic_tabs) and (tabs_in_file = 1)) then message ("Setting tabs visible; block transfer not recommended"); set (text, current_window, graphic_tabs); return; endif; which_action := action_parameter; edit (which_action,trim,lower); which_action := substr (which_action,1,1); if which_action = '' then message ("corner (1) or (2), (c)ut, (p)aste, (u)ndo, (m)ove"); which_action := eve$alphabetic(eve$prompt_key("Press Option: ")); change_case (which_action, lower); if which_action <> "u" then evx$x_mark_undo := 0; endif; endif; which_option := option_parameter; edit (which_option,trim,lower); which_option := substr (which_option,1,1); case which_action from "0" to "z" ["1"] : evx_block_1; ["2"] : evx_block_2; ["c"] : evx_block_load (which_option); ["p"] : evx_block_unload (which_option); ["u"] : evx_block_undo; ["m"] : evx_block_move; [inrange, outrange] : message (which_action + " is not a block option"); endcase; endprocedure; ! Mark upper-left corner of text block procedure evx_block_1 if current_character = eve$kt_null then copy_text (' '); move_horizontal(-1); endif; evx$x_mark_corn1 := mark(reverse); message ("First corner marked"); endprocedure; ! Mark lower-right corner of text block procedure evx_block_2 if current_character = eve$kt_null then copy_text (' '); move_horizontal(-1); endif; evx$x_mark_corn2 := mark(reverse); message ("Second corner marked"); endprocedure; ! Move a marked block to current cursor position procedure evx_block_move local loaded_ok, ! True if cut operation successful this_position; ! Initial cursor position loaded_ok := evx_block_load ('b'); if loaded_ok then evx_block_unload ('o'); endif; endprocedure; ! Copy or move marked block into block_buffer and treat marked block in editing ! buffer according to user response procedure evx_block_load (option_parameter) local load_mode, ! Mode for loading block_buffer this_position, ! Initial cursor position in buffer this_mode, ! Initial buffer mode block_width, ! Width of text block (columns) block_length, ! Length of text block (lines) loop_count, ! Counter for loop through text block left_mark, ! Mark at left end of line right_mark, ! Mark at right of line line_range; ! Range of text line between left and right marks if evx$x_mark_corn1 = 0 then message ("First corner is not marked"); return(0); endif; if evx$x_mark_corn2 = 0 then message ("Second corner is not marked"); return(0); endif; if (get_info (evx$x_mark_corn1, "buffer") <> get_info (evx$x_mark_corn2, "buffer")) then message("Block corners must be in same buffer"); return(0); endif; this_position := mark(none); position (evx$x_mark_corn1); evx$x_initial_col := get_info (current_buffer, "offset_column"); evx$x_initial_line := evx_line_number; position (evx$x_mark_corn2); evx$x_match_col := get_info (current_buffer, "offset_column"); evx$x_match_line := evx_line_number; position (this_position); if ((evx$x_initial_col > evx$x_match_col) or (evx$x_initial_line > evx$x_match_line)) then message ("Corner marks are reversed: " + "#1 c=" + str(evx$x_initial_col) + " l=" + str(evx$x_initial_line) + " #2 c=" + str(evx$x_match_col) + " l=" + str(evx$x_match_line)); return(0); endif; load_mode := option_parameter; if ((load_mode <> "c") and (load_mode <> "r") and (load_mode <> "b")) then message ("Cut options: (c)opy, (r)emove or (b)lank"); loop load_mode := eve$alphabetic(eve$prompt_key("Press Option: ")); change_case (load_mode, lower); exitif ((load_mode = "c") or (load_mode = "r") or (load_mode = "b")); endloop; endif; block_width := evx$x_match_col - evx$x_initial_col; block_length := evx$x_match_line - evx$x_initial_line; erase (evx$x_block_buffer); position (evx$x_mark_corn1); evx_block_pad (block_length, evx$x_match_col); loop_count := 0; loop left_mark := mark(none); move_horizontal(block_width); right_mark := mark(none); line_range := create_range(left_mark, right_mark, none); position (evx$x_block_buffer); if load_mode = "r" then move_text(line_range); else copy_text(line_range); endif; split_line; position (evx$x_mark_corn1); if load_mode = "b" then move_vertical(loop_count); this_mode := get_info (current_buffer, eve$kt_mode); set (overstrike, current_buffer); copy_text (substr(eve$kt_spaces, 1, block_width + 1)); set (this_mode, current_buffer); position (evx$x_mark_corn1); endif; loop_count := loop_count + 1; exitif loop_count > block_length; move_vertical(loop_count); endloop; evx$x_mark_corn1 := 0; evx$x_mark_corn2 := 0; position (this_position); message ("Cut completed"); return(1); endprocedure; ! Copy text block from block_buffer to editing buffer in mode ! specified by user procedure evx_block_unload (option_parameter) local unload_mode, ! Mode for unloading block_buffer block_width, ! Width of text block (columns) block_length, ! Length of text block (lines) loop_count, ! Counter for loop through text block copy_position, ! Mark at current copy position in editing buffer old_line, ! Line to copy to undo_buffer before overstriking right_mark, ! Mark at right of line transfer_line, ! Line to copy from block to edit buffer this_mode, ! Initial buffer mode this_position, ! Initial cursor position this_buffer; ! Editing buffer if get_info (evx$x_block_buffer, "record_count") = 0 then message ("No text block to paste"); return; endif; unload_mode := option_parameter; if ((unload_mode <> "i") and (unload_mode <> "o")) then message ("Paste options: (i)nsert or (o)verstrike"); loop unload_mode := eve$alphabetic(eve$prompt_key("Press Option: ")); change_case (unload_mode, lower); if unload_mode = "" then message ("No text pasted"); return; endif; exitif ((unload_mode = "i") or (unload_mode = "o")); endloop; endif; block_width := evx$x_match_col - evx$x_initial_col + 1; block_length := evx$x_match_line - evx$x_initial_line; this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); this_position := mark(none); update(current_window); if mark(none) = end_of(current_buffer) then eve_open_line; endif; if current_character = eve$kt_null then copy_text (' '); move_horizontal(-1); endif; if unload_mode = "i" then set (insert, this_buffer); evx_block_pad (block_length, get_info (current_buffer, "offset_column") + 1); else set (overstrike, this_buffer); erase (evx$x_undo_buffer); evx_block_pad (block_length, get_info (current_buffer, "offset_column") + block_width + 1); evx$x_mark_undo := mark(none); endif; this_position := mark(none); loop_count := 0; loop copy_position := mark(none); if unload_mode = "o" then move_horizontal(block_width -1); right_mark := mark(none); old_line := create_range(copy_position, right_mark, none); position (evx$x_undo_buffer); copy_text (old_line); split_line; endif; position (beginning_of(evx$x_block_buffer)); move_vertical(loop_count); transfer_line := current_line; position (copy_position); copy_text(transfer_line); loop_count := loop_count + 1; exitif loop_count > block_length; move_horizontal(-block_width); move_vertical(1); endloop; set (this_mode, this_buffer); position (this_position); message ("Paste completed"); endprocedure; ! Move eol to line_length within block by padding with spaces where necessary procedure evx_block_pad (block_length, line_length) local loop_count, ! Counter for loop through text block this_length, ! Length of line this_mode, ! Initial buffer mode this_position, ! Initial cursor position in buffer extra_blanks; ! Number of blank spaces to add to line this_position := mark(none); this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); loop_count := 0; loop if mark(none) = end_of(current_buffer) then eve_open_line; endif; if current_character <> eve$kt_null then eve_end_of_line; endif; this_length := get_info (current_buffer, "offset_column"); if this_length <= line_length then extra_blanks := line_length - this_length + 1; copy_text (substr(eve$kt_spaces, 1, extra_blanks)); endif; eve_start_of_line; loop_count := loop_count + 1; exitif loop_count > block_length; move_vertical(1); endloop; set (this_mode, current_buffer); position (this_position); endprocedure; ! Undo last overstrike-paste procedure evx_block_undo local block_width, ! Width of text block (columns) block_length, ! Length of text block (lines) loop_count, ! Counter for loop through text block copy_position, ! Mark at current copy position in editing buffer transfer_line, ! Line to copy from block to edit buffer this_position, ! Initial cursor position this_mode, ! Initial buffer mode this_buffer; ! Editing buffer if evx$x_mark_undo = 0 then message ("Nothing to undo"); return; endif; this_position := mark(none); this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (overstrike, this_buffer); block_width := evx$x_match_col - evx$x_initial_col + 1; block_length := evx$x_match_line - evx$x_initial_line; position (evx$x_mark_undo); loop_count := 0; loop copy_position := mark(none); position (beginning_of(evx$x_undo_buffer)); move_vertical(loop_count); transfer_line := current_line; position (copy_position); copy_text(transfer_line); loop_count := loop_count + 1; exitif loop_count > block_length; move_horizontal(-block_width); move_vertical(1); endloop; evx$x_mark_undo := 0; set (this_mode, this_buffer); position (this_position); message ("Undo completed"); endprocedure; ! Move to next end of word in forward direction procedure eve_end_of_word local temp_range, ! Range for next end of word pattern_eow, ! End-of-word pattern characters_eow; ! End-of-word characters on_error ! Suppress "string not found" error message endon_error; characters_eow := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" + "!@#$%^&*()[]{}-_+=~`|\:;""'<,>.?/"; pattern_eow := ''&(any(characters_eow)& (any(eve$x_word_separators)|line_end)); move_horizontal(1); temp_range := search (pattern_eow, forward); if temp_range <> 0 then position (end_of(temp_range)); else move_horizontal(-1); message("Already at end of last word"); endif; endprocedure; ! Trim all trailing spaces from current buffer procedure eve_trim_buffer message ("Trimming current buffer..."); eve$trim_buffer (current_buffer); message ("Current buffer trimmed"); endprocedure; ! Convert all tabs to spaces using existing tab settings procedure eve_tabs_to_spaces local this_position, ! Initial cursor position in buffer this_mode, ! Initial buffer mode tab_pos, ! Range for next tab character column_t, ! Column number of tab column_c, ! Column number of next character after tab add_space, ! Number of spaces to add in place of tab confirm_convert;! User confirmation for conversion on_error ! Trap search message endon_error; confirm_convert := read_line('Enter "yes" to change tabs to spaces: '); change_case (confirm_convert, lower); if (confirm_convert <> "yes") then message ("Tabs not changed"); return; endif; this_position := mark(none); this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); position (beginning_of(current_buffer)); loop tab_pos := search (ascii(9),forward); exitif tab_pos = 0; position (beginning_of (tab_pos)); column_t := get_info (current_buffer,"offset_column"); move_horizontal(1); column_c := get_info (current_buffer,"offset_column"); add_space := column_c - column_t; erase_character(-1); copy_text (substr(eve$kt_spaces, 1, add_space)); endloop; position (this_position); set (this_mode, current_buffer); message ("Tabs converted to spaces"); endprocedure; ! Insert an Ascii character, given the decimal equivalent ! PROCEDURE Eve_ASCII_Character(Ascii_Parameter) LOCAL Ascii_Number; !Ascii number to insert ON_ERROR MESSAGE(FAO("Cannot insert character !SL",Ascii_Number)); RETURN; ENDON_ERROR; IF NOT(Eve$Prompt_Number(Ascii_Parameter,Ascii_Number,"Ascii #: ", "No number given"))Then Return; ENDIF; IF(Ascii_Number < 0) OR (Ascii_Number > 255)Then MESSAGE(FAO("Number must be between 0 and 255")); RETURN; ENDIF; COPY_TEXT(ASCII(Ascii_Number)); ENDPROCEDURE; procedure eve_list_files local file_range, dcl_string; on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; endon_error; if (get_info (eve$x_dcl_process, eve$kt_type) = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon"); message(""); endif; dcl_string := read_line("Directory: "); dcl_string := "directory " + dcl_string; eve_buffer("dcl"); evx_set_path; position (end_of(current_buffer)); update(current_window); send (dcl_string, eve$x_dcl_process); position (end_of(current_buffer)); update(current_window); file_range := search(LINE_BEGIN&"Directory",reverse,exact); if file_range <> 0 then position(file_range); update (current_window); move_vertical(2); endif; endprocedure; ! GET the file specified by the filespec under the cursor and the directory ! specified above the file list (created in DCL buffer with DCL directory ! command). procedure eve_gfile local file_range, file_spec, dir_spec, dev_spec, area_spec, parse_flag,full_spec, this_position; on_error if error = tpu$_parsefail then if parse_flag then message (fao ("Don't understand file name: !AS", file_spec)); return; endif; endif; endon_error; this_position := mark(none); if (this_position = end_of(current_buffer)) then return; endif; file_range := eve$current_word; file_spec := substr(file_range,1,length(file_range)); file_range := search(LINE_BEGIN&"Directory",reverse,exact); if file_range <> 0 then position(file_range); eve$end_of_word; file_range := eve$current_word; area_spec := substr(file_range,1,length(file_range)); parse_flag := FALSE; dev_spec := file_parse(area_spec,'','',device); dir_spec := file_parse(area_spec,'','',directory); if ((dev_spec <> '') and (dir_spec <> '')) then file_spec := dev_spec + dir_spec + file_spec; endif; endif; position(this_position); parse_flag := TRUE; full_spec := file_search(""); full_spec := file_search(file_spec); if full_spec = '' then message("Cannot find file: " + file_spec); else eve_get_file(full_spec); evx_set_path; endif; endprocedure; ! Execute a CMS FETCH on the given element. Element goes directly to a ! no_write buffer with the element name. Wildcards not permitted. procedure eve_fetch (fetch_parameter) local dcl_string, ! Command string sent to subprocess file_range, ! Range of fetched text in DCL buffer initial_mark, ! Start of fetched text in DCL buffer final_mark, ! End of fetched text in DCL buffer file_fetched, ! Name of fetched file fint1,fint2, ! Column numbers for name of fetched file this_position; ! Initial editing position on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; endon_error; if not (eve$prompt_string (fetch_parameter, dcl_string, "Element: ", "No element FETCHed")) then return; endif; edit(dcl_string,trim,upper); if (index(dcl_string,".") = 0) then message ("Cannot FETCH a GROUP or CLASS"); return; endif; if ((index(dcl_string,"*") <> 0) or (index(dcl_string,"%") <> 0)) then message ("Cannot do a wildcard FETCH"); return; endif; if eve$find_buffer(dcl_string) <> 0 then message ("Buffer " + dcl_string + " already exists"); return; endif; set (timer,on, "Working"); if (get_info (eve$x_dcl_process, eve$kt_type) = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon"); message(""); endif; dcl_string := "CMS FETCH/OUTPUT=SYS$OUTPUT " + dcl_string; message(dcl_string); this_position := mark(none); position(end_of(eve$dcl_buffer)); eve$insert_text(dcl_string); eve_start_of_line; initial_mark := mark(none); move_vertical(1); send (dcl_string, eve$x_dcl_process); move_vertical(-1); if substr(current_line,1,14) <> "%CMS-S-FETCHED" then move_vertical(-1); message(current_line); move_vertical(2); position(this_position); set (timer, off, ""); return; endif; message(current_line); fint1 := index(current_line,"element")+8; fint2 := index(current_line," fetched") - fint1; file_fetched := substr(current_line,fint1,fint2); move_horizontal(-1); final_mark := mark(none); position(initial_mark); move_vertical(1); initial_mark := mark(none); file_range := create_range(initial_mark,final_mark,none); if eve$find_buffer(file_fetched) <> 0 then erase (file_range); message ("Buffer " + file_fetched + " already exists"); set (timer, off, ""); position (this_position); return; endif; eve_buffer(file_fetched); set (no_write,current_buffer,on); set (output_file, current_buffer, file_fetched); eve$set_status_line (current_window); evx_set_path; move_text(file_range); eve_top; set (timer, off, ""); endprocedure; ! Set EVE mode to normal procedure eve_set_nofortran_mode if get_info(evx$x_fortran_mode,"type") = unspecified then evx$x_fortran_mode := FALSE; evx_set_fortran_parameters; endif; if not evx$x_fortran_mode then return; endif; undefine_key (tab_key, eve$x_user_keys); undefine_key (key_name(tab_key,shift_key), eve$x_user_keys); evx$x_fortran_mode := FALSE; evx_update_status_lines; set (text, eve$main_window, blank_tabs); set (text, eve$top_window, blank_tabs); set (text, eve$bottom_window, blank_tabs); endprocedure; ! Set EVE mode to fortran procedure eve_set_fortran_mode on_error ! supress warning message from search for tabs endon_error if get_info(evx$x_fortran_mode,"type") = unspecified then evx$x_fortran_mode := FALSE; evx_set_fortran_parameters; endif; if evx$x_fortran_mode then return; endif; define_key ("evx_fortran_tab", tab_key, "fortran_tab", eve$x_user_keys); define_key ("evx_gold_tab", key_name(tab_key, shift_key), "continue_tab", eve$x_user_keys); evx$x_fortran_mode := TRUE; eve$trim_buffer(current_buffer); evx_update_status_lines; set (text, eve$main_window, graphic_tabs); set (text, eve$top_window, graphic_tabs); set (text, eve$bottom_window, graphic_tabs); if ((search (ascii(9), forward) <> 0) or (search (ascii(9), reverse) <> 0)) then message ("TABs in file"); endif; endprocedure; ! Initialize Fortran-mode parameters procedure evx_set_fortran_parameters evx$x_first_column := 7; !Leftmost indent column evx$x_tab_space := 2; !Tab spacing evx$x_indent_column := evx$x_first_column; !Initial indent column evx$x_cont_char := "*"; !Continuation character evx$x_comment_char := "c"; !Comment character endprocedure; ! Change tab-formatted file to space-formatted procedure eve_convert_tabs local tab_pos, ! Position of ascii tab column, ! Column number of ascii tab column_f, ! Column number of ascii tab relative to margin add_space, ! Number of spaces to add to replace ascii tab confirm_convert, ! User confirmation to convert this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode this_position; ! Marker for current cursor position on_error ! supress warning message from search endon_error if get_info(evx$x_fortran_mode,"type") = unspecified then message("Fortran Mode must be defined before using CONVERT"); return; endif; eve$trim_buffer(current_buffer); if ((search (ascii(9), forward) = 0) and (search (ascii(9), reverse) = 0)) then message ("No TABs in file, trailing spaces removed"); evx_update_status_lines; return; endif; message ("File contains ASCII TABs"); confirm_convert := read_line ('You are about to remove all TABs: enter "convert" to confirm: '); change_case (confirm_convert, lower); if (confirm_convert = "convert") then message ("Converting..."); this_position := mark (none); this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); position (beginning_of(current_buffer)); loop tab_pos := search (ascii(9), forward); exitif tab_pos = 0; position (beginning_of (tab_pos)); column := get_info (current_buffer,"offset_column"); erase (tab_pos); if column < evx$x_first_column then if (column = 1) and (int(substr(current_line, 1, 1)) <> 0) then add_space := 5; else add_space := evx$x_first_column - column; endif; else column_f := column - evx$x_first_column; add_space := evx$x_tab_space - column_f + evx$x_tab_space*(column_f/evx$x_tab_space); endif; copy_text (substr(eve$kt_spaces, 1, add_space)); endloop; set (this_mode, this_buffer); position (this_position); message ("Converted TABs to spaces, trailing spaces removed"); else message ("ASCII TABs unaltered, trailing spaces removed"); endif; evx_update_status_lines; endprocedure; ! Modify lines within the select range procedure eve_modify (modify_parameter, shift_parameter) local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode this_position, ! Marker for current cursor position mod_range, ! Range being modified which_mod, ! Which modification sol_mark,eol_mark, shift_number,shift_string,! Number of columns to shift bottom_line, ! Last line of select range tab_pos, ! Position of ascii tab blank_count, blank_min, ! Minimum number of leading blanks comment_char, indent_col; on_error ! supress warning message from search endon_error if ((shift_parameter <> 'i') or (eve$x_select_position <> 0)) then if eve$x_select_position = 0 then message ("Use Select before modification"); return; endif; if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Modification must be made in the same buffer as Select."); return; endif; if (get_info (current_buffer, "offset_column") <> 1) or (get_info (beginning_of (select_range), "offset_column") <> 1) then message ("Select range must begin and end in column 1 for modification"); eve$x_select_position := 0; return; endif; mod_range := select_range; else this_position := mark (none); if get_info (current_buffer,"offset_column") <> 1 then eve_start_of_line; endif; sol_mark := mark(none); if current_character <> eve$kt_null then eve_end_of_line; endif; eol_mark := mark(none); mod_range := create_range(sol_mark,eol_mark,none); sol_mark := 0; eol_mark := 0; position(this_position); endif; this_position := mark (none); if mod_range = 0 then message ("Nothing to modify"); eve$x_select_position := 0; return; endif; which_mod := modify_parameter; edit (which_mod, trim, lower); which_mod := substr(which_mod,1,1); if (which_mod = "") then message ("Modifications: (c)om, (!), (%), (u)ncom, (s)hift, (f)ill"); which_mod := eve$alphabetic(eve$prompt_key("Press Option: ")); change_case (which_mod,lower); endif; if ((which_mod <> "c") and (which_mod <> "u") and (which_mod <> "s") and (which_mod <> "!") and (which_mod <> "%") and (which_mod <> "f")) then message ("No modifications made"); eve$x_select_position := 0; return; endif; if which_mod = "f" then fill (mod_range, eve$x_fill_separators); position (this_position); eve$x_select_position := 0; message ("Fill completed."); return; endif; if get_info(evx$x_fortran_mode,"type") = unspecified then comment_char := "c"; indent_col := 7; else comment_char := evx$x_comment_char; indent_col := evx$x_indent_column; endif; bottom_line := end_of (mod_range); if which_mod = "s" then position (beginning_of(mod_range)); tab_pos := search (ascii(9), forward); if (tab_pos <> 0) then if (beginning_of (tab_pos) <= bottom_line) then message ("Tabs in select range - no shift allowed"); eve$x_select_position := 0; position (this_position); return; endif; endif; message(" "); if not eve$prompt_string (shift_parameter, shift_string, "Enter number of columns to shift: ", "No shift") then eve$x_select_position := 0; return; endif; edit (shift_string, trim, lower); shift_number := int(shift_string); blank_min := 1000; ! Don't shift left into statement field if ((shift_number < 0) or (shift_string = "i")) then position (beginning_of(mod_range)); loop ! loop over lines within select range exitif mark(none) > bottom_line; exitif blank_min = 0; if (length (current_line) > 6) and (current_character <> "c") and (current_character <> "C") then blank_count := 0; loop ! loop over characters in line exitif blank_count >= blank_min; exitif substr(current_line, 7, blank_count+1) <> substr(eve$kt_spaces, 1, blank_count+1); blank_count := blank_count + 1; endloop; if blank_count < blank_min then blank_min := blank_count; endif; endif; move_vertical(1); endloop; if shift_string = "i" then shift_number := indent_col - blank_min - 7; else if -shift_number > blank_min then shift_number := -blank_min; endif; endif; endif; endif; this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); position (beginning_of(mod_range)); blank_count := 0; loop; exitif mark(none) > bottom_line; if which_mod = "c" then copy_text(comment_char); move_horizontal(-1); move_vertical(1); endif; if which_mod = "!" then copy_text("!"); move_horizontal(-1); move_vertical(1); endif; if which_mod = "%" then copy_text("%"); move_horizontal(-1); move_vertical(1); endif; if which_mod = "u" then if ((current_character = "c") or (current_character = "C") or (current_character = "!") or (current_character = "%")) then erase_character(1); endif; move_vertical(1); endif; if which_mod = "s" then if (length(current_line) > 6) and (current_character <> "c") and (current_character <> "C") then move_horizontal(6); if shift_number >= 0 then copy_text (substr(eve$kt_spaces, 1, shift_number)); if length(current_line) > 72 then blank_count := blank_count + 1; endif; else erase_character(-shift_number); endif; move_horizontal(-current_offset); endif; move_vertical(1); endif; endloop; position (this_position); eve$x_select_position := 0; set (this_mode, this_buffer); if which_mod = "s" then shift_string := "Shifted " + str(shift_number) + " columns"; if (shift_number >= 0) and (blank_count > 0) then shift_string := shift_string + "; " + str(blank_count) + " lines beyond column 72"; endif; message (shift_string); else message ("Modification completed."); endif; endprocedure; ! Set indent column at cursor column procedure eve_indent_column local cursor_column; !Present cursor column if get_info(evx$x_fortran_mode,"type") = unspecified then message("Fortran Mode is undefined"); return; endif; cursor_column := get_info(current_buffer, "offset_column"); if cursor_column < evx$x_first_column then evx$x_indent_column := evx$x_first_column; else evx$x_indent_column := cursor_column; endif; evx_update_status_lines; endprocedure; ! Tab by adding spaces procedure evx_fortran_tab local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode column, ! Current cursor column column_f, ! Column offset from left margin add_space; ! Spaces to add this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); if get_info(current_window,"beyond_eol") = 0 then column := get_info (current_buffer,"offset_column"); if column < evx$x_first_column then add_space := evx$x_indent_column - column; else column_f := column - evx$x_first_column; add_space := evx$x_tab_space - column_f + evx$x_tab_space*(column_f/evx$x_tab_space); endif; copy_text (substr(eve$kt_spaces, 1, add_space)); endif; set (this_mode, this_buffer); endprocedure; ! Add continuation character in column 5 then spaces to indent column procedure evx_gold_tab local this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode cursor_column, ! Current cursor column add_space; ! Spaces to add this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); if get_info(current_window,"beyond_eol") = 0 then cursor_column := get_info (current_buffer,"offset_column"); if cursor_column = 1 then add_space := evx$x_indent_column - 7; copy_text (" " + evx$x_cont_char + substr(eve$kt_spaces, 1, add_space)); else message("Must be at start of line for gold-tab"); endif; endif; set (this_mode, this_buffer); endprocedure; ! Main routine for putting fortran text into buffer procedure eve_put (text_parameter) local which_text, ! Which type of text-insert to put this_buffer, ! Marker for current buffer this_mode; ! Keyword for current mode if get_info(evx$x_fortran_mode,"type") = unspecified then message("Must be in Fortran Mode to use Put"); return; endif; if not evx$x_fortran_mode then message("Must be in Fortran Mode to use Put"); return; endif; which_text := substr(text_parameter,1,1); if which_text = "" then message ("do-(e)nd, do-(c)ont, (i)f, (r)ead, (w)rite, (s)ub, (f)un, (h)eader"); which_text := eve$alphabetic(eve$prompt_key("Press Option: ")); message (" "); endif; edit (which_text,lower); ! delete markers evx$x_mark_next := 0; evx$x_mark_copy := 0; evx$x_mark_after := 0; this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); if get_info (current_buffer,"offset_column") <> 1 then eve_start_of_line; endif; case which_text from "a" to "z" ["c"] : evx_put_do_cont; ["e"] : evx_put_do_end; ["f"] : evx_put_function; ["h"] : evx_put_header; ["i"] : evx_put_if_block; ["r"] : evx_put_read_format; ["s"] : evx_put_subroutine; ["w"] : evx_put_write_format; [inrange,outrange] : message ("No text inserted"); endcase; set(this_mode, this_buffer); endprocedure; ! Put a header for separation procedure evx_put_header eve_return; move_vertical(-1); copy_text (evx$x_comment_char); eve_return; copy_text (evx$x_comment_char + "**************************************************************************" ); eve_return; copy_text (evx$x_comment_char); move_horizontal(-1); move_vertical(1); endprocedure; ! Put a do-end do loop procedure evx_put_do_end local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "do "); eve_return; copy_text (space + " "); eve_return; copy_text (space + "end do"); move_horizontal(-6); move_vertical(-1); evx$x_mark_next := mark(reverse); move_vertical(-1); move_horizontal(3); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put a do-continue loop procedure evx_put_do_cont local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "do "); eve_return; copy_text (space + " "); eve_return; copy_text (space + "continue"); eve_start_of_line; evx$x_mark_copy := mark(none); move_horizontal(evx$x_indent_column-1); move_vertical(-1); evx$x_mark_next := mark(reverse); move_vertical(-1); move_horizontal(3); evx$x_mark_after := mark(none); message ('%Enter "statement number" then terminate with "\"'); evx_enter_copy (0); copy_text (" "); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put a read with format procedure evx_put_read_format local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "read( )"); eve_return; copy_text (space + "format()"); move_horizontal(-1); evx$x_mark_next := mark(reverse); eve_start_of_line; evx$x_mark_copy := mark(none); move_horizontal(evx$x_indent_column-1); move_vertical(-1); move_horizontal(5); evx$x_mark_after := mark(none); message ('%Enter "unit number, format number" then terminate with "\"'); evx_enter_copy (1); erase_character(1); move_horizontal(1); copy_text (" "); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put a write with format procedure evx_put_write_format local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "write( )"); eve_return; copy_text (space + "format()"); move_horizontal(-1); evx$x_mark_next := mark(reverse); eve_start_of_line; evx$x_mark_copy := mark(none); move_horizontal(evx$x_indent_column-1); move_vertical(-1); move_horizontal(6); evx$x_mark_after := mark(none); message ('%Enter "unit number, format number" then terminate with "\"'); evx_enter_copy (1); erase_character(1); move_horizontal(1); copy_text (" "); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put an if-then-else block procedure evx_put_if_block local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "if () then"); eve_return; copy_text (space + " "); eve_return; copy_text (space + "else if () then"); eve_return; copy_text (space + "else"); eve_return; copy_text (space + "end if"); move_horizontal(-6); move_vertical(-3); evx$x_mark_next := mark(reverse); move_vertical(-1); move_horizontal(4); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put a subroutine procedure evx_put_subroutine local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "subroutine "); eve_return; copy_text (space + " "); eve_return; copy_text (space + "return"); eve_return; copy_text (space + "end"); move_horizontal(-3); move_vertical(-2); evx$x_mark_next := mark(reverse); move_vertical(-1); move_horizontal(11); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Put a function procedure evx_put_function local space; ! Spaces to indent column space := substr(eve$kt_spaces, 1, evx$x_indent_column-1); eve_return; move_vertical(-1); copy_text (space + "function "); eve_return; copy_text (space + " "); eve_return; copy_text (space + "return"); eve_return; copy_text (space + "end"); move_horizontal(-3); move_vertical(-2); evx$x_mark_next := mark(reverse); move_vertical(-1); move_horizontal(9); message ("Use ctrl-n at any point to go to mark"); endprocedure; ! Read user input characters, store in string, copy to statement label ! All input passes to screen and storage-string except delete and \ procedure evx_enter_copy (strip) local next_char, ! Character for char_key char_key, ! Key pressed by user copy_string; ! Storage string for entered string copy_string := ""; update (current_window); loop char_key := read_key; next_char := eve$alphabetic(char_key); exitif next_char = "\"; if char_key = del_key then ! Delete previous character if length (copy_string) > 0 then copy_string := substr(copy_string, 1, length (copy_string)-1); erase_character(-1); endif; else if next_char <> "" then copy_text(next_char); copy_string := copy_string + next_char; endif; endif; update (current_window); endloop; if strip then ! Strip off all characters before comma copy_string := substr(copy_string, index(copy_string,",")+1, 5); endif; set (overstrike, current_buffer); position (evx$x_mark_copy); evx$x_mark_copy := 0; copy_text(copy_string); set (insert, current_buffer); position (evx$x_mark_after); evx$x_mark_after := 0; endprocedure; ! Position cursor at put-mark (next logical typing position) procedure evx_next_mark if get_info(evx$x_mark_next,"type") = unspecified then evx$x_mark_next := 0; endif; if evx$x_mark_next <> 0 then position (evx$x_mark_next); evx$x_mark_next := 0; if current_character = " " then erase_character(1); endif; message(" "); else message("Next mark not set"); endif; endprocedure; ! Add local-font braces around a string procedure eve_inline(font_parameter) local this_range, ! Range to surround with font braces this_buffer, ! Marker for current cursor position this_mode, ! Keyword for current mode final_pos, ! Final cursor position for font="\" font_key, ! Keyword for enclosing strings prev_key, ! Previously pressed key font, ! Which enclosing characters to use start_font, ! Left characters end_font; ! Right characters font := font_parameter; if font = "" then prev_key := last_key; message ('Options: tt bf em it rm verb {} \'); font_key := eve$prompt_key("Press Option: "); if font_key = prev_key then font := "$"; else font := eve$alphabetic(font_key); if font = "-" then font := "$"; endif; if font = "[" then font := "{"; endif; if font = "9" then font := "("; endif; endif; endif; case font from "$" to "{" ["$"] : start_font := "$"; end_font := "$"; ["("] : start_font := "\("; end_font := "\)"; ["b"] : start_font := "{\bf "; end_font := "}"; ["e"] : start_font := "{\em "; end_font := "\/}"; ["i"] : start_font := "{\it "; end_font := "\/}"; ["r"] : start_font := "{\rm "; end_font := "}"; ["t"] : start_font := "{\tt "; end_font := "}"; ["v"] : start_font := "\verb|"; end_font := "|"; ["{"] : start_font := "{"; end_font := "}"; ["\"] : start_font := "{\ "; end_font := "}"; [inrange,outrange] : message("No font inserted");return; endcase; this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); if eve$x_select_position = 0 then if not eve$at_start_of_word then eve$start_of_word; endif; copy_text(start_font); final_pos := mark(none); eve$end_of_word; move_horizontal(-1); else this_range := select_range; eve$x_select_position := 0; position(beginning_of(this_range)); copy_text(start_font); final_pos := mark(none); position(end_of(this_range)); endif; loop exitif current_character <> " "; move_horizontal(-1); endloop; if ((current_character = ",") or (current_character = ".")) then if ((font = "e") or (font = "i")) then end_font := "}"; endif; copy_text(end_font); move_horizontal(1); else move_horizontal(1); copy_text(end_font); endif; if font = "\" then position(final_pos); move_horizontal(-1); endif; set (this_mode, this_buffer); endprocedure; ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! Original EVE routine modified to add Fortran-Eve indicators and to ! preserve status line of system buffers. ! ! 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 modify_label, ! Label showing if buffer has been modified buffer_name, ! String containing name of current buffer col73_mark, ! Mark for column 73 for fortran files indent_label, ! Label showing current indent column auto_mark_label; ! Label showing status of auto mark this_buffer := get_info (this_window, eve$kt_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; buffer_name := get_info (this_buffer, eve$kt_name); ! Buffer-modified mark if get_info (this_buffer, "no_write") then modify_label := "$"; else if get_info (this_buffer, 'modified') then modify_label := "*"; else modify_label := " "; endif; endif; if get_info (this_buffer, eve$kt_mode) = insert then mode_string := "Ins "; else mode_string := "Over"; endif; if get_info (this_buffer, "direction") = reverse then direction_string := "Rev "; else direction_string := "For "; endif; if get_info(evx$x_mark_status,"type") = unspecified then evx$x_mark_status := "N"; endif; auto_mark_label := "P=" + evx$x_mark_status; indent_label := " "; col73_mark := " "; if get_info(evx$x_fortran_mode,"type") <> unspecified then if evx$x_fortran_mode then indent_label := "I= " + str(evx$x_indent_column) + substr (eve$kt_spaces, 1, 2 - length(str(evx$x_indent_column))); col73_mark := "|"; endif; endif; if length (buffer_name) > eve$x_max_buffer_name_length then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length); else buffer_name := buffer_name + substr (eve$kt_spaces, 1, eve$x_max_buffer_name_length - length (buffer_name)); endif; set (status_line, this_window, none, 'Holder'); if get_info (this_buffer, "no_write") then set (status_line, this_window, underline, 'Holder'); endif; set (status_line, this_window, reverse, modify_label + "Buffer " + buffer_name + " " + indent_label + " " + auto_mark_label + " " + mode_string + col73_mark + " " + direction_string); endprocedure; ! Update all status lines currently on the screen procedure evx_update_status_lines eve$check_bad_window; eve$set_status_line (current_window); if eve$x_number_of_windows = 2 then eve_other_window; eve$set_status_line (current_window); eve_other_window; endif; endprocedure; ! Read first file listed in filelist.evex into DATA buffer to use ! as template for defining learn-remember sequence for PLAY procedure eve_template local modify_file, ! File to use as template file_list, ! Full file spec of filelist.evex this_position; ! Initial position if get_info(evx$x_run_buffer,"type") = unspecified then evx$x_run_buffer := eve$init_buffer ("RUN", "[End of buffer]"); endif; if get_info(evx$x_data_buffer,"type") = unspecified then evx$x_data_buffer := eve$init_buffer("DATA","[End of buffer]"); endif; this_position := mark(none); file_list := file_search("filelist.evex"); if file_list = '' then position(this_position); message("No filelist.evex file"); return; else position (evx$x_run_buffer); erase (evx$x_run_buffer); read_file(file_list); position (beginning_of(evx$x_run_buffer)); endif; modify_file := evx_line_file; eve_buffer("data"); erase(evx$x_data_buffer); eve_include_file(modify_file); endprocedure; ! Execute predefined learn sequence on all files as specified in ! either filelist.evex or the RUN buffer. ! Learn sequence must be bound to "enter" key on numerical keypad procedure eve_play local modify_file, ! File to be modified by learn-remember sequence which_list, ! Which file list to use (file or RUN buffer) file_list, ! Full file spec of filelist.evex this_position, ! Initial position learn_sequence, ! Learn sequence used to modify file which_action, ! User-specified action for each file write_action; ! User-specified disposition of modified file on_error eve_buffer("run"); message("Error during modification"); return; endon_error; if get_info(evx$x_run_buffer,"type") = unspecified then evx$x_run_buffer := eve$init_buffer ("RUN", "[End of buffer]"); endif; if get_info(evx$x_data_buffer,"type") = unspecified then evx$x_data_buffer := eve$init_buffer("DATA","[End of buffer]"); endif; this_position := mark(none); learn_sequence := lookup_key (key_name(enter), program); message("Modify files listed in (f)ilelist.evex or (r)un buffer"); which_list := eve$alphabetic(eve$prompt_key("Press Option: ")); edit (which_list, lower); case which_list from "f" to "r" ["f"] : file_list := file_search("filelist.evex"); if file_list = '' then position(this_position); message("No filelist.evex file"); return; else position (evx$x_run_buffer); erase (evx$x_run_buffer); read_file(file_list); position (beginning_of(evx$x_run_buffer)); endif; ["r"] : if get_info(evx$x_run_buffer,"record_count") = 0 then message("No files listed in RUN buffer"); position(this_position); return; else position(beginning_of(evx$x_run_buffer)); endif; [inrange,outrange] : message("No modifications"); position(this_position); return; endcase; which_action := ''; loop modify_file := evx_line_file; exitif modify_file = "#"; if ((modify_file <> "!") and (modify_file <> '')) then eve_buffer("data"); erase (evx$x_data_buffer); read_file (modify_file); eve_top; update(current_window); if which_action <> "a" then message(" (m)odify, (s)kip, (a)ll, or (q)uit " + modify_file); which_action := eve$alphabetic(eve$prompt_key("Press Option: ")); edit (which_action, lower); endif; exitif which_action = "q"; if ((which_action = "m") or (which_action = "a")) then execute (learn_sequence); write_action := "y"; if write_action = "y" then write_file(current_buffer,modify_file); position(evx$x_run_buffer); eve_end_of_line; copy_text(" ### modified"); eve_start_of_line; else position(evx$x_run_buffer); endif; else position(evx$x_run_buffer); endif; endif; move_vertical(1); exitif mark(none) = end_of(current_buffer); endloop; message ("Modifications completed"); position (beginning_of(evx$x_data_buffer)); eve_buffer ("run"); endprocedure; ! Convert the current line into a file spec and check the spec procedure evx_line_file local file_spec, this_line; if mark(none) = end_of(current_buffer) then return('#'); endif; this_line := current_line; if this_line = '' then return(''); endif; if index(this_line,"###") <> 0 then return("!"); endif; if substr(this_line,1,1) = "!" then file_spec := "!"; return(file_spec); endif; file_spec := file_search(''); file_spec := file_search(this_line); if file_spec <> '' then file_spec := file_parse(this_line); else message("Problem with " + this_line + " in file_search"); endif; return(file_spec); endprocedure; ! Alternate key definitions for TeX and LaTeX procedure eve_alternate_key(char_parameter) local alt_char, ! Local copy of key for alternate file_ext, ! Extension of buffer name prev_key, ! Previously pressed key alt_key, ! Alternate key this_buffer, ! Marker for current buffer this_mode; ! Keyword for current mode this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); alt_char := char_parameter; if alt_char = '' then prev_key := last_key; alt_key := read_key; if alt_key = prev_key then file_ext := evx_file_extension; if file_ext = ".BIB" then evx_put_bibtex_entry; set(this_mode, this_buffer); return; endif; evx$x_mark_next := 0; evx_put_environment(""); set(this_mode, this_buffer); return; endif; alt_char := eve$alphabetic(alt_key); endif; if ( (alt_char = "1") or (alt_char = "2") or (alt_char = "3") or (alt_char = "4") or (alt_char = "5") ) then evx_insert_section(alt_char); else case alt_char from "!" to "~" ["C"] : copy_text("\Psi"); ["D"] : copy_text("\Delta"); ["E"] : copy_text("\equiv"); ["F"] : copy_text("\Phi"); ["G"] : copy_text("\Gamma"); ["H"] : copy_text("\Theta"); ["I"] : copy_text("\iotabar"); ["J"] : copy_text("\partial"); ["L"] : copy_text("\Lambda"); ["N"] : copy_text("\nabla"); ["P"] : copy_text("\Pi"); ["R"] : copy_text("\sqrt{}");move_horizontal(-1); ["S"] : copy_text("\Sigma"); ["U"] : copy_text("\Upsilon"); ["W"] : copy_text("\Omega"); ["X"] : copy_text("\Xi"); ["a"] : copy_text("\alpha"); ["b"] : copy_text("\beta"); ["c"] : copy_text("\psi"); ["d"] : copy_text("\delta"); ["e"] : copy_text("\epsilon"); ["f"] : copy_text("\phi"); ["g"] : copy_text("\gamma"); ["h"] : copy_text("\theta"); ["i"] : copy_text("\iota"); ["j"] : copy_text("\ell"); ["k"] : copy_text("\kappa"); ["l"] : copy_text("\lambda"); ["m"] : copy_text("\mu"); ["n"] : copy_text("\nu"); ["p"] : copy_text("\pi"); ["q"] : copy_text("\chi"); ["r"] : copy_text("\rho"); ["s"] : copy_text("\sigma"); ["t"] : copy_text("\tau"); ["u"] : copy_text("\upsilon"); ["w"] : copy_text("\omega"); ["x"] : copy_text("\xi"); ["y"] : copy_text("\eta"); ["z"] : copy_text("\zeta"); ["("] : copy_text("\left("); [")"] : copy_text("\right)"); ["["] : copy_text("\left["); ["]"] : copy_text("\right]"); ["{"] : copy_text("\left\{"); ["}"] : copy_text("\right\}"); ["<"] : copy_text("\left\langle"); [">"] : copy_text("\right\rangle"); ["|"] : copy_text("\bigg|"); ["!"] : copy_text("\perp"); ['"'] : copy_text("\parallel"); ["%"] : copy_text("\infty"); ["&"] : copy_text("\propto"); ["*"] : copy_text("\times"); ["="] : copy_text("\simeq"); ["^"] : copy_text("^{}");move_horizontal(-1); ["6"] : copy_text("^{\rm }");move_horizontal(-1); ["_"] : copy_text("_{}");move_horizontal(-1); ["-"] : copy_text("_{\rm }");move_horizontal(-1); ["~"] : copy_text("\sim"); ["?"] : copy_text("\approx"); ["/"] : copy_text("{ \over }");move_horizontal(-8); ["7"] : copy_text("\cite{}");move_horizontal(-1); ["8"] : copy_text("\ref{}");move_horizontal(-1); ["\"] : copy_text("\item "); [inrange,outrange] : message("No alternate definition"); endcase; endif; set(this_mode, this_buffer); endprocedure; ! Put a blank bibtex entry procedure evx_put_bibtex_entry if current_offset <> 0 then eve_start_of_line; endif; eve_return; move_vertical(-1); copy_text("@{,"); eve_return; copy_text("author = """","); eve_return; copy_text("title = """","); eve_return; copy_text("journal = """","); eve_return; copy_text("volume = """","); eve_return; copy_text("pages = """","); eve_return; copy_text("year = """""); eve_return; copy_text("}"); eve_start_of_line; move_vertical(-7); move_horizontal(1); endprocedure; ! Put an environment procedure evx_put_environment(env_parameter) local environment, ! Name of environment to insert env_hook, ! Hook for non-environment inserts and abbrvs mod_range, ! Range for environment this_position, ! Initial cursor position current_off, ! Current offset option; ! Optional argument braces if not eve$prompt_string (env_parameter, environment, "Environment: ", "No text inserted") then return; endif; edit (environment, trim, lower); env_hook := substr(environment,1,3); if env_hook = "eqa" then evx_put_eqalign; return; endif; if env_hook = "doc" then environment := "document"; endif; option := ""; if ((environment = "tabular") or (environment = "array")) then option := "{}"; endif; if eve$x_select_position <> 0 then mod_range := select_range; this_position := mark (none); eve$x_select_position := 0; if mod_range = 0 then message ("Nothing to modify"); return; endif; position (beginning_of(mod_range)); current_off := get_info (current_buffer, "offset_column"); if current_off <> 0 then eve_start_of_line; endif; split_line; move_vertical(-1); if environment = "document" then copy_text('\documentstyle[11pt]{article}'); eve_return; endif; copy_text('\begin{' + environment + "}" + option); position (end_of(mod_range)); current_off := get_info (current_buffer, "offset_column"); if current_off <> 0 then eve_start_of_line; endif; move_vertical(1); split_line; move_vertical(-1); copy_text('\end{' + environment + "}"); position (this_position); return; endif; if current_offset <> 0 then eve_start_of_line; endif; eve_return; move_vertical(-1); if environment = "document" then copy_text('\documentstyle[11pt]{article}'); eve_return; endif; copy_text('\begin{' + environment + "}" + option); eve_return; eve_return; copy_text('\end{' + environment + "}"); eve_start_of_line; move_vertical(-1); if ((environment = "eqnarray") or (environment = "eqnarray*")) then copy_text(' &=& \\'); eve_return; copy_text(' &=& '); eve_start_of_line; move_vertical(-1); return; endif; if ((environment = "tabular") or (environment = "array")) then copy_text(' & \\'); eve_return; copy_text(' & '); eve_start_of_line; move_vertical(-1); evx$x_mark_next := mark(reverse); move_vertical(-1); eve_end_of_line; move_horizontal(-1); message ("Use ctrl-n at any point to go to mark"); return; endif; if ((environment = "itemize") or (environment = "enumerate")) then copy_text(' \item '); eve_return; copy_text(' \item '); eve_start_of_line; move_vertical(-1); eve_end_of_line; return; endif; endprocedure; ! Put an eqalign procedure evx_put_eqalign if current_offset <> 0 then eve_start_of_line; endif; eve_return; move_vertical(-1); copy_text('$$'); eve_return; copy_text('\eqalign{'); eve_return; copy_text(' &= \cr'); eve_return; copy_text(' &= \cr'); eve_return; copy_text('}'); eve_return; copy_text('$$'); eve_start_of_line; move_vertical(-3); endprocedure; ! Insert a LaTeX sectioning command on a separate line procedure evx_insert_section(section_parameter) local sectype; if mark(none) = end_of (current_buffer) then eve_open_line; endif; if length(current_line) <> 0 then eve_open_line; endif; sectype := section_parameter; case sectype from "1" to "5" ["1"] : copy_text("\section{}"); ["2"] : copy_text("\subsection{}"); ["3"] : copy_text("\subsubsection{}"); ["4"] : copy_text("\paragraph{}"); ["5"] : copy_text("\subparagraph{}"); endcase; move_horizontal(-1); endprocedure; ! Find unmatched brace or \begin-\end in LaTeX file procedure eve_mismatch local no_mismatch; no_mismatch := 1; if eve$insist_y_n("Check matched {} (Y or N)?") then no_mismatch := evx_mismatch; endif; if no_mismatch then if eve$insist_y_n("Check matched \begin - \end (Y or N)?") then evx_begin_end; endif; endif; endprocedure; ! Find unmatched brace in TeX or LaTeX file procedure evx_mismatch local initial_char, ! Left delimiter match_char, ! Matching delimiter prev_char, ! Character before current character this_char, ! Character during search this_position, ! Initial cursor position inter_num, ! Number of intervening matching pairs start_mark, ! Mark at start of search eob_type; ! Type of search which leaves end of buffer on_error ! trap searches that leave the buffer if error = tpu$_strnotfound then if eob_type = 1 then position (this_position); this_position := 0; message ("No mismatched brace"); return(1); endif; if eob_type = 2 then position (start_mark); start_mark:= 0; message ("Cursor moved to mismatched brace"); endif; return(0); endif; endon_error; message("Searching for mismatched braces..."); set (timer,on,"Searching"); this_position := mark(none); position(beginning_of(current_buffer)); initial_char := "{"; match_char := "}"; loop eob_type := 1; loop move_horizontal(1); position(search(''&("{"|"}"),forward)); this_char := current_character; move_horizontal(-1); prev_char := current_character; move_horizontal(1); if ((this_char = match_char) and (prev_char <> "\")) then message ("Cursor moved to mismatched brace"); return(0); endif; exitif ((this_char = initial_char) and (prev_char <> "\")); endloop; start_mark := mark(none); inter_num := 0; eob_type := 2; loop move_horizontal(1); position(search(''&("{"|"}"),forward)); this_char := current_character; move_horizontal(-1); prev_char := current_character; move_horizontal(1); if ((this_char = match_char) and (prev_char <> "\")) then exitif (inter_num = 0); inter_num := inter_num - 1; endif; if ((this_char = initial_char) and (prev_char <> "\"))then inter_num := inter_num + 1; endif; endloop; endloop; return(0); endprocedure; ! Search for \begin without a corresponding \end procedure evx_begin_end local initial_env, ! Initial environment this_env, ! Found environment this_type, ! Type of statement (\begin or \end) this_position, ! Initial cursor position inter_num, ! True-false for intermediate environments level_num, ! Level of nesting for same environment start_mark, ! Mark at start of search eob_type; ! Type of search which leaves end of buffer on_error ! trap searches that leave the buffer if error = tpu$_strnotfound then case eob_type from 1 to 3 [1] : position (this_position); message ("All \begin matched with \end"); [2] : position (start_mark); message ("Cursor moved to unmatched \begin"); [3] : position (this_position); message ("Missing \begin or \end {document}"); endcase; return; endif; message("Error in BE"); return; endon_error; message("Searching for mismatched \begin - \end ..."); set (timer,on,"Searching"); this_position := mark(none); position(beginning_of(current_buffer)); eob_type := 3; position(search("\begin",forward)); initial_env := evx_environment_name; if initial_env <> "document" then message("First \begin must be {document}"); position(this_position); return; endif; start_mark := mark(none); position(end_of(current_buffer)); position(search("\end",reverse)); this_env := evx_environment_name; if this_env <> "document" then message("Final \end must be {document}"); position(this_position); return; endif; position(start_mark); loop eob_type := 1; move_horizontal(1); position(search("\begin",forward)); start_mark := mark(none); initial_env := evx_environment_name; level_num := 0; inter_num := 0; loop eob_type := 2; move_horizontal(1); position(search(''&("\begin"|"\end"),forward)); move_horizontal(1); this_type := current_character; move_horizontal(-1); this_env := evx_environment_name; if this_env = initial_env then if this_type = "b" then level_num := level_num + 1; else exitif level_num = 0; level_num := level_num - 1; endif; else if inter_num = 0 then if this_type = "e" then message("Error in placement of this \end"); return; else inter_num := 1; endif; endif; endif; endloop; position(start_mark); endloop; endprocedure; ! Return name of environment procedure evx_environment_name local mark_1,mark_2, ! Column numbers of end points of environment name env_name, ! Name of environment this_position; ! Initial position on_error position(this_position); return(0); endon_error; this_position := mark(none); position(search("{",forward)); mark_1 := get_info(current_buffer,"offset_column"); position(search("}",forward)); mark_2 := get_info(current_buffer,"offset_column"); env_name := substr(current_line,(mark_1+1),(mark_2-mark_1-1)); edit(env_name,collapse); position(this_position); return(env_name); endprocedure; ! Preview on screen or printer the .dvi file created by eve_run. ! LaTeX only. procedure eve_look local action; ! User choice of preview or print evx$x_looking := true; if eve_run("l") then message("Preview(=cr) or (P)rint?"); action := eve$alphabetic(eve$prompt_key("Press Option: ")); edit (action, lower); if (action <> "p") then message("Running previewer..."); spawn("@evex_area:evex_look preview"); message("Preview complete"); else message("Printing..."); send("@evex_area:evex_look print", evx$x_run_process); message("File qued to LN03"); endif; send ("delete/nolog eve$run_temp_file.*.*", evx$x_run_process); endif; evx$x_looking := false; endprocedure; ! EVEPLUS_KERNEL.TPU - Routines required by multiple modules ! ! Routine to insert text, even in overstrike mode ! procedure eveplus_insert_text(the_text) ! Copy_text in insert mode LOCAL old_mode; old_mode := get_info(current_buffer, "mode"); set(INSERT, current_buffer); copy_text(the_text); set(old_mode, current_buffer); endprocedure; procedure eveplus_search_quietly(target, dir) ! Search w/o "String not found" on_error return(0); endon_error; return(search(target, dir)); endprocedure; ! This routine translates a buffer name to a buffer pointer ! ! Inputs: ! buffer_name String containing the buffer name ! procedure eveplus_find_buffer(buffer_name) ! Find a buffer by name local the_buffer, ! Used to hold the buffer pointer the_name; ! A read/write copy of the name the_name := buffer_name; change_case(the_name, UPPER); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); exitif (the_name = get_info(the_buffer, "name")); the_buffer := get_info(buffer, "next"); endloop; return the_buffer; endprocedure !+ ! BUFED.TPU - Routines to list, goto & delete buffers !- procedure eve_list_buffers ! List non-system buffers bufed_list_buffers(FALSE) endprocedure procedure eve_list_all_buffers ! List system and non-system buffers bufed_list_buffers(TRUE) endprocedure ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT and REMOVE keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! procedure bufed_list_buffers(show_system) ! Build the buffer list local last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed temp; ! Used to build the record count as a string if get_info(evx$x_redefined_keys,"type") = unspecified then evx$x_redefined_keys := create_key_map ("evx$redefined_keys"); add_key_map(eve$x_key_map_list, "first", evx$x_redefined_keys); endif; eve_buffer("LIST BUFFER"); set(system, current_buffer); set(no_write, current_buffer); erase(current_buffer); ! message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); if (show_system or (get_info(the_buffer, "system") = 0)) then split_line; eveplus_insert_text(" "); eveplus_insert_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then eveplus_insert_text(""); else loop exitif (current_offset > 33); eveplus_insert_text(" "); endloop; endif; eveplus_insert_text(temp); if (get_info(the_buffer, "modified")) then eveplus_insert_text("Modified "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "no_write")) then eveplus_insert_text("No-write "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "system")) then eveplus_insert_text("System "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "permanent")) then eveplus_insert_text("Permanent"); else eveplus_insert_text(" "); endif; temp := current_line; move_horizontal (-current_offset); erase (create_range (mark (none), end_of (current_buffer), none)); edit (temp, trim_trailing); copy_text (temp); endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; ! if (eveplus_defined_procedure("eveplus_sort")) then ! message("Sorting buffer list"); ! execute('eveplus_sort ( current_buffer , "" ); '); ! endif; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly("", FORWARD); exitif (temp = 0); position(temp); erase(temp); eveplus_insert_text(" -"); split_line; eveplus_insert_text(" "); endloop; position(beginning_of(current_buffer)); eveplus_insert_text(" Buffer name Lines Attributes"); split_line; position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); if get_info(eveplus$bufed_x_active,"type") = unspecified then eveplus$bufed_x_active := FALSE; endif; if (not eveplus$bufed_x_active) then set(informational,off); define_key("bufed_select_buffer", e4, "select buffer", evx$x_redefined_keys); define_key("bufed_select_buffer", period, "select buffer", evx$x_redefined_keys); define_key("bufed_remove_buffer", e3, "remove buffer", evx$x_redefined_keys); define_key("bufed_remove_buffer", kp6, "remove buffer", evx$x_redefined_keys); set(informational,on); endif; eveplus$bufed_x_active := TRUE; message(" "); endprocedure ! This routine is temporarily bound to the REMOVE key. It deletes ! the buffer listed on the current line. It only works in the ! "LIST BUFFER" buffer. If it is struck outside of that buffer, ! it restores the original binding of the SELECT and REMOVE keys and ! and executes the program originally associated with the REMOVE key. ! The routine bufed_select_buffer also unbinds this key. ! procedure bufed_remove_buffer ! Delete the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type,the_program; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); undefine_key(e4, evx$x_redefined_keys); undefine_key(period, evx$x_redefined_keys); undefine_key(e3, evx$x_redefined_keys); undefine_key(kp6, evx$x_redefined_keys); set(informational,on); eveplus$bufed_x_active := FALSE; the_type := last_key; the_program := lookup_key(the_type,program); if the_program <> 0 then execute(the_program); else message("Undefined key"); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then if (bufed_destroy_buffer(the_name, the_buffer)) then move_horizontal(-current_offset); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-current_offset); erase_line; else move_horizontal(-current_offset); endif; erase_line; endif; endif; endif; endprocedure ! This routine actually destroys a specific buffer. ! ! Inputs: ! the_name The name of the buffer (display only) ! the_buffer Pointer to the buffer to destroy ! procedure bufed_destroy_buffer(the_name, the_buffer) ! Delete a buffer local answer, problem, new_buffer; bufed_destroy_buffer := FALSE; problem := ""; if ((get_info(the_buffer, "modified")) and (get_info(the_buffer, "record_count") <> 0)) then problem := "modified "; endif; if (get_info(the_buffer, "system")) then problem := problem + "system "; endif; if (problem <> "") then answer := read_line(substr(the_name, 1, 32) + " is a " + problem + "buffer. Are you sure? "); change_case (answer, lower); if ((length (answer) = 0) or (answer <> substr ("yes", 1, length (answer)))) then message("No buffer deleted."); return; endif; endif; if (current_buffer <> the_buffer) then delete(the_buffer); else new_buffer := get_info(buffers, "first"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "next"); endloop; if (new_buffer = 0) then eve_buffer("Main"); else eve_buffer(get_info(new_buffer, "name")); endif; if (get_info (the_buffer, "name") = "MAIN") then erase (the_buffer); else delete (the_buffer); endif; endif; bufed_destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure; ! This routine is temporarily bound to the SELECT. It puts you in ! the buffer listed on the current line, and restores the original ! meanings of the SELECT and REMOVE keys. It only works in the ! "LIST BUFFERS" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT and REMOVE keys, ! and executes the code originally associated with SELECT. ! procedure bufed_select_buffer ! Goto the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type, the_program; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); undefine_key(e4, evx$x_redefined_keys); undefine_key(period, evx$x_redefined_keys); undefine_key(e3, evx$x_redefined_keys); undefine_key(kp6, evx$x_redefined_keys); set(informational,on); eveplus$bufed_x_active := FALSE; the_type := last_key; the_program := lookup_key(the_type,program); if the_program <> 0 then execute(the_program); else message("Undefined key"); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then eve_buffer(the_name); evx_set_path; set(informational,off); undefine_key(e4, evx$x_redefined_keys); undefine_key(period, evx$x_redefined_keys); undefine_key(e3, evx$x_redefined_keys); undefine_key(kp6, evx$x_redefined_keys); set(informational,on); eveplus$bufed_x_active := FALSE; endif; endif; endprocedure; ! This routine scans the line the cursor is on and if it is in the ! proper format for a buffer listing, it reurns both the name of ! the buffer and a pointer to it. ! procedure bufed_get_the_buffer(the_name, the_buffer) ! Scan a buffer line local the_start; ! A mark pointing to the buffer name. the_name := ""; the_buffer := 0; if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); else move_horizontal(-current_offset); if (search(ANCHOR & " ", FORWARD) = 0) then message("This is not a buffer listing"); else move_horizontal(2); the_start := mark(none); move_horizontal(-2); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-2); else move_horizontal(32-current_offset); endif; the_name := create_range(the_start, mark(none), bold); the_name := substr(the_name, 1, length(the_name)); edit(the_name, TRIM_TRAILING, OFF); the_buffer := eveplus_find_buffer(the_name); if (the_buffer = 0) then message("No such buffer: " + the_name); endif; move_horizontal(2-current_offset); endif; endif; bufed_get_the_buffer := the_buffer; endprocedure; !+ ! RELEASE_BUFFERS.TPU - Routine to release all buffers !- ! ! Flush all modified buffers to their associated output files and delete ! the buffers. System buffers, and mofied buffers that are either "no_write" ! or have no associated files, are not written out. ! ! ! Buffer Type Action ! ! SYSTEM Ignored (Retained) ! UNMODIFIED Erased and Deleted ! MODIFIED but NO-WRITE Retained ! MODIFIED w/ ASSOCIATED FILE Written out - Erased and Deleted ! MODIFIED w/ NO ASSOCIATED FILE Retained ! procedure eveplus_write_file(the_buffer, file_name) on_error return(0); endon_error; write_file (the_buffer, file_name); return(1); endprocedure procedure eve_release_buffers local the_buffer, file_name, i, success_flag, buffer_count; eve_buffer("CHOICES"); ! Make sure we can't eve_one_window; ! delete surrent_buffer i := 1; loop message(""); exitif (i > 18); i := i + 1; endloop; the_buffer := get_info (buffer, "last"); ! Do it in reverse buffer_count := 0; loop if (get_info(the_buffer, "system") = 0) then ! Only nonsystem buffers if (get_info (the_buffer, "modified")) then if (not get_info (the_buffer, "no_write")) then file_name := get_info (the_buffer, "output_file"); if (file_name = 0) then ! Original if no output ! file name file_name := get_info (the_buffer, "file_name"); endif; if (file_name <> "") then ! Modified files with i := index (file_name, ";"); ! an associated file: if (i <> 0) then ! Strip version number. file_name := substr (file_name, 1, i-1); endif; success_flag := get_info (system, "success"); if (success_flag = 0) then ! Force sucess messages set (success, on); endif; ! Write it out if (eveplus_write_file(the_buffer, file_name)) then erase(the_buffer); delete(the_buffer); ! and get rid of it the_buffer := 0; buffer_count := buffer_count + 1; else ! Stop on errors eve_buffer(get_info(the_buffer, "name")); return; endif; if (success_flag = 0) then ! Restore Success msgs set (success, off); endif; endif; else message(" ** Buffer " + get_info(the_buffer, "name") + " is no-write. **"); endif; else ! Unmodified non-system message("Buffer " + ! buffers are just get_info(the_buffer, "name") + ! disposed of. " deleted"); erase(the_buffer); delete(the_buffer); the_buffer := 0; buffer_count := buffer_count + 1; endif; endif; if (the_buffer = 0) then ! If we deleted it, the_buffer := get_info(buffer, "last"); ! restart at the end else the_buffer := get_info(buffer, "previous"); ! Else get the next endif; exitif (the_buffer = 0); ! That's all, folks! endloop; message(fao("Freed !SL buffer!%S", buffer_count)); eve_buffer("MESSAGES"); ! Make sure we're endprocedure ! somewhere. !+ ! DISPLAY_CHARACTER.TPU !- ! This procedure writes a one line message describing the current character ! in terms of Octal, Decimal, Hexadecimal and (sometimes ) '^' notation. ! PROCEDURE eve_display_character LOCAL i,cc,tc; ! Handle end-of-buffer condition IF MARK( NONE ) = END_OF( CURRENT_BUFFER ) THEN MESSAGE( 'At end of buffer, no current character.' ); RETURN; ENDIF; ! Convert the character to an integer the hard way (no builtin yet) i := 0; LOOP; EXITIF i > 255; EXITIF CURRENT_CHARACTER = ASCII(i); i := i + 1; ENDLOOP; IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL ! Provide ^ notation for ASCII control characters IF i < 32 THEN cc := ', ^' + ASCII(i+64); ELSE cc := ''; ENDIF; ! Provide abbreviation evx_translate_controls(current_character,tc); ! Format and output the results MESSAGE( FAO( "Current Character is '!AS', Octal=!OB, Decimal=!-!UB, " + "Hex=!-!XB!AS", tc, i, cc ) ); ENDPROCEDURE ! eve_display_character !+ ! describe key !- ! This procedure will prompt for a key stroke or shift sequence and look ! up the comment that was attributed to the keystroke when it was defined. ! If there was no comment given, the message "Key Has No Function..." is ! displayed in the message area at the bottom of the screen. Otherwise, ! the key's function is displayed. This function assumes that there will ! always be some sort of comment given when keys are defined to user ! procedures. This may not be an acurate assumption in all circumstances. ! The value of this function depends on the descriptive nature of the names ! of user routines. It should be noted that this works on DEFINE KEY ! operations also. So use the whole function name to get the best ! description. ! PROCEDURE eve_describe_key LOCAL key_to_describe, key_description; MESSAGE("Press Key to Describe:"); key_to_describe := READ_KEY; key_description := LOOKUP_KEY(key_to_describe,COMMENT); IF key_description <> "" THEN MESSAGE("Function Description : " + key_description); ELSE MESSAGE("Key Has No Function..."); ENDIF; ENDPROCEDURE; !+ ! SORT.TPU !-! ! ! Sort the named buffer. Prompt for buffer name if not specified ! procedure eve_sort_buffer (buffer_to_sort) local v_buf ,p_buf; if not eve$prompt_string (buffer_to_sort, v_buf, "Sort buffer: ", "Cancelled") then return; endif; p_buf := eveplus_find_buffer (v_buf); if (p_buf <> 0) then eveplus$$shell_sort (p_buf); else message ("Buffer "+v_buf+" not found"); endif; endprocedure ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! procedure eveplus$$string_compare (string1, string2) local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0 else return 1 endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1, v_i, 1); change_case (v_c1, upper); v_c2 := substr (string2, v_i, 1); change_case (v_c2, upper); v_p1 := index (v_alpha, v_c1); v_p2 := index (v_alpha, v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; endprocedure ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! procedure eveplus$$shell_sort (buffer_to_sort) local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); eveplus$x_shellstep_0 := 1; eveplus$x_shellstep_1 := 4; eveplus$x_shellstep_2 := 13; eveplus$x_shellstep_3 := 40; eveplus$x_shellstep_4 := 121; eveplus$x_shellstep_5 := 364; eveplus$x_shellstep_6 := 1093; eveplus$x_shellstep_7 := 3280; eveplus$x_shellstep_8 := 9841; eveplus$x_shellstep_9:= 32767; eveplus$x_gshell := 0; eveplus$x_shell_index := 0; ! ! Find the highest step to use ! loop eveplus$x_gshell := 0; exitif (eveplus$x_shell_index >= 6); execute ("if (get_info (current_buffer, 'record_count') <"+ fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+ " then eveplus$x_gshell := 1;endif;"); if eveplus$x_gshell then exitif 1; endif; eveplus$x_shell_index := eveplus$x_shell_index + 1; endloop; v_record := get_info (current_buffer, 'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing eveplus$x_shell_index. ! loop execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL", eveplus$x_shell_index)); v_j := eveplus$x_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - eveplus$x_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (eveplus$$string_compare (v_jline, v_iline) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - eveplus$x_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; eveplus$x_shell_index := eveplus$x_shell_index - 1; exitif (eveplus$x_shell_index < 0); endloop; position (v_pos); endprocedure ! ! Search for string 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 ! pattern is all lowercase; otherwise is case-sensitive. ! Returns range if string found, otherwise returns false. ! This procedure is a modification of eve$find. ! procedure eve_search (target) local new_target, ! Local copy of target lowercase_target, ! Lowercase version of evx$x_str start_find_key, ! String describing key used to invoke find stop_find_key, ! String describing key used after prompt 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) or (error =tpu$_executefail)) then evx$x_fr := 0; find_range := 0; endif; endon_error; if get_info(evx$x_str,"type") = unspecified then evx$x_str := eve$kt_null; !Last string for search command endif; evx$x_fr := 0; find_range := 0; start_find_key := eve$lookup_comment (last_key); if target <> eve$kt_null then new_target := target; else if current_direction = forward then new_target := read_line ("Forward Search: "); else new_target := read_line ("Reverse Search: "); endif; endif; stop_find_key := eve$lookup_comment (last_key); if new_target = eve$kt_null then if (start_find_key = "search") and (stop_find_key = "search") then if evx$x_str = eve$kt_null then message ("No previous string to find"); evx$x_find_successful := FALSE; return (0); else if get_info (evx$x_str, eve$kt_type) = string then message (fao ("Finding previous string: !AS", evx$x_str)); else message ("Finding previous string: "); endif; endif; else message ("No string to find"); evx$x_find_successful := FALSE; return (0); endif; else evx$x_str := new_target; evx$x_search_prgm := evx_build_search_buffer; endif; lowercase_target := evx$x_str; if get_info (lowercase_target, eve$kt_type) = string then change_case (lowercase_target, lower); endif; if lowercase_target = evx$x_str then how_exact := no_exact; else how_exact := exact; endif; evx$x_he := how_exact; this_position := mark (none); if current_direction = forward then if this_position <> end_of (current_buffer) then move_horizontal (1); evx$x_dir := forward; evx_execute_search (evx$x_search_prgm); find_range := evx$x_fr; ! find_range := search (evx$x_str, forward, how_exact); else find_range := 0; endif; else if this_position <> beginning_of (current_buffer) then move_horizontal (-1); evx$x_dir := reverse; evx_execute_search (evx$x_search_prgm); find_range := evx$x_fr; ! find_range := search (evx$x_str, 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 move_horizontal (1); evx$x_dir := forward; evx_execute_search (evx$x_search_prgm); find_range := evx$x_fr; ! find_range := search (evx$x_str, forward, how_exact); else find_range := 0; endif; else if this_position <> beginning_of (current_buffer) then move_horizontal (-1); evx$x_dir := reverse; evx_execute_search (evx$x_search_prgm); find_range := evx$x_fr; ! find_range := search (evx$x_str, reverse, how_exact); else find_range := 0; endif; endif; if find_range = 0 then if get_info (evx$x_str, eve$kt_type) = string then message (fao ("Could not find: !AS", evx$x_str)); else message ("Could not find: "); endif; position (this_position); evx$x_find_successful := FALSE; 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$kt_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; eve$position_in_middle (beginning_of (find_range)); evx$x_find_successful := TRUE; return (find_range); else position (this_position); evx$x_find_successful := FALSE; return (0); endif; endif; else eve$position_in_middle (beginning_of (find_range)); evx$x_find_successful := TRUE; return (find_range); endif; endprocedure; ! Execute a pattern search procedure evx_execute_search (execute_program) on_error evx$x_fr := 0; return; endon_error; if execute_program <> 0 then execute (execute_program); else evx$x_fr := 0; endif; endprocedure; ! Create a pattern search command in the execute_buffer procedure evx_build_search_buffer local this_position, ! Marker for current cursor position this_success, ! Keyword for display of success messages first_char, ! First character of user pattern user_string, ! String for constrained search the_target, ! String with expanded wildcards compile_string; ! Compiled execute buffer on_error if (error = tpu$_compilefail) then compile_string := 0; endif; endon_error if get_info(evx$x_execute_buffer,"type") = unspecified then evx$x_execute_buffer := eve$init_buffer ("EXECUTE", eve$kt_null); endif; this_position := mark(none); position (evx$x_execute_buffer); erase (evx$x_execute_buffer); copy_text("set(timer,on,'Searching');"); eve_return; copy_text("evx$x_fr := 0;"); eve_return; copy_text("evx$x_fr := search ("); eve_return; first_char := substr(evx$x_str,1,1); if ((first_char = "") or (first_char = "") or (first_char = "")) then user_string := substr(evx$x_str,2,80); else user_string := evx$x_str; endif; if (first_char = "") then the_target := user_string; else if (evx_build_pattern(user_string, the_target) = 1) then ! message("pat: " + the_target); else ! message("str: " + the_target); the_target := "'" + the_target + "'"; endif; endif; case first_char from "" to "" [""] : copy_text("(any('+-*/,.()=:<> ') "); eve_return; copy_text(" & "); copy_text(the_target); eve_return; copy_text(" & ( any('+-*/,.()=:<> ') | line_end ))"); eve_return; [""] : copy_text("''&(any(eve$x_word_separators) | line_begin)"); eve_return; copy_text(" & "); copy_text(the_target); copy_text(" & "); eve_return; copy_text(" (any(eve$x_word_separators) | line_end)"); eve_return; [inrange,outrange] : copy_text(the_target); eve_return; endcase; copy_text(", evx$x_dir, evx$x_he);"); eve_return; copy_text("set(timer,off);"); eve_return; position (this_position); if get_info (system, "success") then this_success := on; else this_success := off; endif; set (success, off); compile_string := compile(evx$x_execute_buffer); set (success, this_success); return (compile_string); endprocedure; !+ ! Build a pattern for pattern searching. Pattern characters are: ! ! - beginning of line ! - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! # - multi-character wildcard, cross record boundaries (removed 08/22/87) ! - quote next character ! ^ - next char. is ctrl character (removed 08/22/87) ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. !- PROCEDURE evx_build_pattern( input_string, result_string ) LOCAL s1, s2, i, j, c, quote_next, ctrl_next, match_started, pat; s1 := ''; s2 := ''; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; pat := ''; !+ ! Process each character in the input string !- LOOP EXITIF i > LENGTH(input_string); c := SUBSTR(input_string, i, 1); !+ ! Do quoting if we're supposed to !- IF quote_next = 1 THEN IF c = "'" THEN s1 := s1 + "''" ELSE s1 := s1 + c ENDIF; s2 := s2 + c; i := i + 1; quote_next := 0 ELSE !+ ! Do CTRL/n quoting if we're supposed to !- IF ctrl_next = 1 THEN CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1); s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 ELSE !+ ! A normal character or wildcard !- CASE c FROM '' TO '' ['']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['']: !+ ! Begin-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_BEGIN"; i := i + 1; ['']: !+ ! End-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_END"; i := i + 1; ['*']: !+ ! General wildcard, not crossing record boundaries ! ! Eat following * and % !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('*%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Use REMAIN if at end of input_string !- IF i > LENGTH(input_string) THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& REMAIN" ELSE !+ ! Ignore * if followed by # !- ! IF SUBSTR(input_string, i, 1) <> "#" ! THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; !+ ! Use REMAIN if or follows !- IF (SUBSTR(input_string, i, 1) = "") OR (SUBSTR(input_string, i, 1) = "") THEN pat := pat + "& REMAIN" ELSE !+ ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. !- pat := pat + "& MATCH('"; match_started := 1 ENDIF ! ENDIF ENDIF; ['%']: !+ ! Single-character wildcard. ! ! Start by counting consecutive %s !- j := 0; LOOP EXITIF i > LENGTH(input_string); EXITIF SUBSTR(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 ENDLOOP; !+ ! Put it in the pattern !- IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& ARB(" + STR(j) + ")"; ["'"]: !+ ! Apostrophes must be doubled in STR1 !- s1 := s1 + "''"; s2 := s2 + "''"; ! s2 := s2 + "'"; i := i + 1; [INRANGE]: !+ ! Just an ordinary character !- s1 := s1 + c; s2 := s2 + c; i := i + 1; ENDCASE ENDIF ENDIF ENDLOOP; !+ ! Empty out STR1 !- IF (LENGTH(s1) > 0) AND (LENGTH(pat) > 0) THEN IF match_started THEN pat := pat + s1 + "')" ELSE pat := pat + "& '" + s1 + "'" ENDIF ENDIF; !+ ! Return either a string or a pattern string !- IF LENGTH(pat) > 0 THEN result_string := SUBSTR(pat, 3, LENGTH(pat) - 2); RETURN 1 ELSE result_string := s2; RETURN 0 ENDIF ENDPROCEDURE evx_initialize_keys; compile ("procedure evx_initialize_keys endprocedure"); save("evex_area:evex.tpu$section"); quit;