{ EditorPageControl unit Copyright (C) 2012 by Bart Broersma & Flying Sheep Inc. http://www.flyingsheep.nl/ This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version with the following modification: As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. 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. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } unit EditorPageControl; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Controls, Graphics, {StdCtrls,} ComCtrls, Types, LCLProc, LclType, StrUtils, FileUtil, Forms {for Application object needed in TEditorPageControl.ClosePage()}, Menus, SynEdit, {SynMemo,} SynEditTypes, SynEditHighlighter, SynGutter, {SynGutterMarks,} SynGutterChanges, SynGutterLineNumber, {SynGutterCodeFolding,} SynHighlighterPas, SynHighlighterCpp, SynHighlighterPerl, SynHighlighterHTML, SynHighlighterXML, SynHighlighterLFM, SynHighlighterDiff, SynHighlighterCss, SynHighlighterPHP, SynHighlighterPython, SynHighlighterBat, SynHighlighterIni, SynHighlighterJava, SynHighlighterUnixShellScript, SynHighLighterPo, SynEditMouseCmds, SynEditKeyCmds, lazedit_translations, lazedit_constants; type TEditorPageControl = class; //forward declaration TEditor = class; { TEditorOptions } TEditorOptions = record FontName: String; FontSize: Integer; end; TEditorCharsetChangedEvent = procedure(Sender: TEditor; const OldCharSet, NewCharSet: String; const LineNr: Integer) of object; TEditor = class(TSynEdit) private FFileName: String; FPage: TTabSheet; //the designated parent and owner of a TEditor FEditorPageControl: TEditorPageControl; FEditorOptions: TEditorOptions; FFileType: TEditorFileType; FFileMaskList: TFileTypeMaskList; FAutoFiletypeDetection: Boolean; FNoFileTypeChangeOnSave: Boolean; FOnCharsetChanged: TEditorCharsetChangedEvent; procedure SetAutoFiletypeDetection(AValue: Boolean); procedure SetEditorOptions(AValue: TEditorOptions); procedure UpdateEditorOptions(Sender: TObject); function GetUniquePageCaption(const AName: String): String; procedure SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean); //function ExtToFileType(const Ext: String): TEditorFileType; function GuessFileType: TEditorFileType; function GuessSyntaxFromString(S: String): TEditorFileType; procedure SetFileType(AFileType: TEditorFileType); procedure AdjustEncoding; procedure SetDefaultGutterParts; procedure SetDefaultMouseActions; protected procedure DoCharsetChanged(const OldCharset, NewCharset: String; const LineNr: Integer); property OnCharsetChanged: TEditorCharsetChangedEvent read FOnCharsetChanged write FOnCharsetChanged; property FileMaskList: TFileTypeMaskList read FFileMaskList write FFileMaskList; property EditorOptions: TEditorOptions read FEditorOptions write SetEditorOptions; public procedure SetDefaultKeyStrokes; override; // is public in parent class procedure LoadFromFileAnsi(const AnsiFn: String; const AsTemplate: Boolean = False); procedure LoadFromFileUtf8(const Utf8Fn: String; const AsTemplate: Boolean = False); procedure SaveToFileAnsi(const AnsiFn: String); procedure SaveToFileUtf8(const Utf8Fn: String); function IsUnused: Boolean; procedure SetHighlighterByFileType(const AFileType: TEditorFileType; const Permanent: Boolean = False); procedure MarkSelection(const Pre, Post: String); constructor Create(TheOwner: TComponent); override; destructor Destroy; override; property FileName: String read FFileName; //in UTF-8 encoding property FileType: TEditorFileType read FFileType write SetFileType; property AutoFileTypeDetection: Boolean read FAutoFiletypeDetection write SetAutoFiletypeDetection default True; end; const scFileName = scReadOnly; //Use this for FileName changes scAll = [scCaretX,scCaretY,scModified,scInsertMode,scFileName]; type { TEditorPageControl } TCloseEditorEvent = procedure(Sender: TTabSheet; var Cancel: Boolean) of object; THighLighterArray = Array[TEditorFileType] of TSynCustomHighlighter; TEditorPageControl = class(TPageControl) private FCounter: Cardinal; FHighLighters: THighlighterArray; FFileTypeMaskList: TFileTypeMaskList; FEditorOptions: TEditorOptions; FEditorPopupMenu: TPopupMenu; FOnStatusChange: TStatusChangeEvent; FOnBeforeCloseEditor: TCloseEditorEvent; FOnEditorCharsetChanged: TEditorCharsetChangedEvent; function GetCurrentEditor: TEditor; function FindPageCaption(const ACaption: String): TTabSheet; function GetHighLighter(Index: TEditorFileType): TSynCustomHighlighter; function GetFileTypeMaskLists(Index: TEditorFileType): String; procedure SetEditorOptions(AValue: TEditorOptions); function GetEditorOptions: TEditorOptions; procedure SetFileTypeMaskLists(Index: TEditorFileType; AValue: string); procedure SetPopupMenu(AValue: TPopupMenu); procedure UpdateEditorFileMasks; procedure UpdateEditorOptions(Sender: TObject); procedure UpdateEditorPopupMenu; //Called internally by the editor, by AddPage, DoChange and if PageCount becomes 0 procedure InternalEditorStatusChange(Sender: TObject; Changes: TSynStatusChanges); procedure InternalEditorCharsetChange(Sender: TEditor; const OldCharSet, NewCharSet: String; const LineNr: Integer); protected procedure DoChange; override; //procedure RemovePage(Index: Integer); override; //procedure DoCloseTabClicked(APage: TCustomPage); override; property HighLighters[Index: TEditorFileType]: TSynCustomHighlighter read GetHighLighter; //property FileTypeMaskList: TFileTypeMaskList read FFileTypeMaskList write SetFiletypeMaskList; public IsCreating: Boolean; function AddPage: TEditor; function ClosePage(Index: Integer): Boolean; function EditorAtPage(const Index: Integer): TEditor; function EditorAtPage(const APage: TTabSheet): TEditor; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; property CurrentEditor: TEditor read GetCurrentEditor; //setting FileTypeMaskLists[eftNone] results in any file with such an extension treated as eftNone (and no therefore Highlighting) property FileTypeMaskLists[Index: TEditorFileType]: string read GetFileTypeMaskLists write SetFileTypeMaskLists; property EditorOptions: TEditorOptions read GetEditorOptions write SetEditorOptions; property OnStatusChange: TStatusChangeEvent read FonStatusChange write FOnStatusChange; property OnBeforeCloseEditor: TCloseEditorEvent read FOnBeforeCloseEditor write FOnBeforeCloseEditor; property OnEditorCharsetChange: TEditorCharsetChangedEvent read FOnEditorCharsetChanged write FOnEditorCharsetChanged; property EditorPopUpmenu: TPopupMenu read FEditorPopupMenu write SetPopupMenu; end; const EmptyStr = ''; implementation function DefaultEditorOptions: TEditorOptions; begin Result.FontName := ''; Result.FontSize := 0; end; function EditorOptionsAreDifferent(const New, Old: TEditorOptions): Boolean; begin Result := (New.FontName <> Old.FontName) or (New.FontSize <> Old.FontSize); end; function FindInMaskList(const Ext, MaskList: String): Boolean; var SL: TStringList; i: Integer; begin Result := False; if (Length(Ext) = 0) or (Length(MaskList) = 0) then Exit; SL := TStringList.Create; try SL.StrictDelimiter := True; SL.Delimiter := ';'; SL.CaseSensitive := False; SL.Duplicates := dupAccept; SL.DelimitedText := Trim(MaskList); for i := 0 to SL.Count - 1 do begin if CompareText(Ext, SL.Strings[i]) = 0 then begin Result := True; Break; end; end; finally SL.Free; end; end; {TEditor} procedure TEditor.SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean); begin //debugln('TEditor.SetFileName: Utf8Fn = ',Utf8ToSys(Utf8Fn)); if (FFileName = Utf8Fn) and (Utf8Fn <> EmptyStr) then Exit; FFileName := Utf8Fn; if Assigned(FPage) then begin FPage.Caption := GetUniquePageCaption(Utf8Fn); //Debugln('TEditor.SetFileName: setting FPageCaption to ',FPage.Caption); end; //Unless you change ReadOnly, the scFileName will be removed from Changes in TSynEdit.DoOnStatuschange ReadOnly := True; DoOnStatusChange(scAll); ReadOnly := false; //debugln('TEditor.SetFileName: setting FileType'); if UpdateFileType then FileType := GuessFileType else FileType := eftNone; //debugln('TEditor.SetFileName: End'); end; procedure TEditor.SetAutoFiletypeDetection(AValue: Boolean); begin if FAutoFiletypeDetection = AValue then exit; FAutoFiletypeDetection := AValue; if AValue then FNoFileTypeChangeOnSave := False; end; procedure TEditor.SetEditorOptions(AValue: TEditorOptions); begin if EditorOptionsAreDifferent(AValue, FEditorOptions) then begin FEditorOptions := AValue; UpdateEditorOptions(Self); end; end; procedure TEditor.UpdateEditorOptions(Sender: TObject); begin //ToDo if FEditorOptions.FontName <> '' then begin Font.Name := FEditorOptions.FontName; Font.Pitch := fpFixed; end; if (FEditorOptions.FontSize <> Font.Size) and (FEditorOptions.FontSize <> 0) then Font.Size := FEditorOptions.FontSize; end; function TEditor.GetUniquePageCaption(const AName: String): String; var Index, DupNr, CurDupNr: Integer; ShortName, ACap, Dup: String; Pg: TTabSheet; FoundIndexedMatch, FoundExactMatch: Boolean; begin //debugln('TEditor.GetUniquePageCaption'); if (AName = EmptyStr) then ShortName := vTranslations.NoName else ShortName := ExtractFileName(AName); Result := ShortName; //if not (Assigned(FPage) and Assigned(FEditorPageControl)) then debugln(' FPage or FEditorPageControl unassigned'); if not (Assigned(FPage) and Assigned(FEditorPageControl)) then Exit; DupNr := 0; //First try to find exact name, if it is not found we can use it now //even if we already have a ShortName [1] FoundExactMatch := (FEditorPageControl.FindPageCaption(ShortName) <> nil); if not FoundExactMatch then Exit; //Now find any ShortName [x] FoundIndexedMatch := False; for Index := 0 to FEditorPageControl.PageCount - 1 do begin Pg := FEditorPageControl.Pages[Index]; //debugln(' Index: ',dbgs(index),' P.Caption = ',Pg.Caption,' ShortName = ',ShortName); if (Pg <> FPage) then begin ACap := Pg.Caption; //we already handled any ShortName = ACap if (Pos(ShortName + ' [', ACap) = 1) and (ACap[Length(ACap)] = ']') then begin Dup := Copy(ACap, Length(ShortName) + 3, MaxInt); System.Delete(Dup, Length(Dup), 1); //debugln(' Dup = ',Dup); FoundIndexedMatch := (Length(Dup) > 0) and TryStrToInt(Dup, CurDupNr); end; if FoundIndexedMatch then Break; //debugln(' FoundIndexedMatch = ',dbgs(FoundIndexedMatch),' DupNr = ',dbgs(dupnr)); end; end; if not (FoundIndexedMatch or FoundExactMatch) then Exit; DupNr := 1; //if there are more then MaxInt Tabs with the same file open, then bad luck while (FEditorPageControl.FindPageCaption(ShortName + ' [' + IntToStr(DupNr) + ']') <> nil) and (DupNr < MaxInt) do begin //debugln(' ',ShortName,' [',dbgs(dupnr),'] was found'); Inc(DupNr); end; ShortName := ShortName + ' [' + IntToStr(DupNr) + ']'; Result := ShortName; //debugln('TEditor.GetUniquePageCaption End'); end; { function TEditor.ExtToFileType(const Ext: String): TEditorFileType; var Index: TEditorFileType; begin //DebugLn('TEditor.ExtToFileType: Ext = "',Ext,'"'); Result := eftNone; if (Length(Ext) = 0) then Exit; for Index := Low(TEditorFileType) to High(TEditorFileType) do begin if FindInMaskList(Ext, FileMaskList[Index]) then begin Result := Index; Exit; end; end; //Debugln('TEditor.ExtToFileType: Result = ',eftNames[Result]); //DebugLn('TEditor.ExtToFileType: End'); end; } function TEditor.GuessSyntaxFromString(S: String): TEditorFileType; const Shebang = '#!'; begin //Debugln('TEditor.GuessSyntaxFromString, S = "',S,'"'); Result := eftNone; S := TrimLeft(S); if (Pos(Shebang,S) = 1) and ((Pos('/bin/bash',S) > 0) or (Pos('/bin/sh',S) > 0)) then Result := eftUnixShell else if (Pos(Shebang,S) = 1) and (Pos('/perl',S) > 0) then Result := eftPerl else if Pos(' eftNone) then Break; Inc(i); end; end; //DebugLn('TEditor.GuessFileType End'); end; procedure TEditor.SetFileType(AFileType: TEditorFileType); begin //DebugLn('TEditor.SetFileType A'); //DebugLn(Format('FileName = %s, FileType is set to %s',[ExtractFileName(FFileName),eftNames[AFileType]])); if AFileType <> FFileType then begin FFileType := AFileType; SetHighlighterByFileType(AFileType); end; //DebugLn('TEditor.SetFileType End'); end; procedure TEditor.AdjustEncoding; //Search first 50 lines for character encosing metat tag and change to UTF-8 if necessary //the tag is in the form of: //This only works if the meta tag is the first meta-tag on the line var LineNr: Integer; S: String; p, CharsetStart, CharsetEnd: SizeInt; OldCharset: String; const MaxLinesToScan = 5000; begin //DebugLn('TEditor.AdjustEncoding A'); LineNr := 0; while (LineNr < Lines.Count) and (LineNr < MaxLinesToScan) do begin //DbgOut('[',Dbgs(LineNr),'] '); S := {Utf8}UpperCase(Lines[LineNr]); //no need for utf8, this meta-tag can only contain lower ascii p := Pos(' 0) then begin //DbgOut('meta '); //check for closing tag, but do not store value in p, we need the current value of p later on if (PosEx('>',S, p + 1) > 0) then begin //DbgOut('">" '); p := PosEx('"CONTENT-TYPE"',S, p + 1); if (p > 0) then begin //DbgOut('content-type '); p := PosEx('CONTENT',S, p + 1); if (p > 0) then begin //DbgOut('content '); p := PosEx('CHARSET',S, p + 1); if (p > 0) then begin //DbgOut('charset '); p := PosEx('=',S, p + 1); if (p > 0) then begin //DbgOut('='); CharsetStart := p + 1; p := PosEx('"',S, CharsetStart); if p = 0 then p := PosEx(';',S, CharSetStart); if (p > 0) then begin CharsetEnd := p; OldCharset := Copy(S,CharsetStart,CharSetEnd - CharSetStart); //DebugLn('Current charset is ',OldCharSet,' (LineNr = ',DbgS(LineNr),')'); if CompareText(Trim(OldCharSet),'utf-8') <> 0 then begin //DebugLn('Changing charset to utf-8'); TextBetweenPoints[Point(CharsetStart,LineNr+1),Point(CharSetEnd,LineNr+1)] := 'utf-8'; DoCharsetChanged(OldCharSet, 'utf-8', LineNr+1); end; Break; end; end; end; end; end; end; end; Inc(LineNr); //DebugLn; end; //DebugLn('TEditor.AdjustEncoding End'); end; procedure TEditor.SetDefaultKeyStrokes; procedure AddKey(const ACmd: TSynEditorCommand; const AKey: word; const AShift: TShiftState); begin with KeyStrokes.Add do begin Key := AKey; Shift := AShift; Command := ACmd; end; end; begin KeyStrokes.Clear; AddKey(ecUp, VK_UP, []); AddKey(ecSelUp, VK_UP, [ssShift]); AddKey(ecScrollUp, VK_UP, [ssCtrl]); AddKey(ecDown, VK_DOWN, []); AddKey(ecSelDown, VK_DOWN, [ssShift]); AddKey(ecScrollDown, VK_DOWN, [ssCtrl]); AddKey(ecLeft, VK_LEFT, []); AddKey(ecSelLeft, VK_LEFT, [ssShift]); AddKey(ecWordLeft, VK_LEFT, [ssCtrl]); AddKey(ecSelWordLeft, VK_LEFT, [ssShift,ssCtrl]); AddKey(ecRight, VK_RIGHT, []); AddKey(ecSelRight, VK_RIGHT, [ssShift]); AddKey(ecWordRight, VK_RIGHT, [ssCtrl]); AddKey(ecSelWordRight, VK_RIGHT, [ssShift,ssCtrl]); AddKey(ecPageDown, VK_NEXT, []); AddKey(ecSelPageDown, VK_NEXT, [ssShift]); AddKey(ecPageBottom, VK_NEXT, [ssCtrl]); AddKey(ecSelPageBottom, VK_NEXT, [ssShift,ssCtrl]); AddKey(ecPageUp, VK_PRIOR, []); AddKey(ecSelPageUp, VK_PRIOR, [ssShift]); AddKey(ecPageTop, VK_PRIOR, [ssCtrl]); AddKey(ecSelPageTop, VK_PRIOR, [ssShift,ssCtrl]); AddKey(ecLineStart, VK_HOME, []); AddKey(ecSelLineStart, VK_HOME, [ssShift]); AddKey(ecEditorTop, VK_HOME, [ssCtrl]); AddKey(ecSelEditorTop, VK_HOME, [ssShift,ssCtrl]); AddKey(ecLineEnd, VK_END, []); AddKey(ecSelLineEnd, VK_END, [ssShift]); AddKey(ecEditorBottom, VK_END, [ssCtrl]); AddKey(ecSelEditorBottom, VK_END, [ssShift,ssCtrl]); AddKey(ecToggleMode, VK_INSERT, []); AddKey(ecCopy, VK_INSERT, [ssCtrl]); AddKey(ecPaste, VK_INSERT, [ssShift]); AddKey(ecDeleteChar, VK_DELETE, []); AddKey(ecCut, VK_DELETE, [ssShift]); AddKey(ecDeleteLastChar, VK_BACK, []); AddKey(ecDeleteLastChar, VK_BACK, [ssShift]); //jr 2000-09-23 AddKey(ecDeleteLastWord, VK_BACK, [ssCtrl]); AddKey(ecUndo, VK_BACK, [ssAlt]); AddKey(ecRedo, VK_BACK, [ssAlt,ssShift]); AddKey(ecLineBreak, VK_RETURN, []); AddKey(ecSelectAll, ord('A'), [ssCtrl]); AddKey(ecCopy, ord('C'), [ssCtrl]); AddKey(ecBlockIndent, ord('I'), [ssCtrl,ssShift]); AddKey(ecLineBreak, ord('M'), [ssCtrl]); //AddKey(ecInsertLine, ord('N'), [ssCtrl]); AddKey(ecDeleteWord, ord('T'), [ssCtrl]); AddKey(ecBlockUnindent, ord('U'), [ssCtrl,ssShift]); AddKey(ecPaste, ord('V'), [ssCtrl]); AddKey(ecCut, ord('X'), [ssCtrl]); AddKey(ecDeleteLine, ord('Y'), [ssCtrl]); AddKey(ecDeleteEOL, ord('Y'), [ssCtrl,ssShift]); AddKey(ecUndo, ord('Z'), [ssCtrl]); AddKey(ecRedo, ord('Z'), [ssCtrl,ssShift]); //AddKey(ecGotoMarker0, ord('0'), [ssCtrl]); //AddKey(ecGotoMarker1, ord('1'), [ssCtrl]); //AddKey(ecGotoMarker2, ord('2'), [ssCtrl]); //AddKey(ecGotoMarker3, ord('3'), [ssCtrl]); //AddKey(ecGotoMarker4, ord('4'), [ssCtrl]); //AddKey(ecGotoMarker5, ord('5'), [ssCtrl]); //AddKey(ecGotoMarker6, ord('6'), [ssCtrl]); //AddKey(ecGotoMarker7, ord('7'), [ssCtrl]); //AddKey(ecGotoMarker8, ord('8'), [ssCtrl]); //AddKey(ecGotoMarker9, ord('9'), [ssCtrl]); //AddKey(ecSetMarker0, ord('0'), [ssCtrl,ssShift]); //AddKey(ecSetMarker1, ord('1'), [ssCtrl,ssShift]); //AddKey(ecSetMarker2, ord('2'), [ssCtrl,ssShift]); //AddKey(ecSetMarker3, ord('3'), [ssCtrl,ssShift]); //AddKey(ecSetMarker4, ord('4'), [ssCtrl,ssShift]); //AddKey(ecSetMarker5, ord('5'), [ssCtrl,ssShift]); //AddKey(ecSetMarker6, ord('6'), [ssCtrl,ssShift]); //AddKey(ecSetMarker7, ord('7'), [ssCtrl,ssShift]); //AddKey(ecSetMarker8, ord('8'), [ssCtrl,ssShift]); //AddKey(ecSetMarker9, ord('9'), [ssCtrl,ssShift]); //AddKey(ecFoldLevel1, ord('1'), [ssAlt,ssShift]); //AddKey(ecFoldLevel2, ord('2'), [ssAlt,ssShift]); //AddKey(ecFoldLevel3, ord('3'), [ssAlt,ssShift]); //AddKey(ecFoldLevel4, ord('4'), [ssAlt,ssShift]); //AddKey(ecFoldLevel5, ord('5'), [ssAlt,ssShift]); //AddKey(ecFoldLevel6, ord('6'), [ssAlt,ssShift]); //AddKey(ecFoldLevel7, ord('7'), [ssAlt,ssShift]); //AddKey(ecFoldLevel8, ord('8'), [ssAlt,ssShift]); //AddKey(ecFoldLevel9, ord('9'), [ssAlt,ssShift]); //AddKey(ecFoldLevel0, ord('0'), [ssAlt,ssShift]); //AddKey(ecFoldCurrent, ord('-'), [ssAlt,ssShift]); //AddKey(ecUnFoldCurrent, ord('+'), [ssAlt,ssShift]); AddKey(EcToggleMarkupWord, ord('M'), [ssAlt]); AddKey(ecNormalSelect, ord('N'), [ssAlt,ssShift]); //changed Ctrl -> Alt AddKey(ecColumnSelect, ord('C'), [ssAlt,ssShift]); //changed Ctrl -> Alt AddKey(ecLineSelect, ord('L'), [ssCtrl,ssShift]); AddKey(ecTab, VK_TAB, []); AddKey(ecShiftTab, VK_TAB, [ssShift]); AddKey(ecMatchBracket, ord('B'), [ssCtrl,ssShift]); AddKey(ecColSelUp, VK_UP, [ssAlt, ssShift]); AddKey(ecColSelDown, VK_DOWN, [ssAlt, ssShift]); AddKey(ecColSelLeft, VK_LEFT, [ssAlt, ssShift]); AddKey(ecColSelRight, VK_RIGHT, [ssAlt, ssShift]); AddKey(ecColSelPageDown, VK_NEXT, [ssAlt, ssShift]); AddKey(ecColSelPageBottom, VK_NEXT, [ssAlt, ssShift,ssCtrl]); AddKey(ecColSelPageUp, VK_PRIOR, [ssAlt, ssShift]); AddKey(ecColSelPageTop, VK_PRIOR, [ssAlt, ssShift,ssCtrl]); AddKey(ecColSelLineStart, VK_HOME, [ssAlt, ssShift]); AddKey(ecColSelLineEnd, VK_END, [ssAlt, ssShift]); AddKey(ecColSelEditorTop, VK_HOME, [ssAlt, ssShift,ssCtrl]); AddKey(ecColSelEditorBottom, VK_END, [ssAlt, ssShift,ssCtrl]); end; procedure TEditor.SetDefaultGutterParts; begin Gutter.Parts.Clear; with TSynGutterLineNumber.Create(Gutter.Parts) do Name := 'SynGutterLineNumber1'; with TSynGutterChanges.Create(Gutter.Parts) do Name := 'SynGutterChanges1'; with TSynGutterSeparator.Create(Gutter.Parts) do Name := 'SynGutterSeparator1'; end; procedure TEditor.SetDefaultMouseActions; var i: Integer; MA: TSynEditMouseAction; begin //Remove SourceLink MouseAction for i := 0 to MouseActions.Count - 1 do begin MA := MouseActions.Items[i]; if (MA.Command = emcMouseLink) then begin //DebugLn('Deleting MouseAction:',MA.DisplayName); MouseActions.Delete(i); Break; end; end; end; procedure TEditor.DoCharsetChanged(const OldCharset, NewCharset: String; const LineNr: Integer); begin if Assigned(FOnCharsetChanged) then FOnCharsetChanged(Self, OldCharset, NewCharset, LineNr); end; //SynEdit deafults to UTF8 filenames when using LoadFromFile !! procedure TEditor.LoadFromFileAnsi(const AnsiFn: String; const AsTemplate: Boolean = False); begin LoadFromFileUtf8(SysToUtf8(AnsiFn), AsTemplate); end; procedure TEditor.LoadFromFileUtf8(const Utf8Fn: String; const AsTemplate: Boolean = False); begin //DebugLn('TEditor.LoadFromFile: Utf8Fn = ',Utf8ToSys(Utf8Fn)); try Lines.LoadFromFile(Utf8Fn); Modified := False; FNoFileTypeChangeOnSave := False; SetFileName(Utf8Fn, AutoFileTypeDetection); if AsTemplate then begin//blank out internal filename and update caption FFileName := EmptyStr; if Assigned(FPage) then FPage.Caption := vTranslations.NoName; DoOnStatusChange([scFileName]); end; //DebugLn('TEditor.LoadFromFile: FileType = ',eftNames[FileType]); if (FileType = eftHtml) then AdjustEncoding; except SetFileName(EmptyStr, AutoFileTypeDetection); Modified := True; Raise; end; //DebugLn('TEditor.LoadFromFile End'); end; procedure TEditor.SaveToFileAnsi(const AnsiFn: String); begin SaveToFileAnsi(SysToUtf8(AnsiFn)); end; procedure TEditor.SaveToFileUtf8(const Utf8Fn: String); var Attr: LongInt; begin try {$ifdef windows} //TFileStreamUtf8.Create fails on hidden files on Windows, //because it uses FILE_ATTRIBUTE_NORMAL //see http://msdn.microsoft.com/en-us/library/windows/desktop/aa363858%28v=vs.85%29.aspx Attr := FileGetAttrUTF8(Utf8Fn); if (Attr = LongInt(feInvalidHandle)) then Attr := 0; if ((Attr and faHidden) = faHidden) then FileSetAttrUtf8(Utf8Fn, Attr and (not faHidden)); {$endif} Lines.SaveToFile(Utf8Fn); {$ifdef windows} if ((Attr and faHidden) = faHidden) then FileSetAttrUtf8(Utf8Fn, Attr or faHidden or faArchive); {$endif} Modified := False; SetFileName(Utf8Fn, AutoFileTypeDetection and (not FNoFileTypeChangeOnSave)); except Modified := True; SetFileName(EmptyStr, AutoFileTypeDetection and (not FNoFileTypeChangeOnSave)); Raise; end; end; function TEditor.IsUnused: Boolean; begin //debugln('TEditor.IsUnused: Modified = ',DbgS(Modified),', FFileName = "',FFileName,'", Length(Text) = ',DbgS(Length(Text))); Result := (not Modified) and (FFileName = EmptyStr) and (Length(Text) = 0); end; procedure TEditor.SetHighlighterByFileType(const AFileType: TEditorFileType; const Permanent: Boolean = False); begin if Assigned(FEditorPageControl) then begin Highlighter := FEditorPageControl.HighLighters[AFileType]; FFileType := AFileType; if Permanent then FNoFileTypeChangeOnSave := True; end; end; procedure TEditor.MarkSelection(const Pre, Post: String); var SLen: Integer; OldSelMode: TSynSelectionMode; begin //this only works with SelectionMode := scNormal OldSelMode := SelectionMode; SelectionMode := smNormal; //Using SelEnd - SelStart doesn't work correctly when selecting across lines //SynEdit internally works with byte positions, therefore use Length(), not Utf8Length() SLen := {Utf8}Length(Seltext); //SelStart - SelEnd; SelText := Pre + SelText + Post; //SelStart now is after Post, place it before the original selection SelStart := SelStart - {Utf8}Length(Post) - SLen; SelEnd := SelStart + SLen; SelectionMode := OldSelMode; SetFocus; end; constructor TEditor.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FFileName := ''; FPage := nil; FEditorPageControl := nil; FFileType := eftNone; FAutoFiletypeDetection := True; FNoFileTypeChangeOnSave := False; FEditorOptions := DefaultEditorOptions; SetDefaultKeyStrokes; SetDefaultMouseActions; SetDefaultGutterParts; //UpdateEditorOptions(FEditorOptions); end; destructor TEditor.Destroy; begin //Debugln('TEditor.Destroy: ',Name); //self.OnStatusChange := nil; //self.OnChange := nil; //self.OnCharsetChanged := nil; inherited Destroy; //Debugln('TEditor.Destroy: After inherited Destroy'); end; { **************************************************************************** } { TEditorPageControl } type THighlighterClassesArray = array[TEditorFileType] of TSynCustomHighlighterClass; //dummy class for eftNone, needed for eftHighlighterClassesArray TDummyHighlighter = Class(TSynCustomHighlighter) end; //static array used to instatiate all suppoterd highlighters //will give compile-time error if we change definition of TEditorFileType const eftHighlighterClassesArray: THighlighterClassesArray = (TDummyHighlighter, TSynHtmlSyn, TSynXmlSyn, TSynCssSyn, TSynJavaSyn, TSynFreePascalSyn, TSynLfmSyn, TSynCppSyn, TSynPythonSyn, TSynPhpSyn, TSynPerlSyn, TSynUNIXShellScriptSyn, TSynBatSyn, TSynDiffSyn, TSynIniSyn, TSynPoSyn); function TEditorPageControl.GetCurrentEditor: TEditor; var Pg: TTabSheet; begin //DebugLn('TEditorPageControl.GetCurrentEditor: PageCount = ',DbgS(PageCount),' ActivePageIndex = ',DbgS(ActivePageIndex)); Result := nil; //ActivePageIndex = -1 when you remove the last (as in no more pages available) page //PageCount will still be 1 at this time if (PageCount > 0) and (ActivePageIndex >= 0) then begin Pg := Pages[ActivePageIndex]; Result := EditorAtPage(Pg); end; end; function TEditorPageControl.FindPageCaption(const ACaption: String): TTabSheet; var Index: Integer; Pg: TTabSheet; begin Result := nil; for Index := 0 to PageCount - 1 do begin Pg := Pages[Index]; if Pg.Caption = ACaption then begin Result := Pg; Exit; end; end; end; function TEditorPageControl.GetHighLighter(Index: TEditorFileType): TSynCustomHighlighter; begin Result := FHighLighters[Index]; end; function TEditorPageControl.GetFileTypeMaskLists(Index: TEditorFileType): String; begin Result := FFileTypeMaskList[Index]; end; procedure TEditorPageControl.SetEditorOptions(AValue: TEditorOptions); begin if EditorOptionsAreDifferent(AValue, FEditorOptions) then begin FEditorOptions := AValue; UpdateEditorOptions(Self); end; end; function TEditorPageControl.GetEditorOptions: TEditorOptions; var Ed: TEditor; begin Ed := CurrentEditor; if Assigned(Ed) then begin //Get actual fon used by editor and update internal field FEditorOptions.FontName := Ed.Font.Name; FEditorOptions.FontSize := Ed.Font.Size; end; Result := FEditorOptions; end; procedure TEditorPageControl.SetFileTypeMaskLists(Index: TEditorFileType; AValue: string); begin if (AValue = FFileTypeMaskList[Index]) then Exit; AValue := Trim(AValue); if (Length(AValue) > 0) and (AValue[Length(AValue)] = ';') then System.Delete(AValue,Length(AValue),1); FFileTypeMaskList[Index] := AValue; UpdateEditorFileMasks; end; procedure TEditorPageControl.SetPopupMenu(AValue: TPopupMenu); begin if FEditorPopupMenu = AValue then Exit; FEditorPopupMenu := AValue; UpdateEditorPopupMenu; end; procedure TEditorPageControl.UpdateEditorFileMasks; var i: Integer; Ed: TEditor; begin for i := 0 to PageCount - 1 do begin Ed := EditorAtPage(i); if Assigned(Ed) then Ed.FileMaskList := Self.FFileTypeMaskList; end; end; procedure TEditorPageControl.UpdateEditorOptions(Sender: TObject); var i: Integer; Ed: TEditor; begin for i := 0 to PageCount - 1 do begin Ed := EditorAtPage(i); if Assigned(Ed) then Ed.EditorOptions := Self.EditorOptions; end; end; procedure TEditorPageControl.UpdateEditorPopupMenu; var i: Integer; Ed: TEditor; begin for i := 0 to PageCount - 1 do begin Ed := EditorAtPage(i); if Assigned(Ed) then Ed.PopupMenu := Self.EditorPopUpmenu; end; end; procedure TEditorPageControl.InternalEditorStatusChange(Sender: TObject; Changes: TSynStatusChanges); begin if Assigned(FOnStatusChange) then FOnStatusChange(Sender, Changes); end; procedure TEditorPageControl.InternalEditorCharsetChange(Sender: TEditor; const OldCharSet, NewCharSet: String; const LineNr: Integer); begin if Assigned(FOnEditorCharsetChanged) then FOnEditorCharsetChanged(Sender, OldCharSet, NewCharSet, LineNr); end; procedure TEditorPageControl.DoChange; var Ed: TEditor; begin inherited DoChange; Ed := GetCurrentEditor; InternalEditorStatusChange(Ed, [scCaretX,scCaretY,scModified,scInsertMode,scFileName]); if Assigned(Ed) then begin try Ed.SetFocus; except; debugln('TEditorPageControl.DoChange: could not set focus to current editor'); end; end; end; { procedure TEditorPageControl.RemovePage(Index: Integer); begin DebugLn('TEditorPageControl.RemovePage: Index = ',DbgS(Index),' PageCount = ',DbgS(PageCount)); // Pages[Index].DestroyComponents; DebugLn('TEditorPageControl.RemovePage A' ); inherited RemovePage(Index); DebugLn('TEditorPageControl.RemovePage A' ); if PageCount = 0 then InternalEditorStatusChange(nil, scAll); DebugLn('TEditorPageControl.RemovePage A' ); end; } constructor TEditorPageControl.Create(TheOwner: TComponent); var Index: TEditorFileType; begin inherited Create(TheOwner); FCounter := 0; FFileTypeMaskList := DefaultFileTypeMaskList; FEditorOptions := DefaultEditorOptions; //{$Hint Todo: use array of TSynCustomHighlighterClass, so new highlightrs are created if we add them in TEditorFileType} FHighLighters[eftNone] := nil; { The follwing method of instatiating has the advantage that, when we change TEditorFiltype (adding or removing highlighters) we get a compiletime error on the definition of eftHighlighterClassesArray automatically. } //Do not instantiate FHighLighters[Low(TeditorFileType)], because it must remain nil!! for Index := Succ(Low(TEditorFileType)) to High(TEditorFileType) do begin FHighLighters[Index] := eftHighlighterClassesArray[Index].Create(Self); end; { FHighLighters[eftHtml] := TSynHtmlSyn.Create(Self); FHighLighters[eftXml] := TSynXmlSyn.Create(Self); FHighLighters[eftCss] := TSynCssSyn.Create(Self); FHighLighters[eftJS] := TSynJavaSyn.Create(Self); FHighLighters[eftFpc] := TSynFreePascalSyn.Create(Self); FHighLighters[eftLfm] := TSynLfmSyn.Create(Self); FHighLighters[eftC] := TSynCppSyn.Create(Self); FHighLighters[eftPy] := TSynPythonSyn.Create(Self); FHighLighters[eftPhp] := TSynPhpSyn.Create(Self); FHighLighters[eftPerl] := TSynPerlSyn.Create(Self); FHighLighters[eftUnixShell] := TSynUNIXShellScriptSyn.Create(Self); FHighLighters[eftBat] := TSynBatSyn.Create(Self); FHighLighters[eftDiff] := TSynDiffSyn.Create(Self); FHighLighters[eftIni] := TSynIniSyn.Create(Self); FHighLighters[eftPo] := TSynPoSyn.Create(Self); } //these colors are clNone by default which results in no colors at all, just black and white (FHighlighters[eftFpc] as TSynFreePascalSyn).CommentAttri.Foreground := clFuchsia; (FHighlighters[eftFpc] as TSynFreePascalSyn).CommentAttri.Style := [fsItalic]; (FHighlighters[eftFpc] as TSynFreePascalSyn).StringAttri.Foreground := clBlue; (FHighlighters[eftFpc] as TSynFreePascalSyn).DirectiveAttri.Foreground := clRed; (FHighlighters[eftFpc] as TSynFreePascalSyn).DirectiveAttri.Style := [fsBold]; (FHighlighters[eftFpc] as TSynFreePascalSyn).SymbolAttri.Foreground := clRed; //Attribute for Html entities like '&' (FHighLighters[eftHtml] as TSynHtmlSyn).AndAttri.Foreground := $000080FF; //Orange end; destructor TEditorPageControl.Destroy; begin inherited Destroy; end; function TEditorPageControl.AddPage: TEditor; var TS: TTabSheet; E: TEditor; PgIdx: Integer; begin Result := nil; Inc(FCounter); TS := TTabSheet.Create(Self); TS.Name := 'TS' + IntToStr(FCounter); TS.PageControl := Self; PgIdx := TS.PageIndex; E := TEditor.Create(TS); Result := E; E.FileMaskList := FFileTypeMaskList; E.Parent := TS; E.FPage := TS; E.FEditorPageControl := Self; E.Align := alClient; //This will add suffix to TS.Caption if needed E.SetFileName(EmptyStr, E.AutoFileTypeDetection); //E.Lines.Clear; E.Modified := False; E.OnStatusChange := @InternalEditorStatusChange; E.OnCharsetChanged := @InternalEditorCharsetChange; E.Gutter.AutoSize := True; //E.Gutter.DigitCount := 4; //E.Gutter.LeadingZeros := False; E.Gutter.LeftOffset := 0; E.Gutter.RightOffset := 2; //We only want LineNumber, Changes and Separator //E.Font.Name := 'Courier New'; E.Font.Pitch := fpFixed; //E.Font.Size := EditorFontSize; //E.HighLighter := SynHTMLSyn; E.Options := [eoAltSetsColumnMode, eoAutoIndent, eoDragDropEditing, eoGroupUndo, eoScrollPastEol, eoEnhanceHomeKey, eoShowScrollHint, eoSmartTabDelete, eoSmartTabs, eoTabIndent, eoBracketHighlight, eoTabsToSpaces, eoTrimTrailingSpaces]; E.RightEdge := 0; E.RightEdgeColor := clWhite; E.TabWidth := 2; E.WantTabs := True; //DebugLn('TEditorPageContro.AddPage: before applying E.EditorOptions'); //Debugln(' E.Font.Name = ',E.Font.Name,' E.Font.Size = ',DbgS(E.Font.Size)); E.EditorOptions := Self.EditorOptions; //DebugLn('TEditorPageContro.AddPage: after applying E.EditorOptions'); //Debugln(' E.Font.Name = ',E.Font.Name,' E.Font.Size = ',DbgS(E.Font.Size)); E.PopUpMenu := FEditorPopUpMenu; { E.OnKeyPress := EditorKeyPress; E.OnKeyDown := EditorKeyDown; } E.Modified := False; InternalEditorStatusChange(E, [scCaretX,scCaretY,scModified,scInsertMode,scFileName]); ActivePage := Pages[PgIdx]; // Don't try to set focus when creating the first page in TForm.OnCreate or else an exception comes if Self.IsCreating then Exit; try E.SetFocus; except on AnExc: Exception do Debugln('SetFocus failed for Editor "',E.Name,'" with message ',AnExc.Message); end; end; function TEditorPageControl.ClosePage(Index: Integer): Boolean; var Cancel: Boolean; Pg: TTabSheet; Ed: TEditor; begin //Debugln('TEditorPageControl.ClosePage: Index = ',DbgS(Index)); Result := False; if (Index > PageCount - 1) then Exit; Pg := Pages[Index]; Cancel := False; if Assigned(FOnBeforeCloseEditor) then FOnBeforeCloseEditor(Pg, Cancel); if Not Cancel then begin //If you do Pg.Free, then the Editor gets destroyed when it may be //processing an event (keystrokes for instance). //In order to prevent this we first have to queue the destruction of teh Editor //and then queue the destruction of the page, or else we may get an error from TEditor: //WARNING: TLCLComponent.Destroy with LCLRefCount>0. Hint: Maybe the component is processing an event? Ed := EditorAtPage(Pg); if Assigned(Ed) then begin Application.ReleaseComponent(Ed); //Application.ProcessMessages; end; Pg.PageControl := nil; Application.ReleaseComponent(Pg); //Application.ProcessMessages; //Pg.Free; Result := True; if PageCount = 0 then InternalEditorStatusChange(nil, scAll); end; //Debugln('TEditorPageControl.ClosePage End.'); end; function TEditorPageControl.EditorAtPage(const Index: Integer): TEditor; var Pg: TTabSheet; begin Result := nil; if (Index <= PageCount - 1) then begin Pg := Pages[Index]; Result := EditorAtPage(Pg); end; end; function TEditorPageControl.EditorAtPage(const APage: TTabSheet): TEditor; var cc: Integer; begin Result := nil; if not Assigned(APage) then Exit; for cc := 0 to APage.ComponentCount - 1 do begin if APage.Components[cc] is TEditor then begin Result := TEditor(APage.Components[cc]); Exit; end; end; end; end.