1. Implemented mrulists.pp unit, fixes crash on clicking on MRU menu item
2. Translated some remaining dutch strings in English translations and in main.pp
3. Commandline parameter handling
4. Re-introduced --pcp and -n commandline parameters
5. If no parameters specified, no blank page is opened
6. Update View -> Highlighter menu to reflect current active highligter
7. Add suffix to filename in TabSheet caption when needed
8. Fix bug in TEditor.ExtToFileType: FFileType was not updated
9. Fix wrong FileNotSaved dialog on new empty editor when closing


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2306 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2012-02-22 11:32:55 +00:00
parent 8c1b4da5c8
commit 67bf2fc1f7
6 changed files with 709 additions and 54 deletions

View File

@ -79,6 +79,7 @@ type
procedure SetAutoFiletypeDetection(AValue: Boolean); procedure SetAutoFiletypeDetection(AValue: Boolean);
procedure SetEditorOptions(AValue: TEditorOptions); procedure SetEditorOptions(AValue: TEditorOptions);
procedure UpdateEditorOptions(Sender: TObject); procedure UpdateEditorOptions(Sender: TObject);
function GetUniquePageCaption(const AName: String): String;
procedure SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean); procedure SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean);
function ExtToFileType(const Ext: String): TEditorFileType; function ExtToFileType(const Ext: String): TEditorFileType;
function GuessFileType: TEditorFileType; function GuessFileType: TEditorFileType;
@ -133,6 +134,7 @@ type
FOnBeforeCloseEditor: TCloseEditorEvent; FOnBeforeCloseEditor: TCloseEditorEvent;
FOnEditorCharsetChanged: TEditorCharsetChangedEvent; FOnEditorCharsetChanged: TEditorCharsetChangedEvent;
function GetCurrentEditor: TEditor; function GetCurrentEditor: TEditor;
function FindPageCaption(const ACaption: String): TTabSheet;
function GetHighLighter(Index: TEditorFileType): TSynCustomHighlighter; function GetHighLighter(Index: TEditorFileType): TSynCustomHighlighter;
function GetFileTypeMaskLists(Index: TEditorFileType): String; function GetFileTypeMaskLists(Index: TEditorFileType): String;
procedure SetEditorOptions(AValue: TEditorOptions); procedure SetEditorOptions(AValue: TEditorOptions);
@ -226,17 +228,13 @@ end;
procedure TEditor.SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean); procedure TEditor.SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean);
begin begin
//debugln('TEditor.SetFileName: Utf8Fn = ',Utf8ToSys(Utf8Fn)); //debugln('TEditor.SetFileName: Utf8Fn = ',Utf8ToSys(Utf8Fn));
if (FFileName = Utf8Fn) then Exit; if (FFileName = Utf8Fn) and (Utf8Fn <> EmptyStr) then Exit;
FFileName := Utf8Fn; FFileName := Utf8Fn;
if Assigned(FPage) then if Assigned(FPage) then
begin begin
if (Utf8Fn <> EmptyStr) then FPage.Caption := GetUniquePageCaption(Utf8Fn);
FPage.Caption := ExtractFileName(Utf8Fn)
else
FPage.Caption := vTranslations.NoName;
//Debugln('TEditor.SetFileName: setting FPageCaption to ',FPage.Caption); //Debugln('TEditor.SetFileName: setting FPageCaption to ',FPage.Caption);
end; end;
//debugln('TEditor.SetFileName: calling DoOnStatusChange(scAll)');
//Unless you change ReadOnly, the scFileName will be removed from Changes in TSynEdit.DoOnStatuschange //Unless you change ReadOnly, the scFileName will be removed from Changes in TSynEdit.DoOnStatuschange
ReadOnly := True; ReadOnly := True;
DoOnStatusChange(scAll); DoOnStatusChange(scAll);
@ -274,6 +272,62 @@ begin
if (FEditorOptions.FontSize <> Font.Size) and (FEditorOptions.FontSize <> 0) then Font.Size := FEditorOptions.FontSize; if (FEditorOptions.FontSize <> Font.Size) and (FEditorOptions.FontSize <> 0) then Font.Size := FEditorOptions.FontSize;
end; 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; function TEditor.ExtToFileType(const Ext: String): TEditorFileType;
var var
Index: TEditorFileType; Index: TEditorFileType;
@ -639,6 +693,7 @@ begin
if Assigned(FEditorPageControl) then if Assigned(FEditorPageControl) then
begin begin
Highlighter := FEditorPageControl.HighLighters[AFileType]; Highlighter := FEditorPageControl.HighLighters[AFileType];
FFileType := AFileType;
if Permanent then FNoFileTypeChangeOnSave := True; if Permanent then FNoFileTypeChangeOnSave := True;
end; end;
end; end;
@ -724,6 +779,23 @@ begin
end; end;
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; function TEditorPageControl.GetHighLighter(Index: TEditorFileType): TSynCustomHighlighter;
begin begin
Result := FHighLighters[Index]; Result := FHighLighters[Index];
@ -920,12 +992,13 @@ var
begin begin
Result := nil; Result := nil;
Inc(FCounter); Inc(FCounter);
{
NrOfNoNames := 0; NrOfNoNames := 0;
Suffix := ''; Suffix := '';
for i := 0 to PageCount - 1 do for i := 0 to PageCount - 1 do
if Pos(vTranslations.NoName, Pages[i].Caption) = 1 then Inc(NrOfNoNames); if Pos(vTranslations.NoName, Pages[i].Caption) = 1 then Inc(NrOfNoNames);
if NrOfNoNames > 0 then Suffix := ' [' + IntToStr(NrOfNoNames + 1) + ']'; if NrOfNoNames > 0 then Suffix := ' [' + IntToStr(NrOfNoNames + 1) + ']';
}
TS := TTabSheet.Create(Self); TS := TTabSheet.Create(Self);
TS.Name := 'TS' + IntToStr(FCounter); TS.Name := 'TS' + IntToStr(FCounter);
TS.PageControl := Self; TS.PageControl := Self;
@ -944,7 +1017,7 @@ begin
E.Align := alClient; E.Align := alClient;
//This will add suffix to TS.Caption if needed
E.SetFileName(EmptyStr, E.AutoFileTypeDetection); E.SetFileName(EmptyStr, E.AutoFileTypeDetection);
//E.Lines.Clear; //E.Lines.Clear;

View File

@ -19,7 +19,7 @@ begin
RequireDerivedFormResource := True; RequireDerivedFormResource := True;
Application.Initialize; Application.Initialize;
Application.CreateForm(TLazEditMainForm, LazEditMainForm); Application.CreateForm(TLazEditMainForm, LazEditMainForm);
(*
{$ifndef Darwin} {$ifndef Darwin}
// Parse the command line options // Parse the command line options
@ -33,6 +33,7 @@ begin
else else
LazEditMainForm.TryFileOpen(ParamStr(1), False); LazEditMainForm.TryFileOpen(ParamStr(1), False);
{$endif} {$endif}
*)
Application.CreateForm(TformAbout, formAbout); Application.CreateForm(TformAbout, formAbout);
Application.Run; Application.Run;
end. end.

View File

@ -309,9 +309,9 @@ begin
msgMruIndexOutOfBound := 'Index out of bounds [%d]'^m; msgMruIndexOutOfBound := 'Index out of bounds [%d]'^m;
msgFileTypeNotForBrowser := 'The file type is not suited for a browser.'^m+'Continue anyway?'; msgFileTypeNotForBrowser := 'The file type is not suited for a browser.'^m+'Continue anyway?';
msgFileHasNoName := 'The file has no name.'^m + msgFileHasNoName := 'The file has no name.'^m +
'U moet het bestand eerst opslaan om het in de browser te openen.'; 'You must first save the file in order to open it in the browser.';
msgErrorBrowser := 'Er is een fout opgetreden tijdens het openen van'^m+ msgErrorBrowser := 'An error has occured while opening'^m+
'%s'^m'in de browser.'; '%s'^m'in the browser.';
msgTextNotFound := 'Text not found:'^m'"%s"'; msgTextNotFound := 'Text not found:'^m'"%s"';
// main.pp hints in toolbar buttons // main.pp hints in toolbar buttons

View File

@ -5,7 +5,7 @@ object LazEditMainForm: TLazEditMainForm
Width = 575 Width = 575
AllowDropFiles = True AllowDropFiles = True
Caption = 'Lazarus Text Editor' Caption = 'Lazarus Text Editor'
ClientHeight = 398 ClientHeight = 399
ClientWidth = 575 ClientWidth = 575
Menu = MainMenu Menu = MainMenu
OnClose = FormClose OnClose = FormClose
@ -17,8 +17,8 @@ object LazEditMainForm: TLazEditMainForm
LCLVersion = '0.9.31' LCLVersion = '0.9.31'
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 20
Top = 375 Top = 379
Width = 575 Width = 575
Panels = < Panels = <
item item
@ -1673,66 +1673,82 @@ object LazEditMainForm: TLazEditMainForm
Caption = '&Highlighter' Caption = '&Highlighter'
object mnuViewHLeftNone: TMenuItem object mnuViewHLeftNone: TMenuItem
Caption = 'Geen' Caption = 'Geen'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftHtml: TMenuItem object mnuViewHLeftHtml: TMenuItem
Caption = 'Html' Caption = 'Html'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftXml: TMenuItem object mnuViewHLeftXml: TMenuItem
Caption = 'Xml' Caption = 'Xml'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftCss: TMenuItem object mnuViewHLeftCss: TMenuItem
Caption = 'Css' Caption = 'Css'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftJS: TMenuItem object mnuViewHLeftJS: TMenuItem
Caption = 'JavaScript' Caption = 'JavaScript'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftFpc: TMenuItem object mnuViewHLeftFpc: TMenuItem
Caption = 'Pascal' Caption = 'Pascal'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftLfm: TMenuItem object mnuViewHLeftLfm: TMenuItem
Caption = 'Lazarus/Delphi forms' Caption = 'Lazarus/Delphi forms'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftC: TMenuItem object mnuViewHLeftC: TMenuItem
Caption = 'C' Caption = 'C'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftPy: TMenuItem object mnuViewHLeftPy: TMenuItem
Caption = 'Python' Caption = 'Python'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftPhp: TMenuItem object mnuViewHLeftPhp: TMenuItem
Caption = 'Php' Caption = 'Php'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftPerl: TMenuItem object mnuViewHLeftPerl: TMenuItem
Caption = 'Perl' Caption = 'Perl'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftUNIXShell: TMenuItem object mnuViewHLeftUNIXShell: TMenuItem
Caption = 'Unix shell script' Caption = 'Unix shell script'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftBat: TMenuItem object mnuViewHLeftBat: TMenuItem
Caption = 'Dos/Windows batch' Caption = 'Dos/Windows batch'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftDiff: TMenuItem object mnuViewHLeftDiff: TMenuItem
Caption = 'Diff' Caption = 'Diff'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftIni: TMenuItem object mnuViewHLeftIni: TMenuItem
Caption = 'Ini' Caption = 'Ini'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
object mnuViewHLeftPo: TMenuItem object mnuViewHLeftPo: TMenuItem
Caption = 'Po taalbestanden' Caption = 'Po taalbestanden'
RadioItem = True
OnClick = mnuSetHighlighterClick OnClick = mnuSetHighlighterClick
end end
end end

View File

@ -47,7 +47,7 @@ uses
SynEdit, SynEditTypes, SynEdit, SynEditTypes,
EditorPageControl, EditorPageControl,
lazedit_config, HtmlCode, HtmlDialogs, lazedit_constants, lazedit_config, HtmlCode, HtmlDialogs, lazedit_constants,
lazedit_translations, lazedit_about; lazedit_translations, lazedit_about, mrulists;
type type
@ -436,7 +436,7 @@ type
ReplaceOptions: TSynSearchOptions; ReplaceOptions: TSynSearchOptions;
AppOptions: TLazEditOptions; AppOptions: TLazEditOptions;
MruList: TStringList; MruList: TMruList;
MruMenuItems: Array[0..MruEntries-1] of TMenuItem; MruMenuItems: Array[0..MruEntries-1] of TMenuItem;
procedure SetUpAndConfigureLazEdit; procedure SetUpAndConfigureLazEdit;
@ -550,6 +550,8 @@ const pXY = 0; //Panels constanten
itUnixShellScript = '#!/bin/bash'; itUnixShellScript = '#!/bin/bash';
//Commandline options //Commandline options
opt_long_prefix = '--';
opt_short_prefix = '-';
opt_long_PCP = 'pcp'; //--pcp=path/to/configfile opt_long_PCP = 'pcp'; //--pcp=path/to/configfile
opt_short_blankpage = 'n'; opt_short_blankpage = 'n';
@ -592,6 +594,7 @@ procedure TLazEditMainForm.FormDropFiles(Sender: TObject; const FileNames: array
var var
i: Integer; i: Integer;
begin begin
debugln('DropFiles');
for i := Low(FileNames) to High(FileNames) do for i := Low(FileNames) to High(FileNames) do
begin begin
if FileExistsUtf8(FileNames[i]) then if FileExistsUtf8(FileNames[i]) then
@ -1114,12 +1117,6 @@ begin
ConfigFileName := IncludeTrailingPathDelimiter(ConfigFileDir) + GetDefaultIniNameOnly; ConfigFileName := IncludeTrailingPathDelimiter(ConfigFileDir) + GetDefaultIniNameOnly;
//DebugLn('ConfigFileName = ',ConfigFileName); //DebugLn('ConfigFileName = ',ConfigFileName);
// REMOVE !!
//ConfigFileName := 'F:\LazarusProjecten\EPlus\EPlus.ini';
//debugln('Temporarily using: ',ConfigFileName);
//^^^^^^^^^^^^^^
Caption := AppName; Caption := AppName;
TagMenuItemsAndActions; TagMenuItemsAndActions;
@ -1142,22 +1139,20 @@ begin
TableDlg := TTableDlg.Create; TableDlg := TTableDlg.Create;
//MruList //MruList
MruList := TStringList.Create(); MruList := TMruList.Create(Self);
//MruList.MaxEntries := MruEntries; MruList.MaxEntries := MruEntries;
//Configurable options //Configurable options
AppOptions := GetDefaultAppOptions; AppOptions := GetDefaultAppOptions;
if not LoadOptions(AppOptions, ConfigFileName) then if not LoadOptions(AppOptions, ConfigFileName) then
DebugLn('Fout bij laden van opties:',LineEnding,' ',ConfigFileName) DebugLn('Error loading options',LineEnding,' ',ConfigFileName)
else else
ApplyAppOptions(AppOptions); ApplyAppOptions(AppOptions);
ConstructOpenDialogFileFilters; ConstructOpenDialogFileFilters;
//Attach the OnChange handler after filling the list (in LoadOptions) //Attach the OnChange handler after filling the list (in LoadOptions)
//MruList.OnChange := @OnMruListChange; MruList.OnChange := @OnMruListChange;
//Update the MRU menu entries //Update the MRU menu entries
OnMruListChange(Self); OnMruListChange(Self);
end; end;
procedure TLazEditMainForm.DoTranslateAll; procedure TLazEditMainForm.DoTranslateAll;
@ -1354,7 +1349,7 @@ procedure TLazEditMainForm.SaveEplusConfiguration;
begin begin
GatherAppOptions(AppOptions); GatherAppOptions(AppOptions);
if not lazedit_config.SaveOptions(AppOptions, ConfigFileName) then if not lazedit_config.SaveOptions(AppOptions, ConfigFileName) then
DebugLn('Fout bij opslaan van opties:',LineEnding,' ',ConfigFileName); DebugLn('Error saving options:',LineEnding,' ',ConfigFileName);
end; end;
procedure TLazEditMainForm.CleanUp; procedure TLazEditMainForm.CleanUp;
@ -1488,7 +1483,7 @@ begin
for i := 0 to MruEntries - 1 do for i := 0 to MruEntries - 1 do
begin begin
if MruList.Count > i then if MruList.Count > i then
Options.RecentFiles[i] := MruList.Strings[i] Options.RecentFiles[i] := MruList.Items[i]
else else
Options.RecentFiles[i] := ''; Options.RecentFiles[i] := '';
end; end;
@ -1555,44 +1550,57 @@ end;
procedure TLazEditMainForm.ParseCommandlineFilenames(Dummy: PtrInt); procedure TLazEditMainForm.ParseCommandlineFilenames(Dummy: PtrInt);
var var
i: Integer; i, Count: Integer;
S: String; S: String;
OpenBlankPage: Boolean;
begin begin
//debugln('ParseCommandlineFilenames, FileNamesCount = ',DbgS(FileNamesCount)); //debugln('TLazEditMainForm.ParseCommandlineFilenames');
if Dummy = 12345 then Exit; //Get rid of annoying hint if Dummy = 12345 then Exit; //Get rid of annoying hint
{ for i := 1 to MyGetOpt.FileNamesCount do Count := 0;
OpenBlankPage := False;
for i := 1 to ParamCount do
begin begin
S := MyGetOpt.FileNameStr(i); S := ParamStrUtf8(i);
if (S <> EmptyStr) then if not ((Utf8Pos(opt_short_prefix, S) = 1) or (Utf8Pos(opt_long_prefix, S) = 1)) then
begin begin
//it is a file to open //It seems to be not an option, treat it as a filename
Inc(Count);
S := ExpandFileNameUtf8(S); //we want full filename here, e.g. for filename in statusbar S := ExpandFileNameUtf8(S); //we want full filename here, e.g. for filename in statusbar
if FileExistsUtf8(S) then if FileExistsUtf8(S) then
begin begin
if not TryFileOpen(S) then ShowError(Format(msgOpenError,[S])); if not TryFileOpen(S) then ShowError(Format(vTranslations.msgOpenError,[S]));
end end
else ShowError(Format(msgFileNotFound,[S])); else ShowError(Format(vTranslations.msgFileNotFound,[S]));
end end
else if S = opt_short_prefix + opt_short_blankpage then OpenBlankPage := True;
end; end;
if (MyGetOpt.FileNamesCount = 0) and MyGetOpt.HasOption(opt_short_blankpage,False) then if (Count = 0) and OpenBlankPage then DoFileNewByType(eftNone);
DoFileNewByType(eftNone); }
end; end;
procedure TLazEditMainForm.ParseCommandLineSwitches; procedure TLazEditMainForm.ParseCommandLineSwitches;
var var
S: String; S, _PCP: String;
i: Integer;
begin begin
//debugln('ParseCommandlineSwitches'); //debugln('TLazEditMainForm.ParseCommandlineSwitches');
{ if MyGetOpt.HasOption(opt_long_PCP, False, S) then _PCP := EmptyStr;
for i := 1 to ParamCount do
begin begin
if (S <> EmptyStr) then S := ParamStrUtf8(i);
if Utf8Pos(opt_long_prefix+opt_long_pcp+'=', S) = 1 then
begin begin
S := ExcludeTrailingPathdelimiter(ExpandFileName(S)); _PCP := S;
System.Delete(_PCP, 1, Length(opt_long_prefix) + Length('='));
Break;
end;
end;
if (_PCP <> EmptyStr) then
begin
_PCP := ExcludeTrailingPathdelimiter(ExpandFileName(_PCP));
//MyGetOpt returns parameters as UTF8 //MyGetOpt returns parameters as UTF8
//inifiles uses system-encoding //inifiles uses system-encoding
ConfigFileDir := Utf8ToSys(S); ConfigFileDir := Utf8ToSys(_PCP);
end; end;
end;}
end; end;
@ -1722,8 +1730,11 @@ var
C: TComponent; C: TComponent;
HasEditor, HasSelection, HasClipPaste: Boolean; HasEditor, HasSelection, HasClipPaste: Boolean;
NeedsEditor, NeedsSelection, NeedsClipPaste: Boolean; NeedsEditor, NeedsSelection, NeedsClipPaste: Boolean;
AFileType: TEditorFileType;
Ed: TEditor;
begin begin
HasEditor := Assigned(NoteBook.CurrentEditor); Ed := NoteBook.CurrentEditor;
HasEditor := Assigned(Ed);
HasSelection := HasEditor and (NoteBook.CurrentEditor.SelAvail); HasSelection := HasEditor and (NoteBook.CurrentEditor.SelAvail);
HasClipPaste := (ClipBoard.AsText <> EmptyStr); HasClipPaste := (ClipBoard.AsText <> EmptyStr);
for i := 0 to ComponentCount - 1 do for i := 0 to ComponentCount - 1 do
@ -1737,6 +1748,14 @@ begin
TMenuItem(C).Enabled := ((NeedsEditor and HasEditor) or (not NeedsEditor)) and TMenuItem(C).Enabled := ((NeedsEditor and HasEditor) or (not NeedsEditor)) and
((NeedsSelection and HasSelection) or (not NeedsSelection)) and ((NeedsSelection and HasSelection) or (not NeedsSelection)) and
((NeedsClipPaste and HasClipPaste) or (not NeedsClipPaste)); ((NeedsClipPaste and HasClipPaste) or (not NeedsClipPaste));
if HasEditor and (Pos('MNUVIEWHL', UpperCase(C.Name)) = 1) then
begin
if TryHlMenuTagToFileType(C.Tag, AFileType) then
TMenuItem(C).Checked := Ed.FileType = AFileType
else
TMenuItem(C).Checked := False;
end;
end; end;
end; end;
end; end;
@ -1822,7 +1841,7 @@ var
MnuItem: TMenuItem; MnuItem: TMenuItem;
Fn: String; Fn: String;
begin begin
{ for i := 0 to MruList.Count - 1 do for i := 0 to MruList.Count - 1 do
begin begin
MnuItem := MruMenuItems[i]; MnuItem := MruMenuItems[i];
Fn := ExtractFileName(MruList.Items[i]); Fn := ExtractFileName(MruList.Items[i]);
@ -1841,7 +1860,7 @@ begin
MnuItem.Visible := False; MnuItem.Visible := False;
end; end;
mnuSepAboveMru.Enabled := MruList.Count > 0; mnuSepAboveMru.Enabled := MruList.Count > 0;
mnuSepAboveMru.Visible := MruList.Count > 0;} mnuSepAboveMru.Visible := MruList.Count > 0;
end; end;
@ -2065,7 +2084,7 @@ begin
begin begin
ShowError(Format(vTranslations.msgMruIndexOutOfBound,[Index])); ShowError(Format(vTranslations.msgMruIndexOutOfBound,[Index]));
end; end;
Fn := MruList.Strings[Index]; Fn := MruList.Items[Index];
if (Fn <> '') then if (Fn <> '') then
begin begin
if not TryFileOpen(Fn, False) then ShowError(Format(vTranslations.msgOpenError,[Fn])); if not TryFileOpen(Fn, False) then ShowError(Format(vTranslations.msgOpenError,[Fn]));

View File

@ -0,0 +1,546 @@
{ MruLists
Copyright (C) 2007, 2011 by Flying Sheep Inc.
Portions Copyright (C) by Lazarus development team http://www.lazarus.freepascal.org
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 MruLists;
interface
uses
SysUtils, Classes, Controls, {Registry, IniFiles,} FileUtil;
{$if defined(Windows) or defined(darwin)}
{$define CaseInsensitiveFilenames}
{$endif}
{$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
{$DEFINE NotLiteralFilenames}
{$ENDIF}
type
{ TMruList }
TMruList = class(TComponent)
private
{ Private declarations }
FList: TStringList;
FMaxEntries: Integer;
//FIniName: String;
//FIniSection: String;
//FRegRoot: HKEY;
//FRegKey: String;
FOnChange: TNotifyEvent;
protected
{ Protected declarations }
function IndexInBounds(const Index: Integer): Boolean;
function GetItem(const Index: Integer): String;
procedure SetMaxEntries(Value: Integer);
function GetCount: Integer;
function HasDuplicate(const Value: String; out Index: Integer): Boolean;
function GetFileNameOnDisk(const Utf8Fn: String): String;
procedure DoChange;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Clear;
procedure Add(Item: String; const DoNormalizeName: Boolean = False);
procedure AddAnsi(AnsiItem: String; const DoNormalizeName: Boolean = False);
procedure Delete(const Index: Integer);
{
function LoadFromFile(const AnsiFn: String): Boolean;
function LoadFromFileUtf8(const Utf8Fn: String): Boolean;
function LoadFromIni(Ini: TIniFile): Boolean;
function SaveToFile(const AnsiFn: String): Boolean;
function SaveToFileUtf8(const Utf8Fn: String): Boolean;
function SaveToIni(Ini: TIniFile): Boolean;
function LoadFromRegistry: Boolean;
function SaveToRegistry: Boolean;
}
//Note: Items are internally treated as UTF8
property Items[const Index: Integer]:String read GetItem; default;
published
{ Published declarations }
property Count: Integer read GetCount;
property MaxEntries: Integer read FMaxEntries write SetMaxEntries default 5;
//property IniFileName: String read FIniName write FIniName;
//property IniSectionName: String read FIniSection write FIniSection;
//property RegRoot: HKEY read FRegRoot write FRegRoot default HKEY_CURRENT_USER;
//property RegKey: String read FRegKey write FRegKey;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
type
EMruListError = class(Exception);
implementation
const
EntryLimit = 50; //I don't think one needs a 50-items long MRU list, but feel free to alter
FilePrefix = 'File';
//Helper functions
function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer;
{$IFDEF darwin}
var
F1: CFStringRef;
F2: CFStringRef;
{$ENDIF}
begin
{$IFDEF darwin}
if Filename1=Filename2 then exit(0);
F1:=CFStringCreateWithCString(nil,Pointer(Filename1),kCFStringEncodingUTF8);
F2:=CFStringCreateWithCString(nil,Pointer(Filename2),kCFStringEncodingUTF8);
Result:=CFStringCompare(F1,F2,kCFCompareNonliteral+kCFCompareCaseInsensitive);
CFRelease(F1);
CFRelease(F2);
{$ELSE}
Result:=AnsiCompareText(Filename1, Filename2);
{$ENDIF}
end;
function FindDiskFilename(const Filename: string): string;
// Searches for the filename case on disk.
// if it does not exist, only the found path will be improved
// For example:
// If Filename='file' and there is only a 'File' then 'File' will be returned.
var
StartPos: Integer;
EndPos: LongInt;
FileInfo: TSearchRec;
CurDir: String;
CurFile: String;
AliasFile: String;
Ambiguous: Boolean;
FileNotFound: Boolean;
begin
Result:=Filename;
// check every directory and filename
StartPos:=1;
{$IFDEF Windows}
// uppercase Drive letter and skip it
if ((length(Result)>=2) and (Result[1] in ['A'..'Z','a'..'z'])
and (Result[2]=':')) then begin
StartPos:=3;
if Result[1] in ['a'..'z'] then
Result[1] := UpCase(Result[1]);
end;
{$ENDIF}
FileNotFound:=false;
repeat
// skip PathDelim
while (StartPos<=length(Result)) and (Result[StartPos]=PathDelim) do
inc(StartPos);
// find end of filename part
EndPos:=StartPos;
while (EndPos<=length(Result)) and (Result[EndPos]<>PathDelim) do
inc(EndPos);
if EndPos>StartPos then begin
// search file
CurDir:=copy(Result,1,StartPos-1);
CurFile:=copy(Result,StartPos,EndPos-StartPos);
AliasFile:='';
Ambiguous:=false;
if FindFirstUTF8(CurDir+AllFilesMask,faAnyFile,FileInfo)=0 then
begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
then
continue;
if CompareFilenamesIgnoreCase(FileInfo.Name,CurFile)=0 then begin
//writeln('FindDiskFilename ',FileInfo.Name,' ',CurFile);
if FileInfo.Name=CurFile then begin
// file found, has already the correct name
AliasFile:='';
break;
end else begin
// alias found, but has not the correct name
if AliasFile='' then begin
AliasFile:=FileInfo.Name;
end else begin
// there are more than one candidate
Ambiguous:=true;
end;
end;
end;
until FindNextUTF8(FileInfo)<>0;
end else
FileNotFound:=true;
FindCloseUTF8(FileInfo);
if FileNotFound then break;
if (AliasFile<>'') and (not Ambiguous) then begin
// better filename found -> replace
Result:=CurDir+AliasFile+copy(Result,EndPos,length(Result));
end;
end;
StartPos:=EndPos+1;
until StartPos>length(Result);
end;
constructor TMruList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FList := TStringList.Create;
FMaxEntries := 5;
//FIniSection := 'MruList';
//FRegRoot := HKEY_CURRENT_USER;
end;
destructor TMruList.Destroy;
begin
FList.Free;
inherited Destroy;
end;
function TMruList.IndexInBounds(const Index: Integer): Boolean;
begin
Result := (Index < FMaxEntries) and
(Index >= 0) and (Index < FList.Count);
end;
function TMruList.GetItem(const Index: Integer): String;
begin
if IndexInBounds(Index) then Result := FList.Strings[Index]
else Result := '';
end;
function TMruList.HasDuplicate(const Value: String; out Index: Integer): Boolean;
//Returns True if Filename exists in the list, then Index is set appropriate
var
i: Integer;
begin
Index := -1;
Result := False;
for i := 0 to FList.Count - 1 do
begin
if CompareFileNames(FList.Strings[i], Value, True) = 0 then
begin
Result := True;
Index := i;
Break;
end;
end;
end;
procedure TMruList.SetMaxEntries(Value: Integer);
var i: Integer;
begin
if (Value = FMaxEntries) then Exit; //status quo
if (Value < 0) then Value := 0;
if (Value > EntryLimit) then Value := EntryLimit;
if (Value < FMaxEntries) and (Value < FList.Count) then
begin
for i := FList.Count - 1 downto Value do FList.Delete(i);
DoChange;
end;
FMaxEntries := Value;
end;
function TMruList.GetCount: Integer;
begin
Result := FList.Count;
end;
procedure TMruList.Clear;
begin
FList.Clear;
DoChange;
end;
procedure TMruList.DoChange;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TMruList.Add(Item: String; const DoNormalizeName: Boolean = False);
//The MRU list is always sorted in a anti-chronological order
//that is: the most recent added item gets index 0.
//If the list is full (FList.Count = FMaxEntries) the last Item is deleted
//then the new Item is added
//If Item is already in the list, then it gets moved to Index = 0
var Index: Integer;
begin
Item := Trim(Item);
if (FMaxEntries <= 0) or (Item = '') then Exit;
Item := ExpandFileName(Item);
if DoNormalizeName then Item := GetFileNameOnDisk(Item);
if HasDuplicate(Item, Index) then
begin//Filename already in list
if (Index = 0) then Exit;
FList.Delete(Index);
FList.Insert(0, Item);
end
else
begin
if (FList.Count >= FMaxEntries) and (FList.Count > 0) then
begin
FList.Delete(FList.Count - 1);
end;
FList.Insert(0, Item);
end;
DoChange;
end;
procedure TMruList.AddAnsi(AnsiItem: String; const DoNormalizeName: Boolean);
begin
Add(SysToUtf8(AnsiItem), DoNormalizeName);
end;
procedure TMruList.Delete(const Index: Integer);
begin
if IndexInBounds(Index) then
begin
FList.Delete(Index);
DoChange;
end;
end;
{
function TMruList.LoadFromFile(const AnsiFn: String): Boolean;
//Return True if succes
//Return False if the ini file does not exist or we fail on getting read access
//or the read throws an exception
//No validation on correct sequence.
//If only file1 and file3 exist, for example, they are added in the list as entry 0 and 1
var IniFile: TIniFile;
i, dummy: Integer;
S: String;
begin
Result := False;
if not FileExists(AnsiFn) then Exit;
FList.Clear;
IniFile := TIniFile.Create(AnsiFn);
try
try
for i := 0 to FMaxEntries - 1 do
begin
S := IniFile.ReadString(FIniSection, FilePrefix+IntToStr(i),'');
if (S <> '') and (not HasDuplicate(S, dummy)) then FList.Add(S);
end;
Result := True;
except
//Catch any exception during read access
Result := False;
end;
finally
IniFile.Free;
DoChange;
end;
end;
}
{
function TMruList.LoadFromFileUtf8(const Utf8Fn: String): Boolean;
begin
Result := LoadFromFile(Utf8ToSys(Utf8Fn));
end;
}
{
function TMruList.LoadFromIni(Ini: TIniFile): Boolean;
var
i: Integer;
S: String;
dummy: Integer;
begin
Result := False;
if not Assigned(Ini) then Exit;
try
try
for i := 0 to FMaxEntries - 1 do
begin
S := Ini.ReadString(FIniSection, FilePrefix+IntToStr(i),'');
if (S <> '') and (not HasDuplicate(S, dummy)) then FList.Add(S);
end;
Result := True;
except
//Catch any exception during read access
Result := False;
end;
finally
DoChange;
end;
end;
}
{
function TMruList.SaveToFile(const AnsiFn: String): Boolean;
//Return True if succes
//Return False on write errors
var IniFile: TIniFile;
i: Integer;
begin
Result := False;
IniFile := TIniFile.Create(AnsiFn);
IniFile.CacheUpdates := True;
Try
Try
for i := 0 to FList.Count - 1 do IniFile.WriteString(FIniSection, FilePrefix+IntToStr(i), FList.Strings[i]);
IniFile.UpdateFile;
Result := True;
Except
//Catch UpdateFile failures (e.g. file is read-only) that result in Exception (of class Exception)
Result := False;
end;
finally
IniFile.Free;
end;
end;
}
{
function TMruList.SaveToFileUtf8(const Utf8Fn: String): Boolean;
begin
Result := SaveToFile(Utf8ToSys(Utf8Fn));
end;
}
{
function TMruList.SaveToIni(Ini: TIniFile): Boolean;
var
i: Integer;
begin
Result := False;
if not Assigned(Ini) then Exit;
Try
for i := 0 to FList.Count - 1 do Ini.WriteString(FIniSection, FilePrefix+IntToStr(i), FList.Strings[i]);
//if Cached do not update
Result := True;
Except
//Catch UpdateFile/WrieteString failures (e.g. file is read-only) that result in Exception (of class Exception)
Result := False;
end;
end;
}
{
function TMruList.LoadFromRegistry: Boolean;
//Return True if succes
//Return False on read errors
//No validation on correct sequence.
//If only file1 and file3 exist, for example, they are added in the list as entry 0 and 1
var Reg: TRegistry;
i, dummy: Integer;
Error: Boolean;
S: String;
begin
Result := False;
Reg := TRegistry.Create;
FList.Clear;
try
Reg.RootKey := FRegRoot;
//if Reg.KeyExists(FRegKey) then
//begin
if Reg.OpenKeyReadOnly(FRegKey) then
begin
Error := False;
for i := 0 to FMaxEntries - 1 do
begin
Try
S := Reg.ReadString(FilePrefix+IntToStr(i));
if (S <> '') and (not HasDuplicate(S, dummy)) then FList.Add(S);
Except
Error := true;
end;
end;
Result := not Error;
end;//OpenKey
//end;//KeyExists
finally
Reg.Free;
DoChange;
end;
end;
}
{
function TMruList.SaveToRegistry: Boolean;
//Return True if succes
//Return False on write errors
var Reg: TRegistry;
i: Integer;
Error: Boolean;
begin
Result := False;
Reg := TRegistry.Create;
try
Reg.RootKey := FRegRoot;
if Reg.OpenKey(FRegKey, True) then
begin
Error := False;
for i := 0 to FList.Count - 1 do
begin
Try
Reg.WriteString(FilePrefix+IntToStr(i), FList.Strings[i]);
Except
Error := True;
end;
end;
Result := not Error;
end;//if OpenKey
finally
Reg.Free;
end;
end;
}
function TMruList.GetFileNameOnDisk(const Utf8Fn: String): String;
begin
{$IF defined(CaseInsensitiveFilenames) or defined(NotLiteralFilenames)}
Result := FindDiskFilename(Utf8Fn);
{$ELSE}
Result := Utf8Fn;
{$ENDIF}
end;
end.