123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067 |
- {
- 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! }
- Text : PString;
- 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: string; AFlags: longint);
- function GetText: string; virtual;
- procedure SetText(const AText: string); 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:string); virtual;
- function IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): string; virtual;
- procedure ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: string); virtual;
- public
- { Text & info storage abstraction }
- function GetLineCount: sw_integer; virtual;
- function GetLine(LineNo: sw_integer): PCustomLine; virtual;
- function GetLineText(LineNo: sw_integer): string; virtual;
- procedure SetDisplayText(I: sw_integer;const S: string); virtual;
- function GetDisplayText(I: sw_integer): string; virtual;
- procedure SetLineText(I: sw_integer;const S: string); virtual;
- procedure DeleteAllLines; virtual;
- procedure DeleteLine(I: sw_integer); virtual;
- function InsertLine(LineNo: sw_integer; const S: string): PCustomLine; virtual;
- procedure AddLine(const S: string); virtual;
- procedure GetContent(ALines: PUnsortedStringCollection); virtual;
- procedure SetContent(ALines: PUnsortedStringCollection); virtual;
- public
- { Undo info storage }
- procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;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): string; virtual;
- procedure SetDisplayText(I: sw_integer;const S: string); virtual;
- function GetDisplayText(I: sw_integer): string; virtual;
- procedure SetLineText(I: sw_integer;const S: string); virtual;
- procedure GetDisplayTextFormat(I: sw_integer;var DT,DF:string); virtual;
- function GetLineFormat(I: sw_integer): string; virtual;
- procedure SetLineFormat(I: sw_integer;const S: string); virtual;
- procedure DeleteAllLines; virtual;
- procedure DeleteLine(I: sw_integer); virtual;
- function InsertLine(LineNo: sw_integer; const S: string): PCustomLine; virtual;
- procedure AddLine(const S: string); 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: string;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(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+
- {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,
- 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: string; 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: string;
- begin
- GetText:=GetStr(Text);
- end;
- procedure TLine.SetText(const AText: string);
- begin
- SetStr(Text,AText);
- 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 Assigned(Text) then
- DisposeStr(Text);
- Text:=nil;
- 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 LineNo<GetLineCount then
- begin
- P:=GetLine(LineNo);
- if assigned(P) then
- P^.SetFlagState(Flag,ASet);
- end;
- end;
- procedure TCodeEditorCore.GetContent(ALines: PUnsortedStringCollection);
- procedure AddIt(P: PCustomLine);
- begin
- if Assigned(P) then
- ALines^.Insert(NewStr(P^.GetText));
- end;
- begin
- if Assigned(Lines) then
- Lines^.ForEach(TCallbackProcParam(@AddIt));
- end;
- procedure TCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
- procedure AddIt(P: PString);
- begin
- AddLine(GetStr(P));
- end;
- begin
- DeleteAllLines;
- if Assigned(ALines) then
- ALines^.ForEach(TCallbackProcParam(@AddIt));
- LimitsChanged;
- end;
- function TCodeEditorCore.GetTabSize: integer;
- begin
- GetTabSize:=TabSize;
- end;
- procedure TCodeEditorCore.SetTabSize(ATabSize: integer);
- begin
- if ATabSize<>TabSize 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): string;
- var
- L : PCustomLine;
- begin
- GetLineText:='';
- if LineNo<Lines^.Count then
- begin
- L:=Lines^.At(LineNo);
- GetLineText:=L^.GetText;
- end;
- end;
- procedure TCodeEditorCore.LinesInsert(Idx: sw_integer; Line: PLine);
- var I: sw_integer;
- procedure RegLine(P: PEditorBinding);
- begin
- Line^.AddEditorInfo(I,P^.Editor);
- Inc(I);
- end;
- begin
- if Idx=-1 then Idx:=Lines^.Count;
- I:=0;
- Bindings^.ForEach(TCallbackProcParam(@RegLine));
- Lines^.AtInsert(Idx,Line);
- end;
- procedure TCodeEditorCore.SetLineText(I: sw_integer;const S: string);
- var
- L : PCustomLine;
- AddCount : Sw_Integer;
- begin
- AddCount:=0;
- while (Lines^.Count<I+1) do
- begin
- LinesInsert(-1,New(PLine, Init(@Self,'',0)));
- Inc(AddCount);
- end;
- if AddCount>0 then
- LimitsChanged;
- L:=Lines^.At(I);
- L^.SetText(S);
- ContentsChanged;
- end;
- function TCodeEditorCore.GetDisplayText(I: sw_integer): string;
- begin
- GetDisplayText:=ExtractTabs(GetLineText(I),GetTabSize);
- end;
- procedure TCodeEditorCore.SetDisplayText(I: sw_integer;const S: string);
- 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:string);
- var
- L : PCustomLine;
- P,PAdd : SW_Integer;
- begin
- DF:='';
- DT:='';
- if (0<=LineNo) and (LineNo<GetLineCount) then
- begin
- L:=GetLine(LineNo);
- if not assigned(L) then
- exit;
- DF:=IGetLineFormat(Binding,LineNo);
- DT:=L^.GetText;
- p:=0;
- while p<length(DT) do
- begin
- inc(p);
- if DT[p]=#9 then
- begin
- PAdd:=TabSize-((p-1) mod TabSize);
- if DF<>'' then
- DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,High(DF));
- DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,High(DF));
- inc(P,PAdd-1);
- end;
- end;
- end;
- end;
- function TCodeEditorCore.IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): string;
- var P: PCustomLine;
- LI: PEditorLineInfo;
- S: string;
- begin
- if (0<=LineNo) and (LineNo<GetLineCount) then
- P:=GetLine(LineNo)
- else
- P:=nil;
- if P=nil then LI:=nil else
- LI:=P^.GetEditorInfo(Binding^.Editor);
- if LI=nil then S:='' else S:=LI^.GetFormat;
- IGetLineFormat:=S;
- end;
- procedure TCodeEditorCore.ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: string);
- var P: PCustomLine;
- LI: PEditorLineInfo;
- begin
- if (LineNo<GetLineCount) then
- begin
- P:=GetLine(LineNo);
- if P=nil then LI:=nil else LI:=P^.GetEditorInfo(Binding^.Editor);
- if Assigned(LI) then LI^.SetFormat(S);
- end;
- end;
- procedure TCodeEditorCore.DeleteAllLines;
- begin
- if Assigned(Lines) then
- Lines^.FreeAll;
- end;
- procedure TCodeEditorCore.DeleteLine(I: sw_integer);
- var
- CP : Tpoint;
- begin
- if I<Lines^.Count then
- begin
- if StoreUndo then
- begin
- CP.X:=0;CP.Y:=I;
- AddAction(eaDeleteLine,CP,CP,GetLineText(I),0);
- end;
- Lines^.AtFree(I);
- end;
- end;
- function TCodeEditorCore.InsertLine(LineNo: sw_integer; const S: string): PCustomLine;
- var L: PLine;
- begin
- L:=New(PLine, Init(@Self,S,0));
- LinesInsert(LineNo, L);
- InsertLine:=L;
- end;
- procedure TCodeEditorCore.AddLine(const S: string);
- begin
- LinesInsert(-1,New(PLine, Init(@Self,S,0)));
- end;
- procedure TCodeEditorCore.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;AFlags : longint);
- var
- ActionIntegrated : boolean;
- pa : PEditorAction;
- S : String;
- begin
- if (UndoList=nil) or (not StoreUndo) then Exit;
- ActionIntegrated:=false;
- if UndoList^.count>0 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:=GetStr(pa^.text);
- if S<>'' then
- DisposeStr(pa^.text);
- if (AAction=eaDeleteText) and
- (AStartPos.X>AEndPos.X) then
- pa^.text:=NewStr(AText+S)
- else
- pa^.text:=NewStr(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: Char;
- 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): string;
- begin
- GetLineText:=Core^.GetLineText(I);
- end;
- procedure TCodeEditor.SetDisplayText(I: sw_integer;const S: string);
- begin
- Core^.SetDisplayText(I,S);
- end;
- function TCodeEditor.GetDisplayText(I: sw_integer): string;
- begin
- GetDisplayText:=Core^.GetDisplayText(I);
- end;
- procedure TCodeEditor.SetLineText(I: sw_integer;const S: string);
- begin
- Core^.SetLineText(I,S);
- end;
- procedure TCodeEditor.GetDisplayTextFormat(I: sw_integer;var DT,DF:string);
- begin
- Core^.GetDisplayTextFormat(@Self,I,DT,DF);
- end;
- function TCodeEditor.GetLineFormat(I: sw_integer): string;
- begin
- GetLineFormat:=Core^.GetLineFormat(@Self,I);
- end;
- procedure TCodeEditor.SetLineFormat(I: sw_integer;const S: string);
- 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: string): PCustomLine;
- begin
- InsertLine:=Core^.InsertLine(LineNo,S);
- end;
- procedure TCodeEditor.AddLine(const S: string);
- 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 (RX<X) and (i<Length(s)) do
- begin
- inc(i);
- inc(rx);
- if s[i]=#9 then
- inc(rx,TabSize-(rx mod tabsize));
- end;
- if RX<X then Inc(I,X-RX);
- GetLineTextPos:=i;
- end;
- function TCodeEditor.GetDisplayTextPos(Line,X: integer): integer;
- var
- S: string;
- L: PCustomLine;
- rx,i : Sw_integer;
- begin
- S:='';
- if Line<Lines^.Count then
- begin
- L:=Lines^.At(Line);
- if assigned(L^.Text) then
- S:=L^.Text^;
- end;
- i:=0;
- rx:=0;
- while (i<X) and (i<Length(s)) do
- begin
- inc(i);
- inc(rx);
- if s[i]=#9 then
- inc(rx,TabSize-(rx mod tabsize));
- end;
- GetDisplayTextPos:=rx;
- end;}
- procedure TCodeEditor.GetContent(ALines: PUnsortedStringCollection);
- begin
- Core^.GetContent(ALines);
- end;
- procedure TCodeEditor.SetContent(ALines: PUnsortedStringCollection);
- begin
- Lock;
- TextStart; HideSelect;
- Core^.SetContent(ALines);
- LimitsChanged;
- if IsFlagSet(efSyntaxHighlight) then
- Core^.UpdateAttrsRange(0,Min(Delta.Y+Size.Y,GetLineCount-1),
- attrAll
- {$ifndef TEST_PARTIAL_SYNTAX}
- +attrForceFull
- {$endif TEST_PARTIAL_SYNTAX}
- );
- TextStart;
- UnLock;
- end;
- function TCodeEditor.GetCodeCompleteFrag: string;
- begin
- GetCodeCompleteFrag:=GetStr(CodeCompleteFrag);
- end;
- procedure TCodeEditor.SetCodeCompleteFrag(const S: string);
- begin
- SetStr(CodeCompleteFrag,S);
- end;
- function TCodeEditor.GetCompleteState: TCompleteState;
- begin
- GetCompleteState:=CompleteState;
- end;
- procedure TCodeEditor.SetCompleteState(AState: TCompleteState);
- begin
- if AState<>CompleteState 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,IsGrouped,HadefNoIndent : boolean;
- MaxY,MinY : sw_integer;
- Line : String;
- procedure SetMinMax(y : sw_integer);
- begin
- if MinY=-1 then
- MinY:=Y;
- if Y<MinY then
- MinY:=Y;
- if MaxY=-1 then
- MaxY:=Y;
- if Y>MaxY 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;
- case action of
- eaMoveCursor :
- begin
- { move cursor back to original position }
- SetCurPtr(startpos.x,startpos.y);
- end;
- eaInsertText :
- begin
- SetCurPtr(StartPos.X,StartPos.Y);
- if assigned(text) then
- for Temp := 1 to length(Text^) do
- DelChar;
- SetMinMax(StartPos.Y);
- end;
- eaDeleteText :
- begin
- { reinsert deleted text }
- SetCurPtr(EndPos.X,EndPos.Y);
- WasInserting:=GetInsertMode;
- SetInsertMode(true);
- if assigned(text) then
- for Temp := 1 to length(Text^) do
- AddChar(Text^[Temp]);
- 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);
- if assigned(text) then
- for Temp := 1 to length(Text^) do
- begin
- AddChar(Text^[Temp]);
- if StartPos.X+Temp>Length(Line) then
- Text^[Temp]:=' '
- else
- Text^[Temp]:=Line[StartPos.X+Temp];
- end;
- 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)<StartPos.X then
- Line:=Line+CharStr(' ',StartPos.X-length(Line))+GetStr(Text);
- SetDisplayText(StartPos.Y,Line+Copy(GetDisplayText(EndPos.Y),EndPos.X+1,255));
- SetMinMax(EndPos.Y);
- SetCurPtr(0,EndPos.Y);
- DeleteLine(EndPos.Y);
- SetCurPtr(StartPos.X,StartPos.Y);
- SetMinMax(StartPos.Y);
- end;
- eaDeleteLine :
- begin
- HadefNoIndent:=(GetFlags and efNoIndent)<>0;
- WasInserting:=GetInsertMode;
- SetInsertMode(true);
- SetFlags(GetFlags or efNoIndent);
- InsertLine(StartPos.Y,'');
- SetInsertMode(WasInserting);
- if not HadefNoIndent then
- SetFlags(GetFlags and not efNoIndent);
- {DelEnd; wrong for eaCut at least }
- SetCurPtr(StartPos.X,StartPos.Y);
- SetLineText(StartPos.Y,Copy(GetDisplayText(StartPos.Y),1,StartPos.X)+GetStr(Text));
- 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,IsGrouped,ShouldInsertText : boolean;
- Line : String;
- MaxY,MinY : sw_integer;
- procedure SetMinMax(y : sw_integer);
- begin
- if MinY=-1 then
- MinY:=Y;
- if Y<MinY then
- MinY:=Y;
- if MaxY=-1 then
- MaxY:=Y;
- if Y>MaxY 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
- 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(GetStr(Text));
- SetMinMax(StartPos.Y);
- end;
- eaDeleteText :
- begin
- SetCurPtr(EndPos.X,EndPos.Y);
- for Temp := 1 to length(GetStr(Text)) do
- DelChar;
- SetMinMax(EndPos.Y);
- end;
- eaOverwriteText :
- begin
- SetCurPtr(StartPos.X,StartPos.Y);
- Line:=GetDisplayText(StartPos.Y);
- WasInserting:=GetInsertMode;
- SetInsertMode(false);
- if assigned(text) then
- for Temp := 1 to length(Text^) do
- begin
- AddChar(Text^[Temp]);
- if StartPos.X+Temp>Length(Line) then
- Text^[Temp]:=' '
- else
- Text^[Temp]:=Line[StartPos.X+Temp];
- end;
- 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:=GetStr(Text);
- 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)
- +GetStr(Text));
- 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: string;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;
- end;
- function TFileEditor.SaveAsk(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
- 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(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.
|