{ This file is part of the Free Pascal Integrated Development Environment Copyright (c) 1998-2000 by Berczi Gabor Code editor template objects See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$i globdir.inc} unit WCEdit; {$ifdef cpullvm} {$modeswitch nestedprocvars} {$endif} interface uses Objects,Drivers,Views, WUtils,WEditor; type PCodeEditor = ^TCodeEditor; PIndicator = ^TIndicator; TIndicator = object(TView) Location: TPoint; Modified : Boolean; CodeOwner : PCodeEditor; {$ifdef debug} StoreUndo : Boolean; SyntaxComplete : boolean; UseTabs : Boolean; {$endif debug} constructor Init(var Bounds: TRect); procedure Draw; virtual; function GetPalette: PPalette; virtual; procedure SetState(AState: Word; Enable: Boolean); virtual; procedure SetValue(ALocation: TPoint; AModified: Boolean); end; PLine = ^TLine; TLine = object(TCustomLine) public { internal use only! } {$if sizeof(sw_astring)>8} Text : PString; { ShortString version } {$else} Text : sw_AString; { AnsiString version } {$endif} DefaultEditorInfo : PEditorLineInfo; EditorInfos : PEditorLineInfoCollection; Flags : longint; Owner : PCustomCodeEditorCore; procedure AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor); virtual; procedure RemoveEditorInfo(AEditor: PCustomCodeEditor); virtual; public constructor Init(AOwner: PCustomCodeEditorCore; const AText: sw_AString; AFlags: longint); function GetText: sw_AString; virtual; procedure SetText(const AText: sw_AString); virtual; function GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo; virtual; function GetFlags: longint; virtual; procedure SetFlags(AFlags: longint); virtual; destructor Done; virtual; end; PCodeEditorCore = ^TCodeEditorCore; TCodeEditorCore = object(TCustomCodeEditorCore) protected Lines : PLineCollection; CanUndo : Boolean; StoreUndo : boolean; Modified : Boolean; ReadOnly : Boolean; TabSize : integer; IndentSize : integer; ModifiedTime : cardinal; public UndoList : PEditorActionCollection; RedoList : PEditorActionCollection; constructor Init; destructor Done; virtual; procedure ChangeLinesTo(ALines : PLineCollection); virtual; function GetModified: boolean; virtual; procedure SetModified(AModified: boolean); virtual; function GetModifyTime: cardinal; virtual; function GetTabSize: integer; virtual; procedure SetTabSize(ATabSize: integer); virtual; function GetIndentSize: integer; virtual; procedure SetIndentSize(AIndentSize: integer); virtual; function GetStoreUndo: boolean; virtual; procedure SetStoreUndo(AStore: boolean); virtual; function GetSyntaxCompleted: boolean; virtual; procedure SetSyntaxCompleted(SC : boolean); virtual; function GetLastSyntaxedLine: sw_integer; virtual; procedure SetLastSyntaxedLine(ALine: sw_integer); virtual; { Storage } protected { Text & info storage abstraction } procedure ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); virtual; procedure IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:sw_astring); virtual; function IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): sw_astring; virtual; procedure ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: sw_astring); virtual; public { Text & info storage abstraction } function GetLineCount: sw_integer; virtual; function GetLine(LineNo: sw_integer): PCustomLine; virtual; function GetLineText(LineNo: sw_integer): sw_AString; virtual; procedure SetDisplayText(I: sw_integer;const S: sw_astring); virtual; function GetDisplayText(I: sw_integer): sw_astring; virtual; procedure SetLineText(I: sw_integer;const S: sw_AString); virtual; procedure DeleteAllLines; virtual; procedure DeleteLine(I: sw_integer); virtual; function InsertLine(LineNo: sw_integer; const S: sw_AString): PCustomLine; virtual; procedure AddLine(const S: sw_AString); virtual; procedure GetContent(ALines: PUnsortedStringCollection); virtual; procedure SetContent(ALines: PUnsortedStringCollection); virtual; public { Undo info storage } procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint); virtual; procedure AddGroupedAction(AAction : byte); virtual; procedure CloseGroupedAction(AAction : byte); virtual; function GetUndoActionCount: sw_integer; virtual; function GetRedoActionCount: sw_integer; virtual; private OnDiskLoadTime : cardinal; SystemLoadTime : cardinal; procedure LinesInsert(Idx: sw_integer; Line: PLine); end; TCodeEditor = object(TCustomCodeEditor) Core : PCodeEditorCore; Flags : longint; Indicator : PIndicator; HighlightRow: sw_integer; DebuggerRow: sw_integer; CodeCompleteFrag: PString; CodeCompleteWord: PString; ReadOnly : boolean; CompleteState: TCompleteState; ErrorMessage: PString; IndicatorDrawCalled : boolean; Folds : PFoldCollection; MaxFoldLevel: sw_integer; constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator; ACore: PCodeEditorCore); public procedure DrawIndicator; virtual; public function GetFlags: longint; virtual; procedure SetFlags(AFlags: longint); virtual; function GetModified: boolean; virtual; procedure SetModified(AModified: boolean); virtual; function GetStoreUndo: boolean; virtual; procedure SetStoreUndo(AStore: boolean); virtual; procedure ClearUndoList; function GetSyntaxCompleted: boolean; virtual; procedure SetSyntaxCompleted(SC : boolean); virtual; function GetLastSyntaxedLine: sw_integer; virtual; procedure SetLastSyntaxedLine(ALine: sw_integer); virtual; function GetTabSize: integer; virtual; procedure SetTabSize(ATabSize: integer); virtual; function GetIndentSize: integer; virtual; procedure SetIndentSize(AIndentSize: integer); virtual; function IsReadOnly: boolean; virtual; public procedure UpdateIndicator; virtual; procedure ModifiedChanged; virtual; procedure PositionChanged; virtual; procedure LimitsChanged; virtual; function IsClipboard: Boolean; virtual; function LoadFromStream(Stream: PFastBufStream): boolean; virtual; function SaveToStream(Stream: PStream): boolean; virtual; function SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;virtual; destructor Done; virtual; public { ChangedLine : sw_integer;} { Text & info storage abstraction } function GetLineCount: sw_integer; virtual; function GetLine(LineNo: sw_integer): PCustomLine; virtual; function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer; virtual; function LinePosToCharIdx(Line,X: sw_integer): sw_integer; virtual; function GetLineText(I: sw_integer): sw_AString; virtual; procedure SetDisplayText(I: sw_integer;const S: sw_astring); virtual; function GetDisplayText(I: sw_integer): sw_astring; virtual; procedure SetLineText(I: sw_integer;const S: sw_AString); virtual; procedure GetDisplayTextFormat(I: sw_integer;var DT,DF:sw_astring); virtual; function GetLineFormat(I: sw_integer): sw_astring; virtual; procedure SetLineFormat(I: sw_integer;const S: sw_astring); virtual; procedure DeleteAllLines; virtual; procedure DeleteLine(I: sw_integer); virtual; function InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine; virtual; procedure AddLine(const S: sw_astring); virtual; function GetErrorMessage: string; virtual; procedure SetErrorMessage(const S: string); virtual; procedure GetContent(ALines: PUnsortedStringCollection); virtual; procedure SetContent(ALines: PUnsortedStringCollection); virtual; procedure Lock; virtual; procedure UnLock; virtual; public { CodeComplete support } function GetCodeCompleteWord: string; virtual; procedure SetCodeCompleteWord(const S: string); virtual; function GetCodeCompleteFrag: string; virtual; procedure SetCodeCompleteFrag(const S: string); virtual; function GetCompleteState: TCompleteState; virtual; procedure SetCompleteState(AState: TCompleteState); virtual; public { Syntax highlight } {a}function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; virtual; {a}function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; virtual; public { Undo info storage } procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint); virtual; procedure AddGroupedAction(AAction : byte); virtual; procedure CloseGroupedAction(AAction : byte); virtual; function GetUndoActionCount: sw_integer; virtual; function GetRedoActionCount: sw_integer; virtual; procedure JumpToLastCursorPos; virtual; procedure Undo; virtual; procedure Redo; virtual; { Fold support } function GetMaxFoldLevel: sw_integer; virtual; function GetFoldCount: sw_integer; virtual; function GetFold(Index: sw_integer): PFold; virtual; procedure RegisterFold(AFold: PFold); virtual; procedure UnRegisterFold(AFold: PFold); virtual; end; PFileEditor = ^TFileEditor; TFileEditor = object(TCodeEditor) FileName: string; constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator; ACore: PCodeEditorCore; const AFileName: string); function Save: Boolean; virtual; function SaveAs: Boolean; virtual; function SaveAsk(Command: Word; Force: boolean): boolean; virtual; function LoadFile: boolean; virtual; function ReloadFile: boolean; virtual; function SaveFile: boolean; virtual; function Valid(Command: Word): Boolean; virtual; procedure HandleEvent(var Event: TEvent); virtual; function ShouldSave: boolean; virtual; function IsChangedOnDisk : boolean; public procedure BindingsChanged; virtual; end; function DefUseSyntaxHighlight(Editor: PFileEditor): boolean; function DefUseTabsPattern(Editor: PFileEditor): boolean; const DefaultCodeEditorFlags : longint = efBackupFiles+efInsertMode+efAutoIndent+efPersistentBlocks+efOverwriteBlocks+ {efUseTabCharacters+}efBackSpaceUnindents+efSyntaxHighlight+ efExpandAllTabs+efCodeComplete{+efFolds}; DefaultTabSize : integer = 8; DefaultIndentSize : integer = 1; UseSyntaxHighlight : function(Editor: PFileEditor): boolean = {$ifdef fpc}@{$endif}DefUseSyntaxHighlight; UseTabsPattern : function(Editor: PFileEditor): boolean = {$ifdef fpc}@{$endif}DefUseTabsPattern; procedure RegisterWCEdit; implementation uses Dos, WConsts, FVConsts,FPConst, App,WViews; {$ifndef NOOBJREG} const RIndicator: TStreamRec = ( ObjType: 1100; VmtLink: Ofs(TypeOf(TIndicator)^); Load: @TIndicator.Load; Store: @TIndicator.Store ); RCodeEditor: TStreamRec = ( ObjType: 1101; VmtLink: Ofs(TypeOf(TCodeEditor)^); Load: @TCodeEditor.Load; Store: @TCodeEditor.Store ); RFileEditor: TStreamRec = ( ObjType: 1102; VmtLink: Ofs(TypeOf(TFileEditor)^); Load: @TFileEditor.Load; Store: @TFileEditor.Store ); {$endif} constructor TLine.Init(AOwner: PCustomCodeEditorCore; const AText: sw_AString; AFlags: longint); begin inherited Init(AText,AFlags); // New(EditorInfos, Init(10,10)); Owner:=AOwner; end; procedure TLine.AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor); begin if Index=0 then begin DefaultEditorInfo:=New(PEditorLineInfo, Init(AEditor)); exit; end; if not assigned(EditorInfos) then begin New(EditorInfos, Init(10,10)); EditorInfos^.AtInsert(0,DefaultEditorInfo); DefaultEditorInfo:=nil; end; EditorInfos^.AtInsert(Index,New(PEditorLineInfo, Init(AEditor))); end; procedure TLine.RemoveEditorInfo(AEditor: PCustomCodeEditor); var E: PEditorLineInfo; begin E:=GetEditorInfo(AEditor); if Assigned(EditorInfos) then EditorInfos^.Free(E); end; function TLine.GetText: sw_AString; begin {$if sizeof(sw_astring)>8} GetText:=GetStr(Text); {$else} GetText:=Text; {$endif} end; procedure TLine.SetText(const AText: sw_AString); begin {$if sizeof(sw_astring)>8} SetStr(Text,AText); {$else} Text:=AText; {$endif} end; function TLine.GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo; function Match(P: PEditorLineInfo): boolean; begin Match:=P^.Editor=Editor; end; begin if not assigned(EditorInfos) then GetEditorInfo:=DefaultEditorInfo else GetEditorInfo:=EditorInfos^.FirstThat(TCallbackFunBoolParam(@Match)); end; function TLine.GetFlags: longint; begin GetFlags:=Flags; end; procedure TLine.SetFlags(AFlags: longint); begin Flags:=AFlags; if Assigned(Owner) then Owner^.ContentsChanged; end; destructor TLine.Done; begin {$if sizeof(sw_astring)>8} { ShortString version } if Assigned(Text) then DisposeStr(Text); Text:=nil; {$else} Text:=''; { AnsiString version } {$endif} if Assigned(EditorInfos) then Dispose(EditorInfos, Done); EditorInfos:=nil; if Assigned(DefaultEditorInfo) then Dispose(DefaultEditorInfo, Done); DefaultEditorInfo:=nil; inherited Done; end; constructor TCodeEditorCore.Init; begin inherited Init; StoreUndo:=true; new(UndoList,init(500,1000)); new(RedoList,init(500,1000)); New(Lines, Init(500,1000)); TabSize:=DefaultTabSize; IndentSize:=DefaultIndentSize; OnDiskLoadTime:=0; SystemLoadTime:=0; end; procedure TCodeEditorCore.ChangeLinesTo(ALines : PLineCollection); begin if assigned(lines) then Dispose(Lines,Done); Lines:=ALines; end; function TCodeEditorCore.GetLineCount: sw_integer; begin GetLineCount:=Lines^.Count; end; function TCodeEditorCore.GetLine(LineNo: sw_integer): PCustomLine; begin GetLine:=Lines^.At(LineNo); end; function TCodeEditorCore.GetModified: boolean; begin GetModified:=Modified; end; function TCodeEditorCore.GetModifyTime: cardinal; begin GetModifyTime:=ModifiedTime; end; procedure TCodeEditorCore.SetModified(AModified: boolean); begin if AModified<>Modified then begin Modified:=AModified; ModifiedChanged; end; ModifiedTime:=cardinal(Now); end; function TCodeEditorCore.GetStoreUndo: boolean; begin GetStoreUndo:=StoreUndo; end; procedure TCodeEditorCore.SetStoreUndo(AStore: boolean); begin if StoreUndo<>AStore then begin StoreUndo:=AStore; StoreUndoChanged; end; end; function TCodeEditorCore.GetSyntaxCompleted: boolean; begin {$ifdef TEST_PARTIAL_SYNTAX} GetSyntaxCompleted:=SyntaxComplete; {$else} GetSyntaxCompleted:=true; {$endif} end; procedure TCodeEditorCore.SetSyntaxCompleted(SC: boolean); begin {$ifdef TEST_PARTIAL_SYNTAX} if SC<>SyntaxComplete then begin SyntaxComplete:=SC; end; {$endif} end; function TCodeEditorCore.GetLastSyntaxedLine: sw_integer; begin GetLastSyntaxedLine:=LastSyntaxedLine; end; procedure TCodeEditorCore.SetLastSyntaxedLine(ALine: sw_integer); begin LastSyntaxedLine:=ALine; end; procedure TCodeEditorCore.ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); var P: PCustomLine; begin if LineNoTabSize then begin TabSize:=ATabSize; TabSizeChanged; end; end; function TCodeEditorCore.GetIndentSize: integer; begin GetIndentSize:=IndentSize; end; procedure TCodeEditorCore.SetIndentSize(AIndentSize: integer); begin if AIndentSize<>IndentSize then begin IndentSize:=AIndentSize; end; end; function TCodeEditorCore.GetLineText(LineNo: sw_integer): sw_AString; var L : PCustomLine; begin GetLineText:=''; if LineNo0 then LimitsChanged; L:=Lines^.At(I); L^.SetText(S); ContentsChanged; end; function TCodeEditorCore.GetDisplayText(I: sw_integer): sw_astring; begin GetDisplayText:=ExtractTabs(GetLineText(I),GetTabSize); end; procedure TCodeEditorCore.SetDisplayText(I: sw_integer;const S: sw_astring); begin { I disagree here I don't want the editor to change the position of the tabs in my makefiles !! PM if FlagSet(efUseTabCharacters) and (TabSize>0) then SetLineText(I,CompressUsingTabs(S,TabSize)) else } { ... then you better make this optional - Gabor } SetLineText(I,S); end; procedure TCodeEditorCore.IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:sw_astring); var L : PCustomLine; P,PAdd : SW_Integer; begin DF:=''; DT:=''; if (0<=LineNo) and (LineNo'' then DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,Length(DF)); DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,Length(DT)); inc(P,PAdd-1); end; end; end; end; function TCodeEditorCore.IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): sw_astring; var P: PCustomLine; LI: PEditorLineInfo; S: sw_astring; begin if (0<=LineNo) and (LineNo0 then begin pa:=UndoList^.At(UndoList^.count-1); if (pa^.action=AAction) and (pa^.EndPos.X=AStartPos.X) and (pa^.EndPos.Y=AStartPos.Y) and { do not group InsertLine and DeleteLine !! } ((AAction=eaMoveCursor) or (AAction=eaInsertText) or (AAction=eaOverwriteText) or (AAction=eaDeleteText)) and { do not group if a new grouped_action started } (not assigned(UndoList^.CurrentGroupedAction) or (UndoList^.CurrentGroupedAction^.ActionCount>0)) then begin pa^.EndPos:=AEndPos; S:=pa^.GetText; if (AAction=eaDeleteText) and (AStartPos.X>AEndPos.X) then pa^.SetText(AText+S) else pa^.SetText(S+AText); ActionIntegrated:=true; end; end; if not ActionIntegrated then begin UndoList^.Insert(New(PEditorAction,Init(AAction,AStartPos,AEndPos,AText,AFlags))); if assigned(UndoList^.CurrentGroupedAction) then Inc(UndoList^.CurrentGroupedAction^.actionCount); UpdateUndoRedo(cmUndo,AAction); end; if UndoList^.count>0 then begin UpdateUndoRedo(cmRedo,0); RedoList^.FreeAll; end; end; procedure TCodeEditorCore.AddGroupedAction(AAction : byte); begin if (UndoList=nil) or (not StoreUndo) then Exit; if Assigned(UndoList^.CurrentGroupedAction) then inc(UndoList^.GroupLevel) else begin UndoList^.CurrentGroupedAction:=New(PEditorAction,Init_group(AAction)); UndoList^.GroupLevel:=1; end; end; procedure TCodeEditorCore.CloseGroupedAction(AAction : byte); begin if (UndoList=nil) or (not StoreUndo) then Exit; dec(UndoList^.GroupLevel); if UndoList^.GroupLevel=0 then begin UndoList^.CurrentGroupedAction^.TimeStamp:=now; UndoList^.Insert(UndoList^.CurrentGroupedAction); UndoList^.CurrentGroupedAction:=nil; UpdateUndoRedo(cmUndo,AAction); end; end; function TCodeEditorCore.GetUndoActionCount: sw_integer; begin GetUndoActionCount:=UndoList^.Count; end; function TCodeEditorCore.GetRedoActionCount: sw_integer; begin GetRedoActionCount:=RedoList^.Count; end; destructor TCodeEditorCore.Done; begin inherited Done; if Assigned(Lines) then Dispose(Lines, Done); Lines:=nil; if Assigned(RedoList) then Dispose(RedoList, Done); RedoList:=nil; if Assigned(UndoList) then Dispose(UndoList, Done); UndoList:=nil; end; constructor TIndicator.Init(var Bounds: TRect); begin inherited Init(Bounds); GrowMode := gfGrowLoY + gfGrowHiY; end; procedure TIndicator.Draw; var Color: Byte; Frame: AnsiChar; L: array[0..1] of PtrInt; S: String[15]; B: TDrawBuffer; begin if assigned(CodeOwner) and (CodeOwner^.ELockFlag>0) then begin CodeOwner^.IndicatorDrawCalled:=true; exit; end; if (State and sfDragging = 0) and (State and sfActive <> 0) then begin Color := GetColor(1); Frame := #205; end else begin if (State and sfDragging)<>0 then Color := GetColor(2) else Color := GetColor(3); Frame := #196; end; MoveChar(B, Frame, Color, Size.X); if State and sfActive<>0 then begin if Modified then WordRec (B[0]).Lo := ord('*'); {$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); MoveStr(B[8 - Pos(':', S)], S, Color); end; WriteBuf(0, 0, Size.X, 1, B); end; function TIndicator.GetPalette: PPalette; const P: string[Length(CIndicator)] = CIndicator; begin GetPalette := @P; end; procedure TIndicator.SetState(AState: Word; Enable: Boolean); begin inherited SetState(AState, Enable); if (AState = sfDragging) or (AState=sfActive) then DrawView; end; procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean); begin if (Location.X<>ALocation.X) or (Location.Y<>ALocation.Y) or (Modified <> AModified) then begin Location := ALocation; Modified := AModified; DrawView; end; end; {constructor TIndicator.Load(var S: TStream); begin inherited Load(S); S.Read(Location,SizeOf(Location)); S.Read(Modified,SizeOf(Modified)); end; procedure TIndicator.Store(var S: TStream); begin inherited Store(S); S.Write(Location,SizeOf(Location)); S.Write(Modified,SizeOf(Modified)); end;} {***************************************************************************** TCodeEditor *****************************************************************************} constructor TCodeEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator; ACore: PCodeEditorCore); begin inherited Init(Bounds,AHScrollBar,AVScrollBar); New(Folds, Init(100,100)); if ACore=nil then ACore:=New(PCodeEditorCore, Init); Core:=ACore; Core^.BindEditor(@Self); SetState(sfCursorVis,true); SetFlags(DefaultCodeEditorFlags); SetCurPtr(0,0); Indicator:=AIndicator; if assigned(Indicator) then Indicator^.CodeOwner:=@Self; UpdateIndicator; LimitsChanged; end; function TCodeEditor.GetFlags: longint; begin GetFlags:=Flags; end; procedure TCodeEditor.SetFlags(AFlags: longint); var OFlags: longint; begin if AFlags<>Flags then begin OFlags:=Flags; Flags:=AFlags; FlagsChanged(OFlags); end; end; function TCodeEditor.GetModified: boolean; begin GetModified:=Core^.GetModified; end; procedure TCodeEditor.SetModified(AModified: boolean); begin Core^.SetModified(AModified); end; function TCodeEditor.GetStoreUndo: boolean; begin GetStoreUndo:=Core^.GetStoreUndo; end; procedure TCodeEditor.SetStoreUndo(AStore: boolean); begin Core^.SetStoreUndo(AStore); end; procedure TCodeEditor.ClearUndoList; begin Core^.UndoList^.FreeAll; Core^.RedoList^.FreeAll; end; function TCodeEditor.GetSyntaxCompleted: boolean; begin GetSyntaxCompleted:=Core^.GetSyntaxCompleted; end; procedure TCodeEditor.SetSyntaxCompleted(SC : boolean); begin Core^.SetSyntaxCompleted(SC); UpdateIndicator; end; function TCodeEditor.GetLastSyntaxedLine: sw_integer; begin GetLastSyntaxedLine:=Core^.GetLastSyntaxedLine; end; procedure TCodeEditor.SetLastSyntaxedLine(ALine: sw_integer); begin Core^.SetLastSyntaxedLine(ALine); end; function TCodeEditor.GetTabSize: integer; begin GetTabSize:=Core^.GetTabSize; end; procedure TCodeEditor.SetTabSize(ATabSize: integer); begin Core^.SetTabSize(ATabSize); end; function TCodeEditor.GetIndentSize: integer; begin GetIndentSize:=Core^.GetIndentSize; end; procedure TCodeEditor.SetIndentSize(AIndentSize: integer); begin Core^.SetIndentSize(AIndentSize); end; function TCodeEditor.IsReadOnly: boolean; begin IsReadOnly:=ReadOnly or (Core^.ReadOnly); end; function TCodeEditor.IsClipboard: Boolean; begin IsClipboard:=Core^.IsClipboard; end; function TCodeEditor.GetErrorMessage: string; begin GetErrorMessage:=GetStr(ErrorMessage); end; procedure TCodeEditor.SetErrorMessage(const S: string); begin SetStr(ErrorMessage,S); DrawView; end; function TCodeEditor.GetLineCount: sw_integer; begin GetLineCount:=Core^.GetLineCount; end; function TCodeEditor.GetLine(LineNo: sw_integer): PCustomLine; begin GetLine:=Core^.GetLine(LineNo); end; function TCodeEditor.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer; begin CharIdxToLinePos:=Core^.CharIdxToLinePos(Line,CharIdx); end; function TCodeEditor.LinePosToCharIdx(Line,X: sw_integer): sw_integer; begin LinePosToCharIdx:=Core^.LinePosToCharIdx(Line,X); end; function TCodeEditor.GetLineText(I: sw_integer): sw_astring; begin GetLineText:=Core^.GetLineText(I); end; procedure TCodeEditor.SetDisplayText(I: sw_integer;const S: sw_astring); begin Core^.SetDisplayText(I,S); end; function TCodeEditor.GetDisplayText(I: sw_integer): sw_astring; begin GetDisplayText:=Core^.GetDisplayText(I); end; procedure TCodeEditor.SetLineText(I: sw_integer;const S: sw_AString); begin Core^.SetLineText(I,S); end; procedure TCodeEditor.GetDisplayTextFormat(I: sw_integer;var DT,DF:sw_astring); begin Core^.GetDisplayTextFormat(@Self,I,DT,DF); end; function TCodeEditor.GetLineFormat(I: sw_integer): sw_astring; begin GetLineFormat:=Core^.GetLineFormat(@Self,I); end; procedure TCodeEditor.SetLineFormat(I: sw_integer;const S: sw_astring); begin Core^.SetLineFormat(@Self,I,S); end; procedure TCodeEditor.DeleteAllLines; begin Core^.DeleteAllLines; end; procedure TCodeEditor.DeleteLine(I: sw_integer); begin Core^.DeleteLine(I); end; function TCodeEditor.InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine; begin InsertLine:=Core^.InsertLine(LineNo,S); end; procedure TCodeEditor.AddLine(const S: sw_astring); begin Core^.AddLine(S); end; function TCodeEditor.GetMaxFoldLevel: sw_integer; begin GetMaxFoldLevel:=MaxFoldLevel; end; procedure TCodeEditor.RegisterFold(AFold: PFold); var L: sw_integer; begin if Assigned(Folds) then begin Folds^.Insert(AFold); L:=AFold^.GetLevel+1; if L>MaxFoldLevel then MaxFoldLevel:=L; end; end; procedure TCodeEditor.UnRegisterFold(AFold: PFold); begin if Assigned(Folds) then begin Folds^.Delete(AFold); if Folds^.Count=0 then MaxFoldLevel:=0 else MaxFoldLevel:=inherited GetMaxFoldLevel+1; end; end; function TCodeEditor.GetFoldCount: sw_integer; begin GetFoldCount:=Folds^.Count; end; function TCodeEditor.GetFold(Index: sw_integer): PFold; begin GetFold:=Folds^.At(Index); end; {function TCodeEditor.GetLineTextPos(Line,X: integer): integer; var S: string; rx,i : Sw_integer; begin S:=GetLineText(Line); i:=0; rx:=0; while (RXCompleteState then begin CompleteState:=AState; if CompleteState<>csOffering then ClearCodeCompleteWord; end; end; function TCodeEditor.GetCodeCompleteWord: string; begin GetCodeCompleteWord:=GetStr(CodeCompleteWord); end; procedure TCodeEditor.SetCodeCompleteWord(const S: string); begin if Assigned(CodeCompleteWord) then DisposeStr(CodeCompleteWord); CodeCompleteWord:=NewStr(S); inherited SetCodeCompleteWord(S); end; procedure TCodeEditor.DrawIndicator; begin if Assigned(Indicator) then Indicator^.DrawView; end; procedure TCodeEditor.Lock; begin inherited Lock; Core^.Lock(@Self); end; procedure TCodeEditor.UnLock; begin Core^.UnLock(@Self); inherited UnLock; If (ELockFlag=0) and IndicatorDrawCalled then begin DrawIndicator; IndicatorDrawCalled:=false; end; end; procedure TCodeEditor.UpdateIndicator; begin if Indicator<>nil then begin Indicator^.Location:=CurPos; Indicator^.Modified:=GetModified; {$ifdef debug} Indicator^.StoreUndo:=GetStoreUndo; {$ifdef TEST_PARTIAL_SYNTAX} Indicator^.SyntaxComplete:=GetSyntaxCompleted and IsFlagSet(efSyntaxHighlight); {$endif TEST_PARTIAL_SYNTAX} Indicator^.UseTabs:=IsFlagSet(efUseTabCharacters); {$endif debug} if Elockflag>0 then IndicatorDrawCalled:=true else Indicator^.DrawView; end; end; procedure TCodeEditor.LimitsChanged; begin Core^.LimitsChanged; end; procedure TCodeEditor.ModifiedChanged; begin UpdateIndicator; end; procedure TCodeEditor.PositionChanged; begin UpdateIndicator; end; procedure TCodeEditor.JumpToLastCursorPos; var pa : PEditorAction; begin if (Core^.UndoList^.count>0) and (Core^.RedoList^.count=0) then begin { Or should we just call Undo ?? PM } pa:=Core^.UndoList^.At(Core^.UndoList^.count-1); if (pa^.action=eaMoveCursor) then SetCurPtr(pa^.StartPos.X,pa^.StartPos.Y); end; end; procedure TCodeEditor.Undo; var Temp,Idx,Last,Count : Longint; StoredFlags : longint; UndoTime : longint; WasInserting,WasAutoBrackets,IsGrouped,HadefNoIndent : boolean; MaxY,MinY : sw_integer; Line, uText : Sw_AString; procedure SetMinMax(y : sw_integer); begin if MinY=-1 then MinY:=Y; if YMaxY then MaxY:=Y; end; begin Core^.SetStoreUndo(False); Lock; MinY:=-1; MaxY:=-1; if Core^.UndoList^.count > 0 then begin Last:=Core^.UndoList^.count-1; if Core^.UndoList^.At(Last)^.Is_grouped_action then begin Count:=Core^.UndoList^.At(Last)^.ActionCount; UndoTime:=Core^.UndoList^.At(Last)^.TimeStamp; Dec(Last); IsGrouped:=true; end else begin Count:=1; IsGrouped:=false; end; for Idx:=Last downto Last-Count+1 do with Core^.UndoList^.At(Idx)^ do begin if not IsGrouped then UndoTime:=TimeStamp; uText:=GetText; case action of eaMoveCursor : begin { move cursor back to original position } SetCurPtr(startpos.x,startpos.y); end; eaInsertText : begin SetCurPtr(StartPos.X,StartPos.Y); for Temp := 1 to length(uText) do DelChar; SetMinMax(StartPos.Y); end; eaDeleteText : begin { reinsert deleted text } SetCurPtr(EndPos.X,EndPos.Y); WasInserting:=GetInsertMode; SetInsertMode(true); WasAutoBrackets:=GetAutoBrackets; SetAutoBrackets(false); for Temp := 1 to length(uText) do AddChar(uText[Temp]); SetAutoBrackets(WasAutoBrackets); SetInsertMode(WasInserting); SetMinMax(EndPos.Y); SetCurPtr(StartPos.X,StartPos.Y); end; eaOverwriteText : begin SetCurPtr(StartPos.X,StartPos.Y); Line:=GetDisplayText(StartPos.Y); WasInserting:=GetInsertMode; SetInsertMode(false); WasAutoBrackets:=GetAutoBrackets; SetAutoBrackets(false); for Temp := 1 to length(uText) do begin AddChar(uText[Temp]); if StartPos.X+Temp>Length(Line) then uText[Temp]:=' ' else uText[Temp]:=Line[StartPos.X+Temp]; end; SetAutoBrackets(WasAutoBrackets); SetInsertMode(WasInserting); SetMinMax(EndPos.Y); SetCurPtr(StartPos.X,StartPos.Y); end; eaInsertLine : begin SetCurPtr(EndPos.X,EndPos.Y); Line:=Copy(GetDisplayText(StartPos.Y),1,StartPos.X); If Length(Line)0; WasInserting:=GetInsertMode; SetInsertMode(true); SetFlags(GetFlags or efNoIndent); InsertLine(StartPos.Y,uText); SetInsertMode(WasInserting); if not HadefNoIndent then SetFlags(GetFlags and not efNoIndent); {DelEnd; wrong for eaCut at least } SetCurPtr(StartPos.X,StartPos.Y); if StartPos.Y > EndPos.Y then SetLineText(EndPos.Y,Copy(GetDisplayText(EndPos.Y),1,EndPos.X)); SetMinMax(StartPos.Y); end; eaSelectionChanged : begin { move cursor to end of last set selection } end; else { what the 'ell's an undefined action doing round 'ere mate! } ; end; { once this lot is done paste into redo and modify to suit needs } { move item to redo stack } Core^.RedoList^.Insert(Core^.UndoList^.At(Idx)); UpdateUndoRedo(cmRedo,Core^.UndoList^.At(Idx)^.Action); Core^.UndoList^.atDelete(Idx); If Idx>0 then UpdateUndoRedo(cmUndo,Core^.UndoList^.At(Idx-1)^.Action) else UpdateUndoRedo(cmUndo,0); end;{Idx loop for grouped actions } if IsGrouped then begin Idx:=Core^.UndoList^.Count-1; Core^.RedoList^.Insert(Core^.UndoList^.At(Idx)); UpdateUndoRedo(cmRedo,Core^.UndoList^.At(Idx)^.Action); Core^.UndoList^.atDelete(Idx); If Idx>0 then UpdateUndoRedo(cmUndo,Core^.UndoList^.At(Idx-1)^.Action) else UpdateUndoRedo(cmUndo,0); end; if Core^.UndoList^.count=0 then SetCmdState(UndoCmd,false); if (Core^.UndoList^.count=0) or ((Core^.UndoList^.count=1) and (Core^.UndoList^.At(0)^.Action=eaMoveCursor)) then begin SetCmdState(UndoCmd,false); if (UndoTime>=Core^.SystemLoadTime) or (Core^.SystemLoadTime=0) then SetModified(false); end; SetCmdState(RedoCmd,true); Message(Application,evBroadcast,cmCommandSetChanged,nil); if MinY<>-1 then UpdateAttrsRange(MinY,MaxY,attrAll); DrawView; end; Core^.SetStoreUndo(True); Unlock; end; procedure TCodeEditor.Redo; var Temp,Idx,i,Last,Count : Longint; StoredFlags : longint; WasInserting,WasAutoBrackets,IsGrouped,ShouldInsertText : boolean; Line,uText : sw_aString; MaxY,MinY : sw_integer; procedure SetMinMax(y : sw_integer); begin if MinY=-1 then MinY:=Y; if YMaxY then MaxY:=Y; end; begin Core^.SetStoreUndo(False); Lock; MinY:=-1; MaxY:=-1; if Core^.RedoList^.count <> 0 then begin Last:=Core^.RedoList^.count-1; if Core^.RedoList^.At(Last)^.Is_grouped_action then begin Count:=Core^.RedoList^.At(Last)^.ActionCount; Dec(Last); IsGrouped:=true; end else begin Count:=1; IsGrouped:=false; end; for Idx:=Last downto Last-Count+1 do with Core^.RedoList^.At(Idx)^ do begin uText:=GetText; case action of eaMoveCursor : begin { move cursor back to original position } SetCurPtr(EndPos.X,EndPos.Y); end; eaInsertText : begin SetCurPtr(startpos.x,startpos.y); InsertText(uText); SetMinMax(StartPos.Y); end; eaDeleteText : begin SetCurPtr(EndPos.X,EndPos.Y); for Temp := 1 to length(uText) do DelChar; SetMinMax(EndPos.Y); end; eaOverwriteText : begin SetCurPtr(StartPos.X,StartPos.Y); Line:=GetDisplayText(StartPos.Y); WasInserting:=GetInsertMode; SetInsertMode(false); WasAutoBrackets:=GetAutoBrackets; SetAutoBrackets(false); for Temp := 1 to length(uText) do begin AddChar(uText[Temp]); if StartPos.X+Temp>Length(Line) then uText[Temp]:=' ' else uText[Temp]:=Line[StartPos.X+Temp]; end; SetAutoBrackets(WasAutoBrackets); SetInsertMode(WasInserting); SetCurPtr(EndPos.X,EndPos.Y); SetMinMax(StartPos.Y); end; eaInsertLine : begin SetCurPtr(StartPos.X,StartPos.Y); StoredFlags:=GetFlags; SetFlags(Flags); InsertNewLine; SetCurPtr(0,EndPos.Y); Line:=uText; ShouldInsertText:=false; for I:=1 to Length(Line) do if Line[I]<>' ' then ShouldInsertText:=true; If ShouldInsertText then InsertText(Line); SetFlags(StoredFlags); SetCurPtr(EndPos.X,EndPos.Y); SetMinMax(StartPos.Y); end; eaDeleteLine : begin SetCurPtr(StartPos.X,StartPos.Y); DeleteLine(StartPos.Y); SetCurPtr(EndPos.X,EndPos.Y); if EndPos.Y=StartPos.Y-1 then SetDisplayText(EndPos.Y,RExpand( copy(GetDisplayText(EndPos.Y),1,EndPos.X),EndPos.X) +uText); SetCurPtr(EndPos.X,EndPos.Y); SetMinMax(StartPos.Y); SetMinMax(EndPos.Y); end; eaSelectionChanged : begin { move cursor to end of last set test selection } end; else { what the 'ell's an undefined action doing round 'ere mate! } ; end; { once this lot is done paste back into undo and modify to suit needs } { move item to undo stack } Core^.UndoList^.Insert(Core^.RedoList^.At(Idx)); UpdateUndoRedo(cmUndo,Core^.RedoList^.At(Idx)^.Action); If Idx>0 then UpdateUndoRedo(cmRedo,Core^.RedoList^.At(Idx-1)^.Action) else UpdateUndoRedo(cmRedo,0); Core^.RedoList^.atDelete(Idx); end;{ Idx loop for grouped action } If IsGrouped then begin Idx:=Core^.RedoList^.count-1; Core^.UndoList^.Insert(Core^.RedoList^.At(Idx)); UpdateUndoRedo(cmUndo,Core^.RedoList^.At(Idx)^.Action); If Idx>0 then UpdateUndoRedo(cmRedo,Core^.RedoList^.At(Idx-1)^.Action) else UpdateUndoRedo(cmRedo,0); Core^.RedoList^.atDelete(Idx); end; if Core^.RedoList^.count=0 then SetCmdState(RedoCmd,false); SetCmdState(UndoCmd,true); Message(Application,evBroadcast,cmCommandSetChanged,nil); if MinY<>-1 then UpdateAttrsRange(MinY,MaxY,attrAll); DrawView; end; Core^.SetStoreUndo(True); Unlock; end; (*constructor TCodeEditor.Load(var S: TStream); var TS: PSubStream; TSize: longint; begin inherited Load(S); New(UndoList,init(500,1000)); New(RedoList,init(500,1000)); New(Lines, Init(500,1000)); { we have always need at least 1 line } LinesInsert(New(PLine, Init('',0))); GetPeerViewPtr(S,Indicator); S.Read(Flags,SizeOf(Flags)); S.Read(TabSize,SizeOf(TabSize)); if IsFlagSet(efStoreContent) then begin S.Read(TSize,SizeOf(TSize)); New(TS, Init(@S,S.GetPos,TSize)); {$ifdef TEST_PARTIAL_SYNTAX} Core^.SearchBinding(Editor)^.SyntaxComplete:=false; { Idle necessary } EventMask:=EventMask or evIdle; {$endif TEST_PARTIAL_SYNTAX} LoadFromStream(TS); Dispose(TS, Done); end; S.Read(SelStart,SizeOf(SelStart)); S.Read(SelEnd,SizeOf(SelEnd)); S.Read(Highlight,SizeOf(Highlight)); S.Read(CurPos,SizeOf(CurPos)); S.Read(StoreUndo,SizeOf(StoreUndo)); S.Read(IsReadOnly,SizeOf(IsReadOnly)); S.Read(NoSelect,SizeOf(NoSelect)); S.Read(HighlightRow,SizeOf(HighlightRow)); SetDebuggerRow(-1); LimitsChanged; SelectionChanged; HighlightChanged; UpdateIndicator; end; procedure TCodeEditor.Store(var S: TStream); var {NS: TNulStream;} TSizePos,TSize,EndPos: longint; begin inherited Store(S); PutPeerViewPtr(S,Indicator); S.Write(Flags,SizeOf(Flags)); S.Write(TabSize,SizeOf(TabSize)); if IsFlagSet(efStoreContent) then begin { NS.Init; SaveToStream(@NS); TSize:=NS.GetSize; NS.Done; This is waste of time PM use Seek instead !! } { yep. and this won't work for serial streams. - Gabor } TSize:=0; TSizePos:=S.GetPos; S.Write(TSize,SizeOf(TSize)); SaveToStream(@S); EndPos:=S.GetPos; TSize:=EndPos-TSizePos-SizeOf(TSize); S.Seek(TSizePos); S.Write(TSize,SizeOf(TSize)); S.Seek(EndPos); end; S.Write(SelStart,SizeOf(SelStart)); S.Write(SelEnd,SizeOf(SelEnd)); S.Write(Highlight,SizeOf(Highlight)); S.Write(CurPos,SizeOf(CurPos)); S.Write(StoreUndo,SizeOf(StoreUndo)); S.Write(IsReadOnly,SizeOf(IsReadOnly)); S.Write(NoSelect,SizeOf(NoSelect)); S.Write(HighlightRow,SizeOf(HighlightRow)); end;*) function TCodeEditor.LoadFromStream(Stream: PFastBufStream): boolean; var OK: boolean; begin OK:=Core^.LoadFromStream(@Self,Stream); if IsFlagSet(efSyntaxHighlight) then UpdateAttrsRange(0,Min(Delta.Y+Size.Y,GetLineCount-1), attrAll {$ifndef TEST_PARTIAL_SYNTAX} +attrForceFull {$endif TEST_PARTIAL_SYNTAX} ); TextStart; LoadFromStream:=OK; end; function TCodeEditor.SaveToStream(Stream: PStream): boolean; begin SaveToStream:=Core^.SaveToStream(@Self,Stream); end; function TCodeEditor.SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean; begin SaveAreaToStream:=Core^.SaveAreaToStream(@Self,Stream,StartP,EndP); end; function TCodeEditor.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; begin UpdateAttrs:=Core^.UpdateAttrs(FromLine,Attrs); end; function TCodeEditor.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; begin UpdateAttrsRange:=Core^.UpdateAttrsRange(FromLine,ToLine,Attrs); end; procedure TCodeEditor.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint); begin Core^.AddAction(AAction,AStartPos,AEndPos,AText,AFlags); end; procedure TCodeEditor.AddGroupedAction(AAction : byte); begin Core^.AddGroupedAction(AAction); end; procedure TCodeEditor.CloseGroupedAction(AAction : byte); begin Core^.CloseGroupedAction(AAction); end; function TCodeEditor.GetUndoActionCount: sw_integer; begin GetUndoActionCount:=Core^.GetUndoActionCount; end; function TCodeEditor.GetRedoActionCount: sw_integer; begin GetRedoActionCount:=Core^.GetRedoActionCount; end; destructor TCodeEditor.Done; begin inherited Done; if Assigned(Core) then begin Core^.UnBindEditor(@Self); if Core^.CanDispose then Dispose(Core, Done); end; Core:=nil; if Assigned(CodeCompleteFrag) then DisposeStr(CodeCompleteFrag); if Assigned(CodeCompleteWord) then DisposeStr(CodeCompleteWord); if Assigned(ErrorMessage) then DisposeStr(ErrorMessage); if Assigned(Folds) then Dispose(Folds, Done); Folds:=nil; end; constructor TFileEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator;ACore: PCodeEditorCore; const AFileName: string); begin inherited Init(Bounds,AHScrollBAr,AVScrollBAr,AIndicator,ACore); FileName:=AFileName; UpdateIndicator; Message(@Self,evBroadcast,cmFileNameChanged,@Self); end; function TFileEditor.LoadFile: boolean; var OK: boolean; PA : Array[1..2] of pointer; begin OK:=LoadFromFile(FileName); if GetModified and (Core^.GetBindingCount=1) then begin PA[1]:=@FileName; Ptrint(PA[2]):=Core^.GetChangedLine; EditorDialog(edChangedOnloading,@PA); end; Core^.OnDiskLoadTime:=Cardinal(GetFileTime(FileName)); Core^.SystemLoadTime:=Core^.OnDiskLoadTime; LoadFile:=OK; end; function TFileEditor.IsChangedOnDisk : boolean; begin IsChangedOnDisk:=(Core^.OnDiskLoadTime<>Cardinal(GetFileTime(FileName))) and (Core^.OnDiskLoadTime<>0); end; function TFileEditor.SaveFile: boolean; var OK: boolean; BAKName: string; f: text; SaveTime : cardinal; begin If IsChangedOnDisk then begin if EditorDialog(edFileOnDiskChanged, @FileName) <> cmYes then begin SaveFile:=false; exit; end; end; {$I-} if IsFlagSet(efBackupFiles) and ExistsFile(FileName) then begin BAKName:=DirAndNameOf(FileName)+'.bak'; Assign(f,BAKName); Erase(f); EatIO; Assign(f,FileName); Rename(F,BAKName); EatIO; end; {$I+} SaveTime:=cardinal(now); OK:=SaveToFile(FileName); if OK then SetModified(false) { Restore the original } else if IsFlagSet(efBackupFiles) and ExistsFile(BakName) then begin {$I-} Assign(f,BakName); Rename(F,FileName); EatIO; {$I+} end; { don't forget to update the OnDiskLoadTime value } if OK then begin Core^.OnDiskLoadTime:=Cardinal(GetFileTime(FileName)); Core^.SystemLoadTime:=SaveTime; end; if not OK then EditorDialog(edSaveError,@FileName); SaveFile:=OK; end; function TFileEditor.ReloadFile: boolean; var OK,WasModified: boolean; BAKName: string; f: text; begin If not IsChangedOnDisk then begin ReloadFile:=false; exit; end; WasModified:=GetModified; if not WasModified then OK:=EditorDialog(edreloaddiskmodifiedfile, @FileName)=cmYes else OK:=EditorDialog(edreloaddiskandidemodifiedfile, @FileName)=cmYes; if not OK then begin ReloadFile:=false; exit; end; { avoid wrong message } if WasModified then SetModified(false); OK:=LoadFile; if OK then begin SetModified(false); ClearUndoList; { don't forget to update the OnDiskLoadTime value } Core^.OnDiskLoadTime:=Cardinal(GetFileTime(FileName)); Core^.SystemLoadTime:=Core^.OnDiskLoadTime; DrawView; end else begin if WasModified then SetModified(true); EditorDialog(edReadError,@FileName); end; ReloadFile:=OK; end; function TFileEditor.ShouldSave: boolean; begin ShouldSave:=GetModified{ or (FileName='')}; end; function TFileEditor.Save: Boolean; begin if ShouldSave=false then begin Save:=true; Exit; end; if FileName = '' then Save := SaveAs else Save := SaveFile; end; function TFileEditor.SaveAs: Boolean; var SavedName : String; SavedDiskLoadTime : cardinal; begin SaveAs := False; SavedName:=FileName; SavedDiskLoadTime:=Core^.OnDiskLoadTime; if EditorDialog(edSaveAs, @FileName) <> cmCancel then begin FileName:=FExpand(FileName); Message(Owner, evBroadcast, cmUpdateTitle, @Self); { if we rename the file the OnDiskLoadTime is wrong so we reset it } Core^.OnDiskLoadTime:=0; if SaveFile then begin SaveAs := true; end else begin FileName:=SavedName; Core^.OnDiskLoadTime:=SavedDiskLoadTime; Message(Owner, evBroadcast, cmUpdateTitle, @Self); end; if IsClipboard then FileName := ''; Message(Application,evBroadcast,cmFileNameChanged,@Self); end else Message(Application,evBroadcast,cmSaveCancelled,@Self); end; function TFileEditor.SaveAsk(Command: Word; Force: boolean): boolean; var OK: boolean; D: Sw_integer; begin if Force then begin if GetModified then OK:=Save else OK:=true; end else begin OK:=(GetModified=false); if (OK=false) and (Core^.GetBindingCount>1) then if (command<>cmAskSaveAll) or (Core^.GetBindingIndex(PCustomCodeEditor(@self))<>0) then OK:=true; if OK=false then begin if FileName = '' then D := edSaveUntitled else D := edSaveModify; case EditorDialog(D, @FileName) of cmYes : OK := Save; cmNo : begin { the file should be still marked as modified! (FK) } { SetModified(False); } OK:=true; end; cmCancel : begin OK := False; Message(Application,evBroadcast,cmSaveCancelled,@Self); end; end; end; end; SaveAsk:=OK; end; procedure TFileEditor.BindingsChanged; begin Message(Application,evBroadcast,cmUpdateTitle,@Self); end; procedure TFileEditor.HandleEvent(var Event: TEvent); var SH,B: boolean; begin case Event.What of evBroadcast : case Event.Command of cmFileNameChanged : if (Event.InfoPtr=nil) or (Event.InfoPtr=@Self) then begin B:=IsFlagSet(efSyntaxHighlight); SH:=UseSyntaxHighlight(@Self); if SH<>B then if SH then SetFlags(Flags or efSyntaxHighlight) else SetFlags(Flags and not efSyntaxHighlight); if UseTabsPattern(@Self) then SetFlags(Flags or efUseTabCharacters); end; end; end; inherited HandleEvent(Event); end; function TFileEditor.Valid(Command: Word): Boolean; var OK: boolean; begin OK:=inherited Valid(Command); if OK and (Command=cmClose) then if IsClipboard=false then OK:=SaveAsk(Command,false); Valid:=OK; end; (* constructor TFileEditor.Load(var S: TStream); var P: PString; SSP,SEP,CP,DP: TPoint; HR: TRect; PA : Array[1..2] of pointer; HoldUndo : boolean; begin inherited Load(S); HoldUndo:=GetStoreUndo; SetStoreUndo(False); P:=S.ReadStr; FileName:=GetStr(P); if P<>nil then DisposeStr(P); UpdateIndicator; { Message(@Self,evBroadcast,cmFileNameChanged,@Self);} SSP:=SelStart; SEP:=SelEnd; CP:=CurPos; HR:=Highlight; DP:=Delta; if FileName<>'' then LoadFile; { if GetModified then begin PA[1]:=@FileName; longint(PA[2]):=ChangedLine; EditorDialog(edChangedOnloading,@PA); end;} SetHighlight(HR.A,HR.B); SetSelection(SSP,SEP); SetCurPtr(CP.X,CP.Y); ScrollTo(DP.X,DP.Y); SetModified(false); LimitsChanged; SetStoreUndo(HoldUndo); end; procedure TFileEditor.Store(var S: TStream); begin inherited Store(S); S.WriteStr(@FileName); end; *) function DefUseSyntaxHighlight(Editor: PFileEditor): boolean; begin DefUseSyntaxHighlight:=Editor^.IsFlagSet(efSyntaxHighlight); end; function DefUseTabsPattern(Editor: PFileEditor): boolean; begin DefUseTabsPattern:=Editor^.IsFlagSet(efUseTabCharacters); end; procedure RegisterWCEdit; begin {$ifndef NOOBJREG} RegisterType(RIndicator); RegisterType(RCodeEditor); RegisterType(RFileEditor); {$endif} end; end.