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: Improve directory hotlist (patch by Dennis)

Browse source
This commit is contained in:
Alexander Koblov 2014-05-05 16:39:51 +00:00
commit cd46caccfc
7 changed files with 1426 additions and 254 deletions
Download patch file Download diff file Expand all files Collapse all files

332
src/fhotdir.lfm
View file

@ -1,120 +1,326 @@
object frmHotDir: TfrmHotDir
Left = 285
Height = 423
Top = 127
Width = 437
ActiveControl = btnOK
Left = 647
Height = 370
Top = 376
Width = 440
Caption = 'Directory Hotlist'
ClientHeight = 423
ClientWidth = 437
ClientHeight = 370
ClientWidth = 440
Constraints.MinHeight = 370
Constraints.MinWidth = 440
KeyPreview = True
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnKeyPress = FormKeyPress
Position = poScreenCenter
LCLVersion = '1.1'
SessionProperties = 'WindowState;Width;Height'
LCLVersion = '1.0.14.0'
object lsHotDir: TListBox
AnchorSideRight.Control = btnOK
Left = 12
Height = 409
Top = 8
Width = 265
Left = 5
Height = 258
Top = 21
Width = 275
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Right = 12
DragMode = dmAutomatic
ItemHeight = 0
OnMouseMove = lsHotDirMouseMove
OnClick = lsHotDirClick
OnDblClick = lsHotDirDblClick
OnDragDrop = lsHotDirDragDrop
OnDragOver = lsHotDirDragOver
OnMouseDown = lsHotDirMouseDown
OnMouseUp = lsHotDirMouseUp
ScrollWidth = 263
TabOrder = 0
TopIndex = -1
end
object btnOK: TBitBtn
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Height = 32
Top = 8
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
Caption = '&OK'
Kind = bkOK
ModalResult = 1
OnClick = btnOKClick
TabOrder = 1
end
object btnCancel: TBitBtn
AnchorSideTop.Control = btnDelete
object btnAdd: TBitBtn
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Left = 292
Height = 32
Top = 128
Top = 8
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Cancel = True
Caption = '&Cancel'
Kind = bkCancel
ModalResult = 2
Caption = 'Add...'
OnClick = btnAddClick
TabOrder = 4
end
object btnADD: TBitBtn
AnchorSideTop.Control = btnOK
object btnDelete: TBitBtn
AnchorSideTop.Control = btnAdd
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Left = 292
Height = 32
Top = 48
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Caption = '&Add'
OnClick = btnADDClick
TabOrder = 2
Caption = '&Delete'
OnClick = btnDeleteClick
TabOrder = 5
end
object btnDelete: TBitBtn
AnchorSideTop.Control = btnADD
object lbleditHotDirName: TLabeledEdit
Tag = 1
Left = 50
Height = 23
Top = 288
Width = 346
Anchors = [akLeft, akRight, akBottom]
EditLabel.AnchorSideTop.Control = lbleditHotDirName
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = lbleditHotDirName
EditLabel.AnchorSideBottom.Control = lbleditHotDirName
EditLabel.AnchorSideBottom.Side = asrBottom
EditLabel.Left = 11
EditLabel.Height = 16
EditLabel.Top = 291
EditLabel.Width = 36
EditLabel.Caption = 'Name:'
EditLabel.ParentColor = False
LabelPosition = lpLeft
TabOrder = 1
OnEditingDone = lbleditHotDirEditingDone
OnEnter = lbleditHotDirEnter
OnExit = lbleditHotDirExit
OnKeyPress = lbleditHotDirKeyPress
end
object lbleditHotDirPath: TLabeledEdit
Tag = 2
Left = 50
Height = 23
Top = 314
Width = 346
Anchors = [akLeft, akRight, akBottom]
EditLabel.AnchorSideTop.Control = lbleditHotDirPath
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = lbleditHotDirPath
EditLabel.AnchorSideBottom.Control = lbleditHotDirPath
EditLabel.AnchorSideBottom.Side = asrBottom
EditLabel.Left = 19
EditLabel.Height = 16
EditLabel.Top = 317
EditLabel.Width = 28
EditLabel.Caption = 'Path:'
EditLabel.ParentColor = False
LabelPosition = lpLeft
TabOrder = 2
OnEditingDone = lbleditHotDirEditingDone
OnEnter = lbleditHotDirEnter
OnExit = lbleditHotDirExit
OnKeyPress = lbleditHotDirKeyPress
end
object lbleditHotDirTarget: TLabeledEdit
Tag = 3
Left = 50
Height = 23
Top = 340
Width = 346
Anchors = [akLeft, akRight, akBottom]
EditLabel.AnchorSideTop.Control = lbleditHotDirTarget
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = lbleditHotDirTarget
EditLabel.AnchorSideBottom.Control = lbleditHotDirTarget
EditLabel.AnchorSideBottom.Side = asrBottom
EditLabel.Left = 9
EditLabel.Height = 16
EditLabel.Top = 343
EditLabel.Width = 38
EditLabel.Caption = 'Target:'
EditLabel.ParentColor = False
LabelPosition = lpLeft
TabOrder = 3
OnEditingDone = lbleditHotDirEditingDone
OnEnter = lbleditHotDirEnter
OnExit = lbleditHotDirExit
OnKeyPress = lbleditHotDirKeyPress
end
object btnRelativePath: TButton
Tag = 2
Left = 400
Height = 23
Top = 314
Width = 35
Anchors = [akRight, akBottom]
Caption = 'rel'
OnClick = btnRelativeClick
TabOrder = 6
end
object btnRelativeTarget: TButton
Tag = 3
Left = 400
Height = 23
Top = 340
Width = 35
Anchors = [akRight, akBottom]
Caption = 'rel'
OnClick = btnRelativeClick
TabOrder = 7
end
object btnGoToDir: TBitBtn
AnchorSideTop.Control = btnCancel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Left = 292
Height = 32
Top = 206
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Caption = 'OK and goto dir'
Kind = bkAll
ModalResult = 8
OnClick = btnGoToDirClick
TabOrder = 8
end
object btnTestMenu: TBitBtn
AnchorSideTop.Control = btnDelete
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 292
Height = 32
Top = 88
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Caption = '&Delete'
OnClick = btnDeleteClick
TabOrder = 3
Caption = 'Test resulting menu'
OnClick = btnTestMenuClick
TabOrder = 9
end
object btnAddMan: TBitBtn
object btnCancel: TBitBtn
AnchorSideTop.Control = btnTestMenu
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Left = 292
Height = 32
Top = 168
Top = 166
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 46
BorderSpacing.Right = 6
Caption = 'Add &manually'
OnClick = btnAddManClick
TabOrder = 5
DefaultCaption = True
Kind = bkCancel
ModalResult = 5
TabOrder = 10
end
object btnEdit: TBitBtn
object bynOk: TBitBtn
AnchorSideTop.Control = btnGoToDir
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 289
Left = 292
Height = 32
Top = 208
Top = 246
Width = 142
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Caption = '&Edit'
OnClick = btnEditClick
TabOrder = 6
Default = True
DefaultCaption = True
Kind = bkOK
ModalResult = 1
TabOrder = 11
end
object Label1: TLabel
Left = 6
Height = 16
Top = 6
Width = 165
Caption = 'Hot dir list (sort by drag&&drop)'
ParentColor = False
end
object pmPathHelper: TPopupMenu
Images = frmMain.imgLstActions
left = 348
top = 317
object miMakeRelativeDC: TMenuItem
Tag = 1
Caption = 'Make path relative to %commander_path%'
OnClick = miPlayPathClick
end
object miMakeAbsolute: TMenuItem
Tag = 2
Caption = 'Make path absolute'
OnClick = miPlayPathClick
end
object miAddActiveFramePath: TMenuItem
Tag = 3
Caption = 'Add path from active frame'
OnClick = miPlayPathClick
end
object miAddNotActiveFramePath: TMenuItem
Tag = 4
Caption = 'Add path from not active frame'
OnClick = miPlayPathClick
end
object MenuItem10: TMenuItem
Tag = 5
Caption = 'Browse and add selected directory'
OnClick = miPlayPathClick
end
end
object OpenDialog1: TOpenDialog
left = 61
top = 144
end
object pmHotDirTestMenu: TPopupMenu
left = 241
top = 101
object MenuItem11: TMenuItem
Caption = 'New Item1'
end
end
object pmAddHotDirMenu: TPopupMenu
left = 225
top = 20
object MenuItem3: TMenuItem
Tag = 1
Caption = 'Browse and add selected'
OnClick = btnAddHotDirClick
end
object MenuItem4: TMenuItem
Tag = 2
Caption = 'Add manually a directoy I will type'
OnClick = btnAddHotDirClick
end
object MenuItem5: TMenuItem
Tag = 3
Caption = 'Add active frame directory'
OnClick = btnAddHotDirClick
end
object MenuItem6: TMenuItem
Tag = 4
Caption = 'Add active frame directory and inactive one as target'
OnClick = btnAddHotDirClick
end
object MenuItem7: TMenuItem
Caption = '-'
end
object MenuItem8: TMenuItem
Tag = 5
Caption = 'Add separator'
OnClick = btnAddHotDirClick
end
object MenuItem9: TMenuItem
Tag = 6
Caption = 'Add sub menu'
OnClick = btnAddHotDirClick
end
object MenuItem1: TMenuItem
Caption = '-'
end
object MenuItem2: TMenuItem
Caption = 'Add importation from TC'
OnClick = miImportTotalCommanderClick
end
end
end

727
src/fhotdir.pas
View file

@ -5,39 +5,76 @@ unit fHotDir;
interface
uses
SysUtils, Classes, Controls, Forms, StdCtrls, Buttons;
SysUtils, Classes, Controls, Forms, StdCtrls, Buttons, EditBtn, ExtCtrls,
Menus, Dialogs, KASPathEdit, uHotDir;
type
{ TfrmHotDir }
TfrmHotDir = class(TForm)
btnAddMan: TBitBtn;
btnEdit: TBitBtn;
lsHotDir: TListBox;
btnOK: TBitBtn;
bynOk: TBitBtn;
btnGoToDir: TBitBtn;
btnCancel: TBitBtn;
btnADD: TBitBtn;
btnTestMenu: TBitBtn;
btnRelativePath: TButton;
btnRelativeTarget: TButton;
Label1: TLabel;
lbleditHotDirName: TLabeledEdit;
lbleditHotDirPath: TLabeledEdit;
lbleditHotDirTarget: TLabeledEdit;
lsHotDir: TListBox;
btnAdd: TBitBtn;
btnDelete: TBitBtn;
procedure btnAddManClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
miAddActiveFramePath: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
miAddNotActiveFramePath: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
miMakeRelativeDC: TMenuItem;
miMakeAbsolute: TMenuItem;
OpenDialog1: TOpenDialog;
pmPathHelper: TPopupMenu;
pmHotDirTestMenu: TPopupMenu;
pmAddHotDirMenu: TPopupMenu;
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnADDClick(Sender: TObject);
procedure btnAddHotDirClick(Sender: TObject);
procedure btnGoToDirClick(Sender: TObject);
procedure miImportTotalCommanderClick(Sender: TObject);
procedure btnRelativeClick(Sender: TObject);
procedure btnTestMenuClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormKeyPress(Sender: TObject; var Key: char);
procedure lbleditHotDirEditingDone(Sender: TObject);
procedure lbleditHotDirEnter(Sender: TObject);
procedure lbleditHotDirExit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lbleditHotDirKeyPress(Sender: TObject; var Key: char);
procedure lsHotDirClick(Sender: TObject);
procedure lsHotDirDblClick(Sender: TObject);
procedure lsHotDirDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure lsHotDirDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure lsHotDirMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lsHotDirMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lsHotDirMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure miPlayPathClick(Sender: TObject);
procedure miShowWhereItWouldGo(Sender: TObject);
function ActualAddDirectories(sName, sPath, sTarget:string; PositionOfInsertion:longint):longint;
private
{ Private declarations }
fPivotIndex: integer;
HotDirListTemp: THotDirList;
public
{ Public declarations }
procedure LoadFromGlob;
procedure SaveToGlob;
ActiveFramePath,NotActiveFramePath:string;
procedure Refresh_lsHotDir(IndexToSelect:longint);
procedure SubmitToAddOrConfigToHotDirDlg(paramActionDispatcher:longint; paramActiveFramePath,paramNotActiveFramePath:string);
end;
@ -46,114 +83,590 @@ implementation
{$R *.lfm}
uses
Dialogs, DCStrUtils, uGlobs, uLng;
//Lazarus
Graphics,
procedure TfrmHotDir.LoadFromGlob;
//Component
DCClassesUtf8,
//Double Commander
DCStrUtils, uGlobs, uLng, uDCUtils, uDebug;
procedure TfrmHotDir.SubmitToAddOrConfigToHotDirDlg(paramActionDispatcher:longint; paramActiveFramePath,paramNotActiveFramePath:string);
var
CloserIndex:longint;
begin
ActiveFramePath:=paramActiveFramePath;
NotActiveFramePath:=paramNotActiveFramePath;
miAddActiveFramePath.Caption:='Set active frame path ('+paramActiveFramePath+')';
miAddNotActiveFramePath.Caption:='Set not active frame path ('+paramNotActiveFramePath+')';
HotDirListTemp:=THotDirList.Create;
CopyHotDirList(gHotDirList,HotDirListTemp);
case paramActionDispatcher of
ACTION_ADDTOHOTLIST:
begin
CloserIndex:=ActualAddDirectories(GetLastDir(paramActiveFramePath),paramActiveFramePath,paramNotActiveFramePath,HotDirListTemp.TryToGetCloserHotDir(paramActiveFramePath));
lbleditHotDirName.TabOrder:=0;
lbleditHotDirPath.TabOrder:=1;
lbleditHotDirTarget.TabOrder:=2;
lsHotDir.TabOrder:=3;
end;
ACTION_CONFIGTOHOTLIST:
begin
CloserIndex:=HotDirListTemp.TryToGetCloserHotDir(paramActiveFramePath);
HotDirListTemp.FlagModified:=FALSE;
lsHotDir.TabOrder:=0;
lbleditHotDirName.TabOrder:=1;
lbleditHotDirPath.TabOrder:=2;
lbleditHotDirTarget.TabOrder:=3;
end
else
begin
DCDebug('ERROR: "SubmitToAddOrConfigToHotDirDlg" called with incorrect "paramActionDispatcher"');
CloserIndex:=0;
end;
end;
Refresh_lsHotDir(CloserIndex);
end;
procedure TfrmHotDir.Refresh_lsHotDir(IndexToSelect:longint);
var
RememberFirstInList:Integer;
begin
if lsHotDir.Count>0 then RememberFirstInList:=lsHotDir.TopIndex else RememberFirstInList:=-1;
lsHotDir.Clear;
lsHotDir.Items.Assign(glsHotDir);
if glsHotDir.Count > 0 then lsHotDir.ItemIndex:= 0;
HotDirListTemp.LoadToStringList(lsHotDir.Items);
if (RememberFirstInList<>-1) AND (RememberFirstInList<lsHotDir.Count) then lsHotDir.TopIndex:=RememberFirstInList;
btnDelete.Enabled:= (lsHotDir.Items.Count > 0);
btnEdit.Enabled:= (lsHotDir.Items.Count > 0);
end;
if (IndexToSelect<>-1) AND (IndexToSelect<HotDirListTemp.Count) then
begin
lsHotDir.ItemIndex:=IndexToSelect;
end
else
begin
if lsHotDir.Items.Count > 0 then lsHotDir.ItemIndex:= 0;
end;
procedure TfrmHotDir.SaveToGlob;
begin
glsHotDir.Assign(lsHotDir.Items);
end;
procedure TfrmHotDir.btnOKClick(Sender: TObject);
begin
SaveToGlob;
end;
procedure TfrmHotDir.btnAddManClick(Sender: TObject);
var
sDir: String;
begin
if InputQuery(rsMsgManualAddHotDir, rsMsgManualHotDirQuery, sDir) then
lsHotDir.ItemIndex:= lsHotDir.Items.Add(IncludeTrailingBackSlash(sDir));
btnDelete.Enabled:= (lsHotDir.Items.Count > 0);
btnEdit.Enabled:= (lsHotDir.Items.Count > 0);
end;
procedure TfrmHotDir.btnEditClick(Sender: TObject);
var
sDir: String;
begin
if lsHotDir.Items.Count < 1 then Exit;
sDir:= lsHotDir.Items[lsHotDir.ItemIndex];
if InputQuery(rsMsgManualEditHotDir, rsMsgManualHotDirQuery, sDir) then
lsHotDir.Items[lsHotDir.ItemIndex]:= IncludeTrailingBackSlash(sDir);
btnDelete.Enabled:= (lsHotDir.Items.Count > 0);
btnEdit.Enabled:= (lsHotDir.Items.Count > 0);
lsHotDirClick(lsHotDir);
end;
procedure TfrmHotDir.btnDeleteClick(Sender: TObject);
var
iIndex:Integer;
begin
inherited;
if lsHotDir.ItemIndex=-1 then Exit;
iIndex:=lsHotDir.ItemIndex;
lsHotDir.Items.Delete(iIndex);
if (iIndex>=lsHotDir.Items.Count-1) then
iIndex:=lsHotDir.Items.Count-1;
lsHotDir.ItemIndex:=iIndex;
btnDelete.Enabled:= (lsHotDir.Items.Count>0);
btnEdit.Enabled:= (lsHotDir.Items.Count>0);
end;
procedure TfrmHotDir.btnADDClick(Sender: TObject);
var
sName,
sPath: String;
begin
if SelectDirectory(rsSelectDir, '', sPath, False) then
if isHotDirSubMenuStart(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then
begin
sName:= StringReplace(GetLastDir(sPath), '&', '&&', [rfReplaceAll]);
if InputQuery('', rsMsgTitleNewEntryHotDir, sName) then
lsHotDir.ItemIndex:= lsHotDir.Items.Add(sName + '=' + IncludeTrailingPathDelimiter(sPath));
end;
btnDelete.Enabled:= (lsHotDir.Items.Count > 0);
btnEdit.Enabled:= (lsHotDir.Items.Count > 0);
end;
procedure TfrmHotDir.FormCreate(Sender: TObject);
begin
fPivotIndex := -1;
end;
procedure TfrmHotDir.lsHotDirMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fPivotIndex := lsHotDir.GetIndexAtXY(X,Y);
end;
procedure TfrmHotDir.lsHotDirMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
NewIndex: Integer;
begin
if (fPivotIndex>=0) and (Y>=0) then
HotDirListTemp.DeleteHotDirMenuDelimiters(lsHotDir.ItemIndex);
end
else
begin
NewIndex := lsHotDir.GetIndexAtXY(X,Y);
if (NewIndex>=0) and (NewIndex<>fPivotIndex) then
if not isHotDirSubMenuEnd(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then //for security, juste make sure to not delete a end menu
begin
lsHotDir.Items.Exchange(NewIndex, fPivotIndex);
if fPivotIndex=lsHotDir.ItemIndex then
lsHotDir.ItemIndex := NewIndex;
fPivotIndex := NewIndex;
HotDirListTemp.DeleteHotDir(lsHotDir.ItemIndex);
if lsHotDir.ItemIndex>=HotDirListTemp.Count then lsHotDir.ItemIndex:=lsHotDir.ItemIndex-1;
end;
end;
Refresh_lsHotDir(lsHotDir.ItemIndex);
end;
procedure TfrmHotDir.btnAddClick(Sender: TObject);
begin
pmAddHotDirMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
function TfrmHotDir.ActualAddDirectories(sName, sPath, sTarget:string; PositionOfInsertion:longint):longint;
var
LocalHotDir:THotDir;
begin
if sName<>'' then
begin
LocalHotDir:=THotDir.Create;
LocalHotDir.HotDirName:=sName;
LocalHotDir.HotDirPath:=sPath;
LocalHotDir.HotDirTarget:=sTarget;
if (PositionOfInsertion=-1) OR (PositionOfInsertion>=pred(HotDirListTemp.Count)) then
begin
HotDirListTemp.Add(LocalHotDir);
result:=pred(HotDirListTemp.Count);
end
else
begin
HotDirListTemp.Insert(PositionOfInsertion,LocalHotDir);
result:=PositionOfInsertion;
end;
end;
end;
procedure TfrmHotDir.lsHotDirMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TfrmHotDir.btnAddHotDirClick(Sender: TObject);
var
sName, sPath: String;
Dispatcher,PositionOfInsertion:longint;
begin
fPivotIndex := -1;
with Sender as TComponent do Dispatcher:=tag;
PositionOfInsertion:=lsHotDir.ItemIndex+1; //It's a ADD, not an INSERT so we ADD a-f-t-e-r! If're on last item, don't worry, "ActualAddDirectories" will return correct point of insertion
sName:='';
sPath:='';
case Dispatcher of
1:
begin
if SelectDirectory(rsSelectDir, ActiveFramePath, sPath, False) then PositionOfInsertion:=ActualAddDirectories(GetLastDir(sPath),sPath,'',PositionOfInsertion);
end;
2:
begin
PositionOfInsertion:=ActualAddDirectories('Hot dir name','Hot dir path','Hot dir target',PositionOfInsertion);
end;
3:
begin
PositionOfInsertion:=ActualAddDirectories(GetLastDir(ActiveFramePath),ActiveFramePath,'',PositionOfInsertion);
end;
4:
begin
PositionOfInsertion:=ActualAddDirectories(GetLastDir(ActiveFramePath),ActiveFramePath,NotActiveFramePath,PositionOfInsertion);
end;
5:
begin
PositionOfInsertion:=ActualAddDirectories('-','','',PositionOfInsertion);
end;
6:
begin
PositionOfInsertion:=ActualAddDirectories('-Submenu name','','',PositionOfInsertion);
inc(PositionOfInsertion);
PositionOfInsertion:=ActualAddDirectories('Hot dir name','Hot dir path','Hot dir target',PositionOfInsertion);
inc(PositionOfInsertion);
PositionOfInsertion:=ActualAddDirectories('--','','',PositionOfInsertion);
dec(PositionOfInsertion);
end;
end;
Refresh_lsHotDir(PositionOfInsertion);
end;
procedure TfrmHotDir.btnGoToDirClick(Sender: TObject);
begin
end;
procedure TfrmHotDir.miImportTotalCommanderClick(Sender: TObject);
const
TC_SECTIONNAME:string='DirMenu';
DEFAULTNOTPRESENT:string='Mylene233528DE';
var
LocalHotDir:THotDir;
ConfigFile:TIniFileEx;
sName, sPath, sTarget:UTF8String;
InitialNumberOfItems,IndexMenu:longint;
begin
OpenDialog1.Title:='Locate TC "wincmd.ini" file';
if OpenDialog1.Execute then
begin
InitialNumberOfItems:=HotDirListTemp.Count;
IndexMenu:=1;
ConfigFile:=TIniFileEx.Create(OpenDialog1.Filename);
try
repeat
sName:=ConfigFile.ReadString(TC_SECTIONNAME,'menu'+IntToStr(IndexMenu),DEFAULTNOTPRESENT);
if (sName<>DEFAULTNOTPRESENT) then
begin
sPath:=ConfigFile.ReadString(TC_SECTIONNAME,'cmd'+IntToStr(IndexMenu),'');
if length(sPath)>3 then if pos('cd ',lowercase(sPath))=1 then sPath:=copy(sPath,4,length(sPath)-3);
sTarget:=ConfigFile.ReadString(TC_SECTIONNAME,'path'+IntToStr(IndexMenu),'');
if length(sTarget)>3 then if pos('cd ',lowercase(sTarget))=1 then sTarget:=copy(sTarget,4,length(sTarget)-3);
sName:=AnsiToUTF8(sName);
sName:=StringReplace(sName,'&','',[rfReplaceAll, rfIgnoreCase]);
sPath:=AnsiToUTF8(sPath);
sPath:=StringReplace(sPath,'%COMMANDER_PATH%','%commander_path%',[rfReplaceAll, rfIgnoreCase]);
if length(sPath)>1 then if sPath[length(sPath)]<>'\' then sPath:=sPath+PathDelim; //Not an obligation but DC convention seems to like a backslash at the end
sTarget:=AnsiToUTF8(sTarget);
sTarget:=StringReplace(sTarget,'%COMMANDER_PATH%','%commander_path%',[rfReplaceAll, rfIgnoreCase]);
if length(sTarget)>1 then if sTarget[length(sTarget)]<>'\' then sTarget:=sTarget+PathDelim; //Not an obligation but DC convention seems to like a backslash at the end
LocalHotDir:=THotDir.Create;
LocalHotDir.HotDirName:=sName;
LocalHotDir.HotDirPath:=sPath;
LocalHotDir.HotDirTarget:=sTarget;
HotDirListTemp.Add(LocalHotDir);
end;
inc(IndexMenu);
until sName=DEFAULTNOTPRESENT;
finally
FreeAndNil(ConfigFile);
end;
Refresh_lsHotDir(lsHotDir.ItemIndex);
btnDelete.Enabled:= (lsHotDir.Items.Count > 0);
MessageDlg('Directory entries added: '+IntToStr(HotDirListTemp.Count-InitialNumberOfItems),mtInformation,[mbOk],0);
end;
end;
procedure TfrmHotDir.btnRelativeClick(Sender: TObject);
begin
with Sender as TButton do pmPathHelper.Tag:=tag;
pmPathHelper.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
procedure TfrmHotDir.btnTestMenuClick(Sender: TObject);
var
p:TPoint;
begin
HotDirListTemp.CreatePopUpHotDir(pmHotDirTestMenu,POPUPMENU_JUSTDIRECTORIES,@miShowWhereItWouldGo,nil,'');
p:=lsHotDir.ClientToScreen(Classes.Point(0,0));
pmHotDirTestMenu.PopUp(p.X,p.Y);
end;
procedure TfrmHotDir.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if (modalResult=mrOk) or (modalResult=mrAll) then
begin
CopyHotDirList(HotDirListTemp,gHotDirList);
end;
end;
procedure TfrmHotDir.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
Answer:integer;
begin
if (modalResult<>mrOk) AND (modalResult<>mrAll) AND (HotDirListTemp.FlagModified) then
begin
if modalResult<>mrIgnore then //Don't bother user if he voluntary hit CANCEL. It's clear he doesn't want to save!
begin
Answer:=MessageDlg('Directory hotlist has been modified.'+#$0A+'Do you want to save before to exit?',mtConfirmation,[mbYes,mbNo,mbCancel],0);
CanClose:=((Answer=mrYes) OR (Answer=mrNo));
if Answer=mrYes then modalResult:=mrOk;
end;
end;
end;
procedure TfrmHotDir.FormKeyPress(Sender: TObject; var Key: char);
begin
case ord(Key) of
$1B: //Escape? Let's quit, simply
begin
if (not lbleditHotDirName.Focused) AND (not lbleditHotDirPath.Focused) AND (not lbleditHotDirTarget.Focused) then
begin
close;
Key:=#$00;
end;
end;
end;
end;
procedure TfrmHotDir.lbleditHotDirEditingDone(Sender: TObject);
begin
with Sender as TLabeledEdit do
begin
case tag of
1: if isHotDirSubMenuStart(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName:='-'+Text else HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName:=text;
2: HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath:=Text;
3: HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirTarget:=Text;
end;
if tag=1 then Refresh_lsHotDir(lsHotDir.ItemIndex);
HotDirListTemp.FlagModified:=TRUE;
end;
end;
procedure TfrmHotDir.lbleditHotDirEnter(Sender: TObject);
begin
with sender as TLabeledEdit do
begin
pmPathHelper.Tag:=tag;
Font.Style:=[fsBold];
EditLabel.Font.Style:=[fsBold];
end;
end;
procedure TfrmHotDir.lbleditHotDirExit(Sender: TObject);
begin
with sender as TLabeledEdit do
begin
pmPathHelper.Tag:=0;
Font.Style:=[];
EditLabel.Font.Style:=[];
end;
end;
procedure TfrmHotDir.FormCreate(Sender: TObject);
begin
// Initialize property storage
InitPropStorage(Self);
ActiveFramePath:='';
NotActiveFramePath:='';
end;
procedure TfrmHotDir.lbleditHotDirKeyPress(Sender: TObject; var Key: char);
begin
case ord(Key) of
$0D: //Enter? Let's save the field and go to next one
begin
Key:=#00;
with Sender as TLabeledEdit do
begin
case tag of
1: //HotDirName
begin
//if isHotDirSubMenuStart(gHotDirList.HotDir[lsHotDir.ItemIndex].HotDirName) then gHotDirList.HotDir[lsHotDir.ItemIndex].HotDirName:='-'+Text else gHotDirList.HotDir[lsHotDir.ItemIndex].HotDirName:=text;
//lsHotDir.Items.Strings[lsHotDir.ItemIndex]:=Text;
//LoadFromGlob(lsHotDir.ItemIndex);
if lbleditHotDirPath.CanFocus then lbleditHotDirPath.SetFocus;
end;
2: //HotDirPath
begin
//gHotDirList.HotDir[lsHotDir.ItemIndex].HotDirPath:=Text;
if lbleditHotDirTarget.CanFocus then lbleditHotDirTarget.SetFocus;
end;
3: //HotDirTarget
begin
//gHotDirList.HotDir[lsHotDir.ItemIndex].HotDirTarget:=Text;
if lsHotDir.CanFocus then lsHotDir.SetFocus;
end;
end;
end;
end;
$1B: //Escape? Place back the fields like they were
begin
Key:=#00;
with Sender as TLabeledEdit do
begin
case tag of
1: lsHotDirClick(lsHotDir);
2: Text:=HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath;
3: Text:=HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirTarget;
end;
end;
lsHotDir.SetFocus;
end;
end;
end;
procedure TfrmHotDir.lsHotDirClick(Sender: TObject);
begin
if lsHotDir.ItemIndex<>-1 then
begin
if isHotDirSubMenuStart(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then
begin
lbleditHotDirName.EditLabel.Caption:='Menu:';
lbleditHotDirName.Text:=rightstr(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName,length(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName)-1);
lbleditHotDirName.Enabled:=TRUE;
lbleditHotDirPath.Visible:=FALSE;
lbleditHotDirTarget.Visible:=FALSE;
btnGoToDir.Enabled:=FALSE;
btnDelete.Enabled:=TRUE;
end
else
begin
if isHotDirSubMenuEnd(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then
begin
lbleditHotDirName.EditLabel.Caption:='';
lbleditHotDirName.Text:='(end of sub menu)';
lbleditHotDirName.Enabled:=FALSE;
lbleditHotDirPath.Visible:=FALSE;
lbleditHotDirTarget.Visible:=FALSE;
btnGoToDir.Enabled:=FALSE;
btnDelete.Enabled:=FALSE;
end
else
begin
if isHotDirSeparator(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName) then
begin
lbleditHotDirName.EditLabel.Caption:='';
lbleditHotDirName.Text:='(separator)';
lbleditHotDirName.Enabled:=FALSE;
lbleditHotDirPath.Visible:=FALSE;
lbleditHotDirTarget.Visible:=FALSE;
btnGoToDir.Enabled:=FALSE;
btnDelete.Enabled:=TRUE;
end
else
begin
lbleditHotDirName.EditLabel.Caption:='Name:';
lbleditHotDirName.Text:=HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName;
lbleditHotDirName.Enabled:=TRUE;
lbleditHotDirPath.Text:=HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath;
lbleditHotDirTarget.Text:=HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirTarget;
lbleditHotDirPath.Visible:=TRUE;
lbleditHotDirTarget.Visible:=TRUE;
btnGoToDir.Enabled:=TRUE;
btnDelete.Enabled:=TRUE;
end;
end;
end;
btnRelativePath.Visible:=lbleditHotDirPath.Visible;
btnRelativeTarget.Visible:=lbleditHotDirTarget.Visible;
end;
end;
procedure TfrmHotDir.lsHotDirDblClick(Sender: TObject);
begin
if lsHotDir.ItemIndex>-1 then
begin
if (HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath<>'-') AND (HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath<>'--') then
begin
ModalResult:=mrAll;
end;
end;
end;
procedure TfrmHotDir.lsHotDirDragDrop(Sender, Source: TObject; X, Y: Integer);
var
CurIndex, NewIndex: Integer;
begin
CurIndex := lsHotDir.ItemIndex;
if CurIndex = -1 then Exit;
NewIndex := lsHotDir.GetIndexAtY(Y);
if (NewIndex < 0) or (NewIndex >= lsHotDir.Count) then
NewIndex := lsHotDir.Count - 1;
if not isHotDirSubMenuStart(HotDirListTemp.HotDir[CurIndex].HotDirName) then
begin
HotDirListTemp.Move(CurIndex, NewIndex);
end
else
begin
HotDirListTemp.MoveHotDirMenu(CurIndex, NewIndex);
end;
Refresh_lsHotDir(NewIndex);
end;
procedure TfrmHotDir.lsHotDirDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
if Y<20 then
begin
lsHotDir.TopIndex:=lsHotDir.TopIndex-1; //No need to valite if on top already, code is doing it for us!
end
else
begin
if (Y+20)>lsHotDir.Height then
begin
lsHotDir.TopIndex:=lsHotDir.TopIndex+1; //No need to valite if at bottom already, code is doing it for us!
end
else
begin
if (Source = lsHotDir) and (lsHotDir.ItemIndex<>-1) then
begin
Accept:=not isHotDirSubMenuEnd(HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirName); //We don't want "MenuEnd" to be moveable.
end
else
begin
Accept:=FALSE;
end;
end;
end;
end;
procedure TfrmHotDir.lsHotDirMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
lsHotDirClick(lsHotDir); //Might looks stupid an unnecessary but it is to avoid the fact that "OnClick" is not triggered in some circonstances.
//Example? Suppose the focus is on element #n. Suppose we press the down arrow to select n+1, if with the mouse we then click on element #n,
//the element is really selected BUT the event "OnClick" is not triggered (at least on Windows Vista) BUT OnMouseDown is triggered.
end;
procedure TfrmHotDir.miShowWhereItWouldGo(Sender: TObject);
var
StringToShow:string;
begin
with Sender as TComponent do
begin
lsHotDir.ItemIndex:=tag;
lsHotDir.TopIndex:=tag-((lsHotDir.Height div lsHotDir.ItemHeight) div 2);
StringToShow:='This is hot dir named '+HotDirListTemp.HotDir[tag].HotDirName;
StringToShow:=StringToShow+#$0D+#$0A+#$0D+#$0A+'This will change active frame to the following path:';
StringToShow:=StringToShow+#$0D+#$0A+mbExpandFileName(HotDirListTemp.HotDir[tag].HotDirPath);
if HotDirListTemp.HotDir[tag].HotDirTarget<>'' then
begin
StringToShow:=StringToShow+#$0D+#$0A+#$0D+#$0A+'And inactive frame would change to the following path:';
StringToShow:=StringToShow+#$0D+#$0A+mbExpandFileName(HotDirListTemp.HotDir[tag].HotDirTarget);
end;
MessageDlg(StringToShow,mtInformation,[mbOk],0);
end;
end;
procedure TfrmHotDir.miPlayPathClick(Sender: TObject);
var
WorkingPath:string;
DispatcherAction:longint;
begin
with Sender as TComponent do DispatcherAction:=tag;
case DispatcherAction of
1: // Make path relative to %commander_path%
begin
case pmPathHelper.tag of
2: //HotDir Path
begin
WorkingPath:=ExtractRelativePath((ReplaceEnvVars('%commander_path%')+PathDelim),lbleditHotDirPath.Text);
if WorkingPath<>lbleditHotDirPath.Text then lbleditHotDirPath.Text:='%commander_path%'+PathDelim+WorkingPath;
end;
3: //HotDir Target
begin
WorkingPath:=ExtractRelativePath((ReplaceEnvVars('%commander_path%')+PathDelim),lbleditHotDirTarget.Text);
if WorkingPath<>lbleditHotDirTarget.Text then lbleditHotDirTarget.Text:='%commander_path%'+PathDelim+WorkingPath;
end;
end;
end;
2: // Make path absolute
begin
case pmPathHelper.tag of
2: lbleditHotDirPath.Text:=mbExpandFileName(lbleditHotDirPath.Text); //HotDir Path
3: lbleditHotDirTarget.Text:=mbExpandFileName(lbleditHotDirTarget.Text); //HotDir Target
end;
end;
3: //Add path from active frame
begin
case pmPathHelper.tag of
2: lbleditHotDirPath.Text:=ActiveFramePath; //HotDir Path
3: lbleditHotDirTarget.Text:=ActiveFramePath; //HotDir Target
end;
end;
4: //Add path from not active frame
begin
case pmPathHelper.tag of
2: lbleditHotDirPath.Text:=NotActiveFramePath; //HotDir Path
3: lbleditHotDirTarget.Text:=NotActiveFramePath; //HotDir Target
end;
end;
5: //Browse and add selected directory
begin
case pmPathHelper.tag of
2: if SelectDirectory(rsSelectDir, ActiveFramePath, WorkingPath, False) then lbleditHotDirPath.Text:=WorkingPath;
3: if SelectDirectory(rsSelectDir, NotActiveFramePath, WorkingPath, False) then lbleditHotDirTarget.Text:=WorkingPath;
end;
end;
end;
case pmPathHelper.tag of
2: if HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirPath<>lbleditHotDirPath.Text then lbleditHotDirEditingDone(lbleditHotDirPath);
3: if HotDirListTemp.HotDir[lsHotDir.ItemIndex].HotDirTarget<>lbleditHotDirTarget.Text then lbleditHotDirEditingDone(lbleditHotDirTarget);
end;
end;
end.

112
src/fmain.pas
View file

@ -602,17 +602,17 @@ type
//check selected count and generate correct msg, parameters is lng indexs
Function GetFileDlgStr(sLngOne, sLngMulti : String; Files: TFiles):String;
procedure HotDirSelected(Sender:TObject);
procedure HotDirActualSwitchToDir(Index:longint);
procedure HistorySelected(Sender:TObject);
procedure ViewHistorySelected(Sender:TObject);
procedure ViewHistoryPrevSelected(Sender:TObject);
procedure ViewHistoryNextSelected(Sender:TObject);
procedure CreatePopUpHotDir;
procedure CreatePopUpDirHistory;
procedure ShowFileViewHistory;
procedure ShowFileViewHistory(FromFileSourceIndex, FromPathIndex,
ToFileSourceIndex, ToPathIndex: Integer);
procedure miHotAddClick(Sender: TObject);
procedure miHotDeleteClick(Sender: TObject);
procedure miHotConfClick(Sender: TObject);
procedure miHotAddOrConfigClick(Sender: TObject);
{en
Returns @true if copy operation has been successfully started.
}
@ -712,7 +712,8 @@ uses
uFileSourceProperty, uFileSourceExecuteOperation, uArchiveFileSource, uThumbFileView,
uShellExecute, fSymLink, fHardLink, uExceptions, uUniqueInstance, Clipbrd,
uFileSourceOperationOptionsUI, uDebug, uHotkeyManager, uFileSourceUtil,
XMLRead, DCOSUtils, DCStrUtils, fOptions, fOptionsFrame, fOptionsToolbar
XMLRead, DCOSUtils, DCStrUtils, fOptions, fOptionsFrame, fOptionsToolbar,
uhotdir
{$IFDEF COLUMNSFILEVIEW_VTV}
, uColumnsFileViewVtv
{$ENDIF}
@ -807,6 +808,10 @@ begin
btnLeftDrive.Caption := '';
btnRightDrive.Caption := '';
//Have the correct button label to indicate root
btnLeftRoot.Caption:=DirectorySeparator;
btnRightRoot.Caption:=DirectorySeparator;
for I := 0 to pnlKeys.ControlCount - 1 do
FunctionButtonsCaptions[I].ACaption := pnlKeys.Controls[I].Caption;
@ -936,7 +941,7 @@ Var P:TPoint;
begin
if tb_activate_panel_on_click in gDirTabOptions then
SetActiveFrame(fpLeft);
CreatePopUpHotDir;// TODO: i thing in future this must call on create or change
gHotDirList.CreatePopUpHotDir(pmHotList,POPUPMENU_WITHADDANDCONFIG,@HotDirSelected,@miHotAddOrConfigClick,ActiveFrame.CurrentPath); // TODO: i thing in future this must call on create or change
p := Classes.Point(btnLeftDirectoryHotlist.Left,btnLeftDirectoryHotlist.Height);
p := pnlLeftTools.ClientToScreen(p);
pmHotList.PopUp(P.x,P.y);
@ -952,7 +957,7 @@ Var P:TPoint;
begin
if tb_activate_panel_on_click in gDirTabOptions then
SetActiveFrame(fpRight);
CreatePopUpHotDir;// TODO: i thing in future this must call on create or change
gHotDirList.CreatePopUpHotDir(pmHotList,POPUPMENU_WITHADDANDCONFIG,@HotDirSelected,@miHotAddOrConfigClick,ActiveFrame.CurrentPath); // TODO: i thing in future this must call on create or change
p := Classes.Point(btnRightDirectoryHotlist.Left,btnRightDirectoryHotlist.Height);
p := pnlRightTools.ClientToScreen(p);
pmHotList.PopUp(P.x,P.y);
@ -1237,7 +1242,7 @@ var
begin
with FileView do
begin
if Button.Caption = '/' then
if Button.Caption = DirectorySeparator then
CurrentPath := FileSource.GetRootDir(CurrentPath)
else if Button.Caption = '..' then
ChangePathToParent(True)
@ -2353,31 +2358,17 @@ begin
Result := Format(sLngOne, [Files[0].Name]);
end;
procedure TfrmMain.miHotAddClick(Sender: TObject);
procedure TfrmMain.miHotAddOrConfigClick(Sender: TObject);
var
sName: UTF8String;
ActionDispatcher:longint;
begin
sName:= StringReplace(GetLastDir(ActiveFrame.CurrentPath), '&', '&&', [rfReplaceAll]);
if InputQuery('Double Commander', rsMsgTitleNewEntryHotDir, sName) then
glsHotDir.Add(sName + '=' + ActiveFrame.CurrentPath);
end;
with Sender as TComponent do ActionDispatcher:=tag;
procedure TfrmMain.miHotDeleteClick(Sender: TObject);
var
I: Integer;
begin
I:= glsHotDir.IndexOfValue(ActiveFrame.CurrentPath);
if I >= 0 then glsHotDir.Delete(I);
end;
procedure TfrmMain.miHotConfClick(Sender: TObject);
begin
with TfrmHotDir.Create(Application) do
begin
try
LoadFromGlob;
ShowModal;
SubmitToAddOrConfigToHotDirDlg(ActionDispatcher,ActiveFrame.CurrentPath,NotActiveFrame.CurrentPath);
if ShowModal=mrAll then HotDirActualSwitchToDir(lsHotDir.ItemIndex);
finally
Free;
end;
@ -2403,7 +2394,7 @@ begin
mi:= TMenuItem.Create(pmDirHistory);
mi.Caption:= glsDirHistory[I];
mi.Hint:= mi.Caption;
mi.OnClick:= @HotDirSelected;
mi.OnClick:= @HistorySelected;
pmDirHistory.Items.Add(mi);
end;
end;
@ -2595,56 +2586,43 @@ begin
pmDirHistory.Popup(p.X, p.Y);
end;
procedure TfrmMain.CreatePopUpHotDir;
procedure TfrmMain.HotDirActualSwitchToDir(Index:longint);
var
mi: TMenuItem;
I: Integer;
aPath: String;
isCTRLDown: boolean;
begin
// Create All popup menu
pmHotList.Items.Clear;
for I:= 0 to glsHotDir.Count - 1 do
begin
mi:= TMenuItem.Create(pmHotList);
if Pos('&', glsHotDir.Names[I]) = 0 then
mi.Caption:= '&' + glsHotDir.Names[I]
else
mi.Caption:= glsHotDir.Names[I];
mi.Hint:= glsHotDir.ValueFromIndex[I];
mi.OnClick:= @HotDirSelected;
pmHotList.Items.Add(mi);
end;
// now add delimiter
mi:= TMenuItem.Create(pmHotList);
mi.Caption:= '-';
pmHotList.Items.Add(mi);
// now add ADD or DELETE item
// This handler is used by HotDir.
// Hot dirs are only supported by filesystem.
isCTRLDown:=((GetKeyState(VK_CONTROL) AND $80) <> 0); //Will check later is CTRL key was pressed, but let's put state in memory ASAP
mi:= TMenuItem.Create(pmHotList);
if glsHotDir.IndexOfValue(ActiveFrame.CurrentPath) >= 0 then
aPath := gHotDirList.HotDir[Index].HotDirPath;
if aPath<>'' then
begin
mi.Caption:= Format(rsMsgPopUpHotDelete,[ActiveFrame.CurrentPath]);
mi.OnClick:= @miHotDeleteClick;
end
else
begin
mi.Caption:= Format(rsMsgPopUpHotAdd,[ActiveFrame.CurrentPath]);
mi.OnClick:= @miHotAddClick;
aPath := mbExpandFileName(aPath);
ChooseFileSource(ActiveFrame, aPath);
if (not isCTRLDown) then //We don't change target folder if CTRL key is pressed
begin
aPath := gHotDirList.HotDir[Index].HotDirTarget;
if aPath<>'' then
begin
aPath := mbExpandFileName(aPath);
ChooseFileSource(NotActiveFrame, aPath);
end;
end;
end;
pmHotList.Items.Add(mi);
// now add configure item
mi:= TMenuItem.Create(pmHotList);
mi.Caption:= rsMsgPopUpHotCnf;
mi.OnClick:= @miHotConfClick;
pmHotList.Items.Add(mi);
end;
procedure TfrmMain.HotDirSelected(Sender: TObject);
begin
HotDirActualSwitchToDir((Sender as TMenuItem).Tag);
end;
procedure TfrmMain.HistorySelected(Sender: TObject);
var
aPath: String;
begin
// This handler is used by HotDir and DirHistory.
// Hot dirs are only supported by filesystem.
// This handler is used by DirHistory.
aPath := (Sender as TMenuItem).Hint;
aPath := mbExpandFileName(aPath);
ChooseFileSource(ActiveFrame, aPath);

7
src/udcutils.pas
View file

@ -254,6 +254,13 @@ var
EnvValue: String;
begin
Result:= sText;
{$IFDEF UNIX}
if pos('$',sText)=0 then Exit; //If there is no '$' in the name, no need to see if there is something to be replaced...
{$ELSE}
if pos('%',sText)=0 then Exit; //If there is no '?' in the name, no need to see if there is something to be replaced...
{$ENDIF}
if sText = EmptyStr then Exit;
X:= GetEnvironmentVariableCount;
if X = 0 then Exit;

71
src/uglobs.pas
View file

@ -28,7 +28,7 @@ uses
Classes, Controls, Forms, Types, uExts, uColorExt, Graphics, DCClassesUtf8,
uMultiArc, uColumns, uHotkeyManager, uSearchTemplate, uFileSourceOperationOptions,
uWFXModule, uWCXModule, uWDXModule, uwlxmodule, udsxmodule, DCXmlConfig,
uInfoToolTip, fQuickSearch, uTypes, uClassesEx;
uInfoToolTip, fQuickSearch, uTypes, uClassesEx, uhotdir;
type
{ Log options }
@ -181,7 +181,7 @@ var
gAutoFillColumns: Boolean;
gAutoSizeColumn: Integer;
glsHotDir:TStringListEx;
gHotDirList:THotDirList;
glsDirHistory:TStringListEx;
glsCmdLineHistory: TStringListEx;
glsMaskHistory : TStringListEx;
@ -860,33 +860,6 @@ begin
end;
end;
procedure LoadDirHotList(AConfig: TXmlConfig; Node: TXmlNode);
var
Name, Path: String;
begin
glsHotDir.Clear;
Node := Node.FindNode('DirectoryHotList');
if Assigned(Node) then
begin
Node := Node.FirstChild;
while Assigned(Node) do
begin
if Node.CompareName('HotDir') = 0 then
begin
if AConfig.TryGetAttr(Node, 'Name', Name) and
AConfig.TryGetAttr(Node, 'Path', Path) then
begin
glsHotDir.Add(Name + '=' + Path);
end
else
DCDebug('Invalid entry in configuration: ' + AConfig.GetPathFromNode(Node) + '.');
end;
Node := Node.NextSibling;
end;
end;
end;
procedure ConvertIniToXml;
var
MultiRename: TfrmMultiRename = nil;
@ -935,7 +908,7 @@ begin
gExts := TExts.Create;
gColorExt := TColorExt.Create;
gFileInfoToolTip := TFileInfoToolTip.Create;
glsHotDir := TStringListEx.Create;
gHotDirList := THotDirList.Create;
glsDirHistory := TStringListEx.Create;
glsCmdLineHistory := TStringListEx.Create;
glsMaskHistory := TStringListEx.Create;
@ -961,7 +934,7 @@ begin
FreeThenNil(gFileInfoToolTip);
FreeThenNil(glsDirHistory);
FreeThenNil(glsCmdLineHistory);
FreeThenNil(glsHotDir);
FreeThenNil(gHotDirList);
FreeThenNil(glsMaskHistory);
FreeThenNil(glsSearchHistory);
FreeThenNil(glsReplaceHistory);
@ -1227,7 +1200,7 @@ begin
gExts.Clear;
gColorExt.Clear;
gFileInfoToolTip.Clear;
glsHotDir.Clear;
gHotDirList.Clear;
glsDirHistory.Clear;
glsMaskHistory.Clear;
glsSearchHistory.Clear;
@ -1534,7 +1507,9 @@ var
oldQuickFilter: Boolean = False;
oldQuickSearchMode: TShiftState = [ssCtrl, ssAlt];
oldQuickFilterMode: TShiftState = [];
begin
glsHotDirTempoLegacyConversion:TStringListEx;
LocalHotDir: THotDir;
IndexHotDir: integer;begin
{ Layout page }
gButtonBar := gIni.ReadBool('Layout', 'ButtonBar', True);
@ -1697,8 +1672,19 @@ begin
gIni.ReadInteger('Operations', 'DirectoryExists', Integer(gOperationOptionDirectoryExists)));
gOperationOptionCheckFreeSpace := gIni.ReadBool('Operations', 'CheckFreeSpace', gOperationOptionCheckFreeSpace);
gIni.ReadSectionRaw('DirectoryHotList', glsHotDir);
//Let's take the time to do the conversion for those loading from INI file
{ Hot dir }
glsHotDirTempoLegacyConversion:=TStringListEx.Create;
gIni.ReadSectionRaw('DirectoryHotList', glsHotDirTempoLegacyConversion);
for IndexHotDir:=0 to pred(glsHotDirTempoLegacyConversion.Count) do
begin
LocalHotDir:=THotDir.Create;
LocalHotDir.HotDirName:=glsHotDirTempoLegacyConversion.Names[IndexHotDir];
LocalHotDir.HotDirPath:=glsHotDirTempoLegacyConversion.ValueFromIndex[IndexHotDir];
LocalHotDir.HotDirTarget:='';
gHotDirList.Add(LocalHotDir);
end;
FreeAndNil(glsHotDirTempoLegacyConversion); //Thank you, good bye!
gColorExt.LoadIni;
{ Search template list }
@ -1719,10 +1705,6 @@ procedure SaveIniConfig;
var
I: LongInt;
begin
gIni.EraseSection('DirectoryHotList');
for I:= 0 to glsHotDir.Count - 1 do
gIni.WriteString('DirectoryHotList', glsHotDir.Names[I], glsHotDir.ValueFromIndex[I]);
{ Layout page }
gIni.WriteBool('Layout', 'ButtonBar', gButtonBar);
@ -2241,7 +2223,7 @@ begin
end;
{ Directories HotList }
LoadDirHotList(gConfig, Root);
gHotDirList.LoadFromXML(gConfig, Root);
{ Viewer }
Node := Root.FindNode('Viewer');
@ -2553,14 +2535,7 @@ begin
SetValue(Node, 'IgnoreListFile', gIgnoreListFile);
{ Directories HotList }
Node := FindNode(Root, 'DirectoryHotList', True);
gConfig.ClearNode(Node);
for I:= 0 to glsHotDir.Count - 1 do
begin
SubNode := AddNode(Node, 'HotDir');
SetAttr(SubNode, 'Name', glsHotDir.Names[I]);
SetAttr(SubNode, 'Path', glsHotDir.ValueFromIndex[I]);
end;
gHotDirList.SaveToXml(gConfig, Root);
{ Viewer }
Node := FindNode(Root, 'Viewer',True);

492
src/uhotdir.pas Normal file
View file

@ -0,0 +1,492 @@
{
Double Commander
-------------------------------------------------------------------------
Load/Save HotDir
The text here will need to be written by someone better than me...
But at least for now I can write it has been inspired directly from "uSearchTemplate.pas" on 2014-03-12
}
unit uHotDir;
{$mode objfpc}{$H+}
interface
uses
//Lazarus
Classes, SysUtils, Menus,
//DC
DCClassesUtf8, uFile, DCXmlConfig, uFindFiles;
const
ACTION_ADDTOHOTLIST = 1;
ACTION_CONFIGTOHOTLIST = 2;
POPUPMENU_JUSTDIRECTORIES = 1;
POPUPMENU_WITHADDANDCONFIG = 2;
type
{ TProcedureWhenClickOnHotDirMenuItem}
TProcedureWhenClickOnHotDirMenuItem = procedure(Sender: TObject) of object;
{ THotDir }
THotDir = class
private
FHotDirName: string;
FHotDirPath: string;
FHotDirTarget: string;
public
constructor Create;
property HotDirName: string read FHotDirName write FHotDirName;
property HotDirPath: string read FHotDirPath write FHotDirPath;
property HotDirTarget: string read FHotDirTarget write FHotDirTarget;
end;
{ THotDirList }
THotDirList = class(TList)
private
function GetHotDir(Index: Integer): THotDir;
function GetHotDir(const AName: string): THotDir;
public
FlagModified:boolean;
constructor Create;
procedure Clear; override;
function Add(HotDir: THotDir): Integer;
procedure DeleteHotDir(Index: Integer);
procedure DeleteHotDirMenuDelimiters(Index:Integer);
procedure LoadToStringList(StringList: TStrings);
procedure LoadFromIni(IniFile: TIniFileEx);
procedure LoadFromXml(AConfig: TXmlConfig; ANode: TXmlNode);
procedure SaveToIni(IniFile: TIniFileEx);
procedure SaveToXml(AConfig: TXmlConfig; ANode: TXmlNode);
function TryToGetCloserHotDir(APath:string):longint;
function GetIndexSubMenuEnd(SearchIndex:longint):longint;
procedure Move(CurIndex, NewIndex: Integer);
function MoveHotDirMenu(CurIndex, NewIndex: Integer):longint;
property HotDirByName[const AName: string]: THotDir read GetHotDir;
property HotDir[Index: Integer]: THotDir read GetHotDir;
procedure CreatePopUpHotDir(pmHotDir:TPopupMenu; Dispatcher:longint; ProcedureWhenHotDirItemClicked,ProcedureWhenHotDirAddOrConfigClicked:TProcedureWhenClickOnHotDirMenuItem; CurrentPath:string);
end;
procedure CopyHotDirList(SourceHotDirList:THotDirList; var DestinationHotDirList:THotDirList);
function isHotDirSubMenuStart(HotDirString:string):boolean;
function isHotDirSubMenuEnd(HotDirString:string):boolean;
function isHotDirSeparator(HotDirString:string):boolean;
implementation
uses
DCFileAttributes, DCBasicTypes, uDebug, DCStrUtils, uDCUtils, uLng;
{ THotDir }
constructor THotDir.Create;
begin
inherited Create;
end;
{ THotDirList }
constructor THotDirList.Create;
begin
inherited Create;
FlagModified:=FALSE;
end;
procedure THotDirList.Move(CurIndex, NewIndex: Integer);
begin
inherited Move(CurIndex, NewIndex);
FlagModified:=TRUE;
end;
function THotDirList.GetHotDir(Index: Integer): THotDir;
begin
Result:= THotDir(Items[Index]);
end;
function THotDirList.TryToGetCloserHotDir(APath:string):longint;
var
I,SecondAlternative:Integer;
FlagFound:boolean;
begin
APath:=lowercase(APath);
SecondAlternative:=-1;
repeat
I:=0;
FlagFound:=FALSE;
while (I < Count) and (not FlagFound) do
begin
if APath=lowercase(ReplaceEnvVars(THotDir(Items[I]).HotDirPath)) then
begin
FlagFound:=TRUE;
end
else
begin
if (SecondAlternative=-1) and (pos(APath,lowercase(ReplaceEnvVars(THotDir(Items[I]).HotDirPath)))=1) then
begin
SecondAlternative:=I;
end;
inc(I);
end;
end;
if not FlagFound then APath:=DCStrUtils.GetParentDir(APath);
until (FlagFound OR (APath=''));
if FlagFound then result:=I else if SecondAlternative<>-1 then result:=SecondAlternative else result:=-1;
end;
{Given the start of a menu, it will return the index of the end of the same menu}
function THotDirList.GetIndexSubMenuEnd(SearchIndex:longint):longint;
var
InnerMenuCount:longint;
begin
result:=-1;
if isHotDirSubMenuStart(THotDir(Items[SearchIndex]).HotDirName) then
begin
InnerMenuCount:=1;
while (SearchIndex<pred(count)) and (InnerMenuCount<>0) do
begin
inc(SearchIndex);
if isHotDirSubMenuStart(THotDir(Items[SearchIndex]).HotDirName) then
inc(InnerMenuCount)
else
if isHotDirSubMenuEnd(THotDir(Items[SearchIndex]).HotDirName) then dec(InnerMenuCount);
end;
if InnerMenuCount=0 then result:=SearchIndex;
end;
end;
function THotDirList.MoveHotDirMenu(CurIndex, NewIndex: Integer):Integer;
var
HotDirSubMenuEndIndex,OffsetIndex:longint;
begin
result:=-1;
HotDirSubMenuEndIndex:=GetIndexSubMenuEnd(CurIndex);
if HotDirSubMenuEndIndex<>-1 then
begin
if (NewIndex<CurIndex) OR (NewIndex>HotDirSubMenuEndIndex) then
begin
if NewIndex<CurIndex then
begin
for OffsetIndex:=0 to (HotDirSubMenuEndIndex-CurIndex) do
Move(CurIndex+OffsetIndex, NewIndex+OffsetIndex);
end
else
begin
for OffsetIndex:=0 to (HotDirSubMenuEndIndex-CurIndex) do
Move(CurIndex, NewIndex);
end;
FlagModified:=TRUE;
end;
end;
end;
function THotDirList.GetHotDir(const AName: string): THotDir;
var
I: Integer;
begin
Result:= nil;
for I:= 0 to Count - 1 do
if SameText(THotDir(Items[I]).HotDirName, AName) then
begin
Result:= THotDir(Items[I]);
Exit;
end;
end;
procedure THotDirList.Clear;
var
i: Integer;
begin
for i := 0 to Count - 1 do
HotDir[i].Free;
inherited Clear;
end;
function THotDirList.Add(HotDir: THotDir): Integer;
begin
Result:= inherited Add(HotDir);
FlagModified:=TRUE;
end;
procedure THotDirList.DeleteHotDir(Index: Integer);
begin
HotDir[Index].Free;
Delete(Index);
FlagModified:=TRUE;
end;
procedure THotDirList.DeleteHotDirMenuDelimiters(Index:Integer);
var
EndIndex:longint;
begin
if isHotDirSubMenuStart(HotDir[Index].HotDirName) then
begin
EndIndex:=GetIndexSubMenuEnd(Index);
if (EndIndex<>-1) AND (EndIndex<>Index) then
begin
HotDir[EndIndex].Free;
Delete(EndIndex);
end;
HotDir[Index].Free;
Delete(Index);
FlagModified:=TRUE;
end;
end;
{
When loading the structure to a TStrings, let's do that:
-Initial submenu-like entry will have a "-" in front of the initial name.
-Following ones are indented by 2 spaces.
-Ending sub menu will show the "--" in the list.
This duplicates the TC way of showing things.
}
procedure THotDirList.LoadToStringList(StringList: TStrings);
var
I: Integer;
MaybeDirName,Prefix:string;
begin
StringList.Clear;
Prefix:='';
for I:= 0 to Count - 1 do
begin
MaybeDirName:=HotDir[I].HotDirName;
if not isHotDirSubMenuEnd(HotDir[I].HotDirName) then
begin
StringList.Add(Prefix+MaybeDirName); //Let's show the "-" infront of HotDir name like TC
if isHotDirSubMenuStart(HotDir[I].HotDirName) then Prefix:=Prefix+' ';
end
else
begin
if length(Prefix)>1 then Prefix:=leftstr(Prefix,length(Prefix)-4);
StringList.Add(Prefix+MaybeDirName); //Let's show the "--" like TC
end;
end;
//TODO: could check if "prefix" is empty at the end. If not, and "--" until the end is reached! Not only in TStrings but also in structure!
end;
const
cSection = 'DirectoryHotList';
procedure THotDirList.LoadFromIni(IniFile: TIniFileEx);
begin
Clear;
end;
procedure THotDirList.LoadFromXml(AConfig: TXmlConfig; ANode: TXmlNode);
var
Name, Path: String;
LocalHotDir: THotDir;
begin
Clear;
ANode := ANode.FindNode(cSection);
if Assigned(ANode) then
begin
ANode := ANode.FirstChild;
while Assigned(ANode) do
begin
if ANode.CompareName('HotDir') = 0 then
begin
if AConfig.TryGetAttr(ANode, 'Name', Name) and
AConfig.TryGetAttr(ANode, 'Path', Path) then
begin
LocalHotDir:=THotDir.Create;
LocalHotDir.HotDirName:=Name;
LocalHotDir.HotDirPath:=Path;
LocalHotDir.HotDirTarget:=AConfig.GetAttr(ANode, 'Target', '');
Add(LocalHotDir);
end
else
begin
DCDebug('Invalid entry in configuration: ' + AConfig.GetPathFromNode(ANode) + '.');
end;
end;
ANode := ANode.NextSibling;
end;
end;
end;
procedure THotDirList.SaveToIni(IniFile: TIniFileEx);
begin
IniFile.EraseSection(cSection);
end;
procedure THotDirList.SaveToXml(AConfig: TXmlConfig; ANode: TXmlNode);
var
I: Integer;
SubNode: TXmlNode;
begin
ANode := AConfig.FindNode(ANode, cSection, True);
AConfig.ClearNode(ANode);
for I:= 0 to Count - 1 do
begin
SubNode := AConfig.AddNode(ANode, 'HotDir');
AConfig.SetAttr(SubNode, 'Name', HotDir[I].HotDirName);
AConfig.SetAttr(SubNode, 'Path', HotDir[I].HotDirPath);
AConfig.SetAttr(SubNode, 'Target', HotDir[I].HotDirTarget);
end;
end;
procedure THotDirList.CreatePopUpHotDir(pmHotDir:TPopupMenu; Dispatcher:longint; ProcedureWhenHotDirItemClicked,ProcedureWhenHotDirAddOrConfigClicked:TProcedureWhenClickOnHotDirMenuItem; CurrentPath:string);
var
mi: TMenuItem;
I: Integer;
sName:string;
procedure CompleteMenu(ParamMenuItem:TMenuItem);
var
localmi:TMenuItem;
localsName:string;
begin
while I<Count do
begin
localsName:=HotDir[I].HotDirName;
inc(I);
if isHotDirSubMenuStart(localsName) then
begin
localmi:=TMenuItem.Create(ParamMenuItem);
localmi.Caption:=copy(localsName,2,length(localsName)-1);
ParamMenuItem.Add(localmi);
CompleteMenu(localmi);
end
else
begin
if isHotDirSubMenuEnd(localsName) then
begin
exit;
end
else
begin
localmi:=TMenuItem.Create(ParamMenuItem);
localmi.Caption:=localsName;
localmi.tag:=I-1;
localmi.OnClick:=ProcedureWhenHotDirItemClicked;
ParamMenuItem.Add(localmi);
end;
end;
end;
end;
begin
// Create All popup menu
pmHotDir.Items.Clear;
I:=0;
while I<Count do
begin
sName:=HotDir[I].HotDirName;
inc(I);
if isHotDirSubMenuStart(sName) then
begin
mi:= TMenuItem.Create(pmHotDir);
mi.Caption:=copy(sName,2,length(sName)-1);
pmHotDir.Items.Add(mi);
CompleteMenu(mi);
end
else
begin
if not isHotDirSubMenuEnd(sName) then
begin
mi:= TMenuItem.Create(pmHotDir);
mi.Caption:=sName;
mi.tag:= I-1;
mi.OnClick:=ProcedureWhenHotDirItemClicked;
pmHotDir.Items.Add(mi);
end;
end;
end;
case Dispatcher of
POPUPMENU_WITHADDANDCONFIG:
begin
// now add delimiter
mi:= TMenuItem.Create(pmHotDir);
mi.Caption:= '-';
pmHotDir.Items.Add(mi);
// now add the "add current path"
mi:= TMenuItem.Create(pmHotDir);
mi.Caption:= Format(rsMsgPopUpHotAdd,[CurrentPath]);
mi.Tag:=ACTION_ADDTOHOTLIST;
mi.OnClick:=ProcedureWhenHotDirAddOrConfigClicked;
pmHotDir.Items.Add(mi);
// now add configure item
mi:= TMenuItem.Create(pmHotDir);
mi.Caption:= rsMsgPopUpHotCnf;
mi.Tag:=ACTION_CONFIGTOHOTLIST;
mi.OnClick:= ProcedureWhenHotDirAddOrConfigClicked;
pmHotDir.Items.Add(mi);
end;
end;
end;
function isHotDirSubMenuStart(HotDirString:string):boolean;
begin
result:=FALSE;
if length(HotDirString)>1 then
begin
result:=((HotDirString[1]='-') AND (HotDirString[2]<>'-'));
end;
end;
function isHotDirSubMenuEnd(HotDirString:string):boolean;
begin
result:=FALSE;
if length(HotDirString)>1 then
begin
result:=(copy(HotDirString,1,2)='--');
end;
end;
function isHotDirSeparator(HotDirString:string):boolean;
begin
result:=(HotDirString='-');
end;
procedure CopyHotDirList(SourceHotDirList:THotDirList; var DestinationHotDirList:THotDirList);
var
LocalHotDir:THotDir;
Index:longint;
begin
for Index:=pred(DestinationHotDirList.Count) downto 0 do
begin
DestinationHotDirList.DeleteHotDir(Index);
end;
DestinationHotDirList.Clear;
for Index:=0 to pred(SourceHotDirList.Count) do
begin
LocalHotDir:=THotDir.Create;
LocalHotDir.HotDirName:=SourceHotDirList.HotDir[Index].HotDirName;
LocalHotDir.HotDirPath:=SourceHotDirList.HotDir[Index].HotDirPath;
LocalHotDir.HotDirTarget:=SourceHotDirList.HotDir[Index].HotDirTarget;
DestinationHotDirList.Add(LocalHotDir);
end;
end;
end.

5
src/umaincommands.pas
View file

@ -240,7 +240,8 @@ uses Forms, Controls, Dialogs, Clipbrd, strutils, LCLProc, HelpIntfs, StringHash
uTempFileSystemFileSource, uFileProperty, uFileSourceSetFilePropertyOperation,
uFileSorting, uShellContextMenu, uTrash, uFileSystemCopyOperation,
fViewOperations, uVfsModule, uMultiListFileSource, uExceptions,
DCOSUtils, DCStrUtils, DCBasicTypes, uFileSourceCopyOperation, fSyncDirsDlg
DCOSUtils, DCStrUtils, DCBasicTypes, uFileSourceCopyOperation, fSyncDirsDlg,
uhotdir
{$IFDEF COLUMNSFILEVIEW_VTV}
, uColumnsFileViewVtv
{$ENDIF}
@ -2126,7 +2127,7 @@ procedure TMainCommands.cm_DirHotList(const Params: array of string);
var
p:TPoint;
begin
frmMain.CreatePopUpHotDir;// TODO: i thing in future this must call on create or change
gHotDirList.CreatePopUpHotDir(frmMain.pmHotList,POPUPMENU_WITHADDANDCONFIG,@frmMain.HotDirSelected,@frmMain.miHotAddOrConfigClick,frmMain.ActiveFrame.CurrentPath); // TODO: i thing in future this must call on create or change
p:=frmMain.ActiveFrame.ClientToScreen(Classes.Point(0,0));
frmMain.pmHotList.Popup(p.X,p.Y);
end;