! ABEL_SEAREP.TPU ! ! Table of Contents as of 27-Mar-1988 ! ! Procedure name Page Description ! -------------- ---- ----------- ! ! abl$extended_find 1 Extended search routine ! eve_search 2 Wild-card search procedure ! eveplus_build_pattern 3 Makes pattern from wildcard string ! eve_tsearch 4 Native TPU search ! eve_substitute 5 Replaces the replace routine ! eve_scramble 6 Scramble a buffer based on given key ! eve_unscramble 6 Unscramble buffer based on key ! abl$cryptic_ascii 6 Generate a cryptic ascii char set ! eve_eliminate_tabs 7 Turn TABs to spaces ! eve_fix_crlfs 8 Fix carriage-return/line-feed 's ! eve_trim_buffer 9 Remove trailing whitespace on lines ! Page 1 procedure abl$extended_find ! Extended search routine (target,replacing,case_sensitive,hunt) ! Abel's extended search routine ! ! Parameters: ! target str/pat the string or pattern to search for ! replacing boolean should current position be considered? ! case_sen... boolean search case sensitive? ! hunt boolean if not found in current direction, look ! in the other direction, too? ! ! Source: ! Eva2 local ans, here, found; on_error endon_error if target="" then return 0 endif; here:=mark(none); if not replacing then if current_direction=forward then move_horizontal(1) else move_horizontal(-1) endif; endif; if case_sensitive then found:=search(target,current_direction,exact) else found:=search(target,current_direction,no_exact) endif; if (found=0) then position(here); if hunt then if current_direction=forward then set(reverse,current_buffer) else set(forward,current_buffer) endif; eve$update_status_lines; if not replacing then if current_direction=forward then move_horizontal(1) else move_horizontal(-1) endif; endif; if case_sensitive then found:=search(target,current_direction,exact) else found:=search(target,current_direction,no_exact) endif; if found=0 then if not replacing then if get_info(target,"type")=pattern then message("Didn't find pattern") else message("Didn't find "+'"'+target+'"'); endif; endif; position(here); if current_direction=forward then set(reverse,current_buffer) else set(forward,current_buffer) endif; eve$update_status_lines; else ans:=read_line("Found in other direction, go there [yes]? "); edit(ans,trim,lower); ans:=substr(ans,1,1); if ans<>"n" then position(found) else position(here); eve_change_direction; endif; endif; else if not replacing then if get_info(target,"type")=pattern then message("Didn't find pattern") else message("Didn't find "+'"'+target+'"'); endif; endif; endif; else position(found); endif; return(found); endprocedure ! Page 2 procedure eve_search($target_text) ! Wild-card search procedure ! Replacement for Eve's Find ! ! Parameters: ! $target_text str/pat string or pattern to search for ! ! Qualifiers: ! /previous boolean re-use previous search pattern; takes precedence ! over other qualifiers or parameters ! /prompt boolean take input from user (otherwise paste buffer) ! /ascii boolean treat string as numeric list of ascii chars ! /wildcard boolean process string for wildcards ! /case_sensitive boolean search should be case sensitive ! /hunt boolean if not found in current direction look in other ! ! Globals: ! abl$search_pattern pattern previous search pattern ! abl$search_text string previous text that generated above ! ! Source: ! Eveplus and Eva2 local target_prompt, ! string to prompt user for input target_text, ! user's input string, also used for ! "Searching for..." message target_text2, ! target_text after /ASCII massage target_pattern, ! target_text2 after /WILDCARD massage orig_buffer; ! ptr to user's buffer ! ! Get previous search out of the way ! if abl$q_previous then if abl$search_pattern = "" then message("No previously defined pattern; aborting"); return 0; else message("Searching again for " + abl$search_text); abl$extended_find (abl$search_pattern,false,abl$q_case_sensitive,abl$q_hunt); return 1; endif; endif; ! ! New search processing... ! if abl$q_prompt then ! ! Get input from user ! target_text := $target_text; ! local copy of target edit(target_text,trim); if target_text = "" then ! ! Make prompt string ! if current_direction = forward then if abl$q_wildcard then target_prompt := "Forward wildcard search: " else target_prompt := "Forward search: " endif; else if abl$q_wildcard then target_prompt := "Reverse wildcard search: " else target_prompt := "Reverse search: " endif; endif; ! ! Prompt for target string ! target_text := read_line(target_prompt); ! ! If no text entered and return pressed then abort ! if (target_text = "") and (last_key = RET_KEY) then message("Aborted..."); return 0; endif; ! ! If not text entered and some other key pressed, find previous ! search pattern again ! if target_text = "" then if abl$search_pattern = "" then message("No previously defined pattern; aborting"); return 0; else message("Searching again for " + abl$search_text); abl$extended_find(abl$search_pattern,false, abl$q_case_sensitive,abl$q_hunt); return 1; endif; endif; endif; else ! ! Get input from paste buffer ! orig_buffer:=current_buffer; position(beginning_of(paste_buffer)); target_text := erase_line; position(orig_buffer); if target_text = "" then message("No search string found in Insert Here buffer"); return 0; endif; endif; ! ! If ascii character values, translate to string ! Massage target_text for "Searching for..." message ! if abl$q_ascii then if not abl$ascii(target_text,target_text2) then message("Error in list of ascii character values"); return 0; endif; target_text := "ascii character(s): " + target_text; else target_text2 := target_text; target_text := '"' + target_text + '"'; endif; if abl$q_wildcard then ! ! User wants to treat string as having wildcards ! if eveplus_build_pattern(target_text2, target_pattern) then ! ! If there were wildcards, then ... ! execute( "abl$search_pattern := " + target_pattern +";" ); else ! ! Otherwise, treat as a non-wildcarded ! abl$search_pattern := target_pattern; endif; else ! ! Non-wildcarded ! abl$search_pattern := target_text2; endif; abl$search_text := target_text; message("Searching for " + abl$search_text); abl$extended_find(abl$search_pattern,false,abl$q_case_sensitive,abl$q_hunt); endprocedure ! Page 3 procedure eveplus_build_pattern ! Makes pattern from wildcard string ( input_string, result_string ) !+ ! Build a pattern for pattern searching. Pattern characters are: ! ! < - beginning of line ! > - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! # - multi-character wildcard, cross record boundaries ! \ - quote next character ! ^ - next char. is ctrl character ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. !- ! Support non-compose-key terminals ! ! Source: ! Eveplus local s1, s2, i, j, c, quote_next, ctrl_next, match_started, pat, bol, ! add bol and eol eol; s1 := ""; s2 := ""; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; pat := ""; bol:="<"; eol:=">"; !+ ! Process each character in the input string !- loop exitif i > length(input_string); c := substr(input_string, i, 1); !+ ! Do quoting if we're supposed to !- if quote_next = 1 then if c = "'" then s1 := s1 + "''" else s1 := s1 + c endif; s2 := s2 + c; i := i + 1; quote_next := 0 else !+ ! Do CTRL/n quoting if we're supposed to !- if ctrl_next = 1 then change_case(c, upper); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1); s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 else !+ ! A normal character or wildcard !- case c from '' to 'ÿ' ['\']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['^']: !+ ! CTRL next character !- ctrl_next := 1; i := i + 1; ['<']: !+ ! Begin-of-line !- ! if (c='<') then ![1] ! !+ ![1] and next 20 lines ! ! Just an ordinary character ! !- ! s1 := s1 + c; ! s2 := s2 + c; ! i := i + 1; ! else if match_started then pat := pat + "')"; match_started := 0 endif; if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; pat := pat + "& line_begin"; i := i + 1; ! endif; ['>']: !+ ! End-of-line !- ! if not(get_info(screen,"vt100")) and (c='<') then ![1] ! !+ ![1] and next 20 lines ! ! Just an ordinary character ! !- ! s1 := s1 + c; ! s2 := s2 + c; ! i := i + 1; ! else if match_started then pat := pat + "')"; match_started := 0 endif; if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; pat := pat + "& line_end"; i := i + 1; ! endif; ['#']: !+ ! General match, crossing record boundaries. ! ! Start by eating all following wildcards. !- if match_started then pat := pat + "')"; match_started := 0 endif; loop exitif i > length(input_string); exitif index(bol+eol+'*#%', substr(input_string, i, 1)) = 0; i := i + 1 endloop; !+ ! Ignore the wildcard if at end-of-pattern string !- if i <= length(input_string) then !+ ! Get the stop character (which may be quoted) !- case substr(input_string, i, 1) from '' to 'ÿ' ['\']: if i = length(input_string) then c := ascii(0) else c := substr(input_string, i+1, 1) endif; ['^']: if i = length(input_string) then c := ascii(0) else c := substr(input_string, i+1, 1); change_case(c, upper); c := ascii(index("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1) endif; [inrange]: c := substr(input_string, i, 1) endcase; !+ ! Double it if apostrophe !- if c = "'" then c := "''" endif; !+ ! Put it in the pattern !- if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; pat := pat + "& scanl('" + c + "')" endif; ['*']: !+ ! General wildcard, not crossing record boundaries ! ! Eat following * and % !- if match_started then pat := pat + "')"; match_started := 0 endif; loop exitif i > length(input_string); exitif index('*%', substr(input_string, i, 1)) = 0; i := i + 1 endloop; !+ ! Use REMAIN if at end of input_string !- if i > length(input_string) then if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; pat := pat + "& remain" else !+ ! Ignore * if followed by # !- if substr(input_string, i, 1) <> "#" then if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; !+ ! Use REMAIN if bol or eol follows !- if (substr(input_string, i, 1) = bol) or (substr(input_string, i, 1) = eol) then pat := pat + "& remain" else !+ ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. !- pat := pat + "& match('"; match_started := 1 endif endif endif; ['%']: !+ ! Single-character wildcard. ! ! Start by counting consecutive %s !- j := 0; loop exitif i > length(input_string); exitif substr(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 endloop; !+ ! Put it in the pattern !- if length(s1) > 0 then pat := pat + "& '" + s1 + "'"; s1 := "" endif; pat := pat + "& arb(" + str(j) + ")"; ["'"]: !+ ! Apostrophes must be doubled in STR1 !- s1 := s1 + "''"; s2 := s2 + "'"; i := i + 1; [inrange]: !+ ! Just an ordinary character !- s1 := s1 + c; s2 := s2 + c; i := i + 1; endcase; endif; endif; endloop; !+ ! Empty out STR1 !- if (length(s1) > 0) and (length(pat) > 0) then if match_started then pat := pat + s1 + "')" else pat := pat + "& '" + s1 + "'" endif endif; !+ ! Return either a string or a pattern string !- if length(pat) > 0 then result_string := substr(pat, 3, length(pat) - 2); return 1 else result_string := s2; return 0 endif; endprocedure ! Page 4 procedure eve_tsearch($user_text) ! Native TPU search ! Allows more advanced TPU'ers to get to TPU's native search commands... ! Still a rather crude routine. ! ! Parameters: ! $user_text string TPU pattern built-ins ! ! Qualifiers: ! /prompt boolean take input from screen (else paste buffer) ! /previous boolean use previous search criteria; takes precedence ! over /prompt or command line parameter ! ! Globals: ! abl$tsearch_pattern pattern previous complied search pattern ! abl$tsearch_text string previous TPU commands to generate above ! ! Source: ! Eva2 local cur_buf, cur_dir, starting_position, user_text, previous_text; on_error if error = tpu$_executefail then message("Pattern compile failed; see Message buffer for further"+ " information") else message('Pattern '+abl$tsearch_text+' not found'); position(starting_position); endif; set(informational,on); return 0; endon_error; set(informational,off); cur_buf := current_buffer; cur_dir := current_direction; starting_position := mark(none); if abl$q_previous then ! ! if no previous search pattern then error ! if abl$tsearch_pattern = "" then message("No previously defined pattern; aborting"); return 0; ! ! else use previous search criteria ! else message("Using " + abl$tsearch_text); endif; else if abl$q_prompt then ! ! prompt user for input without giving 'no value' message ! if value entered then... ! if eve$prompt_string($user_text, user_text, "Tsearch pattern: ", "") then ! ! use that value ! execute('abl$tsearch_pattern:='+user_text+';'); abl$tsearch_text:=user_text; ! ! else if no value entered ! else ! ! if last key pressed was return then abort ! if last_key = ret_key then message("Aborted..."); return 0; ! ! else ! else ! ! if no previous search pattern then error ! if abl$tsearch_pattern = "" then message("No previously defined pattern; aborting"); return 0; ! ! else use previous search criteria ! else message("Using " + abl$tsearch_text); endif; endif; endif; else ! ! Take input from paste buffer ! position(beginning_of(paste_buffer)); user_text := erase_line; position(cur_buf); edit(user_text,trim); ! ! If no text found then error ! if user_text = "" then message("No pattern text in Insert Here buffer; aborted"); return 0; endif; execute('abl$tsearch_pattern:='+user_text+';'); abl$tsearch_text:=user_text; endif; endif; ! ! Get off current character ! if cur_dir = forward then if starting_position <> end_of(cur_buf) then move_horizontal(1) endif; else if starting_position <> beginning_of(cur_buf) then move_horizontal(-1) endif; endif; position(search(abl$tsearch_pattern,current_direction)); set(informational,on); endprocedure ! Page 5 procedure eve_substitute ! Replaces the replace routine ($string1, $string2) ! Eve's original replace command had some problems; when going through the ! buffer, it starts at the current location and searches in the current ! direction until it cannot search anymore; then it changes direction and ! searches from there. This may not be good because one portion of the buffer ! has been hit twice before the other portion gets touched at all; this problem ! comes to life when the search string is a subset of the replacement string. ! The replace command is also not flexible, can't operate on a subset of the ! buffer, can't use a wildcarded search string, can't use delimiters to specify ! the strings, etc... ! ! There are 2 halves to the substitute code. The first half takes care ! of generating the search and replace strings, the second half does the actual ! search and replace. ! ! Parameters: ! $string1 either the search string, or delimited search and ! replace string, or maybe neither ! $string2 the replace string (maybe) ! ! Qualifiers (old and new string processing): ! /previous boolean uses previous search and replace strings; takes ! precedence over /delimited, /prompt, ! /old_ascii, /new_ascii, and /wildcard ! /delimited boolean use a delimited specification ! /prompt boolean take input from use (else paste buffer); takes ! precedence over strings on command line ! /old_ascii boolean search string is list of ascii character values ! /new_ascii boolean replace string is list of ascii character values ! /wildcard boolean process old string as containing wildcards; you ! may form a wildcard expression from a list ! of ascii char values (/old_ascii) and have ! it processed as a wildcard specification ! ! Qualifiers (execution): ! /iterate boolean perform substitution until can't anymore; will ! only work if new string smaller than old and ! the old string is not a pattern ! /loop boolean prompt to perform same substitution again ! /whole boolean search for old string in whole buffer or not ! /case_sensitive boolean exact or not-exact case ! /match boolean attempt to substitute with a string of same case ! /ask boolean ask about each substitution before doing it ! /reset boolean if using select range, reset it when done ! ! Globals: ! abl$substitute_search_pattern pattern previous compiled search pattern ! abl$substitute_search_text string text of above ! abl$substitute_replace_text string previous replacement string ! ! Source: ! Eva2 local ans, ! result of Substitute? prompt delim_string, ! entered delimited string delta_substitute_count, ! change in substitute_count between passes new_cap, ! capitalized version of new_string_text new_lower, ! lowercase version of new_string_text new_string_text, ! the replacement string (never a pattern) new_upper, ! uppercase version of new_string_text old_cap, ! capitalized version of old_string_pattern old_lower, ! lowercase version of old_string_pattern old_string_pattern, ! the search string/pattern (used for search) old_string_text, ! the search string/pattern text (display only) old_substitute_count, ! previous substitute count before current pass old_upper, ! uppercase version of old_string_pattern origin, ! where we started origin_kludge, ! make sure origin doesn't move if replace there pass_count, ! current number of passes prompt_default, ! prompt for "pass over buffer again?" quitting, ! flag that user doesn't want us anymore range_kludge, ! make sure range doesn't move is replace at beg substitute_range, ! if select was active, the range to replace in substitute_count, ! running number of substitutions target, ! found range of search string in buffer target_highlight, ! highlight of target target_string, ! string version of target wrapped_around; ! flag to let us know if we've done whole buffer on_error !shut up the string not found informationals endon_error; origin := mark(none); if abl$q_previous then if abl$substitute_search_text = eve$kt_null then message("No previous search string"); return 0; endif; old_string_text := abl$substitute_search_text; old_string_pattern := abl$substitute_search_pattern; new_string_text := abl$substitute_replace_text; else if abl$q_delimited then if abl$q_prompt then if not eve$prompt_string($string1,delim_string, "Delimited Substitute: ","Aborted...") then return 0 endif; if $string2 <> eve$kt_null then message("Second argument of command line ignored"); endif; else position(beginning_of(paste_buffer)); delim_string := erase_line; position(origin); endif; if not abl$undelimit(delim_string,old_string_text,new_string_text) then message("Bad delimiter specification"); return 0; endif; else if abl$q_prompt then if not eve$prompt_string($string1,old_string_text,"Substitute old: ", "Aborted...") then return 0 endif; eve$prompt_string($string2,new_string_text,"Substitute new: ",""); else position(beginning_of(paste_buffer)); old_string_text := erase_line; new_string_text := erase_line; position(origin); if old_string_text = eve$kt_null then message("No search string in Insert Here buffer, aborted..."); return 0; endif; endif; endif; if abl$q_old_ascii then if not abl$ascii(old_string_text,old_string_text) then message("Error in list of ascii character values for old string,"+ " aborted"); return 0; endif; endif; if abl$q_new_ascii then if not abl$ascii(new_string_text,new_string_text) then message("Error in list of ascii character values for new string,"+ " aborted"); return 0; endif; endif; ! ! Assign value to abl$substitute_search_pattern (pattern or string) ! if abl$q_wildcard then ! ! If the processed old string creates a pattern, then assign the ! pattern to the global variable ! if eveplus_build_pattern(old_string_text, old_string_pattern) then execute("abl$substitute_search_pattern := " + old_string_pattern + ";" ); ! ! otherwise the pattern processing produced a string, so remember it ! else abl$substitute_search_pattern := old_string_text; endif; else abl$substitute_search_pattern := old_string_text; endif; ! ! Save old_string_text and new_string_text in global variable for later ! abl$substitute_search_text := old_string_text; abl$substitute_replace_text := new_string_text; ! ! Get the pattern back for us to use ! (necessary ! old_string_pattern := abl$substitute_search_pattern; endif; message('Substituting "' +old_string_text + '" with "' + new_string_text + '"'); ! Done with processing new and old strings, now make sure all qualifier ! settings are compatible if get_info(old_string_pattern,"type")=pattern then if abl$q_iterate then message("Cannot iterate with a pattern, looping instead"); abl$q_loop:=true; abl$q_iterate:=false; endif; if abl$q_match then ! message("Cannot match cases on a pattern, continuing..."); abl$q_match:=false; endif; endif; if abl$q_iterate then if length(new_string_text)>length(old_string_pattern) then message("Cannot iterate with a larger substitute string, "+ "looping instead"); abl$q_iterate:=false; endif; abl$q_loop:=true; endif; if abl$q_match then old_cap:=old_string_pattern; eve$capitalize_string(old_cap); old_lower:=old_string_pattern; edit(old_lower,lower,off); old_upper:=old_string_pattern; edit(old_upper,upper,off); new_cap:=new_string_text; eve$capitalize_string(new_cap); new_lower:=new_string_text; edit(new_lower,lower,off); new_upper:=new_string_text; edit(new_upper,upper,off); if old_cap = old_lower then new_cap := new_lower endif; endif; substitute_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 "+ "select range substitute"); else substitute_range:=select_range; endif; endif; substitute_count:=0; old_substitute_count:=0; pass_count:=0; loop wrapped_around:=false; loop loop target := abl$extended_find (old_string_pattern,true,abl$q_case_sensitive,false); exitif target=0; if substitute_range<>0 then if (current_direction=forward) and (end_of(target)>end_of(substitute_range)) then exitif 1; endif; if (current_direction=reverse) and (beginning_of(target)origin) and (wrapped_around) else exitif (end_of(target)0 then target_highlight:=create_range (beginning_of(target),end_of(target),bold); else target_highlight:=create_range (beginning_of(target),end_of(target),reverse); endif; update(current_window); if not abl$prompt_word("/yes/no/all/quit","",ans, "Substitute (yes, no, all, quit) [yes]? ","") then ans := "yes" endif; target_highlight:=0; if ans="all" then abl$q_ask:=false endif; if ans="quit" then quitting:=true endif; endif; exitif quitting; if (not abl$q_ask) or (ans="yes") then if substitute_range<>0 then if beginning_of(target)=beginning_of(substitute_range) then range_kludge:=true else range_kludge:=false endif; endif; if beginning_of(target)=origin then origin_kludge:=true else origin_kludge:=false; endif; erase(target); if abl$q_match then ! ! If the found string is case-independent, copy the ! user's version of the new string ! if (target_string=old_lower) and (target_string=new_lower) then eve$insert_text(new_string_text) else if target_string=old_cap then eve$insert_text(new_cap) else if target_string=old_lower then eve$insert_text(new_lower) else if target_string=old_upper then eve$insert_text(new_upper) else eve$insert_text(new_string_text); endif; endif; endif; endif; else eve$insert_text(new_string_text); endif; if range_kludge then move_horizontal(-length(new_string_text)); substitute_range:=create_range (mark(none),end_of(substitute_range),reverse); move_horizontal(length(new_string_text)); endif; if origin_kludge then move_horizontal(-length(new_string_text)); origin:=mark(none); move_horizontal(length(new_string_text)); endif; substitute_count:=substitute_count+1; if not abl$q_iterate then if current_direction=reverse then move_horizontal(-length(new_string_text)); endif; else if current_direction=forward then move_horizontal(-length(new_string_text) -length(old_string_pattern)+1); else move_horizontal(length(old_string_pattern)-1); endif; endif; else if current_direction=forward then move_horizontal(length(target)) endif; endif; endloop; exitif (not abl$q_whole) or (wrapped_around) or (quitting); wrapped_around:=true; if current_direction=forward then if substitute_range<>0 then position(beginning_of(substitute_range)) else position(beginning_of(current_buffer)); endif; else if substitute_range<>0 then position(end_of(substitute_range)) else position(end_of(current_buffer)); endif; endif; endloop; exitif (not abl$q_loop) or (quitting) or (abl$q_iterate); position(origin); pass_count:=pass_count+1; update(current_window); delta_substitute_count:=substitute_count-old_substitute_count; message("Made "+str(pass_count)+" passes over buffer, "+ str(delta_substitute_count)+" substitutions last pass"); if delta_substitute_count=0 then prompt_default:="no" else prompt_default:="yes" endif; if not abl$prompt_word("/yes/no","",ans, "Continue ["+prompt_default+"]? ","") then ans := prompt_default; endif; exitif ans = "no"; old_substitute_count:=substitute_count; endloop; if abl$q_reset then eve$x_select_position:=0; substitute_range:=0; endif; position(origin); eve$update_status_lines; message(fao("Made !SL substitution!%S",substitute_count)); endprocedure ! Page 6 procedure eve_scramble ! Scramble a buffer based on given key ! Cheap encryption for a little bit of privacy. The key is purposely not ! accepted on the command line since the user probably isn't aware of the ! massaging that the parsing routines will put his key through (this avoids ! the situation where the user encrypts with a key provided on the command line ! then decrypts by letting this procedure get his key). ! ! Qualifiers: ! /prompt boolean get key from user, else get from paste buffer ! ! Source: ! Eva local key, orig_buffer, trntab; if abl$q_prompt then ! ! Get input from user ! if not eve$prompt_string("",key,"Key to use: ","Aborted") then return 0; endif; else ! ! Get input from paste buffer ! orig_buffer:=current_buffer; position(beginning_of(paste_buffer)); key := erase_line; position(orig_buffer); if key = "" then message("No key found in Insert Here buffer"); return 0; endif; endif; abl$cryptic_ascii(key,trntab); translate(current_buffer,trntab,abl$ascii_character_set); endprocedure procedure eve_unscramble ! Unscramble buffer based on key ! See comments on eve_scramble ! ! Qualifiers: ! /prompt boolean get key from user, else get from paste buffer ! ! Source: ! Eva local key, orig_buffer, trntab; if abl$q_prompt then ! ! Get input from user ! if not eve$prompt_string("",key,"Key to use: ","Aborted") then return 0; endif; else ! ! Get input from paste buffer ! orig_buffer:=current_buffer; position(beginning_of(paste_buffer)); key := erase_line; position(orig_buffer); if key = "" then message("No key found in Insert Here buffer"); return 0; endif; endif; abl$cryptic_ascii(key,trntab); translate(current_buffer,abl$ascii_character_set,trntab); endprocedure procedure abl$cryptic_ascii(ky,trntab) ! Generate a cryptic ascii char set ! Folds the ascii character set on the key and returns the resulting character ! set ! ! Source: ! Eva local hi, lo, c, key, key_length, x, y; on_error endon_error; key:=ky; trntab:=abl$ascii_character_set; keylength:=length(key); c:=substr(key,1,1); y:=index(trntab,substr(key,1,1)); trntab:=substr(trntab,y,256)+substr(trntab,1,y-1); x:=2; loop exitif x>keylength; c:=substr(key,x,1); lo:=index(trntab,c); hi:=index(abl$ascii_character_set,c); if lo>hi then y:=lo;lo:=hi;hi:=y; endif; y:=hi-lo; trntab:=substr(trntab,hi,256)+substr(trntab,lo,hi-lo)+substr(trntab,1,lo-1); x:=x+1; endloop; endprocedure ! Page 7 procedure eve_eliminate_tabs ! Turn TABs to spaces ! Routine to remove tabs; cursor will be on same line but possibly not same ! column when finished. ! ! Parameters: ! /log boolean give an informational message when done ! ! Source: ! Eva2 local line, target, cur_buf, here; on_error endon_error if abl$q_log then message("Removing tabs") endif; here:=mark(none); cur_buf := current_buffer; position(beginning_of(cur_buf)); loop target := search(ascii(9), forward); exitif target = 0; position(beginning_of(target)); if not abl$notab_line(line) then message("Could not replace tabs"); return 0; endif; move_horizontal(-current_offset); erase_character(length(current_line)); copy_text(line); endloop; position(here); if abl$q_log then message("Tabs removed") endif; endprocedure ! Page 8 procedure eve_fix_crlfs ! Fix carriage-return/line-feed 's ! Turn CRLFs into line breaks and remove leading CRs and trailing CRLFs ! ! Source: ! VAXTPU example LOCAL starting_position, 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; message("Writing this buffer out now may not produce expected results"); position(starting_position); endprocedure ! Page 9 procedure eve_trim_buffer ! Remove trailing whitespace on lines ! Trims trailing whitespace on lines ! ! Parameters: ! /log boolean give informational messages ! ! Source: ! Eva if abl$q_log then message("Trimmimg buffer") endif; eve$trim_buffer(current_buffer); if abl$q_log then message("Trimming complete") endif; endprocedure