! ABEL_WINBUF.TPU ! ! Table of Contents as of 27-Mar-1988 ! ! Procedure name Page Description ! -------------- ---- ----------- ! ! eve$set_status_line 1 Set buffer status line ! eve$update_status_lines 2 Update all visible status lines ! eve_buffer 3 Map a buffer to the current window ! eve_destroy_buffer 4 Delete a buffer by name ! eve$destroy_buffer 5 Delete a buffer ! eve_number_lines 6 Number lines in a buffer or range ! eve$check_bad_window 7 File and window commands ! abl$expand_window_name 8 Return matching window variables ! eve_default_left_margin 9 Sets the default left margin ! eve_default_right_margin 10 Sets the default right margin ! eve_default_tab_every 11 Sets the default tab interval ! eve_get_file 12 Read a file into a new buffer ! eve$create_buffer 13 Create a new buffer ! eve_other_window 16 Switch editing windows ! eve_set_autoindent 17 Change autoindent setting ! eve_set_text 18 Change window's text display attrib ! eve_set_write 19 Change setting of buffer's write ! eve_set_right_margin 20 Change current buffers right margin ! eve_set_scroll_factor 21 Set scrolling factor (buffering) ! eve_set_eliminate_tabs 22 Change elim-tabs-on-exit setting ! eve_set_trim 23 Change trim-on-exit setting ! eve_set_word_wrap 24 Change hot-zone size ! eve_toggle_message 25 Toggle message window ! eve_write_file 27 Write current buffer to file ! eve_exit 29 Leave Eve ! Page 1 procedure eve$set_status_line ! Set buffer status line (this_window) ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! Also display name of window; since TPU doesn't store window names (like ! buffer names), the name is stored right in the status line. ! ! Parameters: ! this_window window window whose status line is being set ! ! Globals: ! abl$window_name_start integer beginning of window name in status line ! abl$buffer_name_length integer length of buffer name in status line ! ! Source: ! Eve local this_buffer, ! Current buffer mode_string, ! String version of current mode direction_string, ! String version of current direction window_name, ! String of window's name old_status_line, ! Previous status line for window new_status_line, ! Created status line buffer_name; ! String containing name of current buffer this_buffer := get_info (this_window, "buffer"); ! ! Don't add a status line to windows without a status line ! if (this_buffer = 0) or (get_info (this_window, "status_line") = 0) then return; endif; ! ! Get the old status line ! old_status_line:=get_info(this_window,"status_line"); ! ! Get the window name from the old status line ! window_name:= substr(old_status_line,abl$window_name_start,length(old_status_line)); ! ! Find out mode and direction ! if get_info (this_buffer, "mode") = insert then mode_string := "Ins"; else mode_string := "Ovr"; endif; ! if get_info (this_buffer, "direction") = reverse then direction_string := "Rev"; else direction_string := "For"; endif; ! ! Get the buffer name ! (the first abl$buffer_name_length characters, padded with spaces) ! buffer_name:=get_info(this_buffer,"name"); if length(buffer_name)>abl$buffer_name_length then buffer_name:=substr(buffer_name,1,abl$buffer_name_length-3)+"..." else buffer_name:=substr(buffer_name+eve$x_spaces,1,abl$buffer_name_length) endif; ! ! If this buffer is set no_write, then bold the status line ! if (get_info (this_buffer, "no_write")) then set (status_line, this_window, bold, "X"); else set (status_line, this_window, none, "X"); endif; ! ! Compile the new status line ! new_status_line:= " Buffer ("+ mode_string+", "+direction_string+") "+buffer_name+" "+ " Window ("+ str(get_info(this_window,"visible_top"))+"-"+ str( get_info(this_window,"visible_top")+ get_info(this_window,"visible_length")-1 )+") "+eve$x_spaces; new_status_line:=substr(new_status_line,1,abl$window_name_start-1)+window_name; set(status_line, this_window, reverse, new_status_line); endprocedure ! Page 2 procedure eve$update_status_lines ! Update all visible status lines ! Update status lines for all windows visible on the screen; this is a change ! Eve's functionality since Eve update only the windows mapped to the current ! buffer. The distinction is trivial and has never caused a problem with Eve. ! ! Source: ! Eve local this_buffer, ! Current buffer loop_window; ! Window currently being checked in loop this_buffer := current_buffer; loop_window := get_info (window, "first"); loop exitif loop_window = 0; if get_info(loop_window,"visible") then eve$set_status_line (loop_window); endif; loop_window := get_info (window, "next"); endloop; endprocedure; ! Page 3 procedure eve_buffer($buffer_name) ! Map a buffer to the current window ! Map a buffer to the current window. If the buffer doesn't already ! exist, create a new buffer. ! ! Parameters: ! buffer_parameter string buffer name ! ! Qualifiers: ! /new boolean buffer must be a new buffer ! /old boolean buffer must be an old buffer ! /ask boolean ask user before creating new buffer ! ! Source: ! Eve local ans, buffer_name, ! Local copy of buffer_parameter ubuffer_name, ! Local copy of buffer_parameter this_buffer, ! Current buffer loop_buffer, ! Current buffer being checked in loop loop_buffer_name, ! String containing name of loop_buffer possible_buffer_name, ! Most recent string entered in possible_names possible_buffer, ! Buffer whose name is possible_buffer_names how_many_buffers, ! Number of buffers listed in possible_names new_buffer; ! New buffer created when there is no match if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return; endif; ! ! Get the buffer name from the user ! if not eve$prompt_string ($buffer_name, buffer_name, "Buffer name: ", "Buffer not switched") then return 0; endif; eve$cleanse_string (buffer_name); edit(buffer_name,trim,upper); ! ! See if we already have a buffer by that name ! this_buffer := current_buffer; loop_buffer := get_info (buffers, "first"); 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 an exact match, so use it ! how_many_buffers := 1; possible_buffer := loop_buffer; possible_buffer_name := loop_buffer_name; exitif 1; else ! ! If we find a buffer that starts with the user's string, ! remember it and look some more ! 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; ! ! If we found an exact match ! if how_many_buffers = 1 then if abl$q_new then message("Could not create a new buffer named " + possible_buffer_name + "; buffer already exists"); return 0; endif; if possible_buffer = this_buffer then message (fao ("Already in buffer !AS", possible_buffer_name)); else map (current_window, possible_buffer); eve$set_status_line (current_window); endif; return 1; endif; ! ! If we found some partial matches (more than one possibility) ! (don't do this if the user said /NEW, 'cause he wants a buffer of the name ! he specified, regardless of any ambiguity with existing buffer names) ! if (how_many_buffers > 1) and not abl$q_new then change_case (buffer_name, lower); eve$display_choices (fao ("Ambiguous buffer name: !AS", buffer_name)); return 0; endif; ! ! If we found no matches then create the buffer... ! (if /OLD was specified, give a message and don't create buffer) ! (if /ASK was specified, ask user before we create) ! if how_many_buffers = 0 or abl$q_new then if abl$q_old then message("There is no old buffer named " + buffer_name + "; aborted"); return 0; endif; if abl$q_ask then if not abl$prompt_word("/yes/no","",ans, "Create buffer " + buffer_name + " (yes, no) [no]? ", "Aborted...") then return 0; endif; if ans = "no" then message("Aborted..."); return 0; endif; endif; ! ! Create the buffer ! new_buffer := create_buffer (buffer_name); map (current_window, new_buffer); set (eob_text, new_buffer, abl$eob_text); if eve$x_default_right_margin > 0 then set (margins, new_buffer, eve$x_default_left_margin, get_info (eve$main_window, "width") - eve$x_default_right_margin); else set (margins, new_buffer, eve$x_default_left_margin, -eve$x_default_right_margin); endif; set(tab_stops,new_buffer,eve$x_default_tab_interval); eve$update_status_lines; endif; endprocedure; ! Page 4 procedure eve_destroy_buffer ! Delete a buffer by name ($buffer_name) ! Deletes the named buffer (procedure name "eve_delete_buffer" conflicts with ! "eve_delete" routine, hence "destroy") ! ! Parameters: ! $buffer_name string name of the buffer to delete ! ! Qualifiers: ! /confirm boolean check before doing delete (this qualifier ! is checked by routine ! eve$destroy_buffer) ! ! Source: ! Eveplus local the_buffer, buffer_name; ! ! Get buffer name from the user ! if (not eve$prompt_string($buffer_name,buffer_name,"Destroy buffer: ", "Aborted...")) then return; endif; edit(buffer_name,upper); ! ! Get a handle on the buffer ! the_buffer := eveplus_find_buffer(buffer_name); if (the_buffer <> 0) then eve_destroy_buffer := eve$destroy_buffer(buffer_name, the_buffer); else message("No such buffer: " + buffer_name); return 0; endif; endprocedure; ! Page 5 procedure eve$destroy_buffer ! Delete a buffer ($the_name, $the_buffer) ! This routine actually destroys a specific buffer. ! ! Parameters: ! $the_name string name of the buffer ! $the_buffer buffer buffer to destroy ! ! Qualifiers: ! /confirm boolean check before doing delete ! ! Source: ! Eveplus local answer, problem, new_buffer, the_name; eve$destroy_buffer := FALSE; the_name := $the_name; edit(the_name,upper,trim); ! ! Come up with excuses not to use destroy the buffer ! 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 we found a problem then check with the user ! if (problem <> "") and abl$q_confirm then if not abl$prompt_word("/yes/no","",answer, the_name + " is a " + problem + "buffer; are you sure? ", "Aborted...") then return 0; endif; if answer = "no" then message("Aborted..."); return 0; endif; endif; ! ! Delete the buffer ! if (current_buffer <> $the_buffer) then delete($the_buffer); else new_buffer := get_info(buffers, "last"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "previous"); 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 delete($the_buffer); new_buffer:=create_buffer("Main"); map(eve$x_this_window,new_buffer); eve$update_status_lines; else delete ($the_buffer); endif; endif; eve$destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure ! Page 6 procedure eve_number_lines ! Number lines in a buffer or range ! Routine to add line numbers to a buffer; the entire buffer is numbered or ! a selected range if active. ! ! Qualifiers: ! /start integer starting with line number ! /increment integer line number increment ! /reset boolean reset select range when done ! ! Source: ! Eveplus local line_number, ! current line number line_number_range, ! select range if in use line_starting, ! line number of start of select range line_ending, ! line number of end of select range last_line_number; ! last line number (for select range) line_number := abl$q_start; ! ! Get select range if active ! line_number_range := 0; if eve$x_select_position<>0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message("Select range active but not in this buffer; not performing "+ "line number for range"); position(beginning_of(current_buffer)); else line_number_range := select_range; position(end_of(line_number_range)); line_ending := eve$what_line; position(beginning_of(line_number_range)); line_starting := eve$what_line; move_horizontal(-current_offset); last_line_number := ((line_ending - line_starting + 1) * abl$q_increment) + abl$q_start; endif; else position(beginning_of(current_buffer)); endif; loop if (((line_number / 250) * 250) = line_number) then message("Numbering line " + str(line_number)); endif; exitif (mark(none) = end_of(current_buffer)); exitif line_number = last_line_number; eve$insert_text(fao("!6UL ", line_number)); line_number := line_number + abl$q_increment; move_horizontal(-current_offset); move_vertical(1); endloop; if abl$q_reset then eve$x_select_position := 0 endif; endprocedure; ! Page 7 procedure eve$check_bad_window ! File and window commands ! Used before issuing window/buffer manipulation commands. Returns true if ! current window is message window, info window, or command window, in ! which case we may not want to do the command. In these cases, the ! cursor is repositioned to either the main window or the top window, ! depending on the value of eve$x_number_of_windows. This helps people ! who accidentally get stuck in one of these windows. The calling procedure ! determines the error message or other action. In other cases, ! returns false. ! ! Source: ! Eve if (current_window = message_window) or (current_window = eve$command_window) or (current_window = info_window) then if current_window = info_window then unmap (info_window); endif; position (eve$x_this_window); return (1); else return (0); endif; endprocedure; ! Page 8 procedure abl$expand_window_name ! Return matching window name variables (window_name) ! Returns window variable names (like EVE$W_window_name separated by spaces) ! whose window names match or start with window_name (like MAIN). ! ! Parameters: ! window_name string name of window(s) to look for ! ! Source: ! Eva2 local inf_msg, var_name, tmp_list, exp_list; on_error endon_error inf_msg:=get_info(system,"informational"); set(informational,off); var_name:="eve$w_"+window_name; tmp_list:=expand_name(var_name,variables)+" "; exp_list:=""; loop exitif length(tmp_list)<=1; x:=index(tmp_list," "); exp_name:=substr(tmp_list,1,x-1); tmp_list:=substr(tmp_list,x+1,length(tmp_list)); execute("if get_info("+exp_name+",'type')=WINDOW then"+ " abl$x:=1 else abl$x:=0 endif;"); if abl$x then exp_list:=exp_list+exp_name+" " endif; endloop; edit(exp_list,trim); if inf_msg then set(informational,on) endif; return exp_list; endprocedure ! Page 9 procedure eve_default_left_margin ! Sets the default left margin (set_parameter) ! Sets the default left margin for the edit session. Changes the left margin ! for all non-system buffers if /ALL specified. ! ! Parameters: ! set_parameter integer default left margin setting ! ! Qualifiers: ! /all boolean set all non-system buffers' left margin ! ! Globals: ! eve$x_default_left_margin integer current default left margin ! ! Source: ! Eva2 local buff, actual_right_margin, new_default_left_margin; ! Local copy of set_parameter ! ! Get setting from user ! if not eve$prompt_number(set_parameter, new_default_left_margin, "Set default left margin to: ", fao ("Default left margin unchanged, !SL", eve$x_default_left_margin ) ) then return; endif; ! ! Set the global variable ! eve$x_default_left_margin := new_default_left_margin; if abl$q_all then buff := get_info(buffers,"first"); loop exitif buff = 0; if not get_info(buff,"system") then if eve$x_default_right_margin >= 0 then set (margins, buff, eve$x_default_left_margin, get_info (eve$main_window, "width") - eve$x_default_right_margin); else set (margins, buff, eve$x_default_left_margin, -eve$x_default_right_margin); endif; endif; buff:=get_info(buffers,"next"); endloop; endif; message (fao ("Default left margin set to !SL", eve$x_default_left_margin )); endprocedure ! Page 10 procedure eve_default_right_margin ! Sets the default right margin (set_parameter) ! Sets the default right margin for the edit session. Changes the right margin ! for all non-system buffers if /ALL specified. ! ! Parameters: ! set_parameter integer default left margin setting ! ! Qualifiers: ! /all boolean set all non-system buffers' left margin ! ! Globals: ! eve$x_default_right_margin integer current default right margin ! ! Source: ! Eva2 local buff, new_default_right_margin; ! Local copy of set_parameter ! ! Get setting from user ! if not eve$prompt_number(set_parameter, new_default_right_margin, "Set default right margin to: ", fao ("Default right margin unchanged, !SL", eve$x_default_right_margin ) ) then return; endif; ! ! Set the global variable ! eve$x_default_right_margin:=new_default_right_margin; if abl$q_all then buff := get_info(buffers,"first"); loop exitif buff = 0; if not get_info(buff,"system") then if eve$x_default_right_margin >= 0 then set (margins, buff, eve$x_default_left_margin, get_info (eve$main_window, "width") - eve$x_default_right_margin); else set (margins, buff, eve$x_default_left_margin, -eve$x_default_right_margin); endif; endif; buff:=get_info(buffers,"next"); endloop; endif; message (fao ("Default right margin set to !SL", eve$x_default_right_margin )); endprocedure ! Page 11 procedure eve_default_tab_every ! Sets the default tab interval (set_parameter) ! Sets the default tab settings for the edit session. Changes the tab settings ! for all non-system buffers if /ALL specified. Does not support irregulary ! spaced tabs. ! ! Parameters: ! set_parameter integer tab interval ! ! Qualifiers: ! /all boolean set all non-system buffers' tab settings ! ! Source: ! Eva local buff, new_default_tab_every; ! Local copy of set_parameter if not eve$prompt_number( set_parameter, new_default_tab_every, "Set default tab every to: ", fao ("Default tab every unchanged, !SL", eve$x_default_tab_interval ) ) then return; endif; eve$x_default_tab_interval:=new_default_tab_every; if abl$q_all then buff := get_info(buffers,"first"); loop exitif buff = 0; if not get_info(buff,"system") then set(tab_stops,buff,eve$x_default_tab_interval); endif; buff:=get_info(buffers,"next"); endloop; endif; message (fao ("Default tab set to every !SL", eve$x_default_tab_interval )); endprocedure; ! Page 12 procedure eve_get_file($get_file_name) ! Read a file into a new buffer ! Reads an unread file into a new buffer or if the file has already been read, ! makes the buffer containing the file current. ! ! Parameters: ! $get_file_name string name of file to read ! ! Qualifiers: ! /confirm boolean confirm any action that might delete changes ! /again boolean re-read the same version of the file ! /recent boolean re-read the most recent version of the file ! /read_only boolean set the buffer no_write ! ! Source: ! Eve local get_file_name, ! Local copy of get_file_parameter temp_buffer_name, ! String for buffer name based on get_file_name file_search_result, ! Latest string returned by file_search temp_file_name, ! First file name string returned by file_search loop_buffer, ! Buffer currently being checked in loop 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 ans, ! Answer to "should I do this?" loop_window; on_error if error = tpu$_parsefail then message (fao ("Don't understand file name: !AS", get_file_name)); if eve$x_starting_up then eve$set_status_line (current_window); endif; return; endif; endon_error; ! ! Check windows and qualifier-compatibility ! if eve$check_bad_window then message ("Cursor has been moved to a text window; try command again"); return 0; endif; ! if abl$q_recent and abl$q_again then message("Conflicting qualifiers: can't specify both /RECENT and /AGAIN"); return 0; endif; ! ! Get filename to use ! if abl$q_again then get_file_name := get_info(current_buffer,"file_name"); else if abl$q_recent then get_file_name := get_info(current_buffer,"file_name"); get_file_name := substr(get_file_name,1,index(get_file_name,";")-1) + ";0"; else if not (eve$prompt_string ($get_file_name, get_file_name, "File to get: ", "No file specified")) then return 0; endif; endif; endif; ! ! Find all file specs that match ! file_search_result := file_search (eve$x_null); temp_file_name := eve$x_null; erase (eve$choice_buffer); loop file_search_result := file_search (get_file_name); exitif file_search_result = eve$x_null; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; ! ! Multiple files matched ! if get_info (eve$choice_buffer, "record_count") > 1 then ! ! If get_file is called from tpu$init_procedure, can't handle ! multiple choices, so set status line on main window and return ! if eve$x_starting_up then eve$set_status_line (current_window); endif; eve$display_choices (fao ("Ambiguous file name: !AS", get_file_name)); return; endif; ! ! See if we already have a buffer by that name ! if temp_file_name = eve$x_null then temp_buffer_name := file_parse (get_file_name, eve$x_null, eve$x_null, name) + file_parse (get_file_name, eve$x_null, eve$x_null, type); else temp_buffer_name := file_parse (temp_file_name, eve$x_null, eve$x_null, name) + file_parse (temp_file_name, eve$x_null, eve$x_null, type); endif; get_file_name := file_parse (get_file_name); loop_buffer := get_info (buffers, "first"); loop exitif loop_buffer = 0; if temp_buffer_name = get_info (loop_buffer, "name") then found_a_buffer := 1; exitif 1; endif; loop_buffer := get_info (buffers, "next"); endloop; ! ! If there is a buffer by that name, is it the exact same file? ! If so, switch to that buffer. Otherwise use a new buffer, ! asking for a new buffer name (null new name will abort). ! if found_a_buffer then if temp_file_name = eve$x_null then ! ! File not on disk...if output_file same as found buffer don't create ! a new buffer, else do ! if get_file_name = get_info (loop_buffer, "output_file") then want_new_buffer := 0; else want_new_buffer := 1; endif; else ! ! Check to see if the same file ! if (temp_file_name = get_info (loop_buffer, "output_file")) or (temp_file_name = get_info (loop_buffer, "file_name")) then want_new_buffer := 0; else want_new_buffer := 1; endif; endif; if want_new_buffer then message (fao ("Buffer name !AS is in use", temp_buffer_name)); temp_buffer_name := read_line ("Type a new buffer name or press Return to cancel: "); if temp_buffer_name = eve$x_null then message ("No new buffer created"); else new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); endif; else if abl$q_again or abl$q_recent then ! ! Re-read current buffer's file from disk...check with use if ! necessary ! if abl$q_confirm and get_info(loop_buffer,"modified") then if not abl$prompt_word("/yes/no","",ans, fao("Buffer !AS is modified," + " do you really want a new copy? ", get_info(current_buffer,"name")),"Aborted...") then return 0; endif; if ans = "no" then message("Aborted..."); return 0; endif; endif; ! ! Re-read the file ! position(loop_buffer); erase(loop_buffer); read_file(temp_file_name); position(beginning_of(loop_buffer)); ! ! Find the window assoc'd with this file and map it if necessary ! if get_info(loop_buffer,"map_count")=0 then map (current_window, loop_buffer); else loop_window:=get_info(windows,"first"); loop exitif get_info(loop_window,"buffer")=loop_buffer; loop_window:=get_info(windows,"next"); endloop; map(loop_window,loop_buffer); endif; message("Got " + temp_file_name + " again"); else if current_buffer = loop_buffer then message (fao ("Already editing file !AS", get_file_name)); else map (current_window, loop_buffer); endif; endif; endif; else ! ! No buffer with the same name, so create a new buffer ! new_buffer := eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name); endif; if new_buffer <> 0 then if abl$q_read_only then set(no_write,current_buffer) endif; endif; ! Correct the status line in any event eve$set_status_line (current_window); endprocedure; ! Page 13 procedure eve$create_buffer ! Create a new buffer (buffer_name, requested_file_name, actual_file_name) ! Procedure called by eve_get_file to create a new buffer and map it ! to the current window. Returns the created buffer, or zero if error. ! ! Parameters: ! buffer_name string name of new buffer ! requested_file_name string full VMS filespec to use ! actual_file_name string from file_search; "" if not on disk ! ! Source: ! Eve local new_buffer; ! Buffer created on_error if error = tpu$_dupbufname then message (fao ("Buffer !AS already exists", substr (buffer_name, 1, eve$x_max_buffer_name_length))); return (0); endif; endon_error; if actual_file_name = eve$kt_null then if eve$x_starting_up and (get_info (command_line, "create") = 0) then message (fao ("Input file does not exist: !AS", requested_file_name)); exit; endif; new_buffer := create_buffer (buffer_name); message (fao ("Editing new file; could not find !AS", requested_file_name)); set (output_file, new_buffer, requested_file_name); else new_buffer := create_buffer (buffer_name, actual_file_name); set (output_file, new_buffer, actual_file_name); endif; ! ! Set buffer's default settings ! set(tab_stops,new_buffer,eve$x_default_tab_interval); set (eob_text, new_buffer, abl$eob_text); if eve$x_default_right_margin > 0 then set (margins, new_buffer, eve$x_default_left_margin, get_info (eve$main_window, "width") - eve$x_default_right_margin); else set (margins, new_buffer, eve$x_default_left_margin, -eve$x_default_right_margin); endif; ! map (current_window, new_buffer); if eve$x_starting_up and get_info (command_line, "read_only") then set (no_write, new_buffer); endif; ! ! Call dummy procedure to handle buffer specific stuff ! eve$create_buffer_globals(new_buffer); ! return (new_buffer); endprocedure; ! Page 14 !Edit History: ! Jeff [1] make bufed terminal independent...used to only work ! on VT2xx terminals ! Jeff [2] add switch support for /all !+ ! BUFED.TPU - Routines to list, goto & delete buffers !- ! Page 15 ! 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 eve_list_buffers ! !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 ! ! eve_buffer("LIST BUFFER"); ! if get_info(current_buffer,"name")<>"LIST BUFFER" then ! message("Could not get to the LIST BUFFER...aborted"); ! return 0; ! endif; ! set(system, current_buffer); ! set(no_write, current_buffer); ! eve$update_status_lines; ! 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 ($$all 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("eve$sort_buffer")) then ! eve$sort_buffer(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 (not bufed_x_active) then ! set(informational,off); ! if get_info(screen,"vt100") then ![1] and next 10 lines ! eveplus_key("bufed_select_buffer", kp7, "select buffer", ! "bufed_select_key"); ! eveplus_key("bufed_remove_buffer", kp8, "remove buffer", ! "bufed_remove_key"); ! else ! eveplus_key("bufed_select_buffer", e4, "select buffer", ! "bufed_select_key"); ! eveplus_key("bufed_remove_buffer", e3, "remove buffer", ! "bufed_remove_key"); ! endif; ! set(informational,on); ! endif; ! 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; ! 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); ! eveplus_restore_key("bufed_select_key"); ! eveplus_restore_key("bufed_remove_key"); ! set(informational,on); ! bufed_x_active := FALSE; ! the_type := get_info(bufed_remove_key_pgm, "type"); ! if ((the_type = LEARN) or ! (the_type = PROGRAM) or ! (the_type = STRING)) then ! execute(bufed_remove_key_pgm); ! endif; ! return 0; ! else ! if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then ! if (eve_destroy_buffer(the_name)) 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 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; ! 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); ! eveplus_restore_key("bufed_select_key"); ! eveplus_restore_key("bufed_remove_key"); ! set(informational,on); ! bufed_x_active := FALSE; ! the_type := get_info(bufed_select_key_pgm, "type"); ! if ((the_type = LEARN) or ! (the_type = PROGRAM) or ! (the_type = STRING)) then ! execute(bufed_select_key_pgm); ! endif; ! else ! if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then ! eve_buffer(the_name); ! set(informational,off); ! eveplus_restore_key("bufed_select_key"); ! eveplus_restore_key("bufed_remove_key"); ! set(informational,on); ! 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; ! ! Page 16 procedure eve_other_window ! Switch editing windows ! Moves the cursor from one window to the next ! ! Qualifiers: ! /previous boolean search window list in reverse order ! ! Source: ! Eve local loop_window; eve$check_bad_window; loop_window:=get_info(windows,"current"); my_first_window:=loop_window; loop ! ! Get the next window, wrap around list if necessary ! if abl$q_previous then loop_window:=get_info(windows,"previous"); if loop_window = 0 then loop_window := get_info(windows,"last") endif; else loop_window:=get_info(windows,"next"); if loop_window=0 then loop_window:=get_info(windows,"first") endif; endif; ! ! Leave search loop if we've seen all windows ! exitif loop_window=my_first_window; ! ! If window starts above last two lines then that's the window we need ! if get_info(loop_window,"visible") then if get_info(loop_window,"visible_top") < get_info(screen,"visible_length")-1 then exitif 1 endif; endif; endloop; position(loop_window); if loop_window=my_first_window then message("Could not find another visible window"); endif; endprocedure; ! Page 17 procedure eve_set_autoindent($on_off) ! Change autoindent setting ! Turn on/off autoindenting. Autoindenting is performed by the eve$split_line ! routine. ! ! Parameters: ! $on_off string "on" or "off" ! ! Source: ! Eva2 local previous_setting, on_off; if abl$autoindent then previous_setting := "Autoindent unchanged, on" else previous_setting := "Autoindent unchanged, off" endif; if not abl$prompt_word("/on/off",$on_off,on_off, "Set autoindent on or off (on, off) []? ",previous_setting) then return 0; endif; if on_off = "on" then abl$autoindent := 1; message("Autoindent on"); else abl$autoindent := 0; message("Autoindent off"); endif; endprocedure ! Page 18 procedure eve_set_text($attribute) ! Change window's text display attrib ! Changes text attributes for the current window ! ! Parameters: ! $attribute string blank_tabs, graphic_tabs or no_translate ! ! Source: ! Eva2 local attribute; if not abl$prompt_word("/blank_tabs/graphic_tabs/no_translate",$attribute, attribute,"Set text (blank_tabs, graphic_tabs or no_translate) []? ", "Aborted...") then return 0 endif; execute("set(text,current_window,"+attribute+")"); endprocedure ! Page 19 procedure eve_set_write($lock_unlock) ! Change setting of buffer's write lock ! Allows/prevents a buffer to be written out at exit ! ! Paramters: ! $lock_unlock string lock/enable ! ! Source: ! Eveplus local buffer_name, lock_unlock; if not abl$prompt_word("/lock/unlock",$lock_unlock,lock_unlock, "Should this buffer be write-locked or write-unlocked (lock, unlock) []? ", "Aborted...") then return 0; endif; if lock_unlock = "unlock" then if (get_info (current_buffer, "system") = 0) then buffer_name := get_info(current_buffer,"name"); set(no_write, current_buffer, off); message("Buffer " + buffer_name + " is write-enabled"); eve$update_status_lines; endif; else if (get_info (current_buffer, "system") = 0) then buffer_name := get_info(current_buffer,"name"); set(no_write, current_buffer, on); message("Buffer " + buffer_name + " is write-locked"); eve$update_status_lines; endif; endif; endprocedure; ! Page 20 procedure eve_set_right_margin ! Change current buffers right margin (set_parameter) ! Changes the right margin of the current buffer. If margin is non-negative ! then the right margin is based on the screen width (screen width - ! - margin setting), else margin is absolute number. ! ! Parameters: ! set_parameter integer right margin setting ! ! Source: ! Eve 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; new_right_margin := -new_right_margin; current_left_margin := get_info (current_buffer, "left_margin"); if new_right_margin >= 0 then new_right_margin := get_info (eve$main_window, "width") - new_right_margin; else new_right_margin := -new_right_margin; endif; if new_right_margin <= current_left_margin then message ("Right margin must be greater than left margin " + fao ("(left margin is !SL) ", current_left_margin)); else if new_right_margin > eve$x_largest_right_margin then new_right_margin := eve$x_largest_right_margin; endif; set (margins, current_buffer, current_left_margin, new_right_margin); message (fao ("Right margin set to !SL", new_right_margin)); endif; endprocedure ! Page 21 procedure eve_set_scroll_factor ! Set scrolling factor (buffered scroll) ($factor) ! Sets the screen scrolling factor. A value of 0 will give no buffering zones ! when moving up and down; a value of 100 will buffer as often as possible ! ! Parameters: ! $factor integer factor for buffered scrolling ! ! Source: ! Eva2 local factor, buf, x; if not eve$prompt_number($factor,factor, "Scroll factor (0 = only when necessary, 100 = whenever possible) []? ", "Scroll factor unchanged, currently "+str(abl$scroll_factor)) then return 0; endif; if (factor>100) or (factor<0) then message("Scroll factor must be between 0 and 100"); return 0; endif; abl$scroll_factor := factor; loop_window:=get_info(windows,"first"); loop exitif loop_window=0; x:=get_info(loop_window,"original_length"); x:=((x * abl$scroll_factor/100)-1)/2; set(scrolling,loop_window,on,x,x,0); loop_window:=get_info(windows,"next"); endloop; message("Screen scroll factor = " + str(abl$scroll_factor)); return 1; endprocedure ! Page 22 procedure eve_set_eliminate_tabs ! Change elim-tabs-on-exit setting ($on_off) ! Turns tab-elimination-on-exit on or off ! ! Globals: ! abl$elimming boolean 1 if eliminating tabs at exit, otherwise 0 ! ! Source: ! Eva2 local unchanged_text, ! displayed if user doesn't change setting on_off; ! on or off from user ! ! Set unchanged text ! if abl$x_elimming then unchanged_text := "Eliminate tabs setting unchanged, on"; else unchanged_text := "Eliminate tabs setting unchanged, off"; endif; ! ! Get input from user ! if not abl$prompt_word("/on/off",$on_off,on_off, "Elminate tabs in all buffers at exit (on, off) []? ",unchanged_text) then return 0; endif; ! ! Set global ! if on_off = "on" then abl$x_elimming := 1; message("Eliminate tabs on"); else abl$x_elimming := 0; message("Eliminate tabs off"); endif; endprocedure ! Page 23 procedure eve_set_trim($on_off) ! Change trim-on-exit setting ! Turn default trimming on/off. When a buffer is written and default trimming ! is on, trimming will be done. ! ! Parameter: ! $on_off string on/off ! ! Source: ! Eva local no_change_message, on_off; if eve$x_trimming then no_change_message := "Trimming unchanged, on" else no_change_message := "Trimming unchanged, off" endif; if not abl$prompt_word("/on/off",$on_off,on_off, "Buffer trimming by default (on, off) []? ",no_change_message) then return 0; endif; if on_off = "on" then eve$x_trimming := 1; message("Buffer trimming on"); else eve$x_trimming := 0; message("Buffer trimming off"); endif; endprocedure ! Page 24 procedure eve_set_word_wrap ! Change hot-zone size (set_parameter) ! Changes the hot_zone_size for word wrap ! ! Parameters: ! set_parameters integer how close to right margin to wrap ! ! Source: ! Eva local new_word_wrap; ! Local copy of set_parameter if not eve$prompt_number( set_parameter, new_word_wrap, "Set word wrap to (number of columns): ", fao ("Word wrap unchanged, !SL", eve$x_hot_zone_size ) ) then return; endif; eve$x_hot_zone_size:=new_word_wrap; message (fao ("Word wrap set to !SL", eve$x_hot_zone_size )); endprocedure; ! Page 25 procedure eve_toggle_message !Toggle message window ! Maps/unmaps the info_window for quick reading of message buffer stuff ! ! Source: ! Eva if current_window=info_window then unmap(info_window) else map(info_window,message_buffer); endif; eve$update_status_lines; endprocedure ! Page 26 procedure eve_window($window_name_string) local cw, ! pointer to current_window exp_window_vars, scroll_amount, window_exists, window_name_string, window_name_fabricated, window_name_specified, window_var, vt, vl, x; on_error endon_error window_name_string := $window_name_string; ! ! Set up some useful variables ! cw:=current_window; window_exists:=false; window_name_specified:=false; window_name_fabricated:=false; edit(window_name_string,trim,upper); ! ! If window name not specified, then use current window's name ! if window_name_string="" then window_name_string:=get_info(cw,"status_line"); if window_name_string=0 then window_name_string:=""; else window_name_string:=substr(window_name_string,abl$window_name_start,255); edit(window_name_string,trim,upper); window_name_fabricated:=true; endif; else window_name_specified:=true; endif; ! ! Make window_var hold the name of the window's variable, ! determine whether or not window exists ! window_var:="EVE$W_"+window_name_string; exp_window_vars:=abl$expand_window_name(window_name_string); if index(exp_window_vars+" ",window_var+" ")=0 then else window_exists:=true; endif; ! ! Check /NEW and /OLD qualifiers ! if (abl$q_new) and (window_exists) then message("Window already exists"); return; endif; if (abl$q_old) and not window_exists then message("Window does not exist"); return; endif; ! ! List windows ! if abl$q_list then if not window_exists then message("No windows match") else message("This feature not implemented yet"); endif; return; endif; ! ! Delete named window ! if abl$q_delete then if not window_exists then message("No window to delete") else execute("delete("+window_var+")"); message("Window "+window_name_string+" deleted"); endif; if current_window=eve$command_window then abl$do("eve_other_window",""); endif; eve$update_status_lines; return; endif; ! ! Unmap named window ! if abl$q_unmap then if not window_exists then message("No window to unmap") else execute("unmap("+window_var+")"); message("Window "+window_name_string+" unmapped"); endif; if current_window=eve$command_window then eve_other_window; endif; eve$update_status_lines; return; endif; vt:=get_info(cw,"visible_top"); vl:=get_info(cw,"visible_length"); !includes status line if (not window_exists) or (abl$q_split) then if window_name_string="" then message("Must specify a window name; couldn't make one"); return; endif; if abl$q_split then if vl<4 then message("Don't want to split this; too little"); return; endif; if not window_name_specified then loop window_name_string:=window_name_string+"_"; window_var:="EVE$W_"+window_name_string; exitif index(expand_name(window_var,variables)+" ", window_var+" ")=0; execute("if get_info("+window_var+",'type')=unspecified then "+ "abl$x:=1 else abl$x:=0 endif"); exitif abl$x=1; endloop; window_exists:=false; endif; ! abort; abl$q_top:=vt+(vl/2); abl$q_length:=(vl+1)/2; else if abl$q_top<>0 then if (abl$q_rtop<>0) then message("Specify one of /top or /rtop"); return; endif; else abl$q_top:=vt+abl$q_rtop; endif; if abl$q_length<>0 then if (abl$q_bottom<>0) or (abl$q_rbottom<>0) then message("Specify one of /bottom, /rbottom, or /length"); return; endif; else if abl$q_bottom<>0 then if (abl$q_rbottom<>0) then message("Specify one of /bottom, /rbottom, or /length"); return; else abl$q_length:=abl$q_bottom-abl$q_top+1; endif; else abl$q_length:=vl+vt+abl$q_rbottom-abl$q_top; endif; endif; endif; if (abl$q_top<1) or (abl$q_top>22) then message("Top of window needs to be in the range 1 to 22"); return; endif; if abl$q_top+abl$q_length-1>22 then message("Window would cover Eve command prompt, shortened"); abl$q_length:=22-abl$q_top; endif; if abl$q_length<2 then message("Window needs to be 2 lines or longer"); return; endif; execute(window_var+":=create_window("+str(abl$q_top)+ ","+str(abl$q_length)+",on)"); execute("map("+window_var+",current_buffer)"); execute("set(status_line,"+window_var+",none,substr(eve$x_spaces,1,"+ str(abl$window_name_start-1)+")+'"+window_name_string+"')"); scroll_amount := ((abl$q_length * abl$scroll_factor/100)-1)/2; execute("set(scrolling,"+window_var+",on,"+str(scroll_amount)+","+ str(scroll_amount)+",0);"); eve$update_status_lines; return; else execute("if get_info("+window_var+",'buffer')<>0 then "+ "abl$x:=1 else abl$x:=0 endif;"); if abl$x=1 then execute("map("+window_var+",get_info("+window_var+",'buffer'))"); else execute("map("+window_var+",current_buffer)"); endif; if abl$q_top + abl$q_bottom + abl$q_rtop +abl$q_rbottom + abl$q_length + abl$q_original = 0 then else if abl$q_original then abl$q_rtop := get_info(cw,"original_top") - get_info(cw,"visible_top"); abl$q_rbottom := (get_info(cw,"original_top") + get_info(cw,"original_length")) - (get_info(cw,"visible_top") + get_info(cw,"visible_length")); else if abl$q_rtop<>0 then if abl$q_top<>0 then message("Specify one of /top or /rtop"); return; endif; else if abl$q_top<>0 then abl$q_rtop:=abl$q_top-vt endif; endif; if abl$q_rbottom <> 0 then if (abl$q_bottom <> 0) or (abl$q_length <> 0) then message("Specify one of /bottom, /rbottom, or /length"); return; endif; else if abl$q_bottom <> 0 then if abl$q_length <> 0 then message("Specify one of /bottom, /rbottom, or /length"); return; else abl$q_rbottom := abl$q_bottom - (vt+vl-1); endif else if abl$q_length<>0 then abl$q_rbottom := abl$q_length-vl endif; endif; endif; if vt+abl$q_rtop < 1 then message("Top window boundary out of range, altered"); abl$q_rtop := 1-vt; endif; if vt+vl-1+abl$q_rbottom > 22 then message("Bottom window boundary out of range, altered"); abl$q_rbottom := 22-(vt+vl-1); endif; if (vt+vl-1+abl$q_rbottom)-(vt+abl$q_rtop)+1<2 then message("Window needs to be 2 lines or longer"); return; endif; endif; adjust_window(cw,abl$q_rtop,abl$q_rbottom); scroll_amount := get_info(cw,"original_length"); scroll_amount := ((scroll_amount * abl$scroll_factor/100)-1)/2; set(scrolling,cw,on,scroll_amount,scroll_amount,0); endif; endif; eve$update_status_lines; endprocedure ! Page 27 procedure eve_write_file ($file) ! Write current buffer to file ! Write the current buffer to a specified file. If no file specified, ! use the default file name. ! ! Parameters: ! write_file_name string file name to use ! ! Qualifiers: ! /trim_whitespace string "yes", "no", "default" ! /eliminate_tabs boolean "yes", "no", "default" ! /reset boolean reset select range when done ! /remove boolean remove select range when done ! ! Source: ! Eve local file, ! file name to write to this_position, ! user's starting position remove_range, ! range to write if using select range write_result; ! file string returned by write_file on_error message("Error writing file: "+write_result); file:=""; set(output_file,current_buffer,file); return 0; endon_error ! ! Do trimming and elimming if user wants to ! if not abl$prompt_word("/yes/no/default",abl$q_eliminate_tabs, abl$q_eliminate_tabs, "Eliminate tabs before writing (yes, no, default) [default]? ", "") then abl$q_eliminate_tabs := "default"; endif; if (abl$q_eliminate_tabs = "yes") or ((abl$q_eliminate_tabs = "default") and (abl$x_elimming)) then abl$do("eve_eliminate_tabs","abl$q_log := 1"); endif; ! if not abl$prompt_word("/yes/no/default",abl$q_trim_whitespace, abl$q_trim_whitespace, "Trim whitespace before writing (yes, no, default) [default]? ", "") then abl$q_trim_whitespace := "default"; endif; if (abl$q_trim_whitespace = "yes") or ((abl$q_trim_whitespace = "default") and (eve$x_trimming)) then abl$do("eve_trim_buffer","abl$q_log := 1"); endif; if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message("Write select range must be used in the same buffer as Select"); return 0; endif; if not eve$prompt_string($file,file,"File to write to: ","No file written") then message("Aborted..."); return 0; endif; this_position := mark (none); remove_range := select_range; ! ! If select & remove in same spot then ! if remove_range = 0 then ! ! If at end-of-buffer then error else create 1 char range ! if this_position = end_of (current_buffer) then message ("Nothing to write"); return 0; else remove_range := create_range(mark(none),mark(none),none); endif; endif; write_file(remove_range,file); position (this_position); if abl$q_remove then erase(remove_range) endif; if abl$q_reset then eve$x_select_position := 0; remove_range := 0; endif; else !whole file if $file = eve$x_null then write_result := write_file (current_buffer); else write_result := write_file (current_buffer,$file) endif; if write_result<>"" then set (output_file, current_buffer, write_result) endif; endif; endprocedure ! Page 28 ! ! !!+ !! 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. ! ! Page 29 procedure eve_exit ! Leave Eve ! Exit Eve. Write the current buffer if modified, and ask the user ! about writing out any other modified buffers. ! ! Source: ! Eve local exit_buffer, ! Current buffer being checked for writing exit_buffer_name, ! String with name of exit_buffer orig_buffer; on_error ! Lots of different errors possible from write_file, doesn't matter here set (success, on); message (fao ("Will not exit; could not write buffer !AS", exit_buffer_name)); position(orig_buffer); return; endon_error; orig_buffer:=current_buffer; message (eve$kt_null); exit_buffer_name := eve$kt_null; exit_buffer := current_buffer; if (get_info (exit_buffer, "modified")) and (not (get_info (exit_buffer, "no_write"))) then if eve$x_trimming then abl$do("eve_trim_buffer", "abl$q_log := 1") endif; if abl$x_elimming then abl$do("eve_eliminate_tabs","abl$q_log := 1") endif; write_file (exit_buffer); set (no_write, exit_buffer); endif; exit_buffer := get_info (buffers, eve$kt_first); loop exitif exit_buffer = 0; if (get_info (exit_buffer, "modified")) and (not (get_info (exit_buffer, "no_write"))) then exit_buffer_name := substr (get_info (exit_buffer, eve$kt_name), 1, eve$x_max_buffer_name_length); if eve$insist_y_n (fao ("Write buffer !AS? ", exit_buffer_name)) then position(exit_buffer); if eve$x_trimming then abl$do("eve_trim_buffer","abl$q_log := 1") endif; if abl$x_elimming then abl$do("eve_eliminate_tabs","abl$q_log := 1") endif; write_file (exit_buffer); endif; set (no_write, exit_buffer); endif; exit_buffer := get_info (buffers, "next"); endloop; ! Avoid "editor successfully exiting" message - on_error will restore ! success messages set (success, off); exit; endprocedure;