{ ******************************************************************************** SPackGui Copyright (C) 2012-2013 Geoffray Levasseur . Copyright (C) http://www.geoffray-levasseur.org/ http://0.tuxfamilly.org/ This software is governed by the CeCILL license under French law and abiding by the rules of distribution of free software. You can use, modify and/ or redistribute the software under the terms of the CeCILL license as circulated by CEA, CNRS and INRIA at the following URL "http://www.cecill.info". As a counterpart to the access to the source code and rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors have only limited liability. In this respect, the user's attention is drawn to the risks associated with loading, using, modifying and/or developing or reproducing the software by the user in light of its specific status of free software, that may mean that it is complicated to manipulate, and that also therefore means that it is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the software's suitability as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions as regards security. The fact that you are presently reading this means that you have had knowledge of the CeCILL license and that you accept its terms. ******************************************************************************** Description: main window and program functionnalities ******************************************************************************** } unit frmMain; {$include ../common/defines.inc} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons, Menus, ExtCtrls, CheckLst, ComCtrls, ActnList, uPackageManager, frmProgress, StdCtrls; type { TfMain } TfMain = class(TForm) acActionList: TActionList; acFileOpen: TAction; acFileSave: TAction; acFileSaveAll: TAction; acFileShowLog: TAction; acFileExit: TAction; acEditCancel: TAction; acEditApply: TAction; acEditSearch: TAction; acEditShowHistory: TAction; acEditReload: TAction; acPackageReinit: TAction; acPackageInstall: TAction; acPackageUpdate: TAction; acPackageRemove: TAction; acPackageChooseVersion: TAction; acPackageProperties: TAction; acConfigEnvironment: TAction; acConfigDisplay: TAction; acConfigRepositories: TAction; acHelpManual: TAction; acHelpBugReport: TAction; acHelpAbout: TAction; acDebugCreateException: TAction; acDebugLogHeapStatus: TAction; acToolsCheckDeps: TAction; acToolsCheckConfFiles: TAction; clbStates: TCheckListBox; lvPackageList: TListView; mnuLogDatabase: TMenuItem; mnuDebugLogHeapStatus: TMenuItem; mnuDebugCreateException: TMenuItem; mnuDebug: TMenuItem; mnuPackageListBar1: TMenuItem; mnuPackageListProperties: TMenuItem; mnuPackageListChooseVersion: TMenuItem; mnuPackageListBar2: TMenuItem; mnuPackageListRemove: TMenuItem; mnuPackageListReinit: TMenuItem; mnuPackageListInstall: TMenuItem; mnuPackageListUpdate: TMenuItem; mnuTools: TMenuItem; mnuToolsCheckConfFiles: TMenuItem; mnuToolsCheckDependencies: TMenuItem; mmMenu: TMainMenu; mnuFile: TMenuItem; mnuFileOpen: TMenuItem; mnuFileSave: TMenuItem; mnuFileSep2: TMenuItem; mnuFileShowLog: TMenuItem; mnuFileSaveAll: TMenuItem; mnuFileSep1: TMenuItem; mnuFileExit: TMenuItem; mnuEdit: TMenuItem; mnuEditCancel: TMenuItem; mnuEditSep1: TMenuItem; mnuEditSearch: TMenuItem; mnuEditShowHistory: TMenuItem; mnuEditSep2: TMenuItem; mnuEditReload: TMenuItem; mnuEditApply: TMenuItem; mnuPackage: TMenuItem; mnuPackageReinit: TMenuItem; mnuPackageInstall: TMenuItem; mnuPackageUpdate: TMenuItem; mnuPackageRemove: TMenuItem; mnuPackageChooseVersion: TMenuItem; mnuPackageSep1: TMenuItem; mnuPackageSep2: TMenuItem; mnuPackageProperties: TMenuItem; mnuConfig: TMenuItem; mnuConfigEnvironment: TMenuItem; mnuConfigRepositories: TMenuItem; mnuConfigDisplay: TMenuItem; mnuHelp: TMenuItem; mnuHelpManual: TMenuItem; mnuHelpSep1: TMenuItem; mnuHelpBugReport: TMenuItem; mnuHelpSep2: TMenuItem; mnuHelpAbout: TMenuItem; pnLeft: TPanel; pmPackageList: TPopupMenu; spVertPanel: TSplitter; spHorizPanel: TSplitter; sbStatusBar: TStatusBar; tvPackageTree: TTreeView; PackageList: TPackageList; procedure acConfigDisplayExecute(Sender: TObject); procedure acConfigEnvironmentExecute(Sender: TObject); procedure acConfigRepositoriesExecute(Sender: TObject); procedure acDebugCreateExceptionExecute(Sender: TObject); procedure acDebugLogHeapStatusExecute(Sender: TObject); procedure acEditReloadExecute(Sender: TObject); procedure acEditSearchExecute(Sender: TObject); procedure acFileExitExecute(Sender: TObject); procedure acFileShowLogExecute(Sender: TObject); procedure acHelpAboutExecute(Sender: TObject); procedure acPackagePropertiesExecute(Sender: TObject); procedure clbStatesClickCheck(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure lvPackageListColumnClick(Sender: TObject; Column: TListColumn); procedure lvPackageListCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvPackageListCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); procedure mnuLogDatabaseClick(Sender: TObject); procedure tvPackageTreeClick(Sender: TObject); private { private declarations } FLastSortedColumn: Integer; FAscending: Boolean; FRootNode: TTreeNode; FUncategorised: TTreeNode; FSelectedCat: string; procedure AssignIcons; procedure SaveExtraParams; procedure LoadExtraParams; procedure InitRepo; procedure LoadPackages(const AUpdate: Boolean); procedure CreateBaseNodes; procedure AddCategory(const Cat: string; var AParent: TTreeNode); public fProgress: TfProgress; function CompareSize(const S1, S2: string): Integer; { public declarations } end; var fMain: TfMain; implementation uses frmLogFile, LCLType, frmAbout, uIconManager, uDebug, uCommon, uUtils, frmEnvironementSettings, frmRepoSettings, uStrings, uSpackPackage, frmPackageProperty, frmSearch, frmDisplaySettings, uListViewColors; {$R *.lfm} procedure DoProgress(const Min, Max, Pos: LongInt; const Msg: string); begin if Assigned(fMain.fProgress) then begin fMain.fProgress.ProgressBar2.Position := Pos; //if Msg <> '' then // fMain.fProgress.lbProgressionMessage.Caption := Msg; //that is slow end; Application.ProcessMessages; end; { TfMain } procedure TfMain.AssignIcons; begin acFileOpen.ImageIndex := icOpen; acFileSave.ImageIndex := icSave; acFileSaveAll.ImageIndex := icSaveAll; acEditApply.ImageIndex := icApply; acEditCancel.ImageIndex := icUndo; acEditSearch.ImageIndex := icSearch; acEditReload.ImageIndex := icRefresh; acFileExit.ImageIndex := icExit; acPackageProperties.ImageIndex := icProperties; acConfigEnvironment.ImageIndex := icSettings; acConfigDisplay.ImageIndex := icDisplay; acConfigRepositories.ImageIndex := icRepository; acHelpAbout.ImageIndex := icAbout; acHelpBugReport.ImageIndex := icReportBug; acHelpManual.ImageIndex := icManual; end; procedure TfMain.SaveExtraParams; var I: Integer; begin for I := 0 to lvPackageList.ColumnCount - 1 do iniMain.WriteInteger(Self.Name, rsConfNameListViewColumn + IntToStr(I), lvPackageList.Column[I].Width); iniMain.WriteInteger(Self.Name, rsConfNameHorizPanelLeft, pnLeft.Width); iniMain.WriteInteger(Self.Name, rsConfNameVertPanelTop, clbStates.Height); iniMain.WriteInteger(Self.Name, rsConfNameSortColumn, FLastSortedColumn); iniMain.WriteBool(Self.Name, rsConfNameSortAscending, FAscending); end; procedure TfMain.LoadExtraParams; var I: Integer; begin for I := 0 to lvPackageList.ColumnCount - 1 do lvPackageList.Column[I].Width := iniMain.ReadInteger(Self.Name, rsConfNameListViewColumn + IntToStr(I), lvPackageList.Column[I].Width); pnLeft.Width := iniMain.ReadInteger(Self.Name, rsConfNameHorizPanelLeft, pnLeft.Width); clbStates.Height := iniMain.ReadInteger(Self.Name, rsConfNameVertPanelTop, clbStates.Height); FLastSortedColumn := iniMain.ReadInteger(Self.Name, rsConfNameSortColumn, 0); FAscending := iniMain.ReadBool(Self.Name, rsConfNameSortAscending, True); end; procedure TfMain.LoadPackages(const AUpdate: Boolean); var I, J, N, D: Integer; LI: TListItem; begin //cleanning if lvPackageList.Items.Count > 0 then lvPackageList.Clear; //activating this is not allowing to sort anymore //lvPackageList.OwnerData := not bNoColors; if PackageList.InstPackageLoaded then begin Cursor := crHourGlass; lvPackageList.BeginUpdate; for I := 0 to PackageList.Count - 1 do begin if not AUpdate then DoProgress(0, PackageList.Count - 1, I, rsProgressTidyPackageList); // always add category try if (PackageList.Packages[I].Cat <> '') and (not AUpdate) then AddCategory(PackageList.Packages[I].Cat, FRootNode); except ShowMessage('Error adding ' + PackageList.Packages[I].Cat + ' category.'); end; // skip if not in selected cat if ((FSelectedCat <> '/') and (Pos(FSelectedCat, PackageList.Packages[I].Cat) <> 1)) or ((PackageList.Packages[I].Cat = '') and (FSelectedCat <> '')) then Continue; // skip if not in the right state if ((psInstalled in PackageList.Packages[I].State) and (not clbStates.Checked[0])) or ((not (psInstalled in PackageList.Packages[I].State)) and (not clbStates.Checked[1])) or ((psUpdatable in PackageList.Packages[I].State) and (not clbStates.Checked[2])) then Continue; LI := lvPackageList.Items.Add; if PackageList.Packages[I].Name = '' then raise Exception.Create(rsExceptUnnamedPackage); LI.Data := PackageList.Packages[I]; LI.Caption := PackageList.Packages[I].Name; for J := 0 to 4 do LI.SubItems.Add(''); N := PackageList.Packages[I].GetInstalled; D := PackageList.Packages[I].GetDefaultVer; if D = 0 then D := PackageList.Packages[I].GetLatest; if N <> 0 then begin LI.SubItems[0] := PackageList.Packages[I].Alternatives[N].Version + '-' + IntToStr(PackageList.Packages[I].Alternatives[N].Build); if PackageList.Packages[I].Alternatives[N].Size <> 0 then LI.SubItems[2] := DispSize(PackageList.Packages[I].Alternatives[N].Size); LI.SubItems[3] := DispSize(PackageList.Packages[I].InstSize); LI.SubItems[4] := PackageList.Packages[I].Desc; end else begin LI.SubItems[0] := ''; LI.SubItems[2] := ''; LI.SubItems[4] := rsDescNotInstalledPackage; end; if D <> 0 then begin LI.SubItems[1] := PackageList.Packages[I].Alternatives[D].Version + '-' + IntToStr(PackageList.Packages[I].Alternatives[D].Build); if PackageList.Packages[I].Alternatives[D].Size <> 0 then LI.SubItems[2] := DispSize(PackageList.Packages[I].Alternatives[D].Size); end else begin LI.SubItems[1] := ''; LI.SubItems[3] := ''; end; end; Cursor := crArrow; lvPackageList.ScrollBy(0, 0); lvPackageList.EndUpdate; end else begin PrintLnDbg(Format(rsErrorNoPackage, [PackageList.InstPackageDir]), vlLow); MessageDlg(rsNoPackageFound, mtError, [MBOK], 0); end; end; procedure TfMain.InitRepo; var I: Integer; begin LoadRepoSettings; for I := 0 to slRepoList.Count - 1 do begin if (Pos(sHttpPrefix, slRepoList[I]) > 0) or (Pos(sFtpPrefix, slRepoList[I]) > 0) then begin PrintLnDbg(Format(rsInfoAddingDistantRepo, [slRepoList[I]]), vlLow); PackageList.DistantRepoList.Add(slRepoList[I]) end else begin PrintLnDbg(Format(rsInfoAddingLocalRepo, [slRepoList[I]]), vlLow); PackageList.LocalRepoList.Add(slRepoList[I]); end; //does the following really make sense? //clbStates.AddItem(Copy(slRepoList[I], 1, // Pos('=', slRepoList[I]) - 1), nil); end; end; procedure TfMain.CreateBaseNodes; begin FRootNode := tvPackageTree.Items.AddFirst(nil, rsAllPackages); FRootNode.Focused := True; FUncategorised := tvPackageTree.Items.AddChild(FRootNode, rsUncategorized); FUncategorised.MakeVisible; FRootNode.Expanded := True; FSelectedCat := '/'; end; procedure TfMain.AddCategory(const Cat: string; var AParent: TTreeNode); var Node: TTreeNode; S1, S2: string; I: Integer; begin if AParent = nil then AParent := FRootNode; if Pos('/', Cat) > 1 then begin S1 := Copy(Cat, 1, Pos('/', Cat) - 1); S2 := Copy(Cat, Pos('/', Cat) + 1, Length(Cat) - Pos('/', Cat)); end else begin S1 := Cat; S2 := ''; end; Node := nil; for I := 0 to AParent.Count - 1 do if AParent.Items[I].Text = S1 then Node := AParent.Items[I]; if Node = nil then begin PrintLnDbg(Format(rsDebugNodeAdded, [S1, AParent.Text])); Node := tvPackageTree.Items.AddChild(AParent, S1); Node.MakeVisible; Node.Parent.Expanded := True; end; if S2 <> '' then AddCategory(S2, Node); // recursive... Node.AlphaSort; end; procedure TfMain.FormCreate(Sender: TObject); var I: Integer; begin {$IFDEF DEBUG} mnuDebug.Visible := True; {$ELSE} mnuDebug.Visible := False; {$ENDIF} FLastSortedColumn := -1; FAscending := True; PackageList := TPackageList.Create; mmMenu.Images := ilDefault; pmPackageList.Images := ilDefault; acActionList.Images := ilDefault; LoadWindowGeometry(Self); AssignIcons; InitBtnGlyphs(Self); LoadColors; LoadExtraParams; InitRepo; CreateBaseNodes; for I := 0 to clbStates.Count - 1 do clbStates.Checked[I] := True; lvPackageList.GridLines := bShowGrig; end; procedure TfMain.FormShow(Sender: TObject); begin acEditReloadExecute(nil); //lvPackageListColumnClick(lvPackageList, // lvPackageList.Column[FLastSortedColumn]); tvPackageTree.ScrollBy(0, 0); tvPackageTree.Selected := FRootNode; lvPackageList.SortColumn := FLastSortedColumn; lvPackageList.SortType := stData; end; function TfMain.CompareSize(const S1, S2: string): Integer; var N1, N2: LongInt; begin //that solution looks weird but is quite faster that looking into database N1 := SizeStrToInt(S1); N2 := SizeStrToInt(S2); Result := 0; if N1 > N2 then Result := 1 else if N1 < N2 then Result := -1; end; procedure TfMain.lvPackageListColumnClick(Sender: TObject; Column: TListColumn); begin TListView(Sender).SortType := stNone; if Column.Index = FLastSortedColumn then FAscending := not FAscending else begin FLastSortedColumn := Column.Index; FAscending := True; end; lvPackageList.SortColumn := Column.Index; TListView(Sender).SortType := stData; end; procedure TfMain.lvPackageListCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); begin case FLastSortedColumn of 0: Compare := AnsiCompareText(Item1.Caption, Item2.Caption); //pkgname 1: Compare := CompareVersion(Item1.SubItems[0], Item2.SubItems[0]); //installed version 2: Compare := CompareVersion(Item1.SubItems[1], Item2.SubItems[1]); //last version 3: Compare := CompareSize(Item1.SubItems[2], Item2.SubItems[2]); //pkgsize 4: Compare := CompareSize(Item1.SubItems[3], Item2.SubItems[3]); //installed size 5: Compare := AnsiCompareText(Item1.SubItems[4], Item2.SubItems[4]); //description end; if not FAscending then Compare := -Compare; end; procedure TfMain.lvPackageListCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var FontCol, BGCol: TColor; begin if bNoColors then begin inherited; Exit; end; GetColorFromState(TSPackPackage(Item.Data).State, FontCol, BGCol); Sender.Brush.Color := BGCol; Sender.Canvas.Font.Color := FontCol; Sender.Canvas.Refresh; inherited; end; procedure TfMain.mnuLogDatabaseClick(Sender: TObject); var SL: TStringList; I, J, N, P, L: Integer; S: string; begin SL := TStringList.Create; SL.Add(rsInfoStartLoggingDb); for I := 0 to PackageList.Count - 1 do begin SL.Add(Format(rsLogNewPackage, [PackageList.Packages[I].Cat, PackageList.Packages[I].Name])); SL.Add(Format(rsLogDescription, [PackageList.Packages[I].Desc])); N := PackageList.Packages[I].GetInstalled; P := PackageList.Packages[I].GetDefaultVer; L := PackageList.Packages[I].GetLatest; for J := 1 to MaxPackAlt do if PackageList.Packages[I].Alternatives[J].Version <> '' then begin S := Format(rsLogPackageAlt, [J, PackageList.Packages[I].Alternatives[J].Version, PackageList.Packages[I].Alternatives[J].Build, DispSize(PackageList.Packages[I].Alternatives[J].Size), PackageList.Packages[I].Alternatives[J].SourceAddress]); if N = J then S := S + rsLogInstalled; if P = J then S := S + rsLogDefault; if L = J then S := S + rsLogLatest; SL.Add(S); end; SL.Add(rsLogSep); end; PrintLnDbg(SL, vlFull); PrintLnDbg(rsInfoEndLoggingDb, vlFull); end; procedure TfMain.tvPackageTreeClick(Sender: TObject); var Node: TTreeNode; begin lvPackageList.SortType := stNone; if tvPackageTree.Selected = FRootNode then FSelectedCat := '/' else if tvPackageTree.Selected = FUncategorised then FSelectedCat := '' else begin FSelectedCat := ''; Node := tvPackageTree.Selected; while Node <> FRootNode do begin FSelectedCat := Node.Text + '/' + FSelectedCat; Node := Node.Parent; end; FSelectedCat := Copy(FSelectedCat, 1, Length(FSelectedCat) - 1); end; PrintLnDbg(Format(rsDebugDisplayingCategory, [FSelectedCat])); LoadPackages(True); lvPackageList.SortColumn := FLastSortedColumn; lvPackageList.SortType := stData; end; procedure TfMain.acHelpAboutExecute(Sender: TObject); begin with TfAbout.Create(Application) do try ShowModal; finally Free; end; end; procedure TfMain.acPackagePropertiesExecute(Sender: TObject); begin if lvPackageList.Selected = nil then Exit; with TfPackageProperty.Create(Application) do try Self.Cursor := crHourGlass; Application.ProcessMessages; LoadPackageInfo(lvPackageList.Selected.Caption); Self.Cursor := crArrow; ShowModal; finally Free; end; end; procedure TfMain.clbStatesClickCheck(Sender: TObject); begin lvPackageList.SortType := stData; LoadPackages(True); lvPackageList.SortColumn := FLastSortedColumn; lvPackageList.SortType := stData; end; procedure TfMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin try SaveWindowGeometry(Self); SaveExtraParams; except PrintLnDbg(rsErrorCannotSaveConf, vlLow); end; end; procedure TfMain.acFileExitExecute(Sender: TObject); begin Application.Terminate; end; procedure TfMain.acFileShowLogExecute(Sender: TObject); begin if sLogFileName = '' then Exit; if (fLogView = nil) or (not Assigned(fLogView)) then begin PrintLnDbg(rsInfoShowingLogWin, vlHigh); fLogView := TfLogView.Create(Application); fLogView.Show; end else if not fLogView.Visible then fLogView.Show; fLogView.SetFocus; end; procedure TfMain.acEditReloadExecute(Sender: TObject); var Steps, I: Integer; begin try if (PackageList = nil) or (not Assigned(PackageList)) then PackageList := TPackageList.Create else PackageList.Clear; Cursor := crHourGlass; Steps := 2 + PackageList.LocalRepoList.Count + PackageList.DistantRepoList.Count; if PackageList.InstPackageDir = '' then PackageList.InstPackageDir := sDefaultSpackPkgDir; fProgress := CreateProgress(rsProgressLoading, rsProgressInitDB, rsProgressReadingInstalled, 0, Steps, 0, PackageList.GetInstalledCount); PackageList.OnProgress := @DoProgress; fProgress.CanCancel := False; fProgress.ShowOnTop; Application.ProcessMessages; try PackageList.GetInstalledPackages; finally fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1; fProgress.lbProgressionMessage2.Caption := rsProgressReadingLocal; fProgress.ProgressBar2.Position := 0; end; Application.ProcessMessages; try PackageList.LoadLocalRepo; finally fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1; fProgress.lbProgressionMessage2.Caption := rsProgressDownloadingIndex; fProgress.ProgressBar2.Position := 0; end; Application.ProcessMessages; try PackageList.DownloadDistantRepo; finally fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1; fProgress.lbProgressionMessage2.Caption := rsProgressReadingDistant; fProgress.ProgressBar2.Position := 0; end; Application.ProcessMessages; for I := 0 to slRepoList.Count - 1 do if (Pos(sHttpPrefix, slRepoList[I]) - Pos('=', slRepoList[I]) = 1) or (Pos(sFtpPrefix, slRepoList[I]) - Pos('=', slRepoList[I]) = 1) then try PackageList.LoadDistantRepo(Copy(slRepoList[I], 1, Pos('=', slRepoList[I]) - 1)); finally fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1; end; fProgress.lbProgressionMessage2.Caption := rsProgressTidyPackageList; fProgress.ProgressBar2.Position := 0; Application.ProcessMessages; Cursor := crArrow; finally PackageList.SetDeprecated(slDeprecated); LoadPackages(False); fProgress.Free; end; end; procedure TfMain.acEditSearchExecute(Sender: TObject); begin with TfSearch.Create(Application) do try ShowModal; finally Free; end; end; procedure TfMain.acConfigRepositoriesExecute(Sender: TObject); begin with TfRepoSettings.Create(Application) do try if (ShowModal = mrOK) and RepoChanged then if MessageDlg(rsReloadPackagesAfterRepoChange, mtConfirmation, mbYesNo, 0) = mrYes then acEditReloadExecute(nil); finally Free; end; end; procedure TfMain.acDebugCreateExceptionExecute(Sender: TObject); begin raise Exception.Create(rsExceptTest); end; procedure TfMain.acDebugLogHeapStatusExecute(Sender: TObject); begin PrintLnDbg(GetHeapStatus(SysGetHeapStatus)); end; procedure TfMain.acConfigEnvironmentExecute(Sender: TObject); begin with TfEnvironmentSettings.Create(Application) do try if (ShowModal = mrOK) and PathChanged then if MessageDlg(rsReloadPackagesAfterEnvChange, mtConfirmation, mbYesNo, 0) = mrYes then acEditReloadExecute(nil); finally Free; end; end; procedure TfMain.acConfigDisplayExecute(Sender: TObject); begin with TfDisplaySettings.Create(Application) do try if ShowModal = mrOK then LoadPackages(True); finally Free; lvPackageList.GridLines := bShowGrig; end; end; end.