! STP_MISC.TPU ! This module contains miscellaneous routines for the ! SETPOINT Text Processor package. ! procedure stp_misc_module_ident return "V1.0" endprocedure procedure stp_misc_module_init endprocedure; !+ ! This routine will prompt the user before eve exits to make ! sure which kind of exiting he wants to do. !- procedure stp_exit_handler local answer; answer := eve$key_name(eve$prompt_key( "A)ttach, E)xit, C)ancel, Q)uit: ")); edit(answer,UPPER); ! Insure upper case CASE answer from "A" to "Q" ["A"] : eve_attach(""); ["C"] : message ("Exit cancelled."); ["E"] : eve$exit; ["Q"] : eve$quit; [INRANGE] : message ("Invalid entry; Use F10 to exit without questions"); [OUTRANGE] : message ("Invalid entry; Use F10 to exit without questions"); endcase; return(true); endprocedure !+ ! Splits the current window if there is only one editing ! window present. If there is already more than one editing ! window present, then it executes EVE_ONE_WINDOW to which the ! current editing window to be the only window seen. !- procedure eve_toggle_num_windows if (eve$x_number_of_windows > 1) then eve_one_window else eve_split_window endif; endprocedure !+ ! Routine to remove tabs assuming SET TABS EVERY 8 !-! procedure eve_eliminate_tabs ! Turn TABs to spaces local target, n,saved_mode,saved_pos; message("Eliminating tabs from cursor position to end of file."); saved_pos := mark(none); saved_mode := rect_set_mode(INSERT); loop target := search_quietly(ascii(9), FORWARD); exitif (target = 0); position(beginning_of(target)); erase_character(1); n := current_offset; n := n - (8 * (n / 8)); copy_text(substr(" ", 1, 8 - n)) endloop; set(saved_mode,current_buffer); position(saved_pos); message("Eliminated tab characters and replaced with spaces."); endprocedure !+ ! Procedure deletes text from current location up to and including a ! target string given as a parameter. !- procedure eve_zap(the_arg) local the_target, ! Character to zap to the_range, ! Range containing text to zap zap_start, zap_end; ! Start and end of region to delete. on_error eve$learn_abort; return(FALSE); endon_error; if not (eve$prompt_string (the_arg,the_target,"Zap to what string: ", "Zap aborted.")) then eve$learn_abort; return(FALSE); endif; zap_start := mark(none); ! Remember start zap_end := end_of(search(the_target,forward)); the_range := create_range(zap_start,zap_end,none); position(paste_buffer); erase(paste_buffer); move_text(the_range); position(zap_start); update(current_window); endprocedure !+ ! Trims the current buffer of trailing spaces. !- procedure eve_trim_buffer message("Trimming buffer..."); eve$trim_buffer(current_buffer); message("Buffer trimmed of trailing spaces."); endprocedure !+ ! Positions the cursor to the desired column on a line. Given no argument, ! simply reports column position. ! ! Modifications: ! ! Paul Boudreaux, Setpoint, Inc. July, 1988 ! Now displays the current column plus its absolute column. ! Also, If a selection is active, it displays its width. !- procedure eve_column(column_parameter) local the_column, ans, save_it, desired, the_width, select_message, offset, select_col, select_pos; on_error message("Error at line: "+str(error_line)); abort; endon_error; if (column_parameter = "") then if ((eve$x_select_position <> 0) or (rect_select_anchor <> 0)) then If (eve$x_select_position = 0) then select_message := " Rectangular selection includes: "; select_pos := rect_select_anchor; offset := 1; else select_message := " Selection begins: "; select_pos := eve$x_select_position; offset := 0; endif; save_it := mark(none); position(select_pos); select_col := rect_current_column; position(save_it); the_width := rect_current_column + get_info(current_window,"shift_amount") - select_col; if (the_width < 0) then the_width := -the_width; select_message := select_message + str(the_width + offset) + " columns to the right"; else select_message := select_message + str(the_width + offset) + " columns to the left"; endif; else select_message := ""; endif; message("Current column: " + str(rect_current_column) + select_message); else desired := int(column_parameter); if desired <= 0 then message("Column number must be positive"); endif; the_column := rect_current_column; if desired < the_column then cursor_horizontal(desired - the_column); else save_it := mark(none); cursor_horizontal(desired - the_column); if get_info(current_window,"beyond_eol") then message("That would move cursor beyond end of line."); ans := eve$insist_y_n("Extend line? [Y/N]"); if (ans = eve$x_no) then position(save_it); endif; endif; endif; update(current_window); ! To force column info to be current endif; endprocedure; !+ ! FIX_CRLFS.TPU - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs !- procedure eve_fix_crlfs LOCAL the_range; on_error if (ERROR <> tpu$_STRNOTFOUND) then message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE)); return; endif; endon_error; ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13)+ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Next remove naked LFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Finally, remove naked CRs. If they are not at the BOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13), FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then split_line; endif; erase(the_range); endloop; endprocedure !+ ! Add word separators to the list of defined ones !- procedure eve_set_word_separators(the_arg) local add_chars; on_error eve$learn_abort; return(false); endon_error; eve$prompt_string (the_arg,add_chars,"Word separators to add: ",""); eve$add_word_separators (add_chars); message(fao("Word separators are: !AS",eve$read_word_separators)); endprocedure !+ ! Remove word separator parameters !- procedure eve_set_noword_separators(the_arg) local remove_chars, ptr, ptr2, new_separators, the_separator; on_error eve$learn_abort; return(false); endon_error; eve$prompt_string (the_arg,remove_chars, "Remove what word separator characters: ",""); new_separators := eve$read_word_separators; if (remove_chars <> '') then ptr := 1; loop exitif (ptr > length(remove_chars)); the_separator := substr(remove_chars, ptr, 1); loop ptr2 := index(new_separators,the_separator); exitif ptr2 = 0; new_separators := substr(new_separators,1, ptr2-1) + substr(new_separators,ptr2+1, length(new_separators)-ptr2) endloop; ptr := ptr + 1 endloop endif; eve$replace_word_separators(new_separators); message(fao("Word separators are: !AS",eve$read_word_separators)); endprocedure procedure eve_normal_word_separators eve$restore_word_separators; message(fao("Word separators are: !AS",eve$read_word_separators)) endprocedure procedure eve_programmer_word_separators eve$add_word_separators("""',./\[]{}()_<>:;|*=+-"); message(fao("Word separators are: !AS",eve$read_word_separators)) endprocedure eve$$require ("eve$core"); ! Build dependencies eve$$require ("eve$file"); eve$$require ("eve$format"); eve$$require ("eve$extend"); eve$$require ("eve$edit"); eve$$require ("eve$advanced"); eve$$require ("eve$help"); eve$$require ("eve$edt"); ! eve$$require ("stp_rectangle");