diff --git a/applications/lazedit/editorpagecontrol.pp b/applications/lazedit/editorpagecontrol.pp index 777a421e5..a4dea6332 100644 --- a/applications/lazedit/editorpagecontrol.pp +++ b/applications/lazedit/editorpagecontrol.pp @@ -79,6 +79,7 @@ type 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; @@ -133,6 +134,7 @@ type 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); @@ -226,17 +228,13 @@ end; procedure TEditor.SetFileName(const Utf8Fn: String; const UpdateFileType: Boolean); begin //debugln('TEditor.SetFileName: Utf8Fn = ',Utf8ToSys(Utf8Fn)); - if (FFileName = Utf8Fn) then Exit; + if (FFileName = Utf8Fn) and (Utf8Fn <> EmptyStr) then Exit; FFileName := Utf8Fn; if Assigned(FPage) then begin - if (Utf8Fn <> EmptyStr) then - FPage.Caption := ExtractFileName(Utf8Fn) - else - FPage.Caption := vTranslations.NoName; + FPage.Caption := GetUniquePageCaption(Utf8Fn); //Debugln('TEditor.SetFileName: setting FPageCaption to ',FPage.Caption); end; - //debugln('TEditor.SetFileName: calling DoOnStatusChange(scAll)'); //Unless you change ReadOnly, the scFileName will be removed from Changes in TSynEdit.DoOnStatuschange ReadOnly := True; DoOnStatusChange(scAll); @@ -274,6 +272,62 @@ begin 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; @@ -639,6 +693,7 @@ begin if Assigned(FEditorPageControl) then begin Highlighter := FEditorPageControl.HighLighters[AFileType]; + FFileType := AFileType; if Permanent then FNoFileTypeChangeOnSave := True; end; end; @@ -724,6 +779,23 @@ begin 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]; @@ -920,12 +992,13 @@ var begin Result := nil; Inc(FCounter); + { NrOfNoNames := 0; Suffix := ''; for i := 0 to PageCount - 1 do if Pos(vTranslations.NoName, Pages[i].Caption) = 1 then Inc(NrOfNoNames); if NrOfNoNames > 0 then Suffix := ' [' + IntToStr(NrOfNoNames + 1) + ']'; - + } TS := TTabSheet.Create(Self); TS.Name := 'TS' + IntToStr(FCounter); TS.PageControl := Self; @@ -944,7 +1017,7 @@ begin E.Align := alClient; - + //This will add suffix to TS.Caption if needed E.SetFileName(EmptyStr, E.AutoFileTypeDetection); //E.Lines.Clear; diff --git a/applications/lazedit/lazedit.lpr b/applications/lazedit/lazedit.lpr index e94f21c43..e0b1ba65d 100644 --- a/applications/lazedit/lazedit.lpr +++ b/applications/lazedit/lazedit.lpr @@ -19,7 +19,7 @@ begin RequireDerivedFormResource := True; Application.Initialize; Application.CreateForm(TLazEditMainForm, LazEditMainForm); - +(* {$ifndef Darwin} // Parse the command line options @@ -33,6 +33,7 @@ begin else LazEditMainForm.TryFileOpen(ParamStr(1), False); {$endif} +*) Application.CreateForm(TformAbout, formAbout); Application.Run; end. diff --git a/applications/lazedit/lazedit_translations.pas b/applications/lazedit/lazedit_translations.pas index 002000a25..eb95c7acc 100644 --- a/applications/lazedit/lazedit_translations.pas +++ b/applications/lazedit/lazedit_translations.pas @@ -309,9 +309,9 @@ begin msgMruIndexOutOfBound := 'Index out of bounds [%d]'^m; msgFileTypeNotForBrowser := 'The file type is not suited for a browser.'^m+'Continue anyway?'; msgFileHasNoName := 'The file has no name.'^m + - 'U moet het bestand eerst opslaan om het in de browser te openen.'; - msgErrorBrowser := 'Er is een fout opgetreden tijdens het openen van'^m+ - '%s'^m'in de browser.'; + 'You must first save the file in order to open it in the browser.'; + msgErrorBrowser := 'An error has occured while opening'^m+ + '%s'^m'in the browser.'; msgTextNotFound := 'Text not found:'^m'"%s"'; // main.pp hints in toolbar buttons diff --git a/applications/lazedit/main.lfm b/applications/lazedit/main.lfm index f8585eb89..8818b45ac 100644 --- a/applications/lazedit/main.lfm +++ b/applications/lazedit/main.lfm @@ -5,7 +5,7 @@ object LazEditMainForm: TLazEditMainForm Width = 575 AllowDropFiles = True Caption = 'Lazarus Text Editor' - ClientHeight = 398 + ClientHeight = 399 ClientWidth = 575 Menu = MainMenu OnClose = FormClose @@ -17,8 +17,8 @@ object LazEditMainForm: TLazEditMainForm LCLVersion = '0.9.31' object StatusBar: TStatusBar Left = 0 - Height = 23 - Top = 375 + Height = 20 + Top = 379 Width = 575 Panels = < item @@ -1673,66 +1673,82 @@ object LazEditMainForm: TLazEditMainForm Caption = '&Highlighter' object mnuViewHLeftNone: TMenuItem Caption = 'Geen' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftHtml: TMenuItem Caption = 'Html' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftXml: TMenuItem Caption = 'Xml' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftCss: TMenuItem Caption = 'Css' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftJS: TMenuItem Caption = 'JavaScript' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftFpc: TMenuItem Caption = 'Pascal' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftLfm: TMenuItem Caption = 'Lazarus/Delphi forms' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftC: TMenuItem Caption = 'C' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftPy: TMenuItem Caption = 'Python' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftPhp: TMenuItem Caption = 'Php' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftPerl: TMenuItem Caption = 'Perl' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftUNIXShell: TMenuItem Caption = 'Unix shell script' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftBat: TMenuItem Caption = 'Dos/Windows batch' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftDiff: TMenuItem Caption = 'Diff' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftIni: TMenuItem Caption = 'Ini' + RadioItem = True OnClick = mnuSetHighlighterClick end object mnuViewHLeftPo: TMenuItem Caption = 'Po taalbestanden' + RadioItem = True OnClick = mnuSetHighlighterClick end end diff --git a/applications/lazedit/main.pp b/applications/lazedit/main.pp index b823103ed..5504c5824 100644 --- a/applications/lazedit/main.pp +++ b/applications/lazedit/main.pp @@ -47,7 +47,7 @@ uses SynEdit, SynEditTypes, EditorPageControl, lazedit_config, HtmlCode, HtmlDialogs, lazedit_constants, - lazedit_translations, lazedit_about; + lazedit_translations, lazedit_about, mrulists; type @@ -436,7 +436,7 @@ type ReplaceOptions: TSynSearchOptions; AppOptions: TLazEditOptions; - MruList: TStringList; + MruList: TMruList; MruMenuItems: Array[0..MruEntries-1] of TMenuItem; procedure SetUpAndConfigureLazEdit; @@ -550,6 +550,8 @@ const pXY = 0; //Panels constanten itUnixShellScript = '#!/bin/bash'; //Commandline options + opt_long_prefix = '--'; + opt_short_prefix = '-'; opt_long_PCP = 'pcp'; //--pcp=path/to/configfile opt_short_blankpage = 'n'; @@ -592,6 +594,7 @@ procedure TLazEditMainForm.FormDropFiles(Sender: TObject; const FileNames: array var i: Integer; begin +debugln('DropFiles'); for i := Low(FileNames) to High(FileNames) do begin if FileExistsUtf8(FileNames[i]) then @@ -1114,12 +1117,6 @@ begin ConfigFileName := IncludeTrailingPathDelimiter(ConfigFileDir) + GetDefaultIniNameOnly; //DebugLn('ConfigFileName = ',ConfigFileName); - - // REMOVE !! - //ConfigFileName := 'F:\LazarusProjecten\EPlus\EPlus.ini'; - //debugln('Temporarily using: ',ConfigFileName); - //^^^^^^^^^^^^^^ - Caption := AppName; TagMenuItemsAndActions; @@ -1142,22 +1139,20 @@ begin TableDlg := TTableDlg.Create; //MruList - MruList := TStringList.Create(); - //MruList.MaxEntries := MruEntries; + MruList := TMruList.Create(Self); + MruList.MaxEntries := MruEntries; //Configurable options AppOptions := GetDefaultAppOptions; if not LoadOptions(AppOptions, ConfigFileName) then - DebugLn('Fout bij laden van opties:',LineEnding,' ',ConfigFileName) + DebugLn('Error loading options',LineEnding,' ',ConfigFileName) else ApplyAppOptions(AppOptions); ConstructOpenDialogFileFilters; //Attach the OnChange handler after filling the list (in LoadOptions) - //MruList.OnChange := @OnMruListChange; + MruList.OnChange := @OnMruListChange; //Update the MRU menu entries OnMruListChange(Self); - - end; procedure TLazEditMainForm.DoTranslateAll; @@ -1354,7 +1349,7 @@ procedure TLazEditMainForm.SaveEplusConfiguration; begin GatherAppOptions(AppOptions); if not lazedit_config.SaveOptions(AppOptions, ConfigFileName) then - DebugLn('Fout bij opslaan van opties:',LineEnding,' ',ConfigFileName); + DebugLn('Error saving options:',LineEnding,' ',ConfigFileName); end; procedure TLazEditMainForm.CleanUp; @@ -1488,7 +1483,7 @@ begin for i := 0 to MruEntries - 1 do begin if MruList.Count > i then - Options.RecentFiles[i] := MruList.Strings[i] + Options.RecentFiles[i] := MruList.Items[i] else Options.RecentFiles[i] := ''; end; @@ -1555,44 +1550,57 @@ end; procedure TLazEditMainForm.ParseCommandlineFilenames(Dummy: PtrInt); var - i: Integer; + i, Count: Integer; S: String; + OpenBlankPage: Boolean; begin - //debugln('ParseCommandlineFilenames, FileNamesCount = ',DbgS(FileNamesCount)); + //debugln('TLazEditMainForm.ParseCommandlineFilenames'); 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 - S := MyGetOpt.FileNameStr(i); - if (S <> EmptyStr) then + S := ParamStrUtf8(i); + if not ((Utf8Pos(opt_short_prefix, S) = 1) or (Utf8Pos(opt_long_prefix, S) = 1)) then 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 if FileExistsUtf8(S) then begin - if not TryFileOpen(S) then ShowError(Format(msgOpenError,[S])); + if not TryFileOpen(S) then ShowError(Format(vTranslations.msgOpenError,[S])); end - else ShowError(Format(msgFileNotFound,[S])); + else ShowError(Format(vTranslations.msgFileNotFound,[S])); end + else if S = opt_short_prefix + opt_short_blankpage then OpenBlankPage := True; end; - if (MyGetOpt.FileNamesCount = 0) and MyGetOpt.HasOption(opt_short_blankpage,False) then - DoFileNewByType(eftNone); } + if (Count = 0) and OpenBlankPage then DoFileNewByType(eftNone); end; procedure TLazEditMainForm.ParseCommandLineSwitches; var - S: String; + S, _PCP: String; + i: Integer; begin - //debugln('ParseCommandlineSwitches'); -{ if MyGetOpt.HasOption(opt_long_PCP, False, S) then + //debugln('TLazEditMainForm.ParseCommandlineSwitches'); + _PCP := EmptyStr; + for i := 1 to ParamCount do begin - if (S <> EmptyStr) then + S := ParamStrUtf8(i); + if Utf8Pos(opt_long_prefix+opt_long_pcp+'=', S) = 1 then begin - S := ExcludeTrailingPathdelimiter(ExpandFileName(S)); - //MyGetOpt returns parameters as UTF8 - //inifiles uses system-encoding - ConfigFileDir := Utf8ToSys(S); + _PCP := S; + System.Delete(_PCP, 1, Length(opt_long_prefix) + Length('=')); + Break; end; - end;} + end; + if (_PCP <> EmptyStr) then + begin + _PCP := ExcludeTrailingPathdelimiter(ExpandFileName(_PCP)); + //MyGetOpt returns parameters as UTF8 + //inifiles uses system-encoding + ConfigFileDir := Utf8ToSys(_PCP); + end; end; @@ -1722,8 +1730,11 @@ var C: TComponent; HasEditor, HasSelection, HasClipPaste: Boolean; NeedsEditor, NeedsSelection, NeedsClipPaste: Boolean; + AFileType: TEditorFileType; + Ed: TEditor; begin - HasEditor := Assigned(NoteBook.CurrentEditor); + Ed := NoteBook.CurrentEditor; + HasEditor := Assigned(Ed); HasSelection := HasEditor and (NoteBook.CurrentEditor.SelAvail); HasClipPaste := (ClipBoard.AsText <> EmptyStr); for i := 0 to ComponentCount - 1 do @@ -1737,6 +1748,14 @@ begin TMenuItem(C).Enabled := ((NeedsEditor and HasEditor) or (not NeedsEditor)) and ((NeedsSelection and HasSelection) or (not NeedsSelection)) and ((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; @@ -1822,7 +1841,7 @@ var MnuItem: TMenuItem; Fn: String; begin -{ for i := 0 to MruList.Count - 1 do + for i := 0 to MruList.Count - 1 do begin MnuItem := MruMenuItems[i]; Fn := ExtractFileName(MruList.Items[i]); @@ -1841,7 +1860,7 @@ begin MnuItem.Visible := False; end; mnuSepAboveMru.Enabled := MruList.Count > 0; - mnuSepAboveMru.Visible := MruList.Count > 0;} + mnuSepAboveMru.Visible := MruList.Count > 0; end; @@ -2065,7 +2084,7 @@ begin begin ShowError(Format(vTranslations.msgMruIndexOutOfBound,[Index])); end; - Fn := MruList.Strings[Index]; + Fn := MruList.Items[Index]; if (Fn <> '') then begin if not TryFileOpen(Fn, False) then ShowError(Format(vTranslations.msgOpenError,[Fn])); diff --git a/applications/lazedit/mrulists.pp b/applications/lazedit/mrulists.pp new file mode 100644 index 000000000..65c5b6f3f --- /dev/null +++ b/applications/lazedit/mrulists.pp @@ -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. +