Artifact bc8d4e274a19fb4daee02eae05af73623100b7b5ad80f56719cd7bf847f8e347:
- File
psl-1983/emode/search.red
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 10712) [annotate] [blame] [check-ins using] [more...]
% % SEARCH.RED - Search utilities for EMODE % % Author: William F. Galway % Symbolic Computation Group % Computer Science Dept. % University of Utah % Date: 8 June 1982 % Copyright (c) 1982 University of Utah % % These routines to implement minimal string searches for EMODE. Searches % are non-incremental, limited to single line patterns, and always ignore % case. This file also includes routines for moving over other patterns % (words, etc.). %%%%% Changes: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % AS 7/15/82 % - Fixed skip_backward_blanks to behave properly at the beginning % of the buffer (loop termination test was incorrect). % - Use sleep primitive for insert_matching_paren. FLUID '( last_search_string ); Symbolic Procedure forward_string_search(); % Invoked from keyboard, search forward from point for string, leave % "point" unchanged if not found. begin scalar strng; % Get search string, update default. strng := last_search_string := prompt_for_string("Forward search: ", last_search_string); if buffer_search(strng, 1) then % 1 for forward search, and if found for i := 0:size(strng) do % move to end of string. !$ForwardCharacter(); end; Symbolic Procedure reverse_string_search(); % Invoked from keyboard, search backwards from point for string, leave % "point unchanged if not found. begin scalar strng; strng := last_search_string := prompt_for_string("Reverse Search: ", last_search_string); !$Backwardcharacter(); % Back up before starting search. if not buffer_search(strng, -1) then % -1 for backward search !$ForwardCharacter(); % restore point if not found. end; Symbolic Procedure buffer_search(strng,dir); % Search in buffer for strng. "Ding" and leave point unchanged if % not found, return NIL if not found. dir is +1 for forward, -1 % for backward. begin scalar search_point, search_lineindex, found, within_buffer; PutLine(); % Make sure line is "saved" in buffer % Start at current location in the buffer. search_lineindex := CurrentLineIndex; search_point := min(point, size GetBufferText(search_lineindex)); within_buffer := not EndOfBufferP(search_lineindex); while within_buffer and not (found := subscript(strng, GetBufferText(search_lineindex), search_point, dir)) do << % Move to "beginning" of "next" line if dir > 0 then << within_buffer := not EndOfBufferP(NextIndex search_lineindex); if within_buffer then << search_lineindex := NextIndex(search_lineindex); search_point := 0; >>; >> else << within_buffer := not BeginningOfBufferP(search_lineindex); if within_buffer then << search_lineindex := PreviousIndex(search_lineindex); search_point := size GetBufferText(search_lineindex); >>; >>; >>; if found then << SelectLine(search_lineindex); point := found; >> else Ding(); return found; end; Symbolic Procedure subscript(pattern,strng,start,dir); % Locate pattern in strng, starting at "start", searching in direction % "dir" (+1 for forward search, -1 for backward search). % Return NIL if not found, otherwise return the subscript of the first % matching character. begin scalar found; while 0 <= start and start <= size strng and not (found := is_substring(pattern,strng,start)) do start := start + dir; return if found then start else NIL; end; Symbolic Procedure RaiseChar(ch); % Return character code for upper case version of character. % (ch is a character code.) if ch < char lower 'a or ch > char lower 'z then ch else ch - char lower 'a + char 'A; Symbolic Procedure is_substring(substrng,strng,start); % Return T if substrng occurs as substring of strng, starting at "start". % Ignore case differences. begin scalar i; i := 0; while i <= size(substrng) and i+start <= size(strng) and RaiseChar substrng[i] = RaiseChar strng[i+start] do i := i + 1; return i > size(substrng); % T if all chars matched, false otherwise. end; FLUID '(paren_depth); Symbolic Procedure adjust_depth(ch); % Adjust paren_depth based on the character. if ch = char !( then paren_depth := paren_depth + 1 else if ch = char !) then paren_depth := paren_depth - 1; Symbolic Procedure skip_forward_blanks(); % Skip over "blanks", return the first non-blank character seen. begin scalar ch; while not (EndOfBufferP(NextIndex CurrentLineIndex) and point = length CurrentLine) AND % 17 means "ignore". CurrentScanTable!*[ch := CurrentCharacter()] = 17 do !$ForwardCharacter(); return ch; end; Symbolic Procedure skip_backward_blanks(); % Skip backwards over "blanks", return the first non-blank character seen. begin scalar ch, flg; flg := T; while not (BeginningOfBufferP(CurrentLineIndex) and point = 0) AND flg do << !$BackwardCharacter(); % 17 means "ignore". flg := CurrentScanTable!*[ch := CurrentCharacter()] = 17 >>; % Position "cursor" to the right of the terminating character. if not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) then !$ForwardCharacter(); return ch; end; Symbolic Procedure forward_word(); % Move forward one "word", starting from point. begin scalar ch; while not (EndOfBufferP(NextIndex CurrentLineIndex) and point = length CurrentLine) AND % Scan for start of word. not(LetterP(ch := skip_forward_blanks()) OR DigitP(ch)) do !$ForwardCharacter(); % Now, scan for end of word. while not (EndOfBufferP(NextIndex CurrentLineIndex) and point = length CurrentLine) AND (LetterP(ch := CurrentCharacter()) OR DigitP(ch)) do % Can't be a paren, so don't bother to count. !$ForwardCharacter(); end; Symbolic Procedure backward_word(); % Move backward one "word", starting from point. begin scalar ch,flg; flg := T; % Scan for the start of a word (a "letter" or digit). while flg AND not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) do << !$BackwardCharacter(); flg := not (LetterP(ch := CurrentCharacter()) OR DigitP(ch)); >>; % Now, scan for "end" of identifier. flg := T; while flg AND not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) do << !$BackwardCharacter(); flg := (LetterP(ch := CurrentCharacter()) OR DigitP(ch)); >>; % Position "cursor" to the right of the terminating character. if not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) then !$ForwardCharacter(); end; Symbolic Procedure LetterP(ch); % Note that we don't use ch < 128 and CurrentScanTable!*[ch] equal 10; % 10 means "a letter". Symbolic Procedure forward_sexpr(); % Move forward over a set of balanced parenthesis (roughly speaking). begin scalar ch, cline, cpoint, paren_depth; % paren_depth is FLUID. % Remember our spot. cline := CurrentLineIndex; cpoint := point; paren_depth := 0; ch := skip_forward_blanks(); adjust_depth(ch); if paren_depth > 0 then % Skip over balanced parens, if first thing was % a paren. << while not (EndOfBufferP(NextIndex CurrentLineIndex) and point = length CurrentLine) AND paren_depth > 0 do << !$ForwardCharacter(); adjust_depth CurrentCharacter(); >>; % Complain, and avoid moving point, if match not found. if paren_depth > 0 then << ding(); PutLine(); point := cpoint; GetLine(cline); >> else !$ForwardCharacter(); % Skip over trailing right paren. >> % Otherwise (paren not first character seen), just skip a word. else forward_word() end; Symbolic Procedure backward_sexpr(); % Move backwards over a set of balanced parenthesis (roughly speaking). begin scalar ch, flg, cline, cpoint, paren_depth; % paren_depth is FLUID. % Remember our spot. cline := CurrentLineIndex; cpoint := point; paren_depth := 0; ch := skip_backward_blanks(); flg := T; if ch = char !) then % Skip over balanced parens, if first thing was % a paren. << while not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) AND flg do << !$BackwardCharacter(); adjust_depth CurrentCharacter(); flg := paren_depth < 0; % (< 0, since this is backwards search! ) >>; % Complain, and avoid moving point, if match not found. if paren_depth < 0 then << ding(); PutLine(); point := cpoint; GetLine(cline); >>; >> % if a left paren, just back up slightly (a bit of a KLUDGE). else if ch = char !( then !$BackwardCharacter() % Otherwise (paren not first character seen), just skip a word. else backward_word(); end; Symbolic Procedure insert_matching_paren(); % Insert a right parenthesis, back up to a matching left parenthesis, pause % there a "second" and then come back to current location. begin scalar cline, cpoint, flg, timer, paren_depth; InsertCharacter char !); % (Or, InsertSelfCharacter?) cline := CurrentLineIndex; cpoint := point; paren_depth := 0; flg := T; while not(BeginningOfBufferP(CurrentLineIndex) AND point = 0) AND flg do << !$BackwardCharacter(); adjust_depth CurrentCharacter(); flg := paren_depth < 0; >>; if flg then % No match found ding() else << optional_refresh(); % Show where we are, if no typeahead. % "pause" for 1/2 sec (30/60ths) or until character is typed. sleep!-until!-timeout!-or!-input(30); >>; % Go back to original spot. point := cpoint; SelectLine(cline); end;