mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

UPD: Get some more commands working.

Browse source
This commit is contained in:
cobines 2009-07-18 06:41:32 +00:00
commit aea1938ec0
6 changed files with 3224 additions and 3172 deletions
Download patch file Download diff file Expand all files Collapse all files

147
src/newdesign/ucolumnsfileview.pas
View file

@ -220,8 +220,8 @@ type
fUpdateDiskFreeSpace: Boolean;
FSorting: TFileListSorting;
FSortCol:Integer;
fSortDirect:TSortDirection;
FSortColumn: Integer;
FSortDirection: TSortDirection;
pnlFooter: TPanel;
lblInfo: TLabel;
@ -415,20 +415,29 @@ type
published // commands
procedure cm_MarkInvert(param: string='');
procedure cm_MarkMarkAll(param: string='');
procedure cm_MarkUnmarkAll(param: string='');
procedure cm_MarkPlus(param: string='');
procedure cm_MarkMinus(param: string='');
procedure cm_MarkCurrentExtension(param: string='');
procedure cm_UnmarkCurrentExtension(param: string='');
procedure cm_QuickSearch(param: string='');
procedure cm_Open(param: string='');
procedure cm_SortByColumn(param: string='');
procedure cm_CalculateSpace(param: string='');
end;
implementation
uses
LCLProc, Masks, uLng, uShowMsg, uGlobs, GraphType, uPixmapManager,
uDCUtils, uOSUtils, math, fMain, fSymLink, fHardLink,
uDCUtils, uOSUtils, math, fMain, fSymLink, fHardLink, uShellExecute,
uFileSourceListOperation,
uFileProperty, uDefaultFilePropertyFormatter,
uFileSourceProperty,
uFileSourceOperationTypes,
uFileSystemFile,
uFileSystemFileSource,
fColumnsSetConf,
uKeyboard,
uFileViewNotebook
@ -1197,6 +1206,8 @@ end;
}
procedure TColumnsFileView.ChooseFile(AFile: TColumnsViewFile; FolderMode: Boolean = False);
var
sOpenCmd: String;
begin
with AFile do
begin
@ -1229,31 +1240,36 @@ begin
end;
if FolderMode then exit;
{
//now test if exists Open command in doublecmd.ext :)
sOpenCmd:= gExts.GetExtActionCmd(pfri^, 'open');
if (sOpenCmd<>'') then
begin
if Pos('{!VFS}',sOpenCmd)>0 then
begin
if fVFS.FindModule(sName) then
begin
LoadPanelVFS(pfri);
Exit;
end;
end;
LastActive:=sName;
ReplaceExtCommand(sOpenCmd, pfri, ActiveDir);
if ProcessExtCommand(sOpenCmd, ActiveDir) then
Exit;
LastActive := TheFile.Name;
// For now work only for FileSystem until temporary file system is done.
if FileSource is TFileSystemFileSource then
begin
//now test if exists Open command in doublecmd.ext :)
sOpenCmd:= gExts.GetExtActionCmd(AFile.TheFile, 'open');
if (sOpenCmd<>'') then
begin
{
if Pos('{!VFS}',sOpenCmd)>0 then
begin
if fVFS.FindModule(sName) then
begin
LoadPanelVFS(pfri);
Exit;
end;
end;
}
ReplaceExtCommand(sOpenCmd, TheFile, CurrentPath);
if ProcessExtCommand(sOpenCmd, CurrentPath) then
Exit;
end;
// and at the end try to open by system
mbSetCurrentDir(CurrentPath);
ShellExecute(TheFile.Name);
Reload;
end;
// and at the end try to open by system
mbSetCurrentDir(ActiveDir);
LastActive:= sName;
ShellExecute(sName);
LoadPanel;
}
end;
end;
@ -1352,8 +1368,8 @@ begin
if (iColumn >= 0) and (iColumn < ColumnsClass.ColumnsCount) then
begin
FSorting.Clear;
FSorting.AddSorting(iColumn, fSortDirect);
FSortCol := iColumn;
FSorting.AddSorting(iColumn, FSortDirection);
FSortColumn := iColumn;
MakeDisplayFileList; // sorted here
RedrawGrid;
end;
@ -2533,8 +2549,8 @@ begin
FSorting := nil;
// default to sorting by 0-th column
FSortCol := 0;
FSortDirect := sdAscending;
FSortColumn := 0;
FSortDirection := sdAscending;
// -- other components
@ -2638,7 +2654,7 @@ begin
FFiles := TColumnsViewFiles.Create;
FSorting := TFileListSorting.Create;
FSorting.AddSorting(FSortCol, FSortDirect);
FSorting.AddSorting(FSortColumn, FSortDirection);
MakeFileSourceFileList;
end;
@ -2701,8 +2717,8 @@ begin
}
FSorting := Self.FSorting.Clone;
FSortCol := Self.FSortCol;
fSortDirect := Self.fSortDirect;
FSortColumn := Self.FSortColumn;
FSortDirection := Self.FSortDirection;
ActiveColm := Self.ActiveColm;
ActiveColmSlave := nil; // set to nil because only used in preview?
@ -3045,11 +3061,74 @@ begin
InvertAll;
end;
procedure TColumnsFileView.cm_MarkMarkAll(param: string='');
begin
MarkAll;
end;
procedure TColumnsFileView.cm_MarkUnmarkAll(param: string='');
begin
UnMarkAll;
end;
procedure TColumnsFileView.cm_MarkPlus(param: string='');
begin
MarkPlus;
end;
procedure TColumnsFileView.cm_MarkMinus(param: string='');
begin
MarkMinus;
end;
procedure TColumnsFileView.cm_MarkCurrentExtension(param: string='');
begin
MarkShiftPlus;
end;
procedure TColumnsFileView.cm_UnmarkCurrentExtension(param: string='');
begin
MarkShiftMinus;
end;
procedure TColumnsFileView.cm_QuickSearch(param: string='');
begin
ShowAltPanel;
end;
procedure TColumnsFileView.cm_Open(param: string='');
begin
if Assigned(GetActiveItem) then
ChooseFile(GetActiveItem);
end;
procedure TColumnsFileView.cm_SortByColumn(param: string='');
var
ColumnNumber: Integer;
begin
if TryStrToInt(param, ColumnNumber) then
begin
if FSortColumn = ColumnNumber then
FSortDirection := ReverseSortDirection(FSortDirection)
else
FSortDirection := sdAscending;
SortByColumn(ColumnNumber);
end;
end;
procedure TColumnsFileView.cm_CalculateSpace(param: string='');
begin
// For now only works for FileSystem.
if FileSource is TFileSystemFileSource then
begin
// Selection validation in CalculateSpace.
CalculateSpace(True);
end
else
msgWarning(rsMsgNotImplemented);
end;
{ TDrawGridEx }
constructor TDrawGridEx.Create(AOwner: TComponent; AParent: TWinControl);

8
src/newdesign/ufile.pas
View file

@ -95,6 +95,7 @@ type
function IsDirectory: Boolean;
function IsSysFile: Boolean;
function IsLink: Boolean;
function IsLinkToDirectory: Boolean;
function IsExecutable: Boolean; // for ShellExecute
end;
@ -270,6 +271,13 @@ begin
Result := False;
end;
function TFile.IsLinkToDirectory: Boolean;
begin
// For now IsDirectory also returns True when the link points to directory.
// Maybe this should be changed?
Result := False;
end;
function TFile.IsExecutable: Boolean;
var
FileAttributes: TFileAttributesProperty;

338
src/newdesign/ufileview.pas
View file

@ -1,169 +1,169 @@
unit uFileView;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, ExtCtrls,
uFile, uFileSource, uFilePanelSelect, uMethodsList;
type
TOnBeforeChangeDirectory = function (FileView: TCustomPage; const NewDir : String): Boolean of object;
TOnAfterChangeDirectory = procedure (FileView: TCustomPage; const NewDir : String) of object;
{en
Base class for any view of a file or files.
There should always be at least one file displayed on the view.
}
TFileView = class(TWinControl)
private
{en
The file source associated with this view.
For now it lives as long as TFileView lives (it is freed in destructor).
Don't know if this should be changed or not.
}
FFileSource: TFileSource;
FMethods: TMethodsList;
FOnBeforeChangeDirectory : TOnBeforeChangeDirectory;
FOnAfterChangeDirectory : TOnAfterChangeDirectory;
function GetCurrentAddress: String;
function GetNotebookPage: TCustomPage;
protected
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
function GetActiveFile: TFile; virtual;
function GetDisplayedFiles: TFiles; virtual abstract;
function GetSelectedFiles: TFiles; virtual abstract;
public
constructor Create(AOwner: TWinControl;
FileSource: TFileSource); virtual reintroduce;
destructor Destroy; override;
function Clone(NewParent: TWinControl): TFileView; virtual;
procedure CloneTo(FileView: TFileView); virtual;
// Retrieves files from file source again and displays the new list of files.
procedure Reload; virtual abstract;
// For now we use here the knowledge that there are tabs.
// Config should be independent of that in the future.
procedure LoadConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure SaveConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure UpdateView; virtual abstract;
procedure ExecuteCommand(CommandName: String; Parameter: String); virtual;
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property CurrentAddress: String read GetCurrentAddress;
property FileSource: TFileSource read FFileSource write FFileSource;
{en
Currently active file.
There should always be at least one file in the view at any time, but
what 'active' means depends on the specific view, so ActiveFile may
return 'nil' if there is no file active.
}
property ActiveFile: TFile read GetActiveFile;
{en
A list of currently displayed files.
Caller is responsible for freeing the list.
}
property Files: TFiles read GetDisplayedFiles;
{en
A list of files selected by the user
(this should be a subset of displayed files list returned by Files).
Caller is responsible for freeing the list.
}
property SelectedFiles: TFiles read GetSelectedFiles;
property NotebookPage: TCustomPage read GetNotebookPage;
property OnBeforeChangeDirectory : TOnBeforeChangeDirectory read FOnBeforeChangeDirectory write FOnBeforeChangeDirectory;
property OnAfterChangeDirectory : TOnAfterChangeDirectory read FOnAfterChangeDirectory write FOnAfterChangeDirectory;
end;
implementation
uses
uOSUtils, uActs, LCLProc;
constructor TFileView.Create(AOwner: TWinControl; FileSource: TFileSource);
begin
FFileSource := FileSource;
FMethods := TMethodsList.Create(Self);
inherited Create(AOwner);
end;
destructor TFileView.Destroy;
begin
inherited;
FreeAndNil(FFileSource);
FreeAndNil(FMethods);
end;
function TFileView.Clone(NewParent: TWinControl): TFileView;
begin
raise Exception.Create('Cannot create object of abstract class');
end;
procedure TFileView.CloneTo(FileView: TFileView);
begin
if Assigned(FileView) then
begin
// FFileSource should have been passed to FileView constructor already.
// FMethods are created in FileView constructor.
FileView.OnBeforeChangeDirectory := OnBeforeChangeDirectory;
FileView.OnAfterChangeDirectory := OnAfterChangeDirectory;
end;
end;
function TFileView.GetNotebookPage: TCustomPage;
begin
Result := Parent as TCustomPage;
end;
function TFileView.GetCurrentAddress: String;
begin
Result := IncludeTrailingPathDelimiter(FFileSource.CurrentAddress);
end;
function TFileView.GetCurrentPath: String;
begin
Result := IncludeTrailingPathDelimiter( // trailing path delim needed?
FFileSource.CurrentPath);
end;
procedure TFileView.SetCurrentPath(NewPath: String);
begin
FFileSource.CurrentPath := NewPath;
end;
function TFileView.GetActiveFile: TFile;
begin
Result := nil;
end;
procedure TFileView.ExecuteCommand(CommandName: String; Parameter: String);
var
Method: TMethod;
Result: Integer;
begin
Method := FMethods.GetMethod(CommandName);
if Assigned(Method.Code) then
begin
// Command is supported - execute it.
TCommandFunc(Method)(Parameter);
end;
end;
end.
unit uFileView;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, ExtCtrls,
uFile, uFileSource, uFilePanelSelect, uMethodsList;
type
TOnBeforeChangeDirectory = function (FileView: TCustomPage; const NewDir : String): Boolean of object;
TOnAfterChangeDirectory = procedure (FileView: TCustomPage; const NewDir : String) of object;
{en
Base class for any view of a file or files.
There should always be at least one file displayed on the view.
}
TFileView = class(TWinControl)
private
{en
The file source associated with this view.
For now it lives as long as TFileView lives (it is freed in destructor).
Don't know if this should be changed or not.
}
FFileSource: TFileSource;
FMethods: TMethodsList;
FOnBeforeChangeDirectory : TOnBeforeChangeDirectory;
FOnAfterChangeDirectory : TOnAfterChangeDirectory;
function GetCurrentAddress: String;
function GetNotebookPage: TCustomPage;
protected
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
function GetActiveFile: TFile; virtual;
function GetDisplayedFiles: TFiles; virtual abstract;
function GetSelectedFiles: TFiles; virtual abstract;
public
constructor Create(AOwner: TWinControl;
FileSource: TFileSource); virtual reintroduce;
destructor Destroy; override;
function Clone(NewParent: TWinControl): TFileView; virtual;
procedure CloneTo(FileView: TFileView); virtual;
// Retrieves files from file source again and displays the new list of files.
procedure Reload; virtual abstract;
// For now we use here the knowledge that there are tabs.
// Config should be independent of that in the future.
procedure LoadConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure SaveConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure UpdateView; virtual abstract;
procedure ExecuteCommand(CommandName: String; Parameter: String = ''); virtual;
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property CurrentAddress: String read GetCurrentAddress;
property FileSource: TFileSource read FFileSource write FFileSource;
{en
Currently active file.
There should always be at least one file in the view at any time, but
what 'active' means depends on the specific view, so ActiveFile may
return 'nil' if there is no file active.
}
property ActiveFile: TFile read GetActiveFile;
{en
A list of currently displayed files.
Caller is responsible for freeing the list.
}
property Files: TFiles read GetDisplayedFiles;
{en
A list of files selected by the user
(this should be a subset of displayed files list returned by Files).
Caller is responsible for freeing the list.
}
property SelectedFiles: TFiles read GetSelectedFiles;
property NotebookPage: TCustomPage read GetNotebookPage;
property OnBeforeChangeDirectory : TOnBeforeChangeDirectory read FOnBeforeChangeDirectory write FOnBeforeChangeDirectory;
property OnAfterChangeDirectory : TOnAfterChangeDirectory read FOnAfterChangeDirectory write FOnAfterChangeDirectory;
end;
implementation
uses
uOSUtils, uActs, LCLProc;
constructor TFileView.Create(AOwner: TWinControl; FileSource: TFileSource);
begin
FFileSource := FileSource;
FMethods := TMethodsList.Create(Self);
inherited Create(AOwner);
end;
destructor TFileView.Destroy;
begin
inherited;
FreeAndNil(FFileSource);
FreeAndNil(FMethods);
end;
function TFileView.Clone(NewParent: TWinControl): TFileView;
begin
raise Exception.Create('Cannot create object of abstract class');
end;
procedure TFileView.CloneTo(FileView: TFileView);
begin
if Assigned(FileView) then
begin
// FFileSource should have been passed to FileView constructor already.
// FMethods are created in FileView constructor.
FileView.OnBeforeChangeDirectory := OnBeforeChangeDirectory;
FileView.OnAfterChangeDirectory := OnAfterChangeDirectory;
end;
end;
function TFileView.GetNotebookPage: TCustomPage;
begin
Result := Parent as TCustomPage;
end;
function TFileView.GetCurrentAddress: String;
begin
Result := IncludeTrailingPathDelimiter(FFileSource.CurrentAddress);
end;
function TFileView.GetCurrentPath: String;
begin
Result := IncludeTrailingPathDelimiter( // trailing path delim needed?
FFileSource.CurrentPath);
end;
procedure TFileView.SetCurrentPath(NewPath: String);
begin
FFileSource.CurrentPath := NewPath;
end;
function TFileView.GetActiveFile: TFile;
begin
Result := nil;
end;
procedure TFileView.ExecuteCommand(CommandName: String; Parameter: String);
var
Method: TMethod;
Result: Integer;
begin
Method := FMethods.GetMethod(CommandName);
if Assigned(Method.Code) then
begin
// Command is supported - execute it.
TCommandFunc(Method)(Parameter);
end;
end;
end.

4889
src/uacts.pas
View file

File diff suppressed because it is too large Load diff

982
src/uexts.pas
View file

@ -1,490 +1,492 @@
{
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
storing commands (by file extensions)
contributors:
Copyright (C) 2008-2009 Koblov Alexander (Alexx2000@mail.ru)
}
unit uExts;
interface
uses
Classes, Contnrs, uTypes;
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(FileRecItem: TFileRecItem; 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(FileRecItem: TFileRecItem; 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;
const
cMaskDefault = 'default';
cMaskFolder = 'folder';
cMaskFile = 'file';
implementation
uses
LCLProc, SysUtils, uLog, uClassesEx, uOSUtils;
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(FileRecItem: TFileRecItem; var slActions:TStringList):Boolean;
var
I: Integer;
sMask: String;
begin
Result:=False;
if (FPS_ISDIR(FileRecItem.iMode) or (FileRecItem.bLinkIsDir)) then
sMask:= cMaskFolder
else
sMask:= LowerCase(FileRecItem.sExt);
if sMask = '' then Exit;
if sMask[1] = '.' then
Delete(sMask, 1, 1);
for I:= 0 to FExtList.Count - 1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sMask) >= 0 then
begin
slActions.Assign(Actions);
Result:= True;
Break;
end;
end;
if sMask = cMaskFolder then Exit;
for I:= 0 to FExtList.Count - 1 do
with GetItems(i) do
begin
if Extensions.IndexOf(cMaskFile) >= 0 then
begin
slActions.AddStrings(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(FileRecItem: TFileRecItem; const sActionName:String):String;
var
I: Integer;
sMask: String;
begin
Result:= '';
if (FPS_ISDIR(FileRecItem.iMode) or (FileRecItem.bLinkIsDir)) then
sMask:= cMaskFolder
else
sMask:= LowerCase(FileRecItem.sExt);
if sMask = '' then Exit;
if sMask[1] = '.' then
Delete(sMask, 1, 1);
for I:= 0 to FExtList.Count - 1 do
with GetItems(I) do
begin
if Extensions.IndexOf(sMask) >= 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(cMaskDefault) >= 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-2009 Koblov Alexander (Alexx2000@mail.ru)
}
unit uExts;
interface
uses
Classes, Contnrs, uTypes, uFile;
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 file and action name
@param(aFile File for which action is sought)
@param(sActionName Action name)
@returns(Action command)
}
function GetExtActionCmd(aFile: TFile; 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(FileRecItem: TFileRecItem; 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;
const
cMaskDefault = 'default';
cMaskFolder = 'folder';
cMaskFile = 'file';
implementation
uses
LCLProc, SysUtils, uLog, uClassesEx, uOSUtils;
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(FileRecItem: TFileRecItem; var slActions:TStringList):Boolean;
var
I: Integer;
sMask: String;
begin
Result:=False;
if (FPS_ISDIR(FileRecItem.iMode) or (FileRecItem.bLinkIsDir)) then
sMask:= cMaskFolder
else
sMask:= LowerCase(FileRecItem.sExt);
if sMask = '' then Exit;
if sMask[1] = '.' then
Delete(sMask, 1, 1);
for I:= 0 to FExtList.Count - 1 do
with GetItems(i) do
begin
if Extensions.IndexOf(sMask) >= 0 then
begin
slActions.Assign(Actions);
Result:= True;
Break;
end;
end;
if sMask = cMaskFolder then Exit;
for I:= 0 to FExtList.Count - 1 do
with GetItems(i) do
begin
if Extensions.IndexOf(cMaskFile) >= 0 then
begin
slActions.AddStrings(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(aFile: TFile; const sActionName:String):String;
var
I: Integer;
sMask: String;
begin
Result:= '';
if aFile.IsDirectory or aFile.IsLinkToDirectory then
sMask:= cMaskFolder
else
sMask:= LowerCase(aFile.Extension);
if sMask = '' then Exit;
if sMask[1] = '.' then
Delete(sMask, 1, 1);
for I:= 0 to FExtList.Count - 1 do
with GetItems(I) do
begin
if Extensions.IndexOf(sMask) >= 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(cMaskDefault) >= 0 then
begin
Result:=Actions.Values[UpperCase(sActionName)];
Break;
end;
end;
end;
end.

42
src/ushellexecute.pas
View file

@ -27,38 +27,39 @@ unit uShellExecute;
interface
uses
Classes, SysUtils, uTypes;
Classes, SysUtils, uTypes, uFile;
procedure ReplaceExtCommand(var sCmd:String; pfr:PFileRecItem; ActiveDir: String);
procedure ReplaceExtCommand(var sCmd:String; aFile: TFile; ActiveDir: String='');
function ProcessExtCommand(sCmd:String; ActiveDir: String): Boolean;
function ShellExecuteEx(sCmd, sFileName, sActiveDir: String): Boolean;
implementation
uses
Process, UTF8Process, StrUtils, uDCUtils, uShowForm, uGlobs, uOSUtils;
Process, UTF8Process, StrUtils, uDCUtils, uShowForm, uGlobs, uOSUtils,
uFileSystemFile;
procedure ReplaceExtCommand(var sCmd:String; pfr:PFileRecItem; ActiveDir: String);
procedure ReplaceExtCommand(var sCmd:String; aFile: TFile; ActiveDir: String);
var
sDir: String;
iStart,
iCount: Integer;
Process: TProcessUTF8;
begin
with pfr^ do
with aFile do
begin
sDir:= IfThen(sPath<>'', sPath, ActiveDir);
sDir:= IfThen(Path<>'', Path, ActiveDir); // Why ActiveDir if we have Path?
sCmd:= GetCmdDirFromEnvVar(sCmd);
sCmd:= StringReplace(sCmd,'%f',QuoteStr(ExtractFileName(sName)),[rfReplaceAll]);
sCmd:= StringReplace(sCmd,'%d',QuoteStr(sDir),[rfReplaceAll]);
sCmd:= StringReplace(sCmd,'%p',QuoteStr(sDir+ExtractFileName(sName)),[rfReplaceAll]);
sCmd:= StringReplace(sCmd,'%f',QuoteStr(Name),[rfReplaceAll]);
sCmd:= StringReplace(sCmd,'%d',QuoteStr(Path),[rfReplaceAll]);
sCmd:= StringReplace(sCmd,'%p',QuoteStr(Path + Name),[rfReplaceAll]);
sCmd:= Trim(sCmd);
// get output from command between '<?' and '?>'
if Pos('<?', sCmd) <> 0 then
begin
iStart:= Pos('<?', sCmd) + 2;
iCount:= Pos('?>', sCmd) - iStart;
sDir:= GetTempFolder + ExtractFileName(sName) + '.tmp';
sDir:= GetTempFolder + Name + '.tmp';
Process:= TProcessUTF8.Create(nil);
Process.CommandLine:= Format(fmtRunInShell, [GetShell, Copy(sCmd, iStart, iCount) + ' > ' + sDir]);
Process.Options:= [poNoConsole, poWaitOnExit];
@ -101,23 +102,24 @@ end;
function ShellExecuteEx(sCmd, sFileName, sActiveDir: String): Boolean;
var
FileRecItem: TFileRecItem;
aFile: TFileSystemFile;
sCommand: String;
begin
Result:= False;
FillChar(FileRecItem, SizeOf(FileRecItem), #0);
with FileRecItem do
begin
sName:= ExtractFileName(sFileName);
sPath:= ExtractFilePath(sFileName);
sExt:= ExtractFileExt(sFileName);
sCommand:= gExts.GetExtActionCmd(FileRecItem, sCmd);
end;
// Executing files directly only works for FileSystem.
aFile := TFileSystemFile.Create;
aFile.Path := ExtractFilePath(sFileName);
aFile.Name := ExtractFileName(sFileName);
sCommand:= gExts.GetExtActionCmd(aFile, sCmd);
if sCommand <> '' then
begin
ReplaceExtCommand(sCommand, @FileRecItem, sActiveDir);
ReplaceExtCommand(sCommand, aFile, sActiveDir);
Result:= ProcessExtCommand(sCommand, sActiveDir);
end;
if not Result then
begin
mbSetCurrentDir(sActiveDir);