!++ ! FILENAME: EVEDT_PROCS.TPU ! FUNCTION: This file contains the EVEDT versions of the EVE commands. ! The procedures are in this file because: ! 1). I wanted to augment and enhance their functionality ! 2). DEC screwed up and I had to fixt the thing so it worked. ! AUTHOR: DEC, Steven K. Shapiro ! (C) Copyright SKS Enterprises, Austin TX. All Rights Reserved. ! ! The format, structure and contents of this file are the sole ! property of Steven K. Shapiro and are copyrighted to SKS ! Enterprises, Austin Texas. ! ! The information may be freely distributed, used and modified ! provided that the information in this header block is not ! changed, altered, disturbed or modified in any way. ! ! DATE: 2-NOV-1988 Original. ! HISTORY: current. ! CONTENTS: ! EVE$FILE.TPU eve$file_module_init ! EVE$FILE.TPU eve_get_file (get_file_parameter) ! EVE$SHOW.TPU eve_show_buffers ! EVE$SHOW.TPU eve_show_system_buffers ! EVE$FILE.TPU eve_buffer (buffer_parameter) ! EVE$FORMAT.TPU eve_set_left_margin (set_parameter) ! EVE$FORMAT.TPU eve_set_right_margin (set_parameter) ! EVE$FORMAT.TPU eve_fill_paragraph ! EVE$CORE.TPU eve_select ! EVE$FILE.TPU eve_write_file (write_file_name) ! EVE$CORE.TPU eve$process_command (new_do_line) ! EVE$WINDOWS.TPU eve$set_status_line (this_window) ! EVE$FILE.TPU eve_show ! EVE$FILE.TPU eve$$show_buffer_info (this_buffer, this_window) ! EVE$ADVANCED.TPU eve$repeat (repeat_count, the_key) ! EVE$FILE.TPU eve$exit ! EVE$EXTRAS.TPU eve$$spell (text_ptr) ! EVE$EDT.TPU eve$edt_fndnxt ==> evedt_find_next ! !23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H !-- !*----------------------------------------------------------------------------*! procedure evedt_procs_module_ident local file_date, module_vers; file_date := "-<( 27-DEC-1988 15:25:20.36 )>-"; module_vers := substr(file_date,5,2) + substr(file_date,8,3) + substr(file_date,14,2) + substr(file_date,17,5) ; return module_vers; endprocedure; !*----------------------------------------------------------------------------*! ! ! SKS 18-OCT-1988 Modifications to handle wildcards in filename. ! procedure eve$file_module_init ! Module Init local line_editing_mode, ! Line editing mode of terminal output_file_name, ! Original output file name parsed_output_file_name,! Full filespec for output file input_file_name_only, ! No node, disk, directory, or version temp, ! Temporary for a get_info return temp_file_name, ! Temporary for get_file file_count, ! Counts files found by file_search file_search_result, ! File_search result opening_outfile, ! True when we get to the output file input_file, ! Input file spec from command line input_error, ! True if can't parse/find input file name output_error, ! True if can't parse/find output file name get_file_error, ! True if can't do GET FILE on input file name saved_window, ! Save current buffer facility, ! For prompt_line key test legend, ! For prompt_line key test topic, ! For prompt_line key test is_wildcard, ! For wildcard output file journal_file, ! Journal file spec from command line first_wild_file, ! First file found in wildcard file search SKS wild_file, ! Flag if we are handling wildcards SKS orig_input_file; ! Original input file spec with wildcard SKS on_error [TPU$_SEARCHFAIL]: if opening_outfile = 0 then ! error searching for input file input_error := TRUE; eve$message (EVE$_NOSUCHFILE, 0, input_file); else ! error in finding output file output_error := TRUE; endif; [TPU$_TRUNCATE]: eve$message (error_text, error); [OTHERWISE]: eve$$restore_position (saved_window); endon_error; eve$x_read_only := message_text (EVE$_READ_ONLY); eve$x_max_buffer_name_length := 43;! Buffer names can be any size, but this is ! the largest size that will be shown on ! the status line without being truncated eve$$x_right_action_program := 0; ! default action routine (no left) eve$arg1_buffer := "string"; ! leave in for V1 compatibility ! (EVE assigned to this variable ! so users probably did too) eve$arg1_set_width := "integer"; eve$arg1_shift_left := "integer"; eve$arg1_shift_right := "integer"; eve$pattern_trim := span (" " + ascii (9)) + LINE_END; ! Used for trimming buffer ! create the mark array, index = mark name (string), element = marker eve$$x_mark_array := create_array (); ! Create all the necessary default buffers ! Create a main buffer main_buffer := create_buffer ("Main"); set (EOB_TEXT, main_buffer, message_text (EVE$_EOBTEXT, 1)); set (LEFT_MARGIN, main_buffer, eve$x_default_left_margin, CHARACTERS); if get_info (COMMAND_LINE, "display") then set (RIGHT_MARGIN, main_buffer, (get_info (eve$main_window, "width", CHARACTERS) - eve$x_default_right_margin), CHARACTERS); set (RIGHT_MARGIN_ACTION, main_buffer, eve$kt_word_wrap_routine); endif; if eve$main_window <> 0 then map (eve$main_window, main_buffer); endif; ! Command buffer eve$command_buffer := eve$init_buffer ("Commands", ""); set (PERMANENT, eve$command_buffer); set (KEY_MAP_LIST, eve$x_command_key_map_list, eve$command_buffer); line_editing_mode := get_info (SCREEN, "line_editing"); if line_editing_mode <> 0 then set (line_editing_mode, eve$command_buffer); else set (OVERSTRIKE, eve$command_buffer);! for VMS V4 line-editing compatibility endif; set (REVERSE, eve$command_buffer); ! for VMS V4 line-editing compatibility if eve$command_window <> 0 then map (eve$command_window, eve$command_buffer); endif; ! Prompt buffer eve$prompt_buffer := eve$init_buffer ("$Prompts$", ""); if eve$prompt_window <> 0 then set (VIDEO, eve$prompt_window, REVERSE); endif; ! Message buffer--mapped to the message window ! ! No message buffer if /NODISPLAY if get_info (COMMAND_LINE, 'display') then tpu$x_message_buffer := eve$init_buffer ("Messages", ""); set (PERMANENT, tpu$x_message_buffer); if message_window <> 0 then map (message_window, tpu$x_message_buffer); eve$clear_message; ! remove /COMMAND file-read message endif; ! output to sys$output endif; ! Misc buffers tpu$x_show_buffer := eve$init_buffer ("Show", ""); ! Buffer used by parser to display choices when a name is ambiguous eve$choice_buffer := eve$init_buffer ("$Choices$", ""); set (PERMANENT, eve$choice_buffer); ! Create the matches buffer for use by the parser eve$match_buffer := eve$init_buffer ("$Matches$", ""); set (PERMANENT, eve$match_buffer); ! Buffer used by prompt_line, to get the previous reply eve$recall_line_buffer := eve$init_buffer ("$RECALL_LINE$", ""); set (PERMANENT, eve$recall_line_buffer); ! Now do the paste buffer paste_buffer := eve$init_buffer ("Insert Here", message_text (EVE$_PASTEEOBTEXT, 1)); ! Give these buffer variables a value so we can delay their creation until ! they're needed. Otherwise, EVE$ERASE_TEXT can't distinguish between ! buffers (passed as a argument) that aren't created yet (they're = ! unspecified). eve$restore_buffer := 0; eve$x_char_buffer := eve$init_buffer ("$Restore$Char$", ""); eve$x_word_buffer := 2; eve$x_line_buffer := 3; eve$x_sentence_buffer := 4; ! Create a buffer using get_file input_file := get_info (COMMAND_LINE, "file_name"); if eve$main_window <> 0 then position (eve$main_window); ! Assume eve$$init_buffer had left us if input_file = "" ! in last buffer created. then eve$set_status_line (current_window); else ! Simulate an EVE_GET_FILE on the input_file (to insure that when ! we do call it, we'll have a valid filespec): loop ! Protect against earlier file_search with same file name. eve$reset_file_search; erase (eve$choice_buffer); temp_file_name := ""; file_count := 0; ! Put together a list of the wildcard files in the choices buffer. loop file_search_result := eve$$file_search (input_file); if file_search_result = 0 then input_error := TRUE; file_search_result := ""; endif; exitif file_search_result = ""; file_count := file_count + 1; if file_count = 1 then first_wild_file := file_search_result; ! Save first in search SKS endif; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; ! SKS More than 1 file is because of wildcard. Since we are now ! going to process wildcards, comment this THEN out and add our ! own assignments. if file_count > 1 then ! Now lets set it up for the wildcard. wild_file := TRUE; ! SKS temp_file_name := first_wild_file; ! SKS orig_input_file := input_file; ! SKS else exitif; ! file_count = 0 or 1 endif; if temp_file_name = "" ! No file specified on input or at ! Command line prompt then eve$set_status_line (current_window); ! MAIN status line exitif; endif; input_file := temp_file_name; ! loop until get 1 file or "" endloop; if temp_file_name = "" ! No file spec? then if (input_error = 0) and ! User didn't reply with bogus or ! wildcard file spec (file_count = 0) ! & user didn't erase ambiguous spec. then if eve$is_wildcard (input_file) ! Now we know its a wildcard then !eve$message (EVE$_NOFILMATCH, 0, input_file); ! SKS else ! No file exists, get_file will temp_file_name := input_file;! make buffer = bogus file name ! IE no file by that name, edit new endif; endif; endif; ! end of EVE_GET_FILE simulation if temp_file_name <> "" then ! make it look like we executed a GET FILE position (beginning_of (eve$command_buffer)); copy_text (eve$x_command_prompt + "get file " + input_file); position (end_of (eve$command_buffer)); ! SKS Now lets do our wildcard magic. If our wild_file flag is set, ! then we call get_file with the original filespec, else just ! the current file name. if wild_file then ! SKS eve_get_file (orig_input_file); ! SKS else ! not a wildcard filespec ! SKS if not eve_get_file (temp_file_name) ! now a real GET FILE... then position (main_buffer); get_file_error := TRUE; ! prevent qualifiers endif; endif; else eve$set_status_line (current_window); ! MAIN... endif; if (current_buffer <> main_buffer) and (current_window = eve$main_window) then delete (main_buffer); ! Position to the location specified by /START_POSITION ! in the command line, defaulting to 1,1. position (beginning_of (current_buffer)); temp := get_info (COMMAND_LINE, 'start_record'); if temp < 0 then message (EVE$_BADSTARTREC); else if temp > get_info (current_buffer, "record_count") then position (end_of (current_buffer)); else if temp <> 0 then move_vertical (temp - 1); endif; endif; endif; temp := get_info (COMMAND_LINE, 'start_character'); if (temp < 0) then message (EVE$_BADSTARTCHAR); else if mark (NONE) <> end_of (current_buffer) then if temp > length (current_line) then move_horizontal (length (current_line)); else if temp <> 0 then move_horizontal (temp - 1); endif; endif; endif; endif; endif; endif; else if input_file <> "" then input_file := file_parse (input_file); if input_file <> "" then input_file := eve$$file_search (input_file); if input_file = 0 then input_error := TRUE; input_file := ""; endif; if input_file <> "" then delete (main_buffer); main_buffer := create_buffer ("Main", input_file); set (LEFT_MARGIN, main_buffer, eve$x_default_left_margin, CHARACTERS); if get_info (COMMAND_LINE, "display") then set (RIGHT_MARGIN, main_buffer, (get_info (eve$main_window, "width", CHARACTERS) - eve$x_default_right_margin), CHARACTERS); set (RIGHT_MARGIN_ACTION, main_buffer, eve$kt_word_wrap_routine); endif; endif; endif; endif; position (main_buffer); endif; ! Process the qualifiers (/NOCREATE was processed by EVE_GET_FILE call above) ! if no errors on the input file if (not get_file_error) and (not input_error) then ! /NOOUTPUT implies NO_WRITE to ON for the buffer. if not get_info (COMMAND_LINE, "output") then set (NO_WRITE, current_buffer, ON); endif; ! /READ_ONLY implies NO_WRITE to ON and MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "read_only") then set (NO_WRITE, current_buffer, ON); set (MODIFIABLE, current_buffer, OFF); endif; ! /WRITE implies NO_WRITE to OFF and MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "write") then set (NO_WRITE, current_buffer, OFF); set (MODIFIABLE, current_buffer, ON); endif; ! /MODIFY implies MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "modify") then set (MODIFIABLE, current_buffer, ON); endif; ! /NOMODIFY implies MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "nomodify") then set (MODIFIABLE, current_buffer, OFF); endif; ! Abort the editing session if the user specified an output file, ! but also set the buffer NO_WRITE. if (get_info (current_buffer, "no_write")) and (get_info (COMMAND_LINE, "output_file") <> "") then if get_info (COMMAND_LINE, "read_only") then eve$message (EVE$_ILLQUALCOMB, 0, "/OUTPUT=filespec", "/READ_ONLY"); else eve$message (EVE$_ILLQUALCOMB, 0, "/OUTPUT=filespec", "/NOWRITE"); endif; exit; endif; ! The output file should be written to the current directory by default ! unless there is another directory specified in the output_file_name. ! We also DON'T want the node, device or directory of the input file, just ! the name. opening_outfile := TRUE; if not get_info (current_buffer, "no_write") then output_file_name := get_info (COMMAND_LINE, "output_file"); if output_file_name <> "" then if (input_error = 0) then input_file_name_only := file_parse (input_file, "", "", NAME, TYPE); else input_file_name_only := ""; endif; parsed_output_file_name := file_parse (output_file_name, input_file_name_only); if parsed_output_file_name <> "" then if eve$is_wildcard (parsed_output_file_name) then eve$message (EVE$_CANTCREATE, 0, parsed_output_file_name); is_wildcard := TRUE; else temp := parsed_output_file_name; parsed_output_file_name := eve$$file_search (temp); if parsed_output_file_name = 0 then output_error := TRUE; endif; if not output_error then set (OUTPUT_FILE, current_buffer, temp); endif; endif; else temp := output_file_name; output_file_name := eve$$file_search (output_file_name); if output_file_name = 0 then output_error := TRUE; endif; if not output_error then set (OUTPUT_FILE, current_buffer, temp); endif; endif; if (not is_wildcard) and (get_info (current_buffer, "modifiable")) and (not output_error) then ! Want this buffer to be considered modified so it will ! be written on exit - for use especially with mail/edit split_line; append_line; endif; endif; endif; endif; ! Show any new buffer settings just set. if get_info (COMMAND_LINE, "display") then eve$set_status_line (current_window); endif; ! The following can be overwritten by the user /COMMAND or ! /INITIALIZATION files to specify the buffer whose attributes are ! copied to the default buffer in procedure TPU$INIT_POSTPROCEDURE. eve$x_source_for_default_buffer := current_buffer; ! Start journalling. Try to use journal file name, then input file name, ! then output file, and finally "TPU.TJL". if (get_info (COMMAND_LINE, "journal") = 1) then journal_file := get_info (COMMAND_LINE, "journal_file"); input_file_name_only := file_parse (get_info (current_buffer, "file_name"), "", "", NAME); if input_file_name_only = "" then temp := get_info (current_buffer, "output_file"); if temp <> 0 then input_file_name_only := file_parse (temp, "", "", NAME); endif; endif; if input_file_name_only = "" then input_file_name_only := "tpu.tjl"; else input_file_name_only := input_file_name_only + ".tjl"; endif; journal_file := file_parse (journal_file, input_file_name_only); if not eve$$journal_open (journal_file) then eve$test_default_directory; endif; endif; endprocedure; !*----------------------------------------------------------------------------*! ! ! Edit a file in the current window. If the file is already in a buffer, ! use the old buffer. If not, create a new buffer. ! ! SKS 17-OCT-1988 Added variable evedt$x_prior_buffer for use with ! eve_prior_buffer when a new file is edited and a new buffer is created. ! ! SKS 18-OCT-1988 Modifications to handle wildcards in filename. ! ! Parameters: ! get_file_parameter String containing file name - input procedure eve_get_file (get_file_parameter) local get_file_name, ! Local copy of get_file_parameter temp_buffer_name, ! String for buffer name based on get_file_name file_search_result, ! Latest string returned by file_search temp_file, ! Save the filename temp_file_name, ! First file name string returned by file_search loop_buffer, ! Buffer currently being checked in loop file_count, ! Number of files matching the spec temp_answer, ! Answer to "Create file?" new_buffer, ! New buffer created if needed found_a_buffer, ! True if buffer found with same name want_new_buffer, ! True if file should go into a new buffer first_wild_file, ! First file found in wildcard search SKS orig_input_file; ! Original input file spec with wildcard SKS on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [TPU$_SEARCHFAIL]: eve$message (EVE$_NOSUCHFILE, 0, get_file_name); eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if eve$check_bad_window then eve$message (EVE$_CURSINTEXT); eve$learn_abort; return (FALSE); endif; if not (eve$prompt_string (get_file_parameter, get_file_name, message_text (EVE$_GETFILEPROMPT, 1), message_text (EVE$_NOFILESPEC, 0))) then eve$learn_abort; return (FALSE); endif; ! Protect against earlier file_search with same file name. eve$reset_file_search; temp_file_name := ""; erase (eve$choice_buffer); orig_input_file := get_file_name; ! SKS loop file_search_result := eve$$file_search (get_file_name); if file_search_result = 0 then eve$learn_abort; return (FALSE); endif; exitif file_search_result = ""; file_count := file_count + 1; if file_count = 1 then ! SKS first_wild_file := file_search_result; ! SKS endif; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; ! Lets get them wild files. if eve$is_wildcard (orig_input_file) then ! SKS evedt$get_wild_file ( orig_input_file ); ! SKS return (TRUE); ! SKS endif; ! No wild files so let's get the one the user wants ! Set-up to see if we already have a buffer by that name if temp_file_name = "" then temp_buffer_name := file_parse (get_file_name, "", "", NAME, TYPE); else temp_buffer_name := file_parse (temp_file_name, "", "", NAME, TYPE); endif; temp_file := get_file_name; get_file_name := file_search (get_file_name); if get_file_name = "" then get_file_name := temp_file; endif; loop_buffer := get_info (BUFFERS, "first"); loop exitif loop_buffer = 0; if temp_buffer_name = get_info (loop_buffer, "name") then found_a_buffer := 1; exitif 1; endif; loop_buffer := get_info (BUFFERS, "next"); endloop; ! If there is a buffer by that name, is it the exact same file? ! If so, switch to that buffer. Otherwise use a new buffer, ! asking for a new buffer name (null new name will abort). if found_a_buffer then ! Have a buffer with the same name if temp_file_name = "" then ! No file on disk if get_file_name = get_info (loop_buffer, "output_file") then want_new_buffer := 0; else want_new_buffer := 1; endif; else ! Check to see if the same file if (temp_file_name = get_info (loop_buffer, "output_file")) or (temp_file_name = get_info (loop_buffer, "file_name")) then want_new_buffer := 0; else want_new_buffer := 1; endif; endif; if want_new_buffer then eve$message (EVE$_BUFINUSE, 0, temp_buffer_name); temp_buffer_name := eve$prompt_line (message_text (EVE$_NEWBUFPROMPT, 1), eve$$x_prompt_terminators, ""); if temp_buffer_name = 0 then eve$learn_abort; return (FALSE); endif; if temp_buffer_name = "" then eve$message (EVE$_NOBUFFCREA); eve$learn_abort; return (FALSE); else evedt$x_prior_buffer := current_buffer; new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); if new_buffer = 0 then return (FALSE); endif; endif; else if current_buffer = loop_buffer then eve$message (EVE$_ALREDIT, 0, get_file_name); eve$learn_abort; return (FALSE); else evedt$x_prior_buffer := current_buffer; map (current_window, loop_buffer); endif; endif; else if (temp_file_name = "") and (eve$x_starting_up) and (get_info (COMMAND_LINE, "create") = 0) then ! EXIT the editor: input file doesn't exist and /NOCREATE was specified eve$message (EVE$_NOSUCHFILE, 0, get_file_name); exit; endif; ! No buffer with the same name, so create a new buffer if (eve$x_starting_up) then else evedt$x_prior_buffer := current_buffer; endif; new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); ! check the command line switches and set file info accordingly if new_buffer <> 0 then ! /NOOUTPUT implies NO_WRITE to ON for the buffer. if not get_info (COMMAND_LINE, "output") then set (NO_WRITE, new_buffer, ON); endif; ! /READ_ONLY implies NO_WRITE to ON and MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "read_only") then set (NO_WRITE, new_buffer, ON); set (MODIFIABLE, new_buffer, OFF); endif; ! /WRITE implies NO_WRITE to OFF and MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "write") then set (NO_WRITE, new_buffer, OFF); set (MODIFIABLE, new_buffer, ON); endif; ! /MODIFY implies MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "modify") then set (MODIFIABLE, new_buffer, ON); endif; ! /NOMODIFY implies MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "nomodify") then set (MODIFIABLE, new_buffer, OFF); endif; else return (FALSE); endif; endif; ! Correct the status line in any event eve$set_status_line (current_window); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endprocedure; !*----------------------------------------------------------------------------*! PROCEDURE eve_show_buffers ! List non-system buffers bufed_list_buffers(FALSE) ENDPROCEDURE !*----------------------------------------------------------------------------*! PROCEDURE eve_show_system_buffers ! List system and non-system buffers bufed_list_buffers(TRUE) ENDPROCEDURE !*----------------------------------------------------------------------------*! ! ! Map a buffer to the current window. If the buffer doesn't already ! exist, create a new buffer. ! ! SKS 10/14/88. Modified to include evedt$x_prior_buffer so we can move ! to the prior buffer. ! ! Parameters: ! ! buffer_parameter String containing buffer name - input procedure eve_buffer (buffer_parameter) ! Go to a (create a new) buffer local buffer_name, ! Local copy of buffer_parameter saved_buffer, ! Current buffer saved_mark, ! Current cursor position saved_window, ! Current window loop_buffer, ! Current buffer being checked in loop loop_buffer_name, ! String containing name of loop_buffer found_a_buffer, ! True if buffer found with same exact name possible_buffer_name, ! Most recent string entered in choice buffer possible_buffer, ! Buffer whose name is possible_buffer_name how_many_buffers, ! Number of buffers listed in choice buffer new_buffer; ! New buffer created when there is no match on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; if eve$check_bad_window then eve$message (EVE$_CURSINTEXT); eve$learn_abort; return (FALSE); endif; if not (eve$prompt_string (buffer_parameter, buffer_name, message_text (EVE$_BUFNAM, 1), message_text (EVE$_BUFNOTSWITCH, 0))) then eve$learn_abort; return (FALSE); endif; eve$cleanse_string (buffer_name); ! See if we already have a buffer by that name saved_mark := mark (FREE_CURSOR); saved_window := current_window; saved_buffer := current_buffer; loop_buffer := get_info (BUFFERS, "first"); change_case (buffer_name, UPPER); ! buffer names are uppercase erase (eve$choice_buffer); loop exitif loop_buffer = 0; loop_buffer_name := get_info (loop_buffer, "name"); if buffer_name = loop_buffer_name then found_a_buffer := 1; how_many_buffers := 1; exitif 1; else if buffer_name = substr (loop_buffer_name, 1, length (buffer_name)) then eve$add_choice (loop_buffer_name); possible_buffer := loop_buffer; possible_buffer_name := loop_buffer_name; how_many_buffers := how_many_buffers + 1; endif; endif; loop_buffer := get_info (BUFFERS, "next"); endloop; change_case (buffer_name, LOWER); ! for messages if found_a_buffer then if loop_buffer = saved_buffer then eve$message (EVE$_INBUFF, 0, loop_buffer_name); eve$learn_abort; return (FALSE); else evedt$x_prior_buffer := current_buffer; map (current_window, loop_buffer); endif; else if get_info (eve$choice_buffer, "record_count") > 0 then if how_many_buffers = 1 then if possible_buffer = saved_buffer then eve$message (EVE$_INBUFF, 0, possible_buffer_name); eve$learn_abort; return (FALSE); else evedt$x_prior_buffer := current_buffer; map (current_window, possible_buffer); endif; else change_case (buffer_name, LOWER); eve$display_choices (message_text (EVE$_AMBBUF, 0, buffer_name), !** How do we get the synonym for the key that was defined to this command? "buffer " + buffer_name); eve$learn_abort; return (FALSE); endif; else if get_info (eve$default_buffer, "type") <> BUFFER then ! i.e., no default buffer during startup new_buffer := create_buffer (buffer_name); set (eob_text, new_buffer, message_text (EVE$_EOBTEXT, 1)); set (LEFT_MARGIN, new_buffer, eve$x_default_left_margin, CHARACTERS); if get_info (COMMAND_LINE, "display") then set (RIGHT_MARGIN, new_buffer, (get_info (eve$main_window, "width", CHARACTERS) - eve$x_default_right_margin), CHARACTERS); set (RIGHT_MARGIN_ACTION, new_buffer, eve$kt_word_wrap_routine); endif; else new_buffer := create_buffer (buffer_name, "", eve$default_buffer); set (MODIFIABLE, new_buffer, ON); ! override default buffer set (NO_WRITE, new_buffer, OFF); ! override default buffer endif; evedt$x_prior_buffer := current_buffer; map (current_window, new_buffer); endif; endif; eve$set_status_line (current_window); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endprocedure; !*----------------------------------------------------------------------------*! ! ! Set left margin without changing right margin ! ! SKS 16-NOV-1988 Modified to print message stating the new margins. ! ! Parameters: ! ! set_parameter New left margin - input procedure eve_set_left_margin (set_parameter) local new_left_margin, ! Local copy of set_parameter current_right_margin; ! Right margin for current buffer if not (eve$prompt_number (set_parameter, new_left_margin, "Set left margin to: ", "Left margin unchanged")) then return; endif; if new_left_margin <= 0 then message ("Left margin must be at least 1"); else current_right_margin := get_info (current_buffer, eve$kt_right_margin); if new_left_margin >= current_right_margin then message ("Left margin must be smaller than right margin " + fao ("(currently set to !SL)", current_right_margin)); else set (margins, current_buffer, new_left_margin, current_right_margin); eve$update_status_lines; message (fao ("Left margin set to !SL", new_left_margin)); endif; endif; endprocedure; !*----------------------------------------------------------------------------*! ! ! Set right margin without changing left margin ! ! SKS 16-NOV-1988 Modified to print message stating the new margins. ! ! Parameters: ! ! set_parameter New right margin - input procedure eve_set_right_margin (set_parameter) local new_right_margin, ! Local copy of set_parameter current_left_margin; ! Left margin of current buffer if not (eve$prompt_number (set_parameter, new_right_margin, "Set right margin to: ", "Right margin unchanged")) then return; endif; current_left_margin := get_info (current_buffer, eve$kt_left_margin); if new_right_margin <= current_left_margin then message ("Right margin must be greater than left margin " + fao ("(currently set to !SL) ", current_left_margin)); else if new_right_margin > eve$x_largest_right_margin then new_right_margin := eve$x_largest_right_margin; endif; set (margins, current_buffer, current_left_margin, new_right_margin); eve$update_status_lines; message (fao ("Right margin set to !SL", new_right_margin)); endif; endprocedure; !*---------------------------------------------------------------------------*! ! ! Fill the current paragraph. If a select range is specified, ! fill only the range which was selected. ! ! SKS 16-NOV-1988 Compress the current paragraph before filling it. ! procedure eve_fill_paragraph local this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph remove_range, fill_range; ! Range for current paragraph ! Compress the paragraph first. eve_compress_par; ! SKS ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then message ("Nothing to fill"); return; endif; this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then message ("Fill must be done in the same buffer as Select."); else remove_range := select_range; ! If Select & Remove are in same spot then erase this character. if remove_range = 0 then if this_position = end_of (current_buffer) then message ("Nothing to fill."); 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); fill (remove_range, eve$$x_word_separators); position (this_position); eve$x_select_position := 0; remove_range := 0; message ("Fill completed."); endif; else ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph move_horizontal (- current_offset); loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); if eve$paragraph_break then move_vertical (1); exitif 1; endif; endloop; start_paragraph := mark (none); position (this_position); move_horizontal (- current_offset); loop exitif mark (none) = end_of (current_buffer); exitif eve$paragraph_break; move_vertical (1); endloop; if start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); else move_horizontal (-1); stop_paragraph := mark (none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); fill (fill_range, eve$$x_word_separators); position (stop_paragraph); eve$show_first_line; endif; endif; endprocedure; !*----------------------------------------------------------------------------*! ! ! SKS 16-NOV-1988 So we can use EDT keypad select just like the SELECT key. ! ! Start a select region procedure eve_select on_error [OTHERWISE]: ! user may have done own SELECT endon_error; if current_buffer = eve$x_bufed_buffer then if eve$$bufed_select then return (TRUE); else eve$learn_abort; return (FALSE); endif; else if eve$x_select_position <> 0 then eve$x_select_position := 0; eve$message (EVE$_SELCAN); else set(informational,off); evedt_key ("eve_remove",kp6,"remove text",""); evedt_key ("eve_insert_here", key_name(kp6,shift_key),"insert here",""); set(informational,on); eve$x_select_position := select (eve$x_highlighting); eve$message (EVE$_SELSTART); endif; endif; return (TRUE); endprocedure; !*----------------------------------------------------------------------------*! ! ! Write the current buffer to a specified file. If no file specified, ! use the default file name. ! ! SKS 01-JAN-1987 Modified to update DTS upon write. ! ! Parameters: ! ! write_file_name ! String containing file name - input procedure eve_write_file (write_file_name) local write_result; ! File name string returned by write_file if eve$x_trimming then message ("Trimming buffer..."); eve$trim_buffer (current_buffer); message ("Trimming completed"); endif; evedt$dts_replace(current_buffer); !******* if write_file_name = eve$kt_null then write_result := write_file (current_buffer); else write_result := write_file (current_buffer, write_file_name); endif; set (output_file, current_buffer, write_result); endprocedure; !*----------------------------------------------------------------------------*! ! Process command selected in command line editor ! (called by eve$parser_dispatch that's called by eve$$exit_command_window) ! ! SKS 21-OCT-1988, If no command given, tell what line just like EDT. ! ! Parameters: ! ! new_do_line String containing Eve command - input procedure eve$process_command (new_do_line) ! Process a command local valid_command, ! Clean parse or DO/DO saved_count, ! Repeat countr we started with the_program, ! Compiled program to execute saved_window, saved_mark; on_error [TPU$_CONTROLC]: if get_info (COMMAND_LINE, 'display') ! windows only when /display then eve$$restore_position (saved_window); update (saved_window); endif; eve$learn_abort; abort; [OTHERWISE]: if get_info (COMMAND_LINE, 'display') ! windows only when /display then eve$$restore_position (saved_window); update (saved_window); endif; endon_error; if get_info (COMMAND_LINE, 'display') ! windows only when /display then saved_window := current_window; endif; saved_mark := mark (FREE_CURSOR); if new_do_line <> "" then eve$x_do_line := new_do_line; eve$x_parsed_do_line := eve$$parse (eve$x_do_line); if eve$x_parsed_do_line = "" then ! message sent during parse error eve$x_do_line := ""; else valid_command := TRUE; endif; else eve$$x_ambiguous_parse := 0; ! need this since eve$$parse is not called here if eve$test_synonym ("do", eve$$x_start_do_key) and eve$test_synonym ("do", eve$$x_stop_do_key) then if eve$x_do_line = "" then eve$message (EVE$_NOPREVCMD); else eve$message (EVE$_CMDAGAIN, 0, eve$x_do_line); valid_command := TRUE; endif; else eve$message (EVE$_NOEVECMD); eve_what_line; ! SKS 21-OCT-1988 endif; endif; if not eve$$x_ambiguous_parse then if get_info (COMMAND_LINE, 'display') ! windows only when /display then eve$goto_command_window; endif; position (end_of (eve$command_buffer)); if new_do_line = "" then if mark (NONE) <> beginning_of (eve$command_buffer) then move_vertical (-1); erase_line; endif; endif; if get_info (COMMAND_LINE, 'display') ! windows only when /display then update (eve$command_window); endif; position (saved_window); position (saved_mark); if valid_command then ! now execute the program if eve$x_repeat_count = 0 then eve$x_repeat_count := 1; endif; saved_count := eve$x_repeat_count; the_program := compile (eve$$kt_return + eve$x_parsed_do_line); eve$$x_next_repeat_count := 0; loop exitif eve$x_repeat_count <= 0; ! < for nested calls (@file) exitif eve$$x_next_repeat_count <> 0; if execute (the_program) = 0 ! May set eve$$x_ambiguous_parse then if saved_count > 1 then eve$message (EVE$_REPEATSTOP); endif; exitif; endif; ! remember where the command left us in case ^C if get_info (COMMAND_LINE, 'display') ! windows only when /display then saved_window := current_window; endif; saved_mark := mark (FREE_CURSOR); eve$x_repeat_count := eve$x_repeat_count - 1; endloop; eve$x_repeat_count := eve$$x_next_repeat_count; endif; endif; if eve$$x_ambiguous_parse ! Can't combine with above then if eve$$x_in_init_file ! dump any ambiguous /initialization commands then eve$$x_ambiguous_parse := FALSE; position (end_of (eve$command_buffer)); if mark (NONE) <> beginning_of (eve$command_buffer) then move_vertical (-1); ! erase the ambiguous command erase_line; endif; position (saved_mark); return; ! parser already output ambiguous message endif; if not get_info (COMMAND_LINE, 'display') ! windows only when /display then return; ! parser already output ambiguous message endif; eve$map_choices; eve$goto_command_window; position (end_of (eve$command_buffer)); move_horizontal (-1); eve$$set_command_line; endif; endprocedure; !*----------------------------------------------------------------------------*! ! ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! ! SKS 21-OCT-1988 Modified to display margin settings and Readonly status. ! ! Parameters: ! this_window Window whose status line is being set - input procedure eve$set_status_line (this_window) local this_buffer, ! Current buffer new_status_line, ! Built-up status line mode_string, ! String version of current mode direction_string, ! String version of current direction status_string, ! String for status line buffer_name, ! String containing name of current buffer extra_fields, ! String containing other data extra_length, ! Length available for extra_fields buffer_field_length, ! Length available for buffer name lspm, ! Spaces for margins rspm, ! Spaces for margins lm, ! Left margin rm; ! Right margin on_error [OTHERWISE]: endon_error; this_buffer := get_info (this_window, "buffer"); ! Don't add a status line to windows without a status line if (this_buffer = 0) or (get_info (this_window, "status_line") = 0) then return; endif; ! If the buffer's status line is not to be modified by EVE, then ! put up the fixed status line status_string := eve$get_fixed_status_line (this_buffer); if status_string <> "" then set (STATUS_LINE, this_window, REVERSE, status_string); return; endif; if get_info (this_buffer, "modifiable") then if get_info (this_buffer, "mode") = INSERT then mode_string := eve$x_insert; else mode_string := eve$x_overstrike; endif; else mode_string := "Nomodify"; endif; if get_info (this_buffer, "direction") = REVERSE then direction_string := eve$x_reverse; else direction_string := eve$x_forward; endif; lm := get_info(current_buffer,'left_margin'); rm := get_info(current_buffer,'right_margin'); lspm := ""; rspm := ""; if lm < 10 then lspm := " "; else if lm < 100 then lspm := " "; endif; endif; if rm < 10 then rspm := " "; else if rm < 100 then rspm := " "; endif; endif; lm := str(lm); rm := str(rm); buffer_name := get_info (this_buffer, "name"); if length (buffer_name) > eve$x_max_buffer_name_length then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length); else buffer_name := buffer_name + substr (eve$kt_spaces, 1, eve$x_max_buffer_name_length - length (buffer_name) - 4); endif; if (get_info (current_buffer, "no_write")) then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length - 15); set (status_line, this_window, reverse, "Buffer " + buffer_name + " Readonly " + " Margin " + lm + "," + rm + " " + lspm + rspm + mode_string + " " + direction_string); else set (status_line, this_window, reverse, "Buffer " + buffer_name + " Margin " + lm + "," + rm + " " + lspm + rspm + mode_string + " " + direction_string); endif; endprocedure; !*----------------------------------------------------------------------------*! ! ! Show information about all non-system buffers, one at a time. ! Ask if user wants more information after each buffer. ! ! SKS 2-NOV-1988 Modified so as to show the EVEDT version information. ! procedure eve_show local saved_mark, ! Marker for current cursor position saved_window, ! Current window saved_buffer, ! Current buffer buffer_to_show, ! Buffer passed to eve$$show_buffer_info window_to_show, ! Window passed to eve$$show_buffer_info next_buffer, ! Next candidate buffer show_key, ! String associated with key read after prompt throw_away; ! Result of eve$prompt_key - to resume editing on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; if get_info (eve$prompt_window, "buffer") <> 0 then eve$message (EVE$_CANTSHOW); update (message_window); eve$learn_abort; return (FALSE); endif; position (search (ANCHOR, FORWARD)); ! prevent padding saved_mark := mark (FREE_CURSOR); saved_buffer := current_buffer; saved_window := current_window; buffer_to_show := saved_buffer; window_to_show := saved_window; next_buffer := get_info (BUFFERS, "last"); eve$map_help (tpu$x_show_buffer); set (STATUS_LINE, tpu$x_show_window, REVERSE, message_text (EVE$_SHOWSTATUS, 1, eve_version (0))); loop exitif next_buffer = 0; if (next_buffer <> saved_buffer) and (get_info (next_buffer, "system") = 0) then erase (tpu$x_show_buffer); eve$$show_buffer_info (buffer_to_show, window_to_show); if buffer_to_show = saved_buffer then window_to_show := 0; endif; update (tpu$x_show_window); show_key := eve$$lookup_comment (eve$prompt_key ( message_text (EVE$_DOFORMORE, 1)), ""); if eve$test_synonym ("do", show_key) then buffer_to_show := next_buffer; else eve$unmap_help; if get_info (saved_window, "buffer") <> 0 then position (saved_window); ! in case package changed windows endif; return (TRUE); endif; endif; next_buffer := get_info (BUFFERS, "previous"); endloop; erase (tpu$x_show_buffer); eve$$show_buffer_info (buffer_to_show, window_to_show); update (tpu$x_show_window); throw_away := eve$prompt_key (message_text (EVE$_RESUMEPROMPT, 1)); eve$unmap_help; if get_info (saved_window, "buffer") <> 0 then position (saved_window); ! in case package unmap_help changed windows endif; return (TRUE); endprocedure; !*----------------------------------------------------------------------------*! ! ! Main routine called by show command. Append information about the given ! buffer to the end of the show_buffer. Mapping, erasing, etc. are ! handled in eve_show. ! ! SKS 16-NOV-1988 Modified to display the Writability and Modifiability of ! the current buffer. ! ! Parameters: ! ! this_buffer Buffer being inquired about - input ! this_window Window being inquired about - input procedure eve$$show_buffer_info (this_buffer, this_window) ! Show subprocedure local buffer_name, ! String used to hold the name of this_buffer input_file_name, ! String with input file name for this_buffer output_file_name, ! String with output file name for this_buffer how_many_records, ! Number of records in this_buffer record_text, ! String for display of how_many_records the_index, ! Index into array of marks this_window_shift, ! Shift amount for this_window this_window_key_map, ! The key-map list for this window the_eob, ! Default buffer eob text the_action, ! Default buffer left/right margin action temp, ! A real temp variable default_flag, ! True if this_buffer = eve$default_buffer what_tab_stops; ! String or integer with tab stop settings on_error [TPU$_NONAMES, TPU$_MULTIPLENAMES]: [OTHERWISE]: endon_error; default_flag := (this_buffer = eve$default_buffer); position (end_of (tpu$x_show_buffer)); set (INSERT, tpu$x_show_buffer); ! should be insert anyway, but just in case... buffer_name := get_info (this_buffer, "name"); copy_text (message_text (EVE$_SHOW_HEADER, 1, buffer_name)); eve$$letter_wrap (index (current_line, buffer_name)); split_line; split_line; temp := message_text (EVE$_NOTMODIFIED, 1); if not default_flag then input_file_name := get_info (this_buffer, "file_name"); if input_file_name = "" then input_file_name := message_text (EVE$_NONE); endif; copy_text (message_text (EVE$_SHOW_INPUTFILE, 1, input_file_name)); eve$$letter_wrap (index (current_line, input_file_name)); split_line; output_file_name := get_info (this_buffer, "output_file"); if (output_file_name = 0) or (get_info (this_buffer, "no_write")) then output_file_name := message_text (EVE$_NONE, 1); endif; copy_text (message_text (EVE$_SHOW_OUTPUTFILE, 1, output_file_name)); eve$$letter_wrap (index (current_line, output_file_name)); split_line; split_line; if get_info (this_buffer, "modified") then temp := message_text (EVE$_MODIFIED, 1); endif; copy_text (message_text (EVE$_SHOW_FIELD, 1, temp)); else copy_text (message_text (EVE$_SHOW_FIELD, 1, temp)); endif; copy_text (message_text (EVE$_LEFTSETTO, 1, get_info (this_buffer, "left_margin", CHARACTERS))); split_line; if get_info (this_buffer, "mode") = INSERT then temp := eve$x_insert; else temp := eve$x_overstrike; endif; copy_text (message_text (EVE$_SHOW_FIELD, 1, message_text (EVE$_SHOW_MODE, 1, temp))); copy_text (message_text (EVE$_RIGHTSETTO, 1, get_info (this_buffer, "right_margin", CHARACTERS))); split_line; if get_info (this_buffer, "direction") = FORWARD then temp := eve$x_forward; else temp := eve$x_reverse; endif; copy_text (message_text (EVE$_SHOW_FIELD, 1, message_text (EVE$_SHOW_DIRECTION, 1, temp))); if not default_flag then if this_window <> 0 then copy_text (message_text (EVE$_WIDSET, 1, get_info (this_window, "width", CHARACTERS))); endif; split_line; how_many_records := get_info (this_buffer, "record_count"); record_text := message_text (EVE$_SHOW_LINES, 1, how_many_records); else split_line; how_many_records := get_info (this_buffer, "max_lines"); if how_many_records = -1 then record_text := "Max lines: No limit"; else record_text := message_text (EVE$_SHOW_MAXLINES, 1, how_many_records); endif; endif; copy_text (message_text (EVE$_SHOW_FIELD, 1, record_text)); if not default_flag then if this_window <> 0 then this_window_shift := get_info (this_window, "shift_amount"); if this_window_shift > 0 then copy_text (message_text (EVE$_SHIFTCOUNT, 1, this_window_shift)); endif; endif; endif; split_line; split_line; if get_info (this_buffer, "no_write") then copy_text(" Buffer is: NO-WRITE"); else copy_text(" Buffer is: WRITEable"); endif; split_line; if not get_info (this_buffer, "modifiable") then copy_text(" Buffer is: NOT MODIFIABLE"); else copy_text(" Buffer is: MODIFIABLE"); endif; split_line; split_line; what_tab_stops := get_info (this_buffer, "tab_stops"); if get_info (what_tab_stops, "type") = INTEGER then copy_text (message_text (EVE$_SHOW_TABEVERY, 1, what_tab_stops)); else copy_text (message_text (EVE$_SHOW_TABSETAT, 1, what_tab_stops)); eve$$letter_wrap (index (current_line, what_tab_stops)); endif; split_line; position (this_buffer); this_window_key_map := eve$current_key_map_list; position (tpu$x_show_buffer); if this_window_key_map <> eve$x_key_map_list then split_line; if this_window_key_map <> '' then copy_text (message_text (EVE$_SHOW_KEYMAPLIST, 1, this_window_key_map)); else copy_text (message_text (EVE$_SHOW_NOKEYMAP, 1)); endif; split_line; endif; if not default_flag then erase (eve$choice_buffer); position (beginning_of (eve$choice_buffer)); split_line; move_vertical (-1); ! spin thru the mark array the_index := get_info (eve$$x_mark_array, "first"); loop exitif the_index = tpu$k_unspecified; if get_info (eve$$x_mark_array {the_index}, "buffer") = this_buffer then copy_text (the_index); split_line; endif; the_index := get_info (eve$$x_mark_array, "next"); endloop; append_line; ! get rid of blank line ! Display ambiguous mark names in the choice buffer if get_info (eve$choice_buffer, "record_count") = 0 then position (end_of (tpu$x_show_buffer)); copy_text (message_text (EVE$_SHOW_NOMARKS, 1)); else eve$format_choices; position (end_of (tpu$x_show_buffer)); copy_text (message_text (EVE$_SHOW_MARKS, 1)); split_line; split_line; copy_text (eve$choice_buffer); endif; else the_eob := get_info (eve$default_buffer, "eob_text"); if the_eob <> message_text (EVE$_EOBTEXT) then split_line; copy_text (fao (" EOB text: !AS", the_eob)); split_line; endif; ! New EVE buffers are always MODIFIABLE and WRITEABLE, i.e., ignore ! these default buffer attributes. ! wait until the get_info works the_action := get_info (eve$default_buffer, "left_margin_action"); if the_action <> tpu$k_unspecified ! EVE has no default left_margin_action then split_line; copy_text (message_text (EVE$_NONDEFLEFTACT, 1)); split_line; endif; if get_info (eve$$x_right_action_program, "type") <> PROGRAM then eve$$x_right_action_program := compile (eve$kt_word_wrap_routine); endif; the_action := get_info (eve$default_buffer, "right_margin_action"); if the_action <> eve$$x_right_action_program then split_line; copy_text (message_text (EVE$_NONDEFRIGHTACT, 1)); split_line; endif; endif; if current_offset > 0 then split_line; endif; position (beginning_of (tpu$x_show_buffer)); endprocedure; !*----------------------------------------------------------------------------*! ! ! SKS 16-NOV-1988 Modified to display the current value of the loop number ! which is being executed. ! procedure eve$repeat (repeat_count, the_key) ! Repeat subprocedure local ascii_the_key, ! String of the_key saved_count, ! Stack the repeats... executed, ! Number of times command has been executed SKS total, ! Temp holder for count SKS key_program, ! Program associated with the_key repeat_key; ! String associated with the_key on_error [TPU$_CONTROLC]: eve$x_repeat_count := saved_count; eve$learn_abort; abort; [OTHERWISE]: eve$message (EVE$_REPEATSTOP); eve$x_repeat_count := saved_count; eve$learn_abort; return (FALSE); endon_error; saved_count := eve$x_repeat_count; eve$x_repeat_count := repeat_count; if repeat_count = 0 then eve$message (EVE$_NOREPEATZERO); eve$learn_abort; eve$x_repeat_count := saved_count; return (FALSE); endif; ascii_the_key := eve$alphabetic (the_key); key_program := lookup_key (the_key, PROGRAM, eve$current_key_map_list); if (ascii_the_key <> "") and (key_program = 0) then loop exitif eve$x_repeat_count = 0; copy_text (ascii_the_key); eve$x_repeat_count := eve$x_repeat_count - 1; endloop; else ! Check for do key repeat_key := eve$$lookup_comment (the_key, ""); if eve$test_synonym ("do", repeat_key) then eve$$x_next_repeat_count := eve$x_repeat_count; eve$x_repeat_count := saved_count; eve$$enter_command_window; return (TRUE); else if (repeat_key = "keypad repeat") or (eve$test_synonym ("repeat", repeat_key)) then eve$message (EVE$_ORIGREPIGNOR); eve$x_repeat_count := 1; endif; if key_program <> 0 then total := eve$x_repeat_count; ! SKS loop executed := total - eve$x_repeat_count; ! SKS message (fao ("Executed !SL of !SL occurrences.", ! SKS executed,total)); ! SKS exitif eve$x_repeat_count <= 0; if execute (key_program) = 0 then eve$message (EVE$_REPEATSTOP); exitif; endif; eve$x_repeat_count := eve$x_repeat_count - 1; endloop; else eve$message (EVE$_CANTREPT); eve$x_repeat_count := saved_count; return (FALSE); endif; endif; endif; eve$x_repeat_count := saved_count; return (TRUE); endprocedure; !*----------------------------------------------------------------------------*! ! ! Exit Eve. Write the current buffer if modified, and ask the user ! about writing out any other modified buffers. ! Ensure eve$write_file is called with a filename: ! ask for one first (in eve$$get_write_file), and if none supplied, ! warn the user that buffer is as good as gone. ! ! 16-NOV-1988 Modified to trim if flag set. ! 16-NOV-1988 Modified to update date / time string. ! procedure eve$exit ! Actual EVE exit local the_buffer, ! Buffer to be checked and written the_file, ! File name to write it to got_a_file, ! Boolean set if buffer has assoc'd file the_buffer_name; ! Name of the buffer to write it to if get_info (eve$prompt_window, "buffer") <> 0 then eve$message (EVE$_CANTEXIT); eve$learn_abort; return (FALSE); endif; the_file := ""; the_buffer := current_buffer; if get_info (the_buffer, "modified") and not get_info (the_buffer, "no_write") then if not eve$$get_write_file (the_buffer, the_file, got_a_file) then eve$learn_abort; return (FALSE); endif; if (the_file <> "") or ! user pressed RETURN at the prompt got_a_file ! file_name or output_file exist then if eve$x_trimming then eve$trim_buffer (the_buffer); ! trim as necessary endif; evedt$dts_replace(the_buffer); ! update the date/time stamp if not eve$write_file (the_buffer, the_file, 0) then eve$message (EVE$_CANTWRITE, 0, substr (get_info (the_buffer, "name"), 1, eve$x_max_buffer_name_length)); eve$learn_abort; return (FALSE); endif; endif; endif; the_buffer := get_info (BUFFERS, "first"); loop exitif the_buffer = 0; if (the_buffer <> current_buffer) and get_info (the_buffer, "modified") and (not get_info (the_buffer, "no_write")) then the_buffer_name := substr (get_info (the_buffer, "name"), 1, eve$x_max_buffer_name_length); if eve$insist_y_n (message_text (EVE$_WRITEBUF, 1, the_buffer_name)) then if get_info (the_buffer, "modified") and not get_info (the_buffer, "no_write") then if eve$x_trimming then eve$trim_buffer (the_buffer); ! trim as necessary endif; evedt$dts_replace(the_buffer); ! update the date/time stamp if not eve$$get_write_file (the_buffer, the_file, got_a_file) then eve$learn_abort; return (FALSE); endif; endif; if (the_file <> "") or ! from the prompt got_a_file ! from the argument then if eve$x_trimming then eve$trim_buffer (the_buffer); ! trim as necessary endif; evedt$dts_replace(the_buffer); ! update the date/time stamp if not eve$write_file (the_buffer, the_file, 0) then eve$message (EVE$_CANTWRITE, 0, the_buffer_name); eve$learn_abort; return (FALSE); endif; endif; endif; endif; the_buffer := get_info (BUFFERS, "next"); endloop; ! Delete all modified buffers so we can use EXIT without TPU prompting ! (need to return %TPU-S-EXITING for callable interface) the_buffer := get_info (BUFFERS, "first"); loop exitif the_buffer = 0; if get_info (the_buffer, "modified") and (not get_info (the_buffer, "no_write")) then ! delete causes "next" delete (the_buffer); ! to return 0, must the_buffer := get_info (BUFFERS, "first"); ! restart from "first" else the_buffer := get_info (BUFFERS, "next"); endif; endloop; exit; endprocedure !*----------------------------------------------------------------------------*! ! ! 29-NOV-1988 SKS Modifications as per General Release Notes page 7-13. ! procedure eve$$spell (text_ptr) ! Actually invoke DECspell local local_text, start_mark, end_mark, the_file, the_position, is_offset; on_error [TPU$_CONTROLC]: set (SCREEN_UPDATE, ON); eve$learn_abort; abort; [TPU$_CREATEFAIL]: SET (SCREEN_UPDATE, ON); ! SKS 29-NOV-1988 eve$message (EVE$_CANTCREASPELL); eve$learn_abort; return (FALSE); [OTHERWISE]: set (SCREEN_UPDATE, ON); endon_error; local_text := text_ptr; ! first see if DECspell is installed (assume SYS$SYSTEM:LNGSPLCOR.EXE) eve$reset_file_search; ! Negate earlier file_search with same name. if file_search ("LNGSPLCOR", "SYS$SYSTEM:.EXE") = "" then eve$message (EVE$_NODECSPELL); eve$learn_abort; return (0); endif; if get_info (eve$$spell_buffer, "type") <> BUFFER then eve$$spell_buffer := eve$init_buffer ("SPELL", ""); endif; if (get_info (eve$$x_spell_process, "type") = UNSPECIFIED) or (eve$$x_spell_process = 0) then eve$$x_spell_process := create_process (eve$$spell_buffer, "$ set noon"); send ("$ delete:==delete", eve$$x_spell_process); ! disregard user symbols endif; the_file := "sys$scratch:" + str (get_info (eve$$x_spell_process, "pid")) + ".tmp"; set (SCREEN_UPDATE, OFF); ! insure we do complete lines (otherwise single words selected in the middle of ! a line get read_file'd onto previous line, too nasty to prevent) if eve$x_select_position <> 0 then start_mark := beginning_of (local_text); end_mark := end_of (local_text); if get_info (start_mark, "offset") > 0 then position (start_mark); position (LINE_BEGIN); start_mark := mark (NONE); endif; if get_info (end_mark, "offset") > 0 then position (end_mark); position (LINE_END); end_mark := mark (NONE); endif; local_text := create_range (start_mark, end_mark, NONE); endif; ! write out temp file to be checked by DECspell write_file (local_text, the_file); ! should on_error return false? spawn ("SPELL " + the_file + "/output=" + the_file); eve$x_select_position := 0; the_position := beginning_of (local_text); erase (local_text); if (the_position <> beginning_of (current_buffer)) then move_horizontal (-1); the_position := mark (NONE); move_horizontal (1); is_offset := 1; endif; read_file (the_file); ! get corrected text position (the_position); if is_offset then move_horizontal (1); else position (beginning_of (current_buffer)); endif; send ("$ delete " + the_file + ";*", eve$$x_spell_process); set (SCREEN_UPDATE, ON); refresh; return (TRUE); endprocedure !*----------------------------------------------------------------------------*! ! ! EVE$EDT_FNDNXT has a problem in that if set_no_whitespace is turned on, a ! find_next will blow up. This procedure circumvents the problem by first ! checking if there was a pattern built. If there was, and there was a last ! find string, then we're doing a find next. So instead, use the pattern as ! the input to eve_find rather than doing a find next. ! PROCEDURE evedt_find_next IF get_info(eve$x_target, "type") = pattern THEN IF eve$x_printable_target = "" THEN ! is there a last find string? eve$edt_fndnxt; ! let edt keypad find next handle it ELSE eve_find(eve$x_printable_target); ! do a find on the string via EVE_FIND ENDIF; ! make it into a pattern again ELSE eve$edt_fndnxt; ! no previous pattern, just find next ENDIF; ENDPROCEDURE; !*----------------------------------------------------------------------------*!