!+ ! BUFED.TPU - Routines to list, goto & delete buffers !- procedure eve_list_buffers ! List non-system buffers bufed_list_buffers(FALSE) endprocedure procedure eve_list_all_buffers ! List system and non-system buffers bufed_list_buffers(TRUE) endprocedure procedure eve_destroy_buffer(the_name) ! Delete a buffer by name local the_buffer, buffer_name; if (not eve$prompt_string(the_name, buffer_name, "Delete buffer: ", "Cancelled")) then return; endif; the_buffer := eveplus_find_buffer(buffer_name); if (the_buffer <> 0) then bufed_destroy_buffer(buffer_name, the_buffer); else message("No such buffer: " + buffer_name); endif; endprocedure; ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT and REMOVE keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! procedure bufed_list_buffers(show_system) ! Build the buffer list local last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed temp; ! Used to build the record count as a string eve_buffer("LIST BUFFER"); set(system, current_buffer); set(no_write, current_buffer); erase(current_buffer); message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); if (show_system or (get_info(the_buffer, "system") = 0)) then split_line; eveplus_insert_text(" "); eveplus_insert_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then eveplus_insert_text(""); else loop exitif (current_offset > 33); eveplus_insert_text(" "); endloop; endif; eveplus_insert_text(temp); if (get_info(the_buffer, "modified")) then eveplus_insert_text("Modified "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "no_write")) then eveplus_insert_text("No-write "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "system")) then eveplus_insert_text("System "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "permanent")) then eveplus_insert_text("Permanent"); else eveplus_insert_text(" "); endif; temp := current_line; move_horizontal (-current_offset); erase (create_range (mark (none), end_of (current_buffer), none)); edit (temp, trim_trailing); copy_text (temp); endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; if (eveplus_defined_procedure("eveplus_sort")) then message("Sorting buffer list"); execute('eveplus_sort ( current_buffer , "" ); '); endif; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly("", FORWARD); exitif (temp = 0); position(temp); erase(temp); eveplus_insert_text(" -"); split_line; eveplus_insert_text(" "); endloop; position(beginning_of(current_buffer)); eveplus_insert_text(" Buffer name Lines Attributes"); split_line; position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); if (not bufed_x_active) then set(informational,off); eveplus_key("bufed_select_buffer", e4, "select buffer", "bufed_select_key"); eveplus_key("bufed_remove_buffer", e3, "remove buffer", "bufed_remove_key"); 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; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then if (bufed_destroy_buffer(the_name, the_buffer)) then move_horizontal(-current_offset); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-current_offset); erase_line; else move_horizontal(-current_offset); endif; erase_line; endif; endif; endif; endprocedure ! This routine actually destroys a specific buffer. ! ! Inputs: ! the_name The name of the buffer (display only) ! the_buffer Pointer to the buffer to destroy ! procedure bufed_destroy_buffer(the_name, the_buffer) ! Delete a buffer local answer, problem, new_buffer; bufed_destroy_buffer := FALSE; problem := ""; if ((get_info(the_buffer, "modified")) and (get_info(the_buffer, "record_count") <> 0)) then problem := "modified "; endif; if (get_info(the_buffer, "system")) then problem := problem + "system "; endif; if (problem <> "") then answer := read_line(substr(the_name, 1, 32) + " is a " + problem + "buffer. Are you sure? "); change_case (answer, lower); if ((length (answer) = 0) or (answer <> substr ("yes", 1, length (answer)))) then message("No buffer deleted."); return; endif; endif; if (current_buffer <> the_buffer) then delete(the_buffer); else new_buffer := get_info(buffers, "first"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "next"); endloop; if (new_buffer = 0) then eve_buffer("Main"); else eve_buffer(get_info(new_buffer, "name")); endif; if (get_info (the_buffer, "name") = "MAIN") then erase (the_buffer); else delete (the_buffer); endif; endif; bufed_destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure; ! This routine is temporarily bound to the SELECT. It puts you in ! the buffer listed on the current line, and restores the original ! meanings of the SELECT and REMOVE keys. It only works in the ! "LIST BUFFERS" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT and REMOVE keys, ! and executes the code originally associated with SELECT. ! procedure bufed_select_buffer ! Goto the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! 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; procedure tpu$local_init ! BufEd init procedures. bufed_x_active := FALSE; bufed_select_key_pgm := compile("message('Key not defined');"); bufed_remove_key_pgm := compile("message('Key not defined');"); eve$arg1_destroy_buffer := eve$arg1_buffer; endprocedure tpu$local_init;