New list path management

Forms/Forms.About.pas

@@ -76,7 +76,7 @@ procedure TfrmAbout.imgDonateClick(Sender: TObject);
 
 procedure TfrmAbout.imgLicenseClick(Sender: TObject);
 begin
-   OpenDocument(AppendPathDelim(ASuiteInstance.Paths.SuitePathWorking) + 'docs' + PathDelim +  'license.txt');
+   OpenDocument(AppendPathDelim(ASuiteInstance.Paths.SuitePathDocs) + 'license.txt');
 end;
 
 procedure TfrmAbout.lnklblWebSiteClick(Sender: TObject);

Forms/Forms.ImportList.pas

@@ -29,6 +29,9 @@ interface
   Kernel.Enumerations, EditBtn;
 
 type
+
+  { TfrmImportList }
+
   TfrmImportList = class(TForm)
     bvl1: TBevel;
     bvl2: TBevel;
@@ -64,6 +67,10 @@   TfrmImportList = class(TForm)
     procedure CheckAllItems(State: TCheckState);
     procedure PopulateTree(Tree: TVirtualStringTree; FilePath: String);
     function  TreeImpToTree(TreeImp, Tree: TVirtualStringTree): Boolean;
+    procedure MassRelativeToAbsolutePath(Sender: TBaseVirtualTree;
+      Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
+    procedure MassAbsoluteToRelativePath(Sender: TBaseVirtualTree;
+      Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
   public
     { Public declarations }
     class procedure Execute(AOwner: TComponent);
@@ -77,10 +84,10 @@ implementation
 {$R *.lfm}
 
 uses
-  AppConfig.Main, VirtualTree.Methods,
+  AppConfig.Main, VirtualTree.Methods, NodeDataTypes.Files,
   Utility.FileFolder, Utility.XML, Database.Manager, NodeDataTypes.Base,
   Kernel.Logger, Kernel.ResourceStrings, Utility.Misc, Kernel.Instance,
-  mormot.core.log;
+  mormot.core.log, AppConfig.Paths;
 
 procedure TfrmImportList.btnBackClick(Sender: TObject);
 begin
@@ -118,16 +125,27 @@ procedure TfrmImportList.FormCreate(Sender: TObject);
 end;
 
 procedure TfrmImportList.FormClose(Sender: TObject; var Action: TCloseAction);
+var
+  ImportPaths: TConfigPaths;
 begin
   Config.ASuiteState := lsNormal;
   if (ModalResult = mrOk) and (vstListImp.HasChildren[vstListImp.RootNode]) then
   begin
     try
+
+      ImportPaths := TConfigPaths.Create(edtPathList.Text);
+      try
+        vstListImp.IterateSubtree(nil, MassAbsoluteToRelativePath, @ImportPaths, [], True);
+      finally
+        ImportPaths.Free;
+      end;
+
       if TreeImpToTree(vstListImp, ASuiteInstance.MainTree) then
       begin
         ShowMessageFmtEx(msgItemsImported, [GetNumberNodeImp(vstListImp)]);
         TASuiteLogger.Info(msgItemsImported, [GetNumberNodeImp(vstListImp)]);
       end;
+
       TVirtualTreeMethods.GetAllIcons(ASuiteInstance.MainTree, nil);
     except
       on E : Exception do
@@ -169,13 +187,24 @@ class procedure TfrmImportList.Execute(AOwner: TComponent);
 end;
 
 procedure TfrmImportList.tsListShow(Sender: TObject);
+var
+  AsuiteSqlPath: String;
+  ImportPaths: TConfigPaths;
 begin
   lblTitle.Caption := msgImportTitle3;
   btnNext.Caption  := msgImport;
   btnNext.Enabled  := vstListImp.CheckedCount > 0;
+  AsuiteSqlPath    := edtPathList.Text;
   //Import list in temporary vst
   try
-    PopulateTree(vstListImp, edtPathList.Text);
+    PopulateTree(vstListImp, AsuiteSqlPath);
+
+    ImportPaths := TConfigPaths.Create(AsuiteSqlPath);
+    try
+      vstListImp.IterateSubtree(nil, MassRelativeToAbsolutePath, @ImportPaths, [], True);
+    finally
+      ImportPaths.Free;
+    end;
   finally
     TVirtualTreeMethods.GetAllIcons(vstListImp, nil);
   end;
@@ -307,4 +336,42 @@ function TfrmImportList.TreeImpToTree(TreeImp,
   Tree.EndUpdate;
 end;
 
+procedure TfrmImportList.MassRelativeToAbsolutePath(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
+var
+  ImportPath: TConfigPaths;
+  NodeData: TvBaseNodeData;
+begin
+  ImportPath := TConfigPaths(Data^);
+  NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
+  if not(NodeData.IsSeparatorItem) then
+  begin
+    TvFileNodeData(NodeData).PathIcon := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).PathIcon);
+    if NodeData.IsFileItem then
+    begin
+      TvFileNodeData(NodeData).PathFile := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).PathFile);
+      TvFileNodeData(NodeData).WorkingDir := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).WorkingDir);
+    end;
+  end;
+end;
+
+procedure TfrmImportList.MassAbsoluteToRelativePath(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
+var
+  ImportPath: TConfigPaths;
+  NodeData: TvBaseNodeData;
+begin
+  ImportPath := TConfigPaths(Data^);
+  NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
+  if not(NodeData.IsSeparatorItem) then
+  begin
+    TvFileNodeData(NodeData).PathIcon := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).PathIcon);
+    if NodeData.IsFileItem then
+    begin
+      TvFileNodeData(NodeData).PathFile := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).PathFile);
+      TvFileNodeData(NodeData).WorkingDir := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).WorkingDir);
+    end;
+  end;
+end;
+
 end.

Frame/Frame.Properties.General.Software.pas

@@ -106,7 +106,7 @@ function TfrmSWGeneralPropertyPage.InternalLoadData: Boolean;
   //lbInfo2.Caption := Format(lbInfo2.Caption, [ASuiteInstance.Paths.SuitePathWorking, ASuiteInstance.Paths.SuiteDrive]);
 
   //Strange bug. %asuite% and %drive% causing error "Invalid argument index in format...", so I'm using a workaround
-  lbInfo2.Caption := StringReplace(lbInfo2.Caption, '%s', ASuiteInstance.Paths.SuitePathWorking, [rfIgnoreCase]);
+  lbInfo2.Caption := StringReplace(lbInfo2.Caption, '%s', ASuiteInstance.Paths.SuitePathASuiteFolder, [rfIgnoreCase]);
   lbInfo2.Caption := StringReplace(lbInfo2.Caption, '%s', ASuiteInstance.Paths.SuiteDrive, [rfIgnoreCase]);
 
   if Assigned(CurrentNodeData) then

Library/AppConfig.Paths.pas

@@ -33,25 +33,26 @@ interface
   TConfigPaths = class
   private
     FSuitePathCurrentTheme: String;
-    FSuitePathList       : String;
-    FSuiteDrive          : String;
-    FSuitePathData       : String;
-    FSuitePathSettings: String;
-    FSuitePathWorking    : String;
+    FSuitePathASuiteFolder: String;
+    FSuitePathList     : String;
+    FSuiteDrive        : String;
+    FSuitePathData     : String;
+    FSuitePathSettings : String;
 
     FEnvironmentVars : TPathList;
     FASuiteVars      : TPathList;
 
     function DeQuotedStr(AVar: AnsiString): AnsiString;
     function GetSuitePathBackup: String;
     function GetSuitePathCache: String;
+    function GetSuitePathDocs: String;
     function GetSuitePathLocale: String;
     function GetSuitePathMenuThemes: String;
     procedure SetSuitePathCurrentTheme(AValue: String);
     procedure UpdateEnvironmentVars;
     procedure UpdateASuiteVars;
   public
-    constructor Create;
+    constructor Create(APathExecutable: string);
     destructor Destroy; override;
 
     function AbsoluteToRelative(const APath: String): string;
@@ -63,15 +64,16 @@   TConfigPaths = class
     procedure RemoveCacheFolders;
     procedure UpdatePathVariables;
 
-    property SuitePathList: String read FSuitePathList write FSuitePathList;     
-    property SuitePathSettings: String read FSuitePathSettings write FSuitePathSettings;
-    property SuiteDrive: String read FSuiteDrive write FSuiteDrive;
-    property SuitePathData: String read FSuitePathData write FSuitePathData;
-    property SuitePathWorking: String read FSuitePathWorking write FSuitePathWorking;
+    property SuitePathList: String read FSuitePathList write FSuitePathList;     //Path to list
+    property SuitePathSettings: String read FSuitePathSettings; //Path to settings
+    property SuiteDrive: String read FSuiteDrive;
+    property SuitePathData: String read FSuitePathData; //Path to folder data
+    property SuitePathASuiteFolder: String read FSuitePathASuiteFolder; //Path to asuite.exe
     property SuitePathLocale: String read GetSuitePathLocale;
     property SuitePathCache: String read GetSuitePathCache;
     property SuitePathBackup: String read GetSuitePathBackup;
     property SuitePathMenuThemes: String read GetSuitePathMenuThemes;
+    property SuitePathDocs: String read GetSuitePathDocs;
     property SuitePathCurrentTheme: String read FSuitePathCurrentTheme write SetSuitePathCurrentTheme;
 
     property EnvironmentVars: TPathList read FEnvironmentVars;
@@ -164,14 +166,19 @@ function TConfigPaths.GetSuitePathCache: String;
   Result := AppendPathDelim(FSuitePathData + CACHE_DIR);
 end;
 
+function TConfigPaths.GetSuitePathDocs: String;
+begin
+  Result := AppendPathDelim(FSuitePathASuiteFolder + DOCS_DIR);
+end;
+
 function TConfigPaths.GetSuitePathLocale: String;
 begin
-  Result := AppendPathDelim(FSuitePathWorking + LOCALE_DIR);
+  Result := AppendPathDelim(FSuitePathASuiteFolder + LOCALE_DIR);
 end;
 
 function TConfigPaths.GetSuitePathMenuThemes: String;
 begin
-  Result := AppendPathDelim(FSuitePathWorking + MENUTHEMES_DIR);
+  Result := AppendPathDelim(FSuitePathASuiteFolder + MENUTHEMES_DIR);
 end;
 
 procedure TConfigPaths.UpdateASuiteVars;
@@ -183,7 +190,7 @@ procedure TConfigPaths.UpdateASuiteVars;
   strFolderIcon := AppendPathDelim(FSuitePathCurrentTheme + ICONS_DIR);
 
   //CONST_PATH_ASuite = Launcher's path
-  FASuiteVars.Add(DeQuotedStr(CONST_PATH_ASUITE), ExcludeTrailingPathDelimiter(SuitePathWorking));
+  FASuiteVars.Add(DeQuotedStr(CONST_PATH_ASUITE), ExcludeTrailingPathDelimiter(FSuitePathASuiteFolder));
 
   //CONST_PATH_DRIVE = Launcher's Drive (ex. ASuite in H:\Software\ASuite.exe, CONST_PATH_DRIVE is H: )
   FASuiteVars.Add(DeQuotedStr(CONST_PATH_DRIVE), SUITEDRIVE);
@@ -195,44 +202,39 @@ procedure TConfigPaths.UpdateASuiteVars;
   FASuiteVars.Add(DeQuotedStr(CONST_PATH_URLICON), strFolderIcon + FILEICON_Url + EXT_ICO);
 end;
 
-constructor TConfigPaths.Create;
+constructor TConfigPaths.Create(APathExecutable: string);
 var
   strPathExe, strFileListSql, strFileListXml: String;
 begin
   //Default paths
-  strPathExe := Application.ExeName;
-  FSuitePathWorking  := ExtractFilePath(strPathExe);
+  strPathExe := APathExecutable;
+  FSuitePathASuiteFolder  := ExtractFilePath(strPathExe);
 
-  strFileListSql := ExtractFileNameOnly(strPathExe) + EXT_SQL;
-  strFileListXml := ExtractFileNameOnly(strPathExe) + EXT_XML;
+  strFileListSql := ExtractFileNameOnly(Application.ExeName) + EXT_SQL;
+  strFileListXml := ExtractFileNameOnly(Application.ExeName) + EXT_XML;
 
   {$IFDEF MSWINDOWS}
   FSuiteDrive        := LowerCase(ExtractFileDrive(strPathExe));
   {$ELSE}
   //In Linux, use the folder path of asuite
-  FSuiteDrive        := FSuitePathWorking;
+  FSuiteDrive        := FSuitePathASuiteFolder;
   {$ENDIF}
-  SetCurrentDir(FSuitePathWorking);
+  SetCurrentDir(FSuitePathASuiteFolder);
 
   //If ASuite is started from a hard linked folder, it will be falsely unwritable
   //The user is unlikely to create a hard link for ASuite unless they use Scoop
   //In this case, however, the .sqlite files will already exist and you can
   //safely use them
-  if (IsDirectoryWritable(FSuitePathWorking)) or FileExists(FSuitePathWorking + strFileListXml) or
-     FileExists(FSuitePathWorking + strFileListSql) then
-    FSuitePathData := FSuitePathWorking
+  if (IsDirectoryWritable(FSuitePathASuiteFolder)) or FileExists(FSuitePathASuiteFolder + strFileListXml) or
+     FileExists(FSuitePathASuiteFolder + strFileListSql) then
+    FSuitePathData := FSuitePathASuiteFolder
   else begin
-    //FSuitePathWorking = ASuite.exe folder (ex C:\path\to\asuite_folder\)
-    //FSuitePathData    = ASuite config folder (ex. C:\Users\user\AppData\Roaming\asuite\)
+    //FSuitePathASuiteFolder  = ASuite.exe folder (ex C:\path\to\asuite_folder\)
+    //FSuitePathData = ASuite config folder (ex. C:\Users\user\AppData\Roaming\asuite\)
     FSuitePathData := GetAppConfigDir(True);
     SysUtils.ForceDirectories(FSuitePathData);
   end;
 
-  //Check if xml list exists, else get sqlite list
-  FSuitePathList := FSuitePathData + strFileListXml;
-  if not FileExists(FSuitePathList) then
-    FSuitePathList := FSuitePathData + strFileListSql;
-
   FSuitePathSettings := FSuitePathData + SETTINGS_FILENAME;
 
   //Path variables
@@ -285,7 +287,7 @@ function TConfigPaths.RelativeToAbsolute(const APath: String;
     //Note: Unfortunately old asuite vars is not quoted, but in format $var.
     //      So these two vars are deprecated. This code remain for only backwards compatibility
     //CONST_PATH_ASuite_old = Launcher's path
-    Result := StringReplace(Result, CONST_PATH_ASuite_old, SuitePathWorking, [rfIgnoreCase,rfReplaceAll]);
+    Result := StringReplace(Result, CONST_PATH_ASuite_old, ExcludeTrailingPathDelimiter(FSuitePathASuiteFolder), [rfIgnoreCase,rfReplaceAll]);
     //CONST_PATH_DRIVE_old = Launcher's Drive (ex. ASuite in H:\Software\ASuite.exe, CONST_PATH_DRIVE is H: )
     Result := StringReplace(Result, CONST_PATH_DRIVE_old, SUITEDRIVE, [rfIgnoreCase,rfReplaceAll]);
 

Library/Icons.Base.pas

@@ -279,11 +279,11 @@ procedure TBaseIcon.ResetCacheIcon;
   strPathCacheIcon: String;
 begin
   strPathCacheIcon := PathCacheIcon;
-  TASuiteLogger.Debug('Reset cache icon %s', [PathCacheIcon]);
+  TASuiteLogger.Debug('Reset cache icon %s', [strPathCacheIcon]);
 
   //Small icon cache
-  if FileExists(PathCacheIcon) then
-    SysUtils.DeleteFile(PathCacheIcon);
+  if FileExists(strPathCacheIcon) then
+    SysUtils.DeleteFile(strPathCacheIcon);
 
   FCacheIconCRC := 0;
 end;

Library/Icons.Thread.pas

@@ -42,7 +42,7 @@ implementation
 
 uses
   VirtualTree.Methods, NodeDataTypes.Base, AppConfig.Main, Kernel.Enumerations,
-  Kernel.Logger, mormot.core.log;
+  Kernel.Logger, mormot.core.log, Kernel.Instance;
 
 { TTreeIconsThread }
 
@@ -70,7 +70,7 @@ procedure TTreeIconsThread.GetImageIndex(Sender: TBaseVirtualTree;
 var
   NodeData: TvBaseNodeData;
 begin
-  if Config.ASuiteState = lsNormal then
+  if (Config.ASuiteState = lsNormal) or ((Config.ASuiteState = lsImporting) and (Sender = ASuiteInstance.ImportTree)) then
   begin
     NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
     if Assigned(NodeData) then

Library/Kernel.Consts.pas

@@ -39,6 +39,7 @@ interface
   MENUTHEMES_DIR = 'themes';
   ICONS_DIR      = 'icons';
   BUTTONS_DIR    = 'buttons';
+  DOCS_DIR       = 'docs';
 
   //FileSystem
   DriveLetters      = ['a'..'z', 'A'..'Z'];

Library/Kernel.Instance.pas

@@ -71,7 +71,7 @@   TASuiteInstance = class
 implementation
 
 uses
-  Forms.ImportList, Kernel.Logger, Forms, Kernel.Consts, Utility.FileFolder,
+  Forms.ImportList, Kernel.Logger, Forms, Kernel.Consts, Utility.FileFolder, LazFileUtils,
   Utility.Misc, Utility.XML, VirtualTree.Methods, mormot.core.log, Kernel.Manager,
   mormot.core.base, VirtualTrees.Types;
 
@@ -105,16 +105,31 @@ function TASuiteInstance.GetSmallHeightNode: Integer;
 constructor TASuiteInstance.Create;
 var
   I: Integer;
+  strFileListSql, strFileListXml: String;
 begin
   FScheduler := TScheduler.Create;
   FVSTEvents := TVirtualTreeEvents.Create;
 
+  //Create some classes
+  FPaths  := TConfigPaths.Create(Application.ExeName);
+
   //Params
   for I := 1 to ParamCount do
     HandleParam(ParamStr(I));
 
-  //Create some classes
-  FPaths  := TConfigPaths.Create;
+  strFileListSql := ExtractFileNameOnly(Application.ExeName) + EXT_SQL;
+  strFileListXml := ExtractFileNameOnly(Application.ExeName) + EXT_XML;
+
+  // Check if FSuitePathList is a empty string
+  if (FPaths.SuitePathList = '') then
+  begin
+    //Check if xml list exists, else get sqlite list
+    FPaths.SuitePathList := FPaths.SuitePathData + strFileListXml;
+    if not FileExists(FPaths.SuitePathList) then
+      FPaths.SuitePathList := FPaths.SuitePathData + strFileListSql;
+  end
+  else
+    FPaths.SuitePathList := FPaths.RelativeToAbsolute(FPaths.SuitePathList);
 
   //Setup logger
   with TSynLog.Family do
@@ -166,7 +181,7 @@ procedure TASuiteInstance.HandleParam(const Param: string;
   if sName <> '' then
   begin
     if (CompareText(sName, 'list') = 0) and (FirstInstance) then
-      FPaths.SuitePathList := FPaths.RelativeToAbsolute(RemoveAllQuotes(sValue));
+      FPaths.SuitePathList := RemoveAllQuotes(sValue);
 
     //Add new node
     if (CompareText(sName, 'additem') = 0) and (Assigned(ASuiteManager.DBManager)) then