home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 9
/
CD_ASCQ_09_1193.iso
/
news
/
557
/
anedit
/
ae2.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-09-07
|
18KB
|
480 lines
UNIT AE2 ;
{$R-}
{$B-}
{$I-}
{$S+}
{$V-}
{-----------------------------------------------------------------------------}
{ This unit contains all movement procedures. }
{ All procedures operate on the current workspace (CurrentWs), }
{ unless specified otherwise. }
{-----------------------------------------------------------------------------}
INTERFACE
USES Crt, Dos, AE0, AE1 ;
PROCEDURE Home (VAR P : Position) ;
PROCEDURE EndOfLine (VAR P : Position) ;
PROCEDURE CalculateColnr (VAR P : position) ;
PROCEDURE SkipDown (VAR P : Position ; Distance : WORD) ;
PROCEDURE SkipUp (VAR P : Position ; Distance : WORD) ;
PROCEDURE WordDown (VAR P : Position) ;
PROCEDURE WordUp (VAR P : Position) ;
PROCEDURE LineDown (VAR P : Position) ;
PROCEDURE LineUp (VAR P : Position) ;
PROCEDURE SearchUp (Target : STRING ; VAR P : Position ; LimitIndex : WORD) ;
PROCEDURE SearchDown (Target : STRING ; VAR P : Position ; LimitIndex : WORD) ;
PROCEDURE SearchString (Target : STRING ; VAR P : Position) ;
PROCEDURE MatchBracketsDown (OpenBracket, CloseBracket : CHAR ; VAR P : Position) ;
PROCEDURE MatchBracketsUp (OpenBracket, CloseBracket : CHAR ; VAR P : Position) ;
IMPLEMENTATION
{-----------------------------------------------------------------------------}
{ Sets P to the first column of the line it is pointing to }
{-----------------------------------------------------------------------------}
PROCEDURE Home (VAR P : Position) ;
BEGIN
DEC (P.Index, P.Colnr - 1) ;
P.Colnr := 1 ;
END ;
{-----------------------------------------------------------------------------}
{ Sets P to the last column of the current line (line separator or }
{ end of file) }
{-----------------------------------------------------------------------------}
PROCEDURE EndOfLine (VAR P : Position) ;
BEGIN
WITH CurrentWs DO
BEGIN
WHILE (Buffer^ [P.Index] <> LF) AND
(P.Index < Buffersize) DO
BEGIN
INC (P.Index) ;
INC (P.Colnr) ;
END ;
IF (Buffer^ [P.Index - 1] = CR) AND
(Buffer^ [P.Index] = LF)
THEN BEGIN
DEC (P.Index) ;
DEC (P.Colnr) ;
END ;
END ; { of with }
END ;
{-----------------------------------------------------------------------------}
{ Re-calculates the column number by searching for a previous line feed }
{-----------------------------------------------------------------------------}
PROCEDURE CalculateColnr (VAR P : position) ;
BEGIN
WITH CurrentWs DO
BEGIN
IF P.Linenr = 1
THEN P.Colnr := P.Index
ELSE BEGIN
P.Colnr := 1 ;
WHILE (Buffer^ [P.Index - P.Colnr] <> LF) DO INC (P.Colnr) ;
END ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P <Distance> positions downward, adjusting line and column number. }
{ If the end of the buffer is reached, the procedure stops. }
{-----------------------------------------------------------------------------}
PROCEDURE SkipDown (VAR P : Position ; Distance : WORD) ;
VAR Counter : WORD ;
BEGIN
WITH CurrentWs DO
BEGIN
IF (P.Index + Distance) > BufferSize
THEN Distance := BufferSize - P.Index ;
FOR Counter := 1 TO Distance DO
BEGIN
IF Buffer^ [P.Index] = LF
THEN INC (P.Linenr) ;
INC (P.Index) ;
END ;
CalculateColnr (P) ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P <Distance> positions upward, adjusting line and column number. }
{ If the start of the buffer is reached, the procedure stops. }
{-----------------------------------------------------------------------------}
PROCEDURE SkipUp (VAR P : Position ; Distance : WORD) ;
VAR Counter : WORD ;
BEGIN
WITH CurrentWs DO
BEGIN
IF Distance < P.Colnr
THEN BEGIN
{ P will remain within current line }
DEC (P.Colnr, Distance) ;
DEC (P.Index, Distance) ;
END
ELSE BEGIN
IF P.Index <= Distance
THEN BEGIN
{ go to start of buffer }
P.Index := 1 ;
P.Linenr := 1 ;
END
ELSE FOR Counter := 1 TO Distance DO
BEGIN
DEC (P.Index) ;
IF Buffer^ [P.Index] = LF
THEN DEC (P.Linenr) ;
END ;
CalculateColnr (P) ;
END ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P downward until the beginning of the next word in the text. }
{-----------------------------------------------------------------------------}
PROCEDURE WordDown (VAR P : Position) ;
BEGIN
WITH CurrentWs DO
BEGIN
WHILE NOT ( (Buffer^ [P.Index] IN WordDelimiters) OR
(P.Index = BufferSize) ) DO
BEGIN
INC (P.Colnr) ;
INC (P.Index) ;
END ;
WHILE (Buffer^ [P.Index] IN WordDelimiters) AND
(P.Index < BufferSize) DO
BEGIN
IF Buffer^ [P.Index] = LF
THEN BEGIN
INC (P.Linenr) ;
P.Colnr := 1 ;
END
ELSE IF NOT ( (Buffer^ [P.Index] = CR) AND
(Buffer^ [P.Index + 1] = LF) )
THEN INC (P.Colnr) ;
INC (P.Index) ;
END ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P upward until the beginning of the previous word in the text. }
{-----------------------------------------------------------------------------}
PROCEDURE WordUp (VAR P : Position) ;
BEGIN
WITH CurrentWs DO
BEGIN
IF P.Index > 1
THEN BEGIN
REPEAT DEC (P.Index) ;
IF Buffer^ [P.Index] = LF
THEN DEC (P.Linenr) ;
UNTIL ( (NOT (Buffer^ [P.Index] IN WordDelimiters) ) OR
(P.Index = 1) ) ;
WHILE ( (NOT (Buffer^ [P.Index] IN WordDelimiters) ) AND
(P.Index > 0) ) DO
BEGIN
DEC (P.Index) ;
END ;
INC (P.Index) ;
CalculateColnr (P) ;
END ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P downward to the first column of the next line. }
{ If the end of the buffer is reached, the procedure stops. }
{-----------------------------------------------------------------------------}
PROCEDURE LineDown (VAR P : Position) ;
VAR StartIndex : WORD ;
BEGIN
StartIndex := P.Index ;
WITH CurrentWs DO
BEGIN
WHILE (Buffer^ [P.Index] <> LF) AND (P.Index < BufferSize) DO
INC (P.Index) ;
IF (Buffer^ [P.Index] = LF)
THEN BEGIN
INC (P.Index) ;
P.Colnr := 1 ;
INC (P.Linenr) ;
END
ELSE INC (P.Colnr, P.Index - StartIndex) ;
END ;
END ;
{-----------------------------------------------------------------------------}
{ Skips P upward to the first column of the previous line. }
{ If the start of the buffer is reached, the procedure stops. }
{-----------------------------------------------------------------------------}
PROCEDURE LineUp (VAR P : Position) ;
BEGIN
IF P.Linenr <= 2
THEN BEGIN
P.Index := 1 ;
P.Linenr := 1 ;
END
ELSE WITH CurrentWs DO
BEGIN
{ go to line feed before start of current line }
DEC (P.Index, P.Colnr) ;
{ find start of line }
WHILE (Buffer^ [P.Index - 1] <> LF) DO
DEC (P.Index) ;
DEC (P.Linenr) ;
END ;
P.Colnr := 1 ;
END ;
{-----------------------------------------------------------------------------}
{ Searches downward for the string <Target>. On exit, P points to the first }
{ character of the string in the text buffer, if the string is found before }
{ index <LimitIndex> is reached. Otherwise, P will point to <LimitIndex>. }
{ The value of global variable Found will be set accordingly. }
{-----------------------------------------------------------------------------}
PROCEDURE SearchDown (Target : STRING ; VAR P : Position ; LimitIndex : WORD) ;
VAR Counter : BYTE ;
BEGIN
Found := FALSE ;
WITH CurrentWs DO
BEGIN
IF IgnoreCase
THEN BEGIN
{ case-insensitive search }
Target := UpperCase (Target) ;
WHILE (NOT Found) AND (P.Index <= LimitIndex) DO
BEGIN
{ search text for first character of Target }
REPEAT IF Buffer^ [P.Index] = LF
THEN INC (P.Linenr) ;
INC (P.Index) ;
UNTIL (UPCASE (Buffer^ [P.Index]) = Target [1]) OR
(P.Index > LimitIndex) ;
Counter := 2 ;
{ check if following characters are equal to Target }
WHILE (UPCASE (Buffer^ [P.Index + Counter - 1]) = Target [Counter])
AND (Counter <= LENGTH (Target) ) DO
INC (Counter) ;
Found := (Counter > LENGTH (Target) ) AND
( (P.Index + LENGTH (Target) - 1) <= LimitIndex) ;
IF WholeWords
THEN Found := Found AND
(Buffer^ [P.Index-1] IN WordSeparators) AND
(Buffer^ [P.Index+Counter-1] IN WordSeparators) ;
END ; { of while }
END { of case-insensitive search }
ELSE BEGIN
{ normal search }
WHILE (NOT Found) AND (P.Index <= LimitIndex) DO
BEGIN
{ search text for first character of Target }
REPEAT IF Buffer^ [P.Index] = LF
THEN INC (P.Linenr) ;
INC (P.Index) ;
UNTIL (Buffer^ [P.Index] = Target [1]) OR
(P.Index > LimitIndex) ;
Counter := 2 ;
{ check if following characters are equal to Target }
WHILE (Buffer^ [P.Index + Counter - 1] = Target [Counter]) AND
(Counter <= LENGTH (Target) ) DO
INC (Counter) ;
Found := (Counter > LENGTH (Target) ) AND
( (P.Index + LENGTH (Target) - 1) <= LimitIndex) ;
IF WholeWords
THEN Found := Found AND
(Buffer^ [P.Index-1] IN WordSeparators) AND
(Buffer^ [P.Index+Counter-1] IN WordSeparators) ;
END ; { of while }
END ; { of normal search }
CalculateColnr (P) ;
END ; { of with }
END ; { of procedure }
{-----------------------------------------------------------------------------}
{ Searches upward for the string <Target>. On exit, P points to the first }
{ character of the string in the text buffer, if the string is found before }
{ index <LimitIndex> is reached. Otherwise, P will point to <LimitIndex>. }
{ The value of global variable Found will be set accordingly. }
{-----------------------------------------------------------------------------}
PROCEDURE SearchUp (Target : STRING ; VAR P : Position ; LimitIndex : WORD) ;
VAR Counter : WORD ;
BEGIN
Found := FALSE ;
WITH CurrentWs DO
BEGIN
IF IgnoreCase
THEN BEGIN
{ case-insensitive search }
Target := UpperCase (Target) ;
WHILE (NOT Found) AND (P.Index >= LimitIndex) DO
BEGIN
{ search text for first character of Target }
REPEAT DEC (P.Index) ;
IF Buffer^ [P.Index] = LF
THEN DEC (P.Linenr) ;
UNTIL (UPCASE (Buffer^ [P.Index]) = Target [1]) OR
(P.Index < LimitIndex) ;
Counter := 2 ;
{ check if following characters are equal to Target }
WHILE (UPCASE (Buffer^ [P.Index + Counter - 1]) =
Target [Counter]) AND
(Counter <= LENGTH (Target) ) DO
INC (Counter) ;
Found := (Counter > LENGTH (Target) ) AND
(P.Index >= LimitIndex) ;
IF WholeWords
THEN Found := Found AND
(Buffer^ [P.Index-1] IN WordSeparators) AND
(Buffer^ [P.Index+Counter-1] IN WordSeparators) ;
END ; { of while }
END { of case-insensitive search }
ELSE BEGIN
{ normal search }
WHILE (NOT Found) AND (P.Index >= LimitIndex) DO
BEGIN
{ search text for first character of Target }
REPEAT DEC (P.Index) ;
IF Buffer^ [P.Index] = LF
THEN DEC (P.Linenr) ;
UNTIL (Buffer^ [P.Index] = Target [1]) OR
(P.Index < LimitIndex) ;
Counter := 2 ;
{ check if following characters are equal to Target }
WHILE (Buffer^ [P.Index + Counter - 1] = Target [Counter]) AND
(Counter <= LENGTH (Target) ) DO
INC (Counter) ;
Found := (Counter > LENGTH (Target) ) AND
(P.Index >= LimitIndex) ;
IF WholeWords
THEN Found := Found AND
(Buffer^ [P.Index-1] IN WordSeparators) AND
(Buffer^ [P.Index+Counter-1] IN WordSeparators) ;
END ; { of while }
END { of normal search } ;
CalculateColnr (P) ;
END ; { of with }
END ; { of procedure }
{-----------------------------------------------------------------------------}
{ Performs a general search for <Target> according to the search options }
{ that are stored in global boolean variables. (Searching is done by calling }
{ SearchDown or SearchUp.) If Target is found, P will point to the first }
{ character. }
{-----------------------------------------------------------------------------}
PROCEDURE SearchString (Target : STRING ; VAR P : Position) ;
BEGIN
Found := FALSE ;
IF LENGTH (Target) > 0
THEN BEGIN
WITH CurrentWs DO
BEGIN
IF ReverseSearch
THEN BEGIN
SearchUp (Target, P, 1) ;
END
ELSE BEGIN
SearchDown (Target, P, BufferSize - 1) ;
END ;
END ; { of with }
END ;
END ;
{-----------------------------------------------------------------------------}
{ Searches downward for an occurrence of CloseBracket in the buffer, }
{ matching the OpenBracket that P is assumed to point at when the procedure }
{ is called. If no matching bracket is found, P will point to the end of the }
{ buffer, and Found is set to False. }
{-----------------------------------------------------------------------------}
PROCEDURE MatchBracketsDown (OpenBracket, CloseBracket : CHAR ; VAR P : Position) ;
VAR Level : INTEGER ;
{ Level keeps track of the nesting level of the brackets }
BEGIN
Level := 1 ;
WITH CurrentWs DO
BEGIN
WHILE (Level > 0) AND (P.Index < BufferSize) DO
BEGIN
IF Buffer^ [P.Index] = LF
THEN INC (P.Linenr) ;
INC (P.Index) ;
IF Buffer^ [P.Index] = OpenBracket THEN INC (Level) ;
IF Buffer^ [P.Index] = CloseBracket THEN DEC (Level) ;
END ; { of while }
CalculateColnr (P) ;
END ;
Found := (Level = 0) ;
END ;
{-----------------------------------------------------------------------------}
{ Searches upward for an occurrence of CloseBracket in the buffer, matching }
{ the OpenBracket that P is assumed to point at when the procedure is called. }
{ If no matching bracket is found, P will point to the start of the }
{ buffer, and Found is set to False. }
{-----------------------------------------------------------------------------}
PROCEDURE MatchBracketsUp (OpenBracket, CloseBracket : CHAR ; VAR P : Position) ;
VAR Level : INTEGER ;
{ Level keeps track of the nesting level of the brackets }
BEGIN
Level := - 1 ;
WITH CurrentWs DO
BEGIN
WHILE (Level < 0) AND (P.Index > 1) DO
BEGIN
DEC (P.Index) ;
IF Buffer^ [P.Index] = LF
THEN DEC (P.Linenr) ;
IF Buffer^ [P.Index] = OpenBracket THEN INC (Level) ;
IF Buffer^ [P.Index] = CloseBracket THEN DEC (Level) ;
END ; { of while }
CalculateColnr (P) ;
END ;
Found := (Level = 0) ;
END ;
{-----------------------------------------------------------------------------}
END.
