mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 00:09:31 +02:00
+ check if file on disk was changed since load before overwriting
This commit is contained in:
pierre
parent
3c082620f0
commit
a7c0bd0909
@ -21,6 +21,11 @@ interface
|
||||
uses
|
||||
Dos,Objects,Drivers,Views,Menus,Commands;
|
||||
|
||||
|
||||
{ try to only do syntax on part of file until current position
|
||||
does not work correctly yet PM }
|
||||
{ $define TEST_PARTIAL_SYNTAX}
|
||||
|
||||
const
|
||||
cmFileNameChanged = 51234;
|
||||
cmASCIIChar = 51235;
|
||||
@ -79,6 +84,7 @@ const
|
||||
edReplaceFile = 13;
|
||||
edWriteBlock = 14;
|
||||
edReadBlock = 15;
|
||||
edFileOnDiskChanged = 16;
|
||||
|
||||
ffmOptions = $0007; ffsOptions = 0;
|
||||
ffmDirection = $0008; ffsDirection = 3;
|
||||
@ -167,6 +173,8 @@ type
|
||||
Modified : Boolean;
|
||||
{$ifdef debug}
|
||||
StoreUndo : Boolean;
|
||||
SyntaxComplete : boolean;
|
||||
UseTabs : Boolean;
|
||||
{$endif debug}
|
||||
constructor Init(var Bounds: TRect);
|
||||
procedure Draw; virtual;
|
||||
@ -304,6 +312,10 @@ type
|
||||
private
|
||||
LastLocalCmd: word;
|
||||
KeyState : Integer;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
LastSyntaxedLine : sw_integer;
|
||||
SyntaxComplete : boolean;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
ErrorMessage: PString;
|
||||
Bookmarks : array[0..9] of TEditorBookmark;
|
||||
LockFlag : integer;
|
||||
@ -404,6 +416,9 @@ type
|
||||
function ShouldSave: boolean; virtual;
|
||||
constructor Load(var S: TStream);
|
||||
procedure Store(var S: TStream);
|
||||
function IsChangedOnDisk : boolean;
|
||||
private
|
||||
OnDiskLoadTime : longint;
|
||||
end;
|
||||
|
||||
TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
|
||||
@ -1073,10 +1088,14 @@ begin
|
||||
{$ifdef debug}
|
||||
if StoreUndo then
|
||||
WordRec (B[1]).Lo := ord('S');
|
||||
if SyntaxComplete then
|
||||
WordRec(B[2]).lo := ord('C');
|
||||
if UseTabs then
|
||||
WordRec(B[3]).lo := ord('T');
|
||||
{$endif debug}
|
||||
L[0] := Location.Y + 1;
|
||||
L[1] := Location.X + 1;
|
||||
FormatStr(S, ' %d:%d ', L);
|
||||
FormatStr(S, '%d:%d ', L);
|
||||
MoveStr(B[8 - Pos(':', S)], S, Color);
|
||||
end;
|
||||
WriteBuf(0, 0, Size.X, 1, B);
|
||||
@ -1150,7 +1169,11 @@ begin
|
||||
SetDebuggerRow(-1);
|
||||
SetCurPtr(0,0);
|
||||
Indicator:=AIndicator;
|
||||
UpdateIndicator; LimitsChanged;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
SyntaxComplete:=true;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
UpdateIndicator;
|
||||
LimitsChanged;
|
||||
end;
|
||||
|
||||
procedure TCodeEditor.SetFlags(AFlags: longint);
|
||||
@ -1296,6 +1319,10 @@ begin
|
||||
Indicator^.Modified:=Modified;
|
||||
{$ifdef debug}
|
||||
Indicator^.StoreUndo:=StoreUndo;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
Indicator^.SyntaxComplete:=SyntaxComplete and ((Flags and efSyntaxHighlight)<>0);
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
Indicator^.UseTabs:=((Flags and efUseTabCharacters)<>0);
|
||||
{$endif debug}
|
||||
if lockflag>0 then
|
||||
IndicatorDrawCalled:=true
|
||||
@ -1638,6 +1665,10 @@ begin
|
||||
HighlightColColor:=GetColor(11);
|
||||
HighlightRowColor:=GetColor(12);
|
||||
ErrorMessageColor:=GetColor(16);
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
If LastSyntaxedLine<Delta.Y+Size.Y then
|
||||
UpdateAttrsRange(LastSyntaxedLine,Delta.Y+Size.Y,AttrAll);
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
for Y:=0 to Size.Y-1 do
|
||||
if Y=ErrorLine then
|
||||
begin
|
||||
@ -2631,7 +2662,7 @@ begin
|
||||
else LastX:=0;
|
||||
end
|
||||
else begin
|
||||
SetDisplayText(CurLine,copy(S,1,StartX)+copy(S,EndX+1,255));
|
||||
SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)+copy(S,EndX+1,255));
|
||||
LastX:=StartX;
|
||||
if (StartX=0) and (0<LineDelta) and
|
||||
not(((LineDelta=LineCount-1) and (StartX=0) and (StartX=EndX))) then
|
||||
@ -3971,10 +4002,20 @@ var
|
||||
var CurLine: Sw_integer;
|
||||
Line,NextLine,PrevLine,OldLine: PLine;
|
||||
begin
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
If ((Flags and efSyntaxHighlight)<>0) and (LastSyntaxedLine<FromLine)
|
||||
and (FromLine<GetLineCount) then
|
||||
FromLine:=UpdateAttrsRange(LastSyntaxedLine,FromLine,Attrs);
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
if ((Flags and efSyntaxHighlight)=0) or (FromLine>=GetLineCount) then
|
||||
begin
|
||||
SetLineFormat(FromLine,'');
|
||||
UpdateAttrs:=GetLineCount-1;
|
||||
UpdateAttrs:=GetLineCount;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
LastSyntaxedLine:=GetLineCount;
|
||||
SyntaxComplete:=true;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
UpdateIndicator;
|
||||
Exit;
|
||||
end;
|
||||
CurLine:=FromLine;
|
||||
@ -4035,20 +4076,37 @@ begin
|
||||
(NextLine^.BeginsWithDirective=Line^.EndsWithDirective) and
|
||||
(NextLine^.Format<>nil) then
|
||||
Break;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
if not SyntaxComplete then
|
||||
if ((Attrs and attrForceFull)=0) and
|
||||
(CurLine>Delta.Y+Size.Y) then
|
||||
break;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
PrevLine:=Line;
|
||||
until false;
|
||||
UpdateAttrs:=CurLine;
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
If LastSyntaxedLine<CurLine-1 then
|
||||
LastSyntaxedLine:=CurLine-1;
|
||||
if CurLine=GetLineCount then
|
||||
begin
|
||||
SyntaxComplete:=true;
|
||||
UpdateIndicator;
|
||||
end;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
end;
|
||||
|
||||
|
||||
function TCodeEditor.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
|
||||
var Line: Sw_integer;
|
||||
begin
|
||||
Lock;
|
||||
Line:=FromLine;
|
||||
repeat
|
||||
Line:=UpdateAttrs(Line,Attrs);
|
||||
until (Line>GetLineCount) or (Line>ToLine);
|
||||
until (Line>=GetLineCount) or (Line>ToLine);
|
||||
UpdateAttrsRange:=Line;
|
||||
Unlock;
|
||||
end;
|
||||
|
||||
|
||||
@ -4389,6 +4447,9 @@ begin
|
||||
begin
|
||||
S.Read(TSize,SizeOf(TSize));
|
||||
New(TS, Init(@S,S.GetPos,TSize));
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
SyntaxComplete:=false;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
LoadFromStream(TS);
|
||||
Dispose(TS, Done);
|
||||
end;
|
||||
@ -4456,7 +4517,12 @@ begin
|
||||
end;
|
||||
LimitsChanged;
|
||||
if (Flags and efSyntaxHighlight)<>0 then
|
||||
UpdateAttrsRange(0,GetLineCount-1,attrAll+attrForceFull);
|
||||
UpdateAttrsRange(0,Min(Delta.Y+Size.Y,GetLineCount-1),
|
||||
attrAll
|
||||
{$ifndef TEST_PARTIAL_SYNTAX}
|
||||
+attrForceFull
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
);
|
||||
TextStart;
|
||||
LoadFromStream:=OK;
|
||||
end;
|
||||
@ -4572,63 +4638,43 @@ begin
|
||||
FileName:=AFileName;
|
||||
UpdateIndicator;
|
||||
Message(@Self,evBroadcast,cmFileNameChanged,@Self);
|
||||
OnDiskLoadTime:=-1;
|
||||
end;
|
||||
|
||||
(*function TFileEditor.LoadFile: boolean;
|
||||
var S: string;
|
||||
OK: boolean;
|
||||
f: text;
|
||||
FM,Line: Sw_integer;
|
||||
Buf : Pointer;
|
||||
begin
|
||||
DeleteAllLines;
|
||||
GetMem(Buf,EditorTextBufSize);
|
||||
{$I-}
|
||||
EatIO;
|
||||
FM:=FileMode; FileMode:=0;
|
||||
Assign(f,FileName);
|
||||
SetTextBuf(f,Buf^,EditorTextBufSize);
|
||||
Reset(f);
|
||||
OK:=(IOResult=0);
|
||||
if Eof(f) then
|
||||
AddLine('')
|
||||
else
|
||||
while OK and (Eof(f)=false) and (GetLineCount<MaxLineCount) do
|
||||
begin
|
||||
readln(f,S);
|
||||
OK:=OK and (IOResult=0);
|
||||
if OK AddLine(S);
|
||||
end;
|
||||
FileMode:=FM;
|
||||
Close(F);
|
||||
EatIO;
|
||||
{$I+}
|
||||
LimitsChanged;
|
||||
if (Flags and efSyntaxHighlight)<>0 then
|
||||
UpdateAttrsRange(0,GetLineCount-1,attrAll+attrForceFull);
|
||||
TextStart;
|
||||
LoadFile:=OK;
|
||||
FreeMem(Buf,EditorTextBufSize);
|
||||
end;*)
|
||||
|
||||
function TFileEditor.LoadFile: boolean;
|
||||
var S: PBufStream;
|
||||
OK: boolean;
|
||||
begin
|
||||
New(S, Init(FileName,stOpenRead,EditorTextBufSize));
|
||||
OK:=Assigned(S);
|
||||
{$ifdef TEST_PARTIAL_SYNTAX}
|
||||
SyntaxComplete:=false;
|
||||
{$endif TEST_PARTIAL_SYNTAX}
|
||||
if OK then OK:=LoadFromStream(S);
|
||||
if Assigned(S) then Dispose(S, Done);
|
||||
|
||||
OnDiskLoadTime:=GetFileTime(FileName);
|
||||
LoadFile:=OK;
|
||||
end;
|
||||
|
||||
function TFileEditor.IsChangedOnDisk : boolean;
|
||||
begin
|
||||
IsChangedOnDisk:=OnDiskLoadTime<>GetFileTime(FileName);
|
||||
end;
|
||||
|
||||
function TFileEditor.SaveFile: boolean;
|
||||
var OK: boolean;
|
||||
BAKName: string;
|
||||
S: PBufStream;
|
||||
f: text;
|
||||
begin
|
||||
If IsChangedOnDisk then
|
||||
begin
|
||||
if EditorDialog(edFileOnDiskChanged, @FileName) <> cmYes then
|
||||
begin
|
||||
SaveFile:=false;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
{$I-}
|
||||
if (Flags and efBackupFiles)<>0 then
|
||||
begin
|
||||
@ -4646,6 +4692,8 @@ begin
|
||||
if OK then OK:=SaveToStream(S);
|
||||
if Assigned(S) then Dispose(S, Done);
|
||||
if OK then SetModified(false);
|
||||
{ don't forget to update the OnDiskLoadTime value }
|
||||
OnDiskLoadTime:=GetFileTime(FileName);
|
||||
SaveFile:=OK;
|
||||
end;
|
||||
|
||||
@ -4981,6 +5029,10 @@ begin
|
||||
edSaveUntitled:
|
||||
StdEditorDialog := MessageBox('Save untitled file?',
|
||||
nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
|
||||
edFileOnDiskChanged:
|
||||
StdEditorDialog := MessageBox(#3'File %s '#13#3+
|
||||
'was modified by another program.'#13#3'Overwrite new version?',
|
||||
@info, mfInsertInApp+ mfInformation + mfYesNoCancel);
|
||||
edSaveAs,edWriteBlock,edReadBlock:
|
||||
begin
|
||||
Name:=PString(Info)^;
|
||||
@ -4994,7 +5046,10 @@ begin
|
||||
else
|
||||
DriveNumber:=Ord(FileDir[1])-ord('A')+1;
|
||||
GetDir(DriveNumber,StoreDir2);
|
||||
{$ifndef FPC}
|
||||
ChDir(Copy(FileDir,1,2));
|
||||
{ this sets InOutRes in win32 PM }
|
||||
{$endif not FPC}
|
||||
end;
|
||||
if FileDir<>'' then
|
||||
ChDir(FileDir);
|
||||
@ -5033,10 +5088,10 @@ begin
|
||||
end;
|
||||
if DriveNumber<>0 then
|
||||
ChDir(StoreDir2);
|
||||
{$ifdef TP}
|
||||
{$ifndef FPC}
|
||||
if (Length(StoreDir)>1) and (StoreDir[2]=':') then
|
||||
ChDir(Copy(StoreDir,1,2));
|
||||
{$endif}
|
||||
{$endif not FPC}
|
||||
if StoreDir<>'' then
|
||||
ChDir(StoreDir);
|
||||
|
||||
@ -5097,7 +5152,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.63 1999-11-22 17:34:08 pierre
|
||||
Revision 1.64 1999-12-01 17:25:00 pierre
|
||||
+ check if file on disk was changed since load before overwriting
|
||||
|
||||
Revision 1.63 1999/11/22 17:34:08 pierre
|
||||
* fix for form bug 634
|
||||
|
||||
Revision 1.62 1999/11/18 13:42:06 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user