mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-28 10:02:14 +00:00
Code Issues Projects Releases Packages Wiki Activity

FIX: Open with default command

Browse source
This commit is contained in:
Alexander Koblov 2008-12-27 12:19:14 +00:00
commit 1fa5e59caa
1 changed files with 465 additions and 465 deletions
Download patch file Download diff file Expand all files Collapse all files

930
uexts.pas
View file

@ -1,465 +1,465 @@
{
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
storing commands (by file extensions)
contributors:
Copyright (C) 2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uExts;
interface
uses
Classes, Contnrs;
type
{en
Class for storage actions by file extensions
}
TExtAction = class
SectionName: String; //en< Section name, for example "[htm|html|mht]"
Name: String; //en< File type name, for example "Hyper text documents"
Icon: String; //en< Path to icon
IconIndex: Integer; //en< Icon index (used in configuration dialog for paint icons)
Extensions: TStringList; //en< List of extensions
Actions: TStringList; //en< List of actions, for example "Open=opera '%f'"
IsChanged: Boolean; //en< True if item was changed
public
{en
Constructs an object and initializes its data before the object is first used.
}
constructor Create;
{en
Destroys an object and frees its memory.
}
destructor Destroy; override;
end;
{en
Main class for storage actions list by file extensions
}
TExts = class
private
{en
Return the number of items
@returns(The number of items)
}
function GetCount: Integer;
{en
Get item by index
@param(Index Item index)
@returns(TExtAction item)
}
function GetItems(Index: Integer): TExtAction;
protected
{en
Internal ObjectList for storage items.
}
FExtList:TObjectList;
{en
Return new section name for item by index
@param(Index Item index)
@returns(New section name)
}
function GetNewSectionName(Index: Integer): String;
{en
Erase section from file by section line index
@param(extFile StringList with loaded extension file)
@param(SectionIndex Section line index)
@param(SkipComments If @true then don't delete comments)
}
procedure EraseSection(extFile : TStringList; var SectionIndex: Integer; SkipComments : Boolean = False);
public
{en
Constructs an object and initializes its data before the object is first used.
}
constructor Create;
{en
Destroys an object and frees its memory.
}
destructor Destroy; override;
{en
Inserts a new item at the end of the list
@param(AExtAction TExtAction item)
@returns(The index of the new item)
}
function AddItem(AExtAction: TExtAction): Integer;
{en
Removes the item at the position given by the Index parameter
@param(Index Item index)
}
procedure DeleteItem(Index: Integer);
{en
Fills the actions list from file
@param(sName File name)
}
procedure LoadFromFile(const sName:String);
{en
Save the actions list to file
@param(sName File name)
}
procedure SaveToFile(const sName:String);
{en
Return action command by extension and action name
@param(sExt File extension)
@param(sActionName Action name)
@returns(Action command)
}
function GetExtActionCmd(sExt:String; const sActionName:String):String;
{en
Return list of actions by extension
@param(sExt File extension)
@param(slActions Actions list)
@returns(The function returns @true if successful, @false otherwise)
}
function GetExtActions(sExt:String; var slActions:TStringList):Boolean;
{en
Indicates the number of items
}
property Count: Integer read GetCount;
{en
Give access to items by index
}
property Items[Index: Integer]: TExtAction read GetItems;
end;
implementation
uses
LCLProc, SysUtils, uLog, uClassesEx;
constructor TExtAction.Create;
begin
Extensions := TStringList.Create;
Actions := TStringList.Create;
end;
destructor TExtAction.Destroy;
begin
if Assigned(Extensions) then
FreeAndNil(Extensions);
if Assigned(Actions) then
FreeAndNil(Actions);
inherited
end;
procedure TExts.LoadFromFile(const sName:String);
var
extFile: TStringListEx;
sLine, s, sExt: String;
extcmd: TExtAction;
I, iIndex: Integer;
begin
extFile:= TStringListEx.Create;
extFile.LoadFromFile(sName);
extcmd:=nil;
for I:= 0 to extFile.Count - 1 do
begin
sLine:= extFile.Strings[I];
sLine:= Trim(sLine);
if (sLine='') or (sLine[1]='#') then Continue;
// writeln(sLine);
if sLine[1]='[' then
begin
extCmd:= TExtAction.Create;
FExtList.Add(extcmd);
iIndex:=pos(']', sLine);
if iIndex>0 then
sLine:=Copy(sLine,1,iIndex)
else
logWrite('] not found in line '+sLine);
{ add | for easy searching in two and more extensions
now I can search for example |pas| or |z|
}
extCmd.SectionName:=LowerCase(sLine);
// fill extensions list
s := LowerCase(sLine);
Delete(s, 1, 1); // Delete '['
Delete(s, Length(s), 1); // Delete ']'
s := s + '|';
while Pos('|', s) <> 0 do
begin
iIndex := Pos('|',s);
sExt := Copy(s,1,iIndex-1);
Delete(s, 1, iIndex);
extCmd.Extensions.Add(sExt);
end;
end // end if.. '['
else
begin // this must be a command
if not assigned(extCmd) then
begin
logWrite('Command '+sLine+' have not defined extension - ignored.');
Continue;
end;
// now set command to lowercase
s := sLine;
for iIndex:=1 to Length(s) do
begin
if s[iIndex]='=' then Break;
s[iIndex]:= LowerCase(s[iIndex]);
end;
// DebugLn(sLine);
if Pos('name', s) = 1 then // File type name
extCmd.Name := Copy(sLine, iIndex + 1, Length(sLine))
else if Pos('icon', s) = 1 then // File type icon
extCmd.Icon := Copy(sLine, iIndex + 1, Length(sLine))
else // action
extCmd.Actions.Add(sLine);
end;
end;
extFile.Free;
end;
function TExts.GetNewSectionName(Index: Integer): String;
var
I, iCount: Integer;
begin
with GetItems(Index) do
begin
iCount := Extensions.Count - 1;
Result := Extensions[0];
for I:= 1 to iCount do
Result := Result + '|' + Extensions[I];
end;
Result := '[' + Result + ']';
end;
procedure TExts.EraseSection(extFile : TStringList; var SectionIndex: Integer; SkipComments : Boolean = False);
var
sLine : String;
begin
repeat
if SkipComments and (Pos('#', Trim(extFile.Strings[SectionIndex]))=1) then
Inc(SectionIndex)
else
extFile.Delete(SectionIndex);
if SectionIndex >= extFile.Count then Exit;
sLine := extFile.Strings[SectionIndex];
//DebugLn('sLine = ', sLine);
until ((Pos('[', sLine)<>0) and (Pos(']', sLine)<>0)) or
((Pos('#', sLine)<>0) and (Pos('[', extFile.Strings[SectionIndex+1])<>0) and
(Pos(']', extFile.Strings[SectionIndex+1])<>0));
end;
procedure TExts.SaveToFile(const sName: String);
var
I, J, iIndex,
iCount,
iBegin, iEnd : Integer;
extFile : TStringListEx;
sLine,
sNewName,
sSectionName: String;
bExists : Boolean;
begin
extFile:= TStringListEx.Create;
if FileExists(sName) then
begin
extFile.LoadFromFile(sName);
// first rename sections if needed
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
sNewName := GetNewSectionName(I);
if SectionName <> sNewName then
begin
iIndex:= extFile.IndexOf(SectionName);
if iIndex >= 0 then
extFile.Strings[iIndex] := sNewName;
end;
end;
// second delete old sections
I := 0;
iCount := extFile.Count - 1;
while I <= iCount do
begin
sLine := Trim(extFile.Strings[I]);
iBegin:= Pos('[', sLine);
iEnd:= Pos(']', sLine);
if (iBegin = 1) and (iEnd <> 0) then
begin
sSectionName := LowerCase(Copy(extFile.Strings[I],iBegin, iEnd));
bExists:= False;
for J:= 0 to Count - 1 do
begin
//DebugLn('sSectionName = ', sSectionName);
//DebugLn('GetItems(J).SectionName = ', GetItems(J).SectionName);
if sSectionName = GetItems(J).SectionName then
begin
bExists := True;
Break;
end;
end; // for
if not bExists then // delete section
begin
EraseSection(extFile, I);
iCount := extFile.Count - 1;
end;
end;
Inc(I);
end; // while
// third rewrite changed sections
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
if IsChanged then
begin
sNewName := GetNewSectionName(I);
iIndex:= extFile.IndexOf(sNewName);
if iIndex >= 0 then // if section exists then insert actions
begin
Inc(iIndex); // skip section name
EraseSection(extFile, iIndex, True);
if Name <> '' then
begin
extFile.Insert(iIndex, 'Name=' + Name);
Inc(iIndex);
end;
if Icon <> '' then
begin
extFile.Insert(iIndex, 'Icon=' + Icon);
Inc(iIndex);
end;
for J:= 0 to Actions.Count - 1 do
begin
extFile.Insert(iIndex, Actions.Strings[J]);
Inc(iIndex);
end;
extFile.Insert(iIndex, ''); // add empty line
end
else // else add new section
begin
extFile.Add(sNewName); // section
if Name <> '' then
extFile.Add('Name=' + Name); // file type name
if Icon <> '' then
extFile.Add('Icon=' + Icon); // icon path
for J:= 0 to Actions.Count - 1 do
extFile.Add(Actions.Strings[J]);
extFile.Add(''); // add empty line
end;
end;
end;
end // FileExists
else
begin
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
extFile.Add(GetNewSectionName(I));
if Name <> '' then
extFile.Add('Name=' + Name); // file type name
if Icon <> '' then
extFile.Add('Icon=' + Icon); // icon path
for J:= 0 to Actions.Count - 1 do
extFile.Add(Actions.Strings[J]);
extFile.Add(''); // add empty line
end;
end;
extFile.SaveToFile(sName);
extFile.Free;
end;
function TExts.GetExtActions(sExt:String; var slActions:TStringList):Boolean;
var
i:Integer;
begin
Result:=False;
if sExt='' then Exit;
if sExt[1]='.' then
Delete(sExt,1,1);
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sExt) >= 0 then
begin
slActions.Assign(Actions);
Result:=True;
Break;
end;
end;
end;
function TExts.GetCount: Integer;
begin
Result := FExtList.Count;
end;
function TExts.GetItems(Index: Integer): TExtAction;
begin
Result := TExtAction(FExtList.Items[Index]);
end;
constructor TExts.Create;
begin
FExtList:=TObjectList.Create;
end;
destructor TExts.Destroy;
begin
if assigned(FExtList) then
FreeAndNil(FExtList);
inherited
end;
function TExts.AddItem(AExtAction: TExtAction): Integer;
begin
Result := FExtList.Add(AExtAction);
end;
procedure TExts.DeleteItem(Index: Integer);
begin
FExtList.Delete(Index);
end;
function TExts.GetExtActionCmd(sExt:String; const sActionName:String):String;
var
i:Integer;
begin
Result:='';
if sExt='' then Exit;
if sExt[1]='.' then
Delete(sExt,1,1);
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sExt) >= 0 then
begin
Result:=Actions.Values[UpperCase(sActionName)];
Break;
end;
end;
// if command not found then try to find default command
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf('default') >= 0 then
begin
Result:=Actions.Values[UpperCase(sActionName)];
Break;
end;
end;
end;
end.
{
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
storing commands (by file extensions)
contributors:
Copyright (C) 2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uExts;
interface
uses
Classes, Contnrs;
type
{en
Class for storage actions by file extensions
}
TExtAction = class
SectionName: String; //en< Section name, for example "[htm|html|mht]"
Name: String; //en< File type name, for example "Hyper text documents"
Icon: String; //en< Path to icon
IconIndex: Integer; //en< Icon index (used in configuration dialog for paint icons)
Extensions: TStringList; //en< List of extensions
Actions: TStringList; //en< List of actions, for example "Open=opera '%f'"
IsChanged: Boolean; //en< True if item was changed
public
{en
Constructs an object and initializes its data before the object is first used.
}
constructor Create;
{en
Destroys an object and frees its memory.
}
destructor Destroy; override;
end;
{en
Main class for storage actions list by file extensions
}
TExts = class
private
{en
Return the number of items
@returns(The number of items)
}
function GetCount: Integer;
{en
Get item by index
@param(Index Item index)
@returns(TExtAction item)
}
function GetItems(Index: Integer): TExtAction;
protected
{en
Internal ObjectList for storage items.
}
FExtList:TObjectList;
{en
Return new section name for item by index
@param(Index Item index)
@returns(New section name)
}
function GetNewSectionName(Index: Integer): String;
{en
Erase section from file by section line index
@param(extFile StringList with loaded extension file)
@param(SectionIndex Section line index)
@param(SkipComments If @true then don't delete comments)
}
procedure EraseSection(extFile : TStringList; var SectionIndex: Integer; SkipComments : Boolean = False);
public
{en
Constructs an object and initializes its data before the object is first used.
}
constructor Create;
{en
Destroys an object and frees its memory.
}
destructor Destroy; override;
{en
Inserts a new item at the end of the list
@param(AExtAction TExtAction item)
@returns(The index of the new item)
}
function AddItem(AExtAction: TExtAction): Integer;
{en
Removes the item at the position given by the Index parameter
@param(Index Item index)
}
procedure DeleteItem(Index: Integer);
{en
Fills the actions list from file
@param(sName File name)
}
procedure LoadFromFile(const sName:String);
{en
Save the actions list to file
@param(sName File name)
}
procedure SaveToFile(const sName:String);
{en
Return action command by extension and action name
@param(sExt File extension)
@param(sActionName Action name)
@returns(Action command)
}
function GetExtActionCmd(sExt:String; const sActionName:String):String;
{en
Return list of actions by extension
@param(sExt File extension)
@param(slActions Actions list)
@returns(The function returns @true if successful, @false otherwise)
}
function GetExtActions(sExt:String; var slActions:TStringList):Boolean;
{en
Indicates the number of items
}
property Count: Integer read GetCount;
{en
Give access to items by index
}
property Items[Index: Integer]: TExtAction read GetItems;
end;
implementation
uses
LCLProc, SysUtils, uLog, uClassesEx;
constructor TExtAction.Create;
begin
Extensions := TStringList.Create;
Actions := TStringList.Create;
end;
destructor TExtAction.Destroy;
begin
if Assigned(Extensions) then
FreeAndNil(Extensions);
if Assigned(Actions) then
FreeAndNil(Actions);
inherited
end;
procedure TExts.LoadFromFile(const sName:String);
var
extFile: TStringListEx;
sLine, s, sExt: String;
extcmd: TExtAction;
I, iIndex: Integer;
begin
extFile:= TStringListEx.Create;
extFile.LoadFromFile(sName);
extcmd:=nil;
for I:= 0 to extFile.Count - 1 do
begin
sLine:= extFile.Strings[I];
sLine:= Trim(sLine);
if (sLine='') or (sLine[1]='#') then Continue;
// writeln(sLine);
if sLine[1]='[' then
begin
extCmd:= TExtAction.Create;
FExtList.Add(extcmd);
iIndex:=pos(']', sLine);
if iIndex>0 then
sLine:=Copy(sLine,1,iIndex)
else
logWrite('] not found in line '+sLine);
{ add | for easy searching in two and more extensions
now I can search for example |pas| or |z|
}
extCmd.SectionName:=LowerCase(sLine);
// fill extensions list
s := LowerCase(sLine);
Delete(s, 1, 1); // Delete '['
Delete(s, Length(s), 1); // Delete ']'
s := s + '|';
while Pos('|', s) <> 0 do
begin
iIndex := Pos('|',s);
sExt := Copy(s,1,iIndex-1);
Delete(s, 1, iIndex);
extCmd.Extensions.Add(sExt);
end;
end // end if.. '['
else
begin // this must be a command
if not assigned(extCmd) then
begin
logWrite('Command '+sLine+' have not defined extension - ignored.');
Continue;
end;
// now set command to lowercase
s := sLine;
for iIndex:=1 to Length(s) do
begin
if s[iIndex]='=' then Break;
s[iIndex]:= LowerCase(s[iIndex]);
end;
// DebugLn(sLine);
if Pos('name', s) = 1 then // File type name
extCmd.Name := Copy(sLine, iIndex + 1, Length(sLine))
else if Pos('icon', s) = 1 then // File type icon
extCmd.Icon := Copy(sLine, iIndex + 1, Length(sLine))
else // action
extCmd.Actions.Add(sLine);
end;
end;
extFile.Free;
end;
function TExts.GetNewSectionName(Index: Integer): String;
var
I, iCount: Integer;
begin
with GetItems(Index) do
begin
iCount := Extensions.Count - 1;
Result := Extensions[0];
for I:= 1 to iCount do
Result := Result + '|' + Extensions[I];
end;
Result := '[' + Result + ']';
end;
procedure TExts.EraseSection(extFile : TStringList; var SectionIndex: Integer; SkipComments : Boolean = False);
var
sLine : String;
begin
repeat
if SkipComments and (Pos('#', Trim(extFile.Strings[SectionIndex]))=1) then
Inc(SectionIndex)
else
extFile.Delete(SectionIndex);
if SectionIndex >= extFile.Count then Exit;
sLine := extFile.Strings[SectionIndex];
//DebugLn('sLine = ', sLine);
until ((Pos('[', sLine)<>0) and (Pos(']', sLine)<>0)) or
((Pos('#', sLine)<>0) and (Pos('[', extFile.Strings[SectionIndex+1])<>0) and
(Pos(']', extFile.Strings[SectionIndex+1])<>0));
end;
procedure TExts.SaveToFile(const sName: String);
var
I, J, iIndex,
iCount,
iBegin, iEnd : Integer;
extFile : TStringListEx;
sLine,
sNewName,
sSectionName: String;
bExists : Boolean;
begin
extFile:= TStringListEx.Create;
if FileExists(sName) then
begin
extFile.LoadFromFile(sName);
// first rename sections if needed
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
sNewName := GetNewSectionName(I);
if SectionName <> sNewName then
begin
iIndex:= extFile.IndexOf(SectionName);
if iIndex >= 0 then
extFile.Strings[iIndex] := sNewName;
end;
end;
// second delete old sections
I := 0;
iCount := extFile.Count - 1;
while I <= iCount do
begin
sLine := Trim(extFile.Strings[I]);
iBegin:= Pos('[', sLine);
iEnd:= Pos(']', sLine);
if (iBegin = 1) and (iEnd <> 0) then
begin
sSectionName := LowerCase(Copy(extFile.Strings[I],iBegin, iEnd));
bExists:= False;
for J:= 0 to Count - 1 do
begin
//DebugLn('sSectionName = ', sSectionName);
//DebugLn('GetItems(J).SectionName = ', GetItems(J).SectionName);
if sSectionName = GetItems(J).SectionName then
begin
bExists := True;
Break;
end;
end; // for
if not bExists then // delete section
begin
EraseSection(extFile, I);
iCount := extFile.Count - 1;
end;
end;
Inc(I);
end; // while
// third rewrite changed sections
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
if IsChanged then
begin
sNewName := GetNewSectionName(I);
iIndex:= extFile.IndexOf(sNewName);
if iIndex >= 0 then // if section exists then insert actions
begin
Inc(iIndex); // skip section name
EraseSection(extFile, iIndex, True);
if Name <> '' then
begin
extFile.Insert(iIndex, 'Name=' + Name);
Inc(iIndex);
end;
if Icon <> '' then
begin
extFile.Insert(iIndex, 'Icon=' + Icon);
Inc(iIndex);
end;
for J:= 0 to Actions.Count - 1 do
begin
extFile.Insert(iIndex, Actions.Strings[J]);
Inc(iIndex);
end;
extFile.Insert(iIndex, ''); // add empty line
end
else // else add new section
begin
extFile.Add(sNewName); // section
if Name <> '' then
extFile.Add('Name=' + Name); // file type name
if Icon <> '' then
extFile.Add('Icon=' + Icon); // icon path
for J:= 0 to Actions.Count - 1 do
extFile.Add(Actions.Strings[J]);
extFile.Add(''); // add empty line
end;
end;
end;
end // FileExists
else
begin
iCount := Count - 1;
for I := 0 to iCount do
with GetItems(I) do
begin
extFile.Add(GetNewSectionName(I));
if Name <> '' then
extFile.Add('Name=' + Name); // file type name
if Icon <> '' then
extFile.Add('Icon=' + Icon); // icon path
for J:= 0 to Actions.Count - 1 do
extFile.Add(Actions.Strings[J]);
extFile.Add(''); // add empty line
end;
end;
extFile.SaveToFile(sName);
extFile.Free;
end;
function TExts.GetExtActions(sExt:String; var slActions:TStringList):Boolean;
var
i:Integer;
begin
Result:=False;
if sExt='' then Exit;
if sExt[1]='.' then
Delete(sExt,1,1);
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sExt) >= 0 then
begin
slActions.Assign(Actions);
Result:=True;
Break;
end;
end;
end;
function TExts.GetCount: Integer;
begin
Result := FExtList.Count;
end;
function TExts.GetItems(Index: Integer): TExtAction;
begin
Result := TExtAction(FExtList.Items[Index]);
end;
constructor TExts.Create;
begin
FExtList:=TObjectList.Create;
end;
destructor TExts.Destroy;
begin
if assigned(FExtList) then
FreeAndNil(FExtList);
inherited
end;
function TExts.AddItem(AExtAction: TExtAction): Integer;
begin
Result := FExtList.Add(AExtAction);
end;
procedure TExts.DeleteItem(Index: Integer);
begin
FExtList.Delete(Index);
end;
function TExts.GetExtActionCmd(sExt:String; const sActionName:String):String;
var
i:Integer;
begin
Result:='';
if sExt='' then Exit;
if sExt[1]='.' then
Delete(sExt,1,1);
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sExt) >= 0 then
begin
Result:=Actions.Values[UpperCase(sActionName)];
Exit;
end;
end;
// if command not found then try to find default command
for i:=0 to FExtList.Count-1 do
with GetItems(i) do
begin
if Extensions.IndexOf('default') >= 0 then
begin
Result:=Actions.Values[UpperCase(sActionName)];
Break;
end;
end;
end;
end.