www.pudn.com > tp60src.zip > EDITOR.PAS
unit Editor;
{$O+,F+,S-,X+,V-}
interface
uses Objects, Drivers, Views, TDos, TVars, TEdit, CompVars, TWindows;
const
gfProgram = 1;
gfExec = 2;
gfAlways = 4;
gfNoTop = 8;
esReplace = $1000;
esNoPrompt = $2000;
esChangeAll = $4000;
CEditView = #6#7#8#9#10;
EditCommands = [cmFind, cmReplace, cmSearchAgain, cmSave, cmSaveAs, cmPrint,
cmGotoLineNumber, cmFindProcedure, cmFindError, cmGotoCursor, cmCompile,
cmToggleBreakpoint, cmTopicSearch];
EditCommands2 = EditCommands + [cmCut, cmCopy, cmPaste, cmClear,
cmRestoreLine];
type
TSearchStr = string[80];
PIndicator = ^TIndicator;
TIndicator = object(TView)
Location: TPoint;
Modified: Boolean;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure SetState(AState: Word; Enable: Boolean); virtual;
procedure SetValue(ALocation: TPoint; AModified: Boolean);
end;
PEditView = ^TEditView;
TEditView = object(TView)
HScrollBar, VScrollBar: PScrollBar;
Indicator: PIndicator;
Editor: PEditor;
IsValid: Boolean;
constructor Init(var Bounds: TRect;
AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator;
var AName: PathStr);
constructor Load(var S: TStream);
procedure InitEditor(var S: PathStr);
destructor Done; virtual;
procedure DoneEditor;
procedure CenterScreen;
procedure ChangeBounds(var Bounds: TRect); virtual;
procedure Clear;
procedure ClearModifiedFlag;
procedure CopyToClip; virtual;
function CanReplace: Word;
procedure Copy;
procedure Cut;
procedure CompilerError(var S: string);
procedure Draw; virtual;
function EditData: PEditSegment;
function GetHelpCtx: Word; virtual;
function GetPalette: PPalette; virtual;
procedure GotoLine;
procedure GotoOldLine(I: Integer; Exec: Boolean);
procedure HandleEvent(var Event: TEvent); virtual;
procedure SetBpt(var B: TBreakpoint);
function BlockSet: Boolean;
function CanRestore: Boolean;
function Noname: Boolean;
function DoFunc(Func: Word): Integer;
function DoFunc1(Func: Word; Param: Pointer): Integer;
procedure Message(I: Integer);
function Modified: Boolean;
function RwBlock(Mode: Word): Integer;
procedure Repaint;
procedure Paste;
procedure ChangeName(S: PathStr);
procedure EditNewFile(var S: PathStr);
function ReplaceDialog(var S1, S2: TSearchStr; var Opts: Word): Boolean;
procedure RestoreLine;
function SaveAs: Boolean; virtual;
function Save: Boolean;
function SaveFile: Boolean;
procedure SearchFailure(var S: TSearchStr);
function SearchDialog(var S: TSearchStr; var Opts: Word): Boolean;
procedure SearchReplace(var S1, S2: TSearchStr;var Opts: Word);
procedure SetColors;
procedure SetPos(X, Y: Integer);
procedure SetScrollBars;
procedure SetState(AState: Word;Enable: Boolean); virtual;
procedure Store(var S: TStream);
procedure ToggleBpt;
function TotalLines: Integer;
procedure Update;
procedure UpdateCommands;
procedure UpdateFrame; virtual;
function Valid(Command: Word): Boolean; virtual;
end;
PClipboard = ^TClipboard;
TClipboard = object(TEditView)
constructor Init(var Bounds:TRect;
AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator);
constructor Load(var S: TStream);
procedure CopyToClip; virtual;
function GetHelpCtx: Word; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
function SaveAs: Boolean; virtual;
procedure SetState(AState: Word; Enable: Boolean); virtual;
procedure UpdateFrame; virtual;
function Valid(Command: Word): Boolean; virtual;
end;
PEditWindow = ^TEditWindow;
TEditWindow = object(TTurboWindow)
EditView: PEditView;
constructor Init(var Bounds: TRect; AName: PString; ANumber: Integer);
constructor Load(var S: TStream);
function GetTitle(MaxSize: Integer): TTitleStr; virtual;
procedure Store(var S: TStream);
end;
function FindEditor(P: PString): PEditView;
procedure TopmostName(var S: PathStr);
function CreateEditor(var S: PathStr; Replace, NoTop: Boolean): PEditView;
function OpenFile(var S: PathStr; NoTop: Boolean): PEditView;
function GoFileLine(S: PathStr; I: Integer; Options: byte): Boolean;
procedure SetOptions;
const
Clipboard: PEditView = nil;
DefTabSize: Word = 8;
DefOptions: Word = eoAutoIndent + eoAutoOutdent;
BackupFiles: Boolean = True;
DefCommandTable: Pointer = nil;
EditCount: Integer = 0;
const
REditView: TStreamRec = (
ObjType: 12000;
VmtLink: Ofs(TypeOf(TEditView)^);
Load: @TEditView.Load;
Store: @TEditView.Store
);
RIndicator: TStreamRec = (
ObjType: 12001;
VmtLink: Ofs(TypeOf(TIndicator)^);
Load: @TIndicator.Load;
Store: @TIndicator.Store
);
RClipboard: TStreamRec = (
ObjType: 12003;
VmtLink: Ofs(TypeOf(TClipboard)^);
Load: @TClipboard.Load;
Store: @TClipboard.Store
);
REditWindow: TStreamRec = (
ObjType: 12004;
VmtLink: Ofs(TypeOf(TEditWindow)^);
Load: @TEditWindow.Load;
Store: @TEditWindow.Store
);
implementation
uses App, VMem, TStatus, Compiler, Tracer, CompOpt, Utils, Fnames, StrNames,
Context;
const
ChangingOptions = eoOverwrite + eoAutoIndent + eoUseTab + eoAutoOutdent +
eoOptimalFill + eoRoamingCursor;
NoClipCommands = [cmSave, cmGotoCursor, cmCompile, cmToggleBreakpoint,
cmTopicSearch];
ClipName: string[8] = '$$CLIP$$';
constructor TIndicator.Init(var Bounds: TRect);
var
R: TRect;
begin
TView.Init(Bounds);
GrowMode := gfGrowLoY + gfGrowHiY;
end;
procedure TIndicator.Draw;
var
Color: Byte;
Frame: Char;
S: string[5];
B: array[0..13] of Word;
begin
if State and sfDragging <> 0 then
begin
Color := GetColor(3);
Frame := #196;
end else
begin
Color := GetColor(2);
Frame := #205;
end;
MoveChar(B, Frame, Color, 14);
if Modified then
WordRec(B[0]).Lo := 15;
Str(Location.Y, S);
WordRec(B[6-Length(S)]).Lo := Ord(' ');
MoveStr(B[7-Length(S)], S, Color);
WordRec(B[7]).Lo := Ord(':');
Str(Location.X, S);
MoveStr(B[8], S, Color);
WordRec(B[8+Length(S)]).Lo := Ord(' ');
WriteBuf(0, 0, 14, 1, B);
end;
procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean);
begin
if (Longint(Location) <> Longint(ALocation)) or (Modified <> AModified) then
begin
Location := ALocation;
Modified := AModified;
DrawView;
end;
end;
procedure TIndicator.SetState(AState: Word; Enable: Boolean);
begin
TView.SetState(AState, Enable);
if AState = sfDragging then
DrawView;
end;
procedure ForEachEditor(Proc: Pointer);
var
P: PFileRec;
V: PEditor;
begin
P := LoadedFiles;
while P <> nil do
begin
V := P^.Editor;
while V <> nil do
begin
asm
PUSH V.Word[2]
PUSH V.Word[0]
PUSH WORD PTR [BP]
CALL Proc
end;
V := V^.Next;
end;
P := P^.Next;
end;
end;
procedure ShowError(Error: Integer);
var
I: Integer;
begin
for I := 0 to 5 do
if (1 shl I) and Error <> 0 then
PEditView(CurEditView)^.Message(I);
end;
function ParamFile(var S: PathStr): Pointer;
const
L: array[0..0] of Longint = (0);
SS: PathStr = '';
begin
SS := S;
ConvertPath(SS, 25);
L[0] := Longint(@SS);
ParamFile := @L;
end;
function Unnamed(var S: PathStr): Boolean;
var
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
begin
FSplit(S, Dir, Name, Ext);
if Length(Name) > 6 then
Name[0] := #6;
Unnamed := Name = 'NONAME';
end;
constructor TEditView.Init(var Bounds: TRect;
AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator;
var AName: PathStr);
var
P: Pointer;
begin
TView.Init(Bounds);
GrowMode := gfGrowHiX + gfGrowHiY;
Options := Options or ofSelectable;
EventMask := EventMask or (evBroadcast + evEditor + evConfig + evRightClick);
HScrollBar := AHScrollBar;
VScrollBar := AVScrollBar;
Indicator := AIndicator;
IsValid := True;
ShowCursor;
InitEditor(AName);
SetScrollBars;
if Editor^.Options and eoOverwrite <> 0 then
BlockCursor
else
NormalCursor;
end;
constructor TEditView.Load(var S: TStream);
var
Name: PathStr;
begin
TView.Load(S);
GetPeerViewPtr(S, HScrollBar);
GetPeerViewPtr(S, VScrollBar);
GetPeerViewPtr(S, Indicator);
S.Read(Name[0], 1);
S.Read(Name[1], Length(Name));
IsValid := True;
InitEditor(Name);
S.Read(Editor^.ScreenPos, 19 * SizeOf(TPoint));
S.Read(Editor^.Options, SizeOf(Word));
DoFunc(edCenterFixScreenPos);
end;
procedure TEditView.InitEditor(var S: PathStr);
var
I, J: Integer;
P: PFileRec;
L: array[0..0] of Longint;
begin
New(Editor);
FillChar(Editor^, SizeOf(Editor^), 0);
with Editor^ do
begin
EditView := @Self;
CommandTable := DefCommandTable;
WindowWidth := Size.X;
WindowHeight := Size.Y;
Options := DefOptions;
TabSize := DefTabSize;
ErrorProc := nil;
ScreenPos.X := 1;
ScreenPos.Y := 1;
CursorPos.X := 1;
CursorPos.Y := 1;
if S <> ClipName then
Inc(EditCount);
P := FindFile(S);
if P <> nil then
Handle := P^.Editor^.Handle
else
begin
New(P);
P^.Editor := nil;
P^.Time := GetFileTime(S);
if P^.Time = -1 then
P^.Time := GetDateTime;
P^.Next := LoadedFiles;
P^.FileName := S;
LoadedFiles := P;
end;
FileRec := P;
Next := P^.Editor;
P^.Editor := Editor;
if Handle = nil then
begin
if DoFunc(edNop) < 0 then
begin
Message(eeNoVirtMem);
IsValid := false;
end else
begin
I := FOpen(S, 0);
if I >= 0 then
begin
L[0] := Longint(@S);
StatusLine^.PrintStr(sLoading, @L);
if DoFunc1(edReadFile, Pointer(I)) <> 0 then
MessageBox(sReadError, ParamFile(S), mfWarning + mfOkButton);
FClose(I);
end else if I <> -2 then
begin
L[0] := Longint(@S);
if not ValidFileName(S) then
MessageBox(sInvalidFileName, ParamFile(S), mfError + mfOkButton)
else
MessageBox(sUnableOpen, ParamFile(S), mfError + mfOkButton);
IsValid := False;
end;
Bpts2Editor(P);
EditData^.BreakPts := @P^.Breakpoints;
DoFunc(edStorePagesInfo);
if (ExecPos.Fn<>0) and (S = GetSourceName(ExecPos.Fn)^) then
EditData^.ExecBar := ExecPos.Ln;
end;
end;
if IsValid then
ErrorProc := @ShowError;
end;
end;
destructor TEditView.Done;
begin
DoneEditor;
TView.Done;
end;
procedure TEditView.DoneEditor;
var
P, Q: PEditor;
PP, QQ: PFileRec;
begin
if Editor = nil then
Exit;
with Editor^ do
begin
if FileRec^.FileName <> ClipName then
Dec(EditCount);
MFree(UndoPtr, UndoBufLen);
UndoPtr := nil;
Q := nil;
P := FileRec^.Editor;
while P <> Editor do
begin
Q := P;
P := P^.Next
end;
if Q = nil then
FileRec^.Editor := P^.Next
else
Q^.Next := P^.Next;
if FileRec^.Editor = nil then
begin
QQ := nil;
PP := LoadedFiles;
while PP <> FileRec do
begin
QQ := PP;
PP := PP^.Next
end;
if QQ = nil then
LoadedFiles := PP^.Next
else
QQ^.Next := PP^.Next;
if Handle <> nil then
begin
DoFunc(edClearText);
FreeVMem(Handle)
end;
Dispose(FileRec);
end;
Dispose(Editor);
end;
end;
procedure TEditView.CenterScreen;
begin
DoFunc(edCenterFixScreenPos);
Repaint;
end;
procedure TEditView.ChangeBounds(var Bounds: TRect);
begin
Editor^.WindowWidth := Bounds.B.X - Bounds.A.X;
Editor^.WindowHeight := Bounds.B.Y - Bounds.A.Y;
TView.ChangeBounds(Bounds);
HScrollBar^.SetStep(Size.X, 1);
VScrollBar^.SetStep(Size.Y, 1);
end;
procedure TEditView.Clear;
begin
DoFunc(edDeleteBlockRaw);
CenterScreen;
end;
procedure TEditView.ClearModifiedFlag;
begin
EditData^.Modified := 0;
end;
procedure TEditView.CopyToClip;
const
CR: array[0..1] of Char = ^M#0;
begin
if Clipboard <> nil then
begin
Clipboard^.DoFunc(edEndCursorRaw);
if Clipboard^.Editor^.CursorPos.X <> 1 then
Clipboard^.DoFunc1(edInsertBuf, @CR);
Clipboard^.DoFunc1(edReadBlk, Pointer(hVMem));
Clipboard^.DoFunc(edMoveToBlockBegRaw);
Clipboard^.CenterScreen;
end;
end;
function TEditView.CanReplace: Word;
var
P: TPoint;
begin
MakeGlobal(Cursor, P);
CanReplace := MessageBox(sQueryReplace, Pointer(P),
mfInformation + mfAwarePoint + mfYesNoCancel);
end;
procedure TEditView.Copy;
begin
if Clipboard <> nil then
begin
DoFunc1(edWriteBlk, Pointer(hVMem));
CopyToClip;
Update;
end;
end;
procedure TEditView.Cut;
begin
Copy;
Clear;
end;
procedure TEditView.CompilerError(var S: string);
var
Color: Byte;
I: Integer;
B: TDrawBuffer;
begin
Color := GetColor(3);
MoveChar(B, ' ', Color, Size.X);
MoveStr(B[1], S, Color);
if Cursor.Y = 0 then
I := Size.Y - 1
else
I := 0;
WriteBuf(0, I, Size.X, 1, B);
end;
procedure TEditView.Draw;
begin
Editor^.PrevScreenRow := 0;
FillChar(Editor^.LineLens, SizeOf(Editor^.LineLens), 255);
DoFunc(edSmartRefreshScreen);
end;
function TEditView.EditData: PEditSegment;
begin
EditData := UseHandle(Editor^.Handle);
end;
function TEditView.GetHelpCtx: Word;
begin
if ProgramStatus = psRunning then
HelpCtx := hcDebugging
else
HelpCtx := hcEditWindow;
GetHelpCtx := TView.GetHelpCtx;
end;
function TEditView.GetPalette: PPalette;
const
P: string[Length(CEditView)] = CEditView;
begin
GetPalette := @P;
end;
procedure TEditView.GotoLine;
const
I: Integer = 1;
begin
if ExecDialog('GotoLineDialog', @I) <> cmCancel then
SetPos(1, I);
end;
procedure TEditView.GotoOldLine(I: Integer; Exec: Boolean);
begin
DoFunc1(edFindOldLine, Pointer(I));
if Exec then
EditData^.ExecBar := Editor^.CursorPos.Y;
CenterScreen;
end;
procedure TEditView.HandleEvent(var Event: TEvent);
const
Dummy: Integer = 0;
SearchStr: TSearchStr = '';
ReplaceStr: TSearchStr = '';
SearchOptions: Word = 0;
SearchAlready: Boolean = False;
Selecting: Boolean = False;
P: TPoint = (X: 0; Y: 0);
var
Mouse: TPoint;
ExitCode: Integer;
Double: Boolean;
First: Boolean;
Expand: Boolean;
LineSelDirection: Boolean;
H, SaveModified: Integer;
ShiftState: Byte absolute $40:$17;
procedure SetBegPoint;
begin
DoFunc(edSetPrevPos);
with Editor^ do
if PrevPos.Y < BlockBeg.Y then
P := BlockEnd
else if PrevPos.Y > BlockEnd.Y then
P := BlockBeg
else if PrevPos.X < BlockBeg.X then
P := BlockEnd
else
P := BlockBeg;
end;
procedure ExpandSel;
begin
DoFunc(edSetPrevPos);
with Editor^ do
if PrevPos.Y < P.Y then
begin
BlockEnd := P;
DoFunc(edSetBlockBegRaw);
end else if PrevPos.Y > P.Y then
begin
BlockBeg := P;
DoFunc(edSetBlockEndRaw);
end else if PrevPos.X < P.X then
begin
BlockEnd := P;
DoFunc(edSetBlockBegRaw);
end else
begin
BlockBeg := P;
DoFunc(edSetBlockEndRaw);
end;
end;
procedure ExpandLineSel;
var
SaveCursorPos: TPoint;
Y: Integer;
begin
with Editor^ do
begin
SaveCursorPos := CursorPos;
Y := ScreenPos.Y;
if P.Y < BlockEnd.Y then
begin
Inc(CursorPos.Y);
DoFunc(edLeftOfLine);
ExpandSel;
if not LineSelDirection then
begin
CursorPos.Y := P.Y + 1;
DoFunc(edLeftOfLine);
ExpandSel;
LineSelDirection := True;
end;
end else
begin
DoFunc(edLeftOfLine);
ExpandSel;
if LineSelDirection then
begin
CursorPos.Y := P.Y;
DoFunc(edLeftOfLine);
ExpandSel;
LineSelDirection := False;
end;
end;
CursorPos := SaveCursorPos;
ScreenPos.Y := Y;
end;
end;
procedure ProcessMouse;
var
Q: TPoint;
R: TRect;
begin
GetExtent(R);
Double := Event.Double;
First := True;
Expand := True;
LineSelDirection := True;
with Editor^ do
repeat
MakeLocal(Event.Where, Q);
if R.Contains(Q) then
begin
CursorPos.X := Q.X + ScreenPos.X;
CursorPos.Y := Q.Y + ScreenPos.Y;
if First then
begin
First := False;
Options := Options and not eoBlockHidden;
if ShiftState and (kbRightShift + kbLeftShift) = 0 then
begin
if Double then
DoFunc(edLeftOfLine);
DoFunc(edSetBlockBegRaw);
SetBegPoint;
if Double then
DoFunc(edCursorDown);
DoFunc(edSetBlockEndRaw);
end else
begin
SetBegPoint;
ExpandSel
end;
end else if Double then
ExpandLineSel
else
ExpandSel;
Repaint;
end else if Event.What = evMouseAuto then
begin
if Q.Y < 0 then
begin
CursorPos.Y := ScreenPos.Y;
DoFunc(edCursorUp);
Expand := True;
end;
if Q.Y >= Size.Y then
begin
CursorPos.Y := ScreenPos.Y + Size.Y - 1;
DoFunc(edCursorDown);
Expand := True;
end;
if Q.X < 0 then
begin
CursorPos.X := ScreenPos.X;
DoFunc(edCursorSwitchedLeft);
Expand := True;
end;
if Q.X >= Size.X then
begin
CursorPos.X := ScreenPos.X + Size.X - 1;
DoFunc(edCursorSwitchedRight);
Expand := True;
end;
if Expand then
begin
if Double then
ExpandLineSel
else
ExpandSel;
Repaint;
Expand := False;
end;
end;
until not MouseEvent(Event,evMouseMove + evMouseAuto);
end;
procedure ClearFoundBar;
begin
if EditData^.SearchPos <> -1 then
begin
EditData^.SearchPos := -1;
Repaint;
end;
end;
procedure UpdateOptions(P: PEditor); far;
begin
P^.Options := P^.Options and not ChangingOptions or
DefOptions and ChangingOptions;
if DefOptions and eoOverwrite <> 0 then
P^.EditView^.BlockCursor
else
P^.EditView^.NormalCursor;
end;
procedure InsertCompOpt;
var S: string;
begin
CompOptions(S);
S[Length(S)+1] := #0;
DoFunc1(edInsertBuf, @S[1]);
DrawView;
end;
begin
TView.HandleEvent(Event);
case Event.What of
evKeyDown:
begin
ClearFoundBar;
if (Event.ScanCode in Arrows) and
(ShiftState and (kbRightShift + kbLeftShift) <> 0) then
begin
Event.CharCode := #0;
if not Selecting then
begin
Editor^.Options := Editor^.Options and not eoBlockHidden;
DoFunc(edSetBlockBegRaw);
SetBegPoint;
DoFunc(edSetBlockEndRaw);
Selecting := True;
end;
end;
ExitCode := DoFunc(Event.KeyCode);
Update;
case ExitCode of
4:
if SearchDialog(SearchStr, SearchOptions) then
begin
SearchReplace(SearchStr, ReplaceStr, SearchOptions);
SearchAlready := True;
end;
5:
if SearchAlready then
SearchReplace(SearchStr,ReplaceStr,SearchOptions);
6:
if ReplaceDialog(SearchStr,ReplaceStr,SearchOptions) then
begin
SearchReplace(SearchStr,ReplaceStr,SearchOptions);
SearchAlready := True;
end;
3:
begin
H := RwBlock(0);
if H >= 0 then
begin
DoFunc1(edReadBlk, Pointer(H));
FClose(H);
Repaint;
end;
end;
2:
begin
H := RwBlock(1);
if H >= 0 then
begin
if DoFunc1(edWriteBlk, Pointer(H)) < 0 then
MessageBox(sDiskFull, nil, mfError + mfOkButton);
FClose(H);
end;
end;
18:
Save;
10:
InsertCompOpt;
11:
begin
SaveModified := EditData^.Modified;
DoFunc1(edWriteBlk, Pointer(4));
EditData^.Modified := SaveModified;
end;
20:
begin
Event.What := evCommand;
Event.Command := cmLastError;
PutEvent(Event);
end;
-1:
Exit;
else
if ExitCode < 0 then
begin
Event.What := evCommand;
Event.Command := ExitCode and $FF;
Event.InfoPtr := nil;
PutEvent(Event);
end;
end;
if (Event.ScanCode in Arrows) and
(ShiftState and (kbRightShift + kbLeftShift) <> 0) then
begin
if Selecting then
begin
ExpandSel;
Repaint
end
end else
Selecting:=False;
with Editor^ do
if DefOptions <> Options then
begin
DefOptions := Options;
ForEachEditor(@UpdateOptions);
end;
ClearEvent(Event);
end;
evMouseDown:
begin
ClearFoundBar;
ProcessMouse;
ClearEvent(Event);
end;
evRightClick:
if RBAction <> 0 then
begin
MakeLocal(Event.Where, Mouse);
with Editor^ do
begin
CursorPos.X := Mouse.X + ScreenPos.X;
CursorPos.Y := Mouse.Y + ScreenPos.Y;
end;
Repaint;
Event.What := evCommand;
Event.Command := RBActs[RBAction];
PutEvent(Event);
ClearEvent(Event);
end;
evCommand:
begin
case Event.Command of
cmFind:
if SearchDialog(SearchStr, SearchOptions) then
begin
SearchReplace(SearchStr, ReplaceStr, SearchOptions);
SearchAlready := True;
end;
cmReplace:
if ReplaceDialog(SearchStr, ReplaceStr, SearchOptions) then
begin
SearchReplace(SearchStr, ReplaceStr, SearchOptions);
SearchAlready := True;
end;
cmSearchAgain:
if SearchAlready then
SearchReplace(SearchStr, ReplaceStr, SearchOptions);
cmSave:
Save;
cmSaveAs:
SaveAs;
cmRestoreLine:
RestoreLine;
cmCut:
Cut;
cmCopy:
Copy;
cmPaste:
Paste;
cmClear:
Clear;
cmToggleBreakpoint:
ToggleBpt;
cmGotoLineNumber:
GotoLine;
cmPrint:
begin
SaveModified:=EditData^.Modified;
DoFunc1(edWriteFile, Pointer(4));
EditData^.Modified:=SaveModified;
end;
else
Exit;
end;
ClearEvent(Event);
end;
evBroadcast:
if Event.Command = cmScrollBarChanged then
with Editor^ do
if (HScrollBar = Event.InfoPtr) and
(HScrollBar^.Value <> ScreenPos.X) then
begin
ScreenPos.X:=HScrollBar^.Value;
DrawView;
end else if (VScrollBar = Event.InfoPtr) and
(VScrollBar^.Value<>ScreenPos.Y) then
begin
ScreenPos.Y := VScrollBar^.Value;
DrawView;
end;
evEditor, evConfig:
case Event.Command of
cmFindEditor:
if (Event.InfoPtr = nil) or
(Editor^.FileRec^.FileName = PString(Event.InfoPtr)^) then
ClearEvent(Event);
cmDirChanged:
PWindow(Owner)^.Frame^.DrawView;
cmSaveAll:
if Modified and not Save then
ClearEvent(Event);
cmUpdateCommandTable:
Editor^.CommandTable := Event.InfoPtr;
cmUpdateColors:
SetColors;
end;
end;
end;
procedure TEditView.SetBpt(var B: TBreakpoint);
begin
FillChar(B, SizeOf(B), 0);
B.FileName := Editor^.FileRec^.FileName;
B.LineNumber := Editor^.CursorPos.Y;
end;
function TEditView.BlockSet: Boolean;
begin
BlockSet := (Editor^.Options and eoBlockHidden = 0) and
((Editor^.BlockBeg.X <> Editor^.BlockEnd.X) or
(Editor^.BlockBeg.Y <> Editor^.BlockEnd.Y));
end;
function TEditView.CanRestore: Boolean;
begin
CanRestore := Editor^.UndoBeg.Y <> 0;
end;
function TEditView.Noname: Boolean;
begin
Noname := Unnamed(Editor^.FileRec^.FileName);
end;
function TEditView.DoFunc(Func: Word): Integer;
begin
DoFunc := EditFunc(Editor, Func, nil, 0);
end;
function TEditView.DoFunc1(Func: Word; Param: Pointer): Integer;
begin
DoFunc1 := EditFunc(Editor, Func, Param, 0);
end;
procedure TEditView.Message(I: Integer);
begin
MessageBox(I + sEditorErrorBase, nil, mfError + mfOkButton);
end;
function TEditView.Modified: Boolean;
begin
Modified := EditData^.Modified and (emShow + emUpdate) <> 0;
end;
function TEditView.RwBlock(Mode: Word): Integer;
var
H: Integer;
Name: PathStr;
P: Pointer;
I: Word;
PP: Pointer;
begin
Name := '';
H := -1;
if Mode = 0 then
begin
I := ExecDialog('ReadBlockDialog', @Name);
if I <> cmCancel then
begin
H := FOpen(Name, 0);
if H < 0 then
MessageBox(sFileNotFound, ParamFile(Name), mfError + mfOkButton);
end;
end else
begin
I := ExecDialog('WriteBlockDialog', @Name);
if (I <> cmCancel) and (not FileExists(Name) or
(MessageBox(sFileExists, ParamFile(Name), mfWarning + mfYesNoCancel) =
cmYes)) then
begin
H := FOpen(Name, 3);
if H < 0 then
MessageBox(sCantCreate, ParamFile(Name), mfError + mfOkButton);
end;
end;
RwBlock := H;
end;
procedure TEditView.Repaint;
begin
DoFunc(edFullPaintScreen);
Update;
end;
procedure TEditView.Paste;
begin
if Clipboard <> nil then
begin
Clipboard^.DoFunc1(edWriteBlk, Pointer(hVMem));
DoFunc1(edReadBlk, Pointer(hVMem));
Repaint;
end;
end;
procedure TEditView.ChangeName(S: PathStr);
var
P: PEditor;
begin
with Editor^.FileRec^ do
begin
FileName := S;
P := Editor;
while P <> nil do
begin
PEditView(P^.EditView)^.UpdateFrame;
P := P^.Next;
end;
end;
end;
procedure TEditView.EditNewFile(var S: PathStr);
begin
DoneEditor;
InitEditor(S);
SetScrollBars;
SetColors;
Draw;
UpdateFrame;
end;
function TEditView.ReplaceDialog(var S1, S2: TSearchStr; var Opts: Word):
Boolean;
const
R: record
S1, S2: TSearchStr;
Opts: Word;
Direction: Word;
Scope: Word;
Origin: Word;
end = (S1: ''; S2: ''; Opts: 8; Direction: 0; Scope: 0; Origin: 1);
var
I: Word;
begin
R.S1 := '';
I := ExecDialog('ReplaceDialog', @R);
if I <> cmCancel then
begin
S1 := R.S1;
S2 := R.S2;
Opts := esReplace;
if R.Opts and 1 = 0 then
Inc(Opts, esIgnoreCase);
if R.Opts and 2 <> 0 then
Inc(Opts, esWholeWordsOnly);
if R.Opts and 4 <> 0 then
Inc(Opts, esRegularExprs);
if R.Opts and 8 = 0 then
Inc(Opts, esNoPrompt);
if R.Direction <> 0 then
Inc(Opts, esBackward);
if R.Scope <> 0 then
Inc(Opts, esSelectedText);
if R.Origin <> 0 then
Inc(Opts, esEntireScope);
if I = cmChangeAll then
Inc(Opts, esChangeAll);
ReplaceDialog := True;
end else
ReplaceDialog := False;
end;
procedure TEditView.RestoreLine;
begin
DoFunc(edRestoreLine);
Repaint;
end;
function TEditView.SaveAs: Boolean;
var
S: PathStr;
P: Pointer;
begin
SaveAs := False;
S := '';
if (ExecDialog('SaveAsDialog', @S) <> cmCancel) and (not FileExists(S) or
(MessageBox(sFileExists, ParamFile(S), mfWarning + mfYesNoCancel) =
cmYes)) then
begin
ChangeName(S);
SaveAs := SaveFile;
end;
end;
function TEditView.Save: Boolean;
begin
if Noname then
Save := SaveAs
else
Save := SaveFile;
end;
function TEditView.SaveFile: Boolean;
var
H: Integer;
BakFile, TempFile: PathStr;
P: ^PathStr;
Success: Boolean;
SaveModified: Word;
function ForceExt(var S: PathStr; NewExt: ExtStr): PathStr;
var
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
begin
FSplit(S, Dir, Name, Ext);
ForceExt := Dir + Name + NewExt;
end;
function ErrorP(I: Integer): Boolean;
begin
ErrorP := (I <> 0) and (I <> -2);
end;
function Rename(var S1, S2: PathStr): Integer;
begin
if not FileExists(S1) then
Rename := -2
else
Rename := FRename(S1, S2);
end;
begin
SaveFile := False;
P := @Editor^.FileRec^.FileName;
if FileExists(P^) and (GetFileAttr(P^) and ReadOnly <> 0) then
begin
MessageBox(sReadOnly, ParamFile(P^), mfError + mfOkButton);
Exit;
end;
TempFile := ForceExt(Editor^.FileRec^.FileName, '.$$$');
Success := True;
H := FOpen(TempFile, 3);
if H >= 0 then
begin
SaveModified := EditData^.Modified;
StatusLine^.PrintStr(sSaving, @P);
if DoFunc1(edWriteFile, Pointer(H)) < 0 then
begin
FClose(H);
FDelete(TempFile);
MessageBox(sDiskFull, nil, mfError + mfOkButton);
end else
begin
if Editor^.FileRec^.Time <> -1 then
SetFTime(H, Editor^.FileRec^.Time);
FClose(H);
if BackupFiles then
begin
BakFile := ForceExt(Editor^.FileRec^.FileName, '.BAK');
if ErrorP(FDelete(BakFile)) or
ErrorP(Rename(Editor^.FileRec^.FileName, BakFile)) then
begin
MessageBox(sUnableBackup, ParamFile(P^), mfWarning + mfOkButton);
Success := not ErrorP(FDelete(Editor^.FileRec^.FileName));
end;
end else
Success := not ErrorP(FDelete(Editor^.FileRec^.FileName));
if not Success or (Rename(TempFile,Editor^.FileRec^.FileName) <> 0) then
begin
MessageBox(sCantCreate, ParamFile(P^), mfError + mfOkButton);
FDelete(TempFile);
EditData^.Modified := SaveModified;
Exit;
end;
Indicator^.SetValue(Editor^.CursorPos, False);
SaveFile := True;
end;
end else MessageBox(sCantCreate, ParamFile(P^), mfError + mfOkButton);
end;
procedure TEditView.SearchFailure(var S: TSearchStr);
begin
MessageBox(sStringNotFound, nil, mfError + mfOkButton);
end;
function TEditView.SearchDialog(var S: TSearchStr; var Opts: Word): Boolean;
const
R: record
S: TSearchStr;
Opts: Word;
Direction: Word;
Scope: Word;
Origin: Word;
end = (S: ''; Opts: 0; Direction: 0; Scope: 0; Origin: 1);
var
I: Word;
begin
R.S := '';
I := ExecDialog('FindDialog', @R);
if I <> cmCancel then
begin
S := R.S;
Opts := 0;
if R.Opts and 1 = 0 then
Inc(Opts, esIgnoreCase);
if R.Opts and 2 <> 0 then
Inc(Opts, esWholeWordsOnly);
if R.Opts and 4 <> 0 then
Inc(Opts, esRegularExprs);
if R.Direction <> 0 then
Inc(Opts, esBackward);
if R.Scope <> 0 then
Inc(Opts, esSelectedText);
if R.Origin <> 0 then
Inc(Opts, esEntireScope);
SearchDialog := True;
end else
SearchDialog := False;
end;
procedure TEditView.SearchReplace(var S1, S2: TSearchStr; var Opts: Word);
var
R: record
Opts: Word;
S: TSearchStr;
end;
Cont: Boolean;
function OK: Boolean;
var
I: Word;
begin
I := CanReplace;
if I = cmCancel then
Cont := False;
OK := I = cmYes;
end;
begin
R.Opts := Opts and not (esReplace + esNoPrompt + esChangeAll);
repeat
Cont := False;
R.S := S1;
if DoFunc1(edSearchText, @R) = 0 then
begin
CenterScreen;
if Opts and esReplace <> 0 then
begin
if Opts and esChangeAll <> 0 then
Cont := True;
if (Opts and esNoPrompt <> 0) or OK then
begin
R.S := S2;
DoFunc1(edReplaceText,@R);
end;
end;
end else if Opts and esChangeAll = 0 then
begin
SearchFailure(S1);
Cont := False;
end;
R.Opts := R.Opts and not esEntireScope;
until not Cont;
CenterScreen;
Opts := Opts and not esEntireScope;
end;
procedure TEditView.SetColors;
var
I: Integer;
begin
with Editor^ do
begin
Colors[0] := GetColor(1);
Colors[1] := GetColor(2);
Colors[2] := GetColor(5);
for I := 0 to 15 do
FileRec^.Breakpoints.EBpt[I].Color := GetColor(4);
end;
end;
procedure TEditView.SetPos(X, Y: Integer);
var
I: Integer;
begin
if (X > 0) and (Y > 0) and (Y <= TotalLines) then
with Editor^ do
begin
TempPos.X := X;
TempPos.Y := Y;
DoFunc(edMoveToTempPos);
CenterScreen;
end;
end;
procedure TEditView.SetScrollBars;
begin
HScrollBar^.SetParams(Editor^.CursorPos.X, 1, 128, Size.X, 1);
VScrollBar^.SetParams(Editor^.CursorPos.Y, 1, TotalLines, Size.Y, 1);
end;
procedure TEditView.SetState(AState: Word; Enable: Boolean);
procedure DoShow(P: PView);
begin
if Enable then
P^.Show
else
P^.Hide;
end;
begin
TView.SetState(AState, Enable);
case AState of
sfActive:
begin
Update;
DoShow(HScrollBar);
DoShow(VScrollBar);
DoShow(Indicator);
if Enable then
EnableCommands(EditCommands)
else
DisableCommands(EditCommands2);
end;
sfExposed:
SetColors;
end;
end;
procedure TEditView.Store(var S: TStream);
begin
TView.Store(S);
PutPeerViewPtr(S, HScrollBar);
PutPeerViewPtr(S, VScrollBar);
PutPeerViewPtr(S, Indicator);
S.Write(Editor^.FileRec^.FileName, Length(Editor^.FileRec^.FileName) + 1);
S.Write(Editor^.ScreenPos, 19 * SizeOf(TPoint));
S.Write(Editor^.Options, SizeOf(Word));
end;
procedure TEditView.ToggleBpt;
var
I: Integer;
B: TBreakpoint;
begin
with Editor^ do
begin
SetBpt(B);
I := FindBpt(B);
if I < BptCount then
DeleteBpt(I)
else
Tracer.SetBpt(I, B);
end;
ConnectAllBpts;
end;
function TEditView.TotalLines: Integer;
begin
TotalLines := DoFunc(edGetTotalLines);
end;
procedure TEditView.Update;
var
I: Word;
begin
with Editor^ do
begin
HScrollBar^.SetValue(ScreenPos.X);
VScrollBar^.SetValue(ScreenPos.Y);
Indicator^.SetValue(CursorPos, EditData^.Modified and emShow <> 0);
UpdateCommands;
I := EditData^.Modified;
if I and emUpdate <> 0 then
begin
EditData^.Modified := I and not emUpdate;
FileRec^.Time := GetDateTime;
Editor2Bpts(FileRec);
VScrollBar^.SetRange(1, TotalLines);
SourceModified := 1;
end;
end;
end;
procedure TEditView.UpdateCommands;
var
T: TCommandSet;
begin
if State and sfActive <> 0 then
begin
GetCommands(T);
ChangeSet(T, cmCut, BlockSet);
ChangeSet(T, cmCopy, BlockSet);
ChangeSet(T, cmClear, BlockSet);
ChangeSet(T, cmPaste, Clipboard^.BlockSet);
ChangeSet(T, cmRestoreLine, CanRestore);
SetCommands(T);
end;
end;
procedure TEditView.UpdateFrame;
begin
PWindow(Owner)^.Frame^.DrawView;
end;
function TEditView.Valid(Command: Word): Boolean;
var
L: array[0..0] of Longint;
S: TTitleStr;
begin
if IsValid then
begin
Valid := True;
if (Command <> cmValid) and Modified and
((Editor^.FileRec^.Editor^.Next = nil) or (Command = cmQuit)) then
begin
S := PWindow(Owner)^.GetTitle(36);
L[0] := Longint(@S);
case MessageBox(sFileModified, @L, mfInformation + mfYesNoCancel) of
cmYes:
Valid := Save;
cmNo:
ClearModifiedFlag;
cmCancel:
Valid := False;
end;
end;
end else
Valid := False;
end;
constructor TClipboard.Init(var Bounds: TRect;
AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator);
begin
TEditView.Init(Bounds, AHScrollBar, AVScrollBar, AIndicator, ClipName);
EventMask := EventMask and not evEditor;
Clipboard := @Self;
end;
constructor TClipboard.Load(var S:TStream);
begin
TEditView.Load(S);
Clipboard := @Self;
end;
procedure TClipboard.CopyToClip;
const
CR: array[0..1] of Char = ^M#0;
var
SaveCursorPos, SaveScreenPos: TPoint;
begin
with Editor^ do
begin
SaveCursorPos := CursorPos;
SaveScreenPos.Y := ScreenPos.Y;
SaveScreenPos.X := ScreenPos.X;
DoFunc(edEndCursorRaw);
end;
if Editor^.CursorPos.X <> 1 then
DoFunc1(edInsertBuf, @CR);
DoFunc1(edReadBlk, Pointer(hVMem));
with Editor^ do
begin
CursorPos := SaveCursorPos;
ScreenPos.Y := SaveScreenPos.Y;
ScreenPos.X := SaveScreenPos.X;
end;
Repaint;
end;
function TClipboard.GetHelpCtx: Word;
begin
GetHelpCtx := hcClipboard;
end;
procedure TClipboard.HandleEvent(var Event: TEvent);
begin
case Event.What of
evCommand:
if Event.Command = cmClose then
begin
Owner^.Hide;
ClearEvent(Event);
end;
end;
TEditView.HandleEvent(Event);
end;
function TClipboard.SaveAs: Boolean;
begin
SaveAs := TEditView.SaveAs;
ChangeName(ClipName);
end;
procedure TClipboard.SetState(AState: Word; Enable: Boolean);
begin
TEditView.SetState(AState, Enable);
if Enable and (AState and sfActive <> 0) then
DisableCommands(NoClipCommands);
end;
procedure TClipboard.UpdateFrame;
begin
end;
function TClipboard.Valid(Command: Word): Boolean;
begin
Valid := True;
end;
constructor TEditWindow.Init(var Bounds: TRect; AName: PString;
ANumber: Integer);
var
HScrollBar, VScrollBar: PScrollBar;
Indicator: PIndicator;
Extent, R: TRect;
S: string[25];
begin
if AName = nil then
S := Strings^.Get(sClipboard)
else
S := '';
TTurboWindow.Init(Bounds, S, ANumber, wpEditWindow);
GetExtent(Extent);
R.Assign(Extent.A.X + 18, Extent.B.Y - 1, Extent.B.X - 2, Extent.B.Y);
HScrollBar := New(PScrollBar, Init(R));
HScrollBar^.Hide;
Insert(HScrollBar);
R.Assign(Extent.B.X - 1, Extent.A.Y + 1, Extent.B.X, Extent.B.Y - 1);
VScrollBar := New(PScrollBar, Init(R));
VScrollBar^.Hide;
Insert(VScrollBar);
R.Assign(Extent.A.X + 2, Extent.B.Y - 1, Extent.A.X + 16, Extent.B.Y);
Indicator := New(PIndicator, Init(R));
Indicator^.Hide;
Insert(Indicator);
Extent.Grow(-1, -1);
if AName = nil then
EditView := New(PClipboard, Init(Extent, HScrollBar, VScrollBar, Indicator))
else
begin
EditView := New(PEditView, Init(Extent, HScrollBar, VScrollBar, Indicator, AName^));
HelpCtx := hcEditWindow;
end;
Options := Options or ofTileable;
Insert(EditView);
end;
constructor TEditWindow.Load(var S: TStream);
begin
TTurboWindow.Load(S);
GetSubViewPtr(S, EditView);
end;
function TEditWindow.GetTitle(MaxSize: Integer): TTitleStr;
var
S: PathStr;
begin
if Title <> nil then
GetTitle := Title^
else if EditView = nil then
GetTitle := ''
else
begin
S := EditView^.Editor^.FileRec^.FileName;
ConvertPath(S, MaxSize);
GetTitle := S;
end;
end;
procedure TEditWindow.Store(var S: TStream);
begin
TTurboWindow.Store(S);
PutSubViewPtr(S, EditView);
end;
function FindEditor(P: PString): PEditView;
begin
FindEditor := Message(Desktop, evEditor, cmFindEditor, P);
end;
procedure TopmostName(var S: PathStr);
var
P: PEditView;
begin
P := FindEditor(nil);
if P <> nil then
S := P^.Editor^.FileRec^.FileName
else
S := '';
end;
function CreateEditor(var S: PathStr; Replace, NoTop: Boolean): PEditView;
var
W: PEditWindow;
V: PEditView;
Event: TEvent;
P: PView;
Min, Max: TPoint;
R, Topmost, Extent: TRect;
begin
CreateEditor := nil;
V := FindEditor(nil);
if V = nil then
Replace := False
else if V^.Noname and (V^.TotalLines = 0) then
Replace := not Unnamed(S);
if Replace then
begin
if not V^.Valid(cmQuit) then
Exit
else
begin
V^.EditNewFile(S);
CreateEditor := V
end;
end else
begin
Desktop^.GetExtent(Extent);
Event.What := evBroadcast;
Event.Command := cmFindBottomLimit;
Event.InfoInt := Extent.B.Y;
Desktop^.HandleEvent(Event);
if Event.InfoInt - Extent.A.Y >= MinWinSize.Y then
Extent.B.Y := Event.InfoInt;
R := Extent;
if V <> nil then
begin
V^.Owner^.GetBounds(Topmost);
Inc(Topmost.A.X);
Inc(Topmost.A.Y);
V^.Owner^.SizeLimits(Min,Max);
if Topmost.B.X - Topmost.A.X < Min.X then
Topmost.B.X := Topmost.A.X + Min.X;
if Topmost.B.Y - Topmost.A.Y < Min.Y then
Topmost.B.Y := Topmost.A.Y + Min.Y;
R.Intersect(Topmost);
if not R.Equals(Topmost) then
R := Extent;
end;
W := PEditWindow(ValidView(New(PEditWindow, Init(R, @S, GetFreeWNum))));
if W <> nil then
begin
if NoTop and (V <> nil) then
P := V^.Owner
else
P := Desktop^.First;
Desktop^.InsertBefore(W, P);
CreateEditor := W^.EditView;
end;
end;
end;
function OpenFile(var S: PathStr; NoTop: Boolean): PEditView;
var
P: PEditView;
V: PView;
begin
P := FindEditor(@S);
if P <> nil then
begin
if NoTop then
V := FindEditor(nil)^.Owner
else
V := Desktop^.First;
P^.Owner^.PutInFrontOf(V);
end else if FileExists(S) then
P := CreateEditor(S, Preferences.SourceTracking <> 0, NoTop);
OpenFile := P;
end;
function GoFileLine(S: PathStr; I: Integer; Options: Byte): Boolean;
var
P: PEditView;
L: array[0..1] of Longint;
type
PLong = ^Longint;
begin
P := OpenFile(S, Options and gfNoTop <> 0);
if P <> nil then
begin
if Options and gfProgram <> 0 then
P^.GotoOldLine(I, Options and gfExec <> 0)
else
P^.SetPos(1, I);
GoFileLine := True
end else
begin
if Options and gfAlways <> 0 then
begin
L[0] := PLong(ParamFile(S))^;
L[1] := I;
MessageBox(sCantFindSource, @L, mfError + mfOkButton);
end;
GoFileLine := False;
end;
end;
procedure SetOptions;
procedure DoSetOptions(P: PEditor); far;
begin
P^.Options := P^.Options and not ChangingOptions or
DefOptions and ChangingOptions;
P^.TabSize := DefTabSize;
P^.EditView^.SetState(sfCursorIns, DefOptions and eoOverwrite <> 0);
P^.EditView^.DrawView;
end;
begin
ForEachEditor(@DoSetOptions);
end;
end.