home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
progm
/
tptools.zip
/
FIRSTED.ZIP
/
EDBLOK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-21
|
15KB
|
538 lines
{ EDBLOK.PAS
ED 4.0
Copyright (c) 1985, 87 by Borland International, Inc. }
{$I eddirect.inc}
unit EdBlok;
{-Block move, copy and delete}
interface
uses
crt, {Basic video operations - standard unit}
Dos, {DOS calls - standard unit}
Errors, {Runtime error handler}
EdVars, {Global types and declarations}
EdScrn1, {Fast screen writing routines}
EdString, {String primitives}
EdPtrOp, {Primitive pointer operations}
EdCmds, {Maps keystrokes to commands}
int24, {DOS critical error handler}
Message, {Message system}
EdUser, {User keyboard input, line editing and error reporting}
EdMemOp, {Text buffer allocation and deallocation}
EdBack, {Background processes}
EdScrn2, {Editor screen updating}
EdEdit; {Basic editing commands}
procedure EdBlockMove;
{-Process move block command}
procedure EdBlockCopy;
{-Process copy block command}
procedure EdBlockDelete;
{-Process delete block command}
{==========================================================================}
implementation
procedure EdBlockCleanup;
{-Reset markers and generally clean up when done with a block operation}
begin {EdBlockCleanup}
CurWin^.Modified := True;
EdJumpMarker(Blockfrom);
EdRealign;
EdOffblock;
Blockhide := False;
end; {EdBlockCleanup}
{***}
procedure EdBlockMove;
{-Process move block command}
var
WindFrom : PwinDesc;
F, T, C : BlockMarker;
Cline, fRight, Tright, Cright : PlineDesc;
M, ColFrom, ColTo, ColPos, NewColFrom, NewColTo : Integer;
begin {EdBlockMove}
{A block must be defined and unhidden}
if EdNoBlock then
Exit;
{Don't allow the cursor within the block}
if EdCursorInBlock(CurWin^.CurLine, CurWin^.ColNo, False) then
Exit;
{Provide some temporary margin for the move, which overall conserves memory}
FreeListSpace := FreeListPerm-(MaxLineLength shl 2);
if (Blockfrom.Line = Blockto.Line) and (CurWin^.CurLine = Blockfrom.Line) then begin
{Move within a single line is special case}
{Temporary variables}
ColFrom := Blockfrom.Col;
ColTo := Blockto.Col;
ColPos := CurWin^.ColNo;
Cline := CurWin^.CurLine;
with Cline^ do begin
if ColPos >= Bufflen then
{Size up line}
if not(EdSizeline(Cline, Succ(ColPos), True)) then begin
{Insufficient memory - should be impossible to reach here}
FreeListSpace := FreeListPerm;
Exit;
end;
{Initialize buffer}
Move(Txt^[1], WorkBuf[1], Bufflen);
if ColPos < ColFrom then begin
{Cursor to left of marked block}
Move(Txt^[ColFrom], WorkBuf[ColPos], ColTo-ColFrom);
Move(Txt^[ColPos], WorkBuf[ColPos+ColTo-ColFrom], ColFrom-ColPos);
NewColFrom := ColPos;
NewColTo := ColPos+ColTo-ColFrom;
end else begin
{Cursor to right of marked block}
Move(Txt^[ColTo], WorkBuf[ColFrom], ColPos-ColTo);
Move(Txt^[ColFrom], WorkBuf[ColFrom+ColPos-ColTo], ColTo-ColFrom);
NewColFrom := ColFrom+ColPos-ColTo;
NewColTo := ColPos;
end;
{Copy buffer to current}
Move(WorkBuf[1], Txt^[1], Bufflen);
end;
{Save new block pointers}
Blockfrom.Col := NewColFrom;
Blockto.Col := NewColTo;
{Fix up text markers}
if EdFlagSet(Cline, InMark) then
for M := 0 to MaxMarker do
with Marker[M] do
if Line = Cline then
if ColPos < ColFrom then begin
if (Col >= ColPos) and (Col < ColFrom) then
Col := Col+ColTo-ColFrom
else if (Col >= ColFrom) and (Col < ColTo) then
Col := Col-ColFrom+ColPos;
end else begin
if (Col >= ColFrom) and (Col < ColTo) then
Col := Col+ColPos-ColTo
else if (Col >= ColTo) and (Col < ColPos) then
Col := Col+ColFrom-ColTo;
end;
end else begin
{Move from one line to another}
{Store temporary markers}
F := Blockfrom;
T := Blockto;
with C, CurWin^ do begin
Line := CurLine;
Col := ColNo;
end;
{Determine whether all of any window topline or curline is in marked block}
WindFrom := EdFindWindow(Blockfrom.Line);
WindFrom^.Modified := True;
EdFixBaseLine(WindFrom);
{Insert line breaks at the three markers}
{ORDER is IMPORTANT}
if C.Line = T.Line then
EdInsertLinePrimitive(C, Cright);
EdInsertLinePrimitive(T, Tright);
EdInsertLinePrimitive(F, fRight);
if C.Line <> T.Line then
EdInsertLinePrimitive(C, Cright);
{Splice}
if T.Line = F.Line then begin
{Block contained within single line}
fRight^.FwdLink := Cright;
EdJoinLinePrimitive(fRight, T.Col-F.Col);
end else begin
{Multiline block}
T.Line^.FwdLink := Cright;
EdJoinLinePrimitive(T.Line, Pred(T.Col));
end;
if T.Line = C.Line then begin
{Cursor on same line as end of block}
Tright^.FwdLink := fRight;
EdJoinLinePrimitive(Tright, C.Col-T.Col);
end else begin
C.Line^.FwdLink := fRight;
EdJoinLinePrimitive(C.Line, Pred(C.Col));
end;
if F.Line = C.Line then begin
{Cursor on same line as begin of block}
T.Line^.FwdLink := Tright;
EdJoinLinePrimitive(T.Line, Pred(T.Col+F.Col-C.Col));
end else begin
F.Line^.FwdLink := Tright;
EdJoinLinePrimitive(F.Line, Pred(F.Col));
end;
{Set block markers again}
if T.Line = C.Line then begin
Blockfrom.Line := F.Line;
Blockfrom.Col := F.Col+C.Col-T.Col;
end else
Blockfrom := C;
if F.Line = T.Line then begin
Blockto.Line := C.Line;
Blockto.Col := C.Col+T.Col-F.Col;
end else
Blockto := T;
end;
EdBlockCleanup;
end; {EdBlockMove}
{***}
procedure EdBlockCopy;
{-Process copy block command}
var
C : BlockMarker;
Cline, Cright, P, Q, B, F, T : PlineDesc;
M, ColPos, ColFrom, ColTo, Blen : Integer;
Done : Boolean;
begin {EdBlockCopy}
{A block must be defined and visible}
if EdNoBlock then
Exit;
{Don't allow cursor within block}
if EdCursorInBlock(CurWin^.CurLine, CurWin^.ColNo, True) then
Exit;
Cline := CurWin^.CurLine;
ColPos := CurWin^.ColNo;
with C do begin
Line := Cline;
Col := ColPos;
end;
ColFrom := Blockfrom.Col;
ColTo := Blockto.Col;
F := Blockfrom.Line;
T := Blockto.Line;
if (F = T) and (Cline = F) then begin
{Copy within a single line is special case}
with Cline^ do begin
{Size up current line}
if ColPos > Bufflen then
Blen := ColPos
else
Blen := Bufflen;
if not(EdSizeline(Cline, Succ(Blen+ColTo-ColFrom), True)) then
Exit;
{Initialize buffer}
Move(Txt^[1], WorkBuf[1], Bufflen);
{Copy the appropriate text}
Move(Txt^[ColFrom], WorkBuf[ColPos], ColTo-ColFrom);
if Blen <> ColPos then
Move(Txt^[ColPos], WorkBuf[ColPos+ColTo-ColFrom], Succ(Blen-ColPos));
{Copy buffer to current}
Move(WorkBuf[1], Txt^[1], Bufflen);
end;
{Save new block markers}
Blockfrom.Col := ColPos;
Blockto.Col := ColPos+ColTo-ColFrom;
{Fix up text markers}
if EdFlagSet(Cline, InMark) then
for M := 0 to MaxMarker do
with Marker[M] do
if Line = Cline then
if (Col >= ColPos) then
Col := Col+ColTo-ColFrom;
end else begin
{Reduce available memory so we have something left to link with}
FreeListSpace := FreeListPerm+(MaxLineLength shl 1);
{Break at the cursor position}
EdInsertLinePrimitive(C, Cright);
if GotError then begin
FreeListSpace := FreeListPerm;
Exit;
end;
{P will track the source text}
if Cline = Blockfrom.Line then
P := Cright
else
P := Blockfrom.Line;
{Q will track the destination text}
Q := Cline;
Done := False;
repeat
if (P = F) then begin
if (P = T) then begin
{Current source line contains begin and end of block}
Blen := ColTo-ColFrom;
B := EdMaktextdesc(Blen);
if EdPtrNotNil(B) then begin
{Copy text into buffer}
Move(P^.Txt^[ColFrom], B^.Txt^[1], Blen);
{Force exit for last line of block}
Done := True;
end;
end else begin
{First line of block}
Blen := Succ(P^.Bufflen-ColFrom);
B := EdMaktextdesc(Blen);
if EdPtrNotNil(B) then begin
{Copy text into buffer}
Move(P^.Txt^[ColFrom], B^.Txt^[1], Blen);
EdFwdPtr(P);
end;
end;
end else if (P = T) then begin
{Last line of block}
Blen := Pred(ColTo);
B := EdMaktextdesc(Blen);
if EdPtrNotNil(B) then begin
{Copy text into buffer}
if Blen > 0 then
Move(P^.Txt^[1], B^.Txt^[1], Blen);
{Force exit}
Done := True;
end;
end else begin
{Middle of block}
Blen := P^.Bufflen;
B := EdMaktextdesc(Blen);
if EdPtrNotNil(B) then begin
{Copy text into buffer}
Move(P^.Txt^[1], B^.Txt^[1], Blen);
EdFwdPtr(P);
end;
end;
if EdPtrIsNil(B) then begin
{Out of memory error already reported}
{Move b back to previous success and go on to the relink step}
B := Q;
Blen := Succ(EdTextLength(B));
{Correct blockto marker for as far as we got}
Blockto.Col := Blen;
Done := True;
GotError := False;
end else begin
{Insert buffer between current q and cright}
Q^.FwdLink := B;
B^.Backlink := Q;
B^.FwdLink := Cright;
Cright^.Backlink := B;
{Move q forward to b so that next line is inserted after b}
Q := B;
end;
until Done; {Loop through all lines of block}
{Get stack space back so we have room to link up}
FreeListSpace := FreeListPerm;
{Join at begin and end}
{Join right part of original current line to last buffer}
EdJoinLinePrimitive(B, Blen);
if GotError then begin
EdBlockCleanup;
Exit;
end;
{Join first buffer to left part of current line}
EdJoinLinePrimitive(Cline, Pred(ColPos));
if GotError then begin
EdBlockCleanup;
Exit;
end;
{Set block markers}
if F = T then begin
{Original block contained in a single line}
Blockto.Line := Cline;
Blockto.Col := ColPos+Blen;
end else
Blockto.Line := B;
Blockfrom.Line := Cline;
Blockfrom.Col := ColPos;
end;
EdBlockCleanup;
end; {EdBlockCopy}
{***}
procedure EdBlockDelete;
{-Process delete block command}
var
WindFrom : PwinDesc;
P, Q, Tright, fRight : PlineDesc;
C : BlockMarker;
M, ColFrom, ColTo, Blen : Integer;
begin {EdBlockDelete}
{A block must be defined and not hidden}
if EdNoBlock then
Exit;
ColFrom := Blockfrom.Col;
ColTo := Blockto.Col;
WindFrom := EdFindWindow(Blockfrom.Line);
{Determine whether all of any window topline or curline is in marked block}
EdFixBaseLine(WindFrom);
{Special case when block is within a single line}
if (Blockfrom.Line = Blockto.Line) then begin
P := Blockfrom.Line;
Blen := EdTextLength(P);
with P^ do begin
{Initialize buffer}
Move(Txt^[1], WorkBuf[1], Bufflen);
{Remove characters and right pad with blanks}
if ColTo <= Blen then
Move(Txt^[ColTo], WorkBuf[ColFrom], Succ(Blen-ColTo));
FillChar(WorkBuf[ColFrom+Succ(Blen-ColTo)], (ColTo-ColFrom), Blank);
{Copy buffer to current}
Move(WorkBuf[1], Txt^[1], Bufflen);
end;
{Correct cursor}
if CurWin^.CurLine = Blockfrom.Line then
CurWin^.ColNo := Blockfrom.Col;
{Fix up text markers}
if EdFlagSet(P, InMark) then
for M := 0 to MaxMarker do
with Marker[M] do
if Line = P then
if (Col >= ColTo) then
Col := Col-ColTo+ColFrom
else if (Col >= ColFrom) then
EdSetPtrNil(Line);
end else begin
{Store temporary marker}
with C do begin
Line := CurWin^.CurLine;
Col := CurWin^.ColNo;
end;
{Provide some memory margin to get started deleting}
FreeListSpace := FreeListPerm-(MaxLineLength shl 1);
{Inserting line breaks before and after block}
EdInsertLinePrimitive(Blockfrom, fRight);
if GotError then begin
FreeListSpace := FreeListPerm;
Exit;
end;
EdInsertLinePrimitive(Blockto, Tright);
if GotError then begin
FreeListSpace := FreeListPerm;
Exit;
end;
{Now scan and delete all lines in the block}
P := fRight;
repeat
{Get the forward link now. push to undo destroys it}
Q := P^.FwdLink;
{Put line on undo stack if possible}
EdPushUndo(P);
P := Q;
until P = Tright;
{Splice blockfrom to tright}
Blockfrom.Line^.FwdLink := Tright;
EdJoinLinePrimitive(Blockfrom.Line, Pred(Blockfrom.Col));
FreeListSpace := FreeListPerm;
EdRealign;
EdJumpMarker(C);
end;
WindFrom^.Modified := True;
{Indicate that markers are gone}
EdSetPtrNil(Blockto.Line);
EdOffblock;
Blockhide := True;
end; {EdBlockDelete}
end.
