lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / ide / cleandirdlg.pas

{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    A dialog for cleaning directories.
}
unit CleanDirDlg;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons,
  StdCtrls, FileUtil, LCLProc, Laz_XMLCfg, SynRegExpr, IDEContextHelpEdit,
  LazarusIDEStrConsts, LazConf, IDEProcs, TransferMacros, InputHistory,
  ButtonPanel, ShowDeletingFilesDlg;

type

  { TCleanDirectoryDialog }

  TCleanDirectoryDialog = class(TForm)
    ButtonPanel: TButtonPanel;
    DirBrowseButton: TButton;
    KeepTextFilesCheckbox: TCHECKBOX;
    SubDirsCheckbox: TCHECKBOX;
    SimpleSyntaxKeepCheckbox: TCHECKBOX;
    KeepCombobox: TCOMBOBOX;
    KeepGroupbox: TGROUPBOX;
    SimpleSyntaxRemoveCheckbox: TCHECKBOX;
    RemoveCombobox: TCOMBOBOX;
    DirCombobox: TCOMBOBOX;
    DirGroupbox: TGROUPBOX;
    RemoveGroupbox: TGROUPBOX;
    procedure HelpButtonClick(Sender: TObject);
    procedure CleanDirectoryDialogCreate(Sender: TObject);
    procedure DirBrowseButtonClick(Sender: TObject);
    procedure OkButtonClick(Sender: TObject);
  private
    FMacros: TTransferMacroList;
    procedure SetMacros(const AValue: TTransferMacroList);
  public
    procedure LoadSettings;
    procedure SaveSettings;
    function GetConfigFilename: string;
    function SearchFilesToDelete(var List: TStrings): boolean;
    function DeleteFiles(List: TStrings): boolean;
    procedure AddDirectory(const Directory: string);
    property Macros: TTransferMacroList read FMacros write SetMacros;
  end;
  
function ShowCleanDirectoryDialog(const DefaultDirectory: string;
  Macros: TTransferMacroList): TModalResult;

implementation

{$R *.lfm}

const
  CleanDirXMLFilename = 'cleandirectorydialog.xml';
  CleanDirXMLVersion = 1;

function ShowCleanDirectoryDialog(const DefaultDirectory: string;
  Macros: TTransferMacroList): TModalResult;
var
  CleanDirectoryDialog: TCleanDirectoryDialog;
begin
  CleanDirectoryDialog:=TCleanDirectoryDialog.Create(nil);
  CleanDirectoryDialog.Macros:=Macros;
  CleanDirectoryDialog.LoadSettings;
  CleanDirectoryDialog.AddDirectory(DefaultDirectory);
  Result:=CleanDirectoryDialog.ShowModal;
  CleanDirectoryDialog.Free;
end;

{ TCleanDirectoryDialog }

procedure TCleanDirectoryDialog.OkButtonClick(Sender: TObject);
var
  List: TStrings;
begin
  SaveSettings;
  if not SearchFilesToDelete(List) then exit;
  try
    if not DeleteFiles(List) then exit;
  finally
    List.Free;
  end;
  ModalResult:=mrOk;
end;

procedure TCleanDirectoryDialog.SetMacros(const AValue: TTransferMacroList);
begin
  if FMacros=AValue then exit;
  FMacros:=AValue;
end;

procedure TCleanDirectoryDialog.CleanDirectoryDialogCreate(Sender: TObject);
begin
  Caption:=lisClDirCleanDirectory;
  DirGroupbox.Caption:=lisCodeToolsDefsInsertBehindDirectory;
  SubDirsCheckbox.Caption:=lisClDirCleanSubDirectories;
  RemoveGroupbox.Caption:=lisClDirRemoveFilesMatchingFilter;
  SimpleSyntaxRemoveCheckbox.Caption:=lisClDirSimpleSyntaxEGInsteadOf;
  KeepGroupbox.Caption:=lisClDirKeepFilesMatchingFilter;
  SimpleSyntaxKeepCheckbox.Caption:=lisClDirSimpleSyntaxEGInsteadOf;
  KeepTextFilesCheckbox.Caption:=lisClDirKeepAllTextFiles;

  ButtonPanel.OKButton.Caption:=lisOk;
  ButtonPanel.HelpButton.Caption:=lisMenuHelp;
  ButtonPanel.CancelButton.Caption:=dlgCancel;

  ButtonPanel.OKButton.OnClick := @OKButtonClick;
  ButtonPanel.HelpButton.OnClick := @HelpButtonClick;
end;

procedure TCleanDirectoryDialog.HelpButtonClick(Sender: TObject);
begin
  ShowContextHelpForIDE(Self);
end;

procedure TCleanDirectoryDialog.DirBrowseButtonClick(Sender: TObject);
var
  NewDirectory: String;
begin
  NewDirectory:=InputHistories.SelectDirectory(lisMenuCleanDirectory, true,
           ExtractFilePath(DirCombobox.Text),ExtractFilename(DirCombobox.Text));
  if NewDirectory<>'' then
    DirCombobox.Text:=NewDirectory;
end;

procedure TCleanDirectoryDialog.LoadSettings;
var
  XMLConfig: TXMLConfig;

  procedure LoadComboList(AComboBox: TComboBox; const Path: string);
  var
    List: TStringList;
  begin
    List:=TStringList.Create;
    LoadRecentList(XMLConfig,List,Path+'Directories');
    AComboBox.Items.Assign(List);
    List.Free;
  end;
  
  procedure AddStandardComboItem(AComboBox: TComboBox; const Item: string);
  begin
    if AComboBox.Items.IndexOf(Item)>=0 then exit;
    AComboBox.Items.Add(Item);
    AComboBox.ItemIndex:=0;
  end;

var
  Filename: String;
  Path: String;
begin
  try
    Filename:=GetConfigFilename;
    XMLConfig:=TXMLConfig.Create(Filename);
  except
    DebugLn('ERROR: unable to open clean directory options "',Filename,'"');
    exit;
  end;
  try
    try
      Path:='CleanDirectoryOptions/';
      //FileVersion:=XMLConfig.GetValue(Path+'Version/Value',0);
      
      SubDirsCheckbox.Checked:=XMLConfig.GetValue(
                                             Path+'SubDirectories/Value',false);
      LoadComboList(DirCombobox,Path+'Directories');
      LoadComboList(RemoveCombobox,Path+'RemoveFilters');
      SimpleSyntaxRemoveCheckbox.Checked:=XMLConfig.GetValue(
                                         Path+'RemoveFilter/SimpleSyntax',true);
      LoadComboList(KeepCombobox,Path+'KeepFilters');
      SimpleSyntaxKeepCheckbox.Checked:=XMLConfig.GetValue(
                                           Path+'KeepFilter/SimpleSyntax',true);
      KeepTextFilesCheckbox.Checked:=XMLConfig.GetValue(
                                               Path+'KeepTextFiles/Value',true);

      // set defaults
      AddStandardComboItem(DirCombobox,'$(ProjPath)');
      AddStandardComboItem(RemoveCombobox,'*.(bak|ppu|ppl|o|or|a|so|dll)');
      AddStandardComboItem(RemoveCombobox,'*.bak|*~');
      AddStandardComboItem(KeepCombobox,
                           '*.(pas|pp|lpr|lfm|lrs|lpi|lpk|inc|sh|xml)');

    finally
      XMLConfig.Free;
    end;
  except
    on E: Exception do begin
      DebugLn('ERROR: unable to read clean directory options from "',
        Filename,'": ',E.Message);
    end;
  end;
end;

procedure TCleanDirectoryDialog.SaveSettings;
var
  XMLConfig: TXMLConfig;
  Filename: String;
  Path: String;
begin
  AddToRecentList(DirCombobox.Text, DirCombobox.Items, 20);
  AddToRecentList(RemoveCombobox.Text, RemoveCombobox.Items, 20);
  AddToRecentList(KeepCombobox.Text, KeepCombobox.Items, 20);
  try
    InvalidateFileStateCache;
    Filename:=GetConfigFilename;
    XMLConfig:=TXMLConfig.CreateClean(Filename);
  except
    DebugLn('ERROR: unable to open clean directory options "',Filename,'"');
    exit;
  end;
  try
    try
      Path:='CleanDirectoryOptions/';
      XMLConfig.SetValue(Path+'Version/Value',CleanDirXMLVersion);

      XMLConfig.SetDeleteValue(Path+'SubDirectories/Value',
                               SubDirsCheckbox.Checked,false);
      SaveRecentList(XMLConfig,DirCombobox.Items,Path+'Directories');
      SaveRecentList(XMLConfig,RemoveCombobox.Items,Path+'RemoveFilters');
      XMLConfig.SetDeleteValue(Path+'RemoveFilter/SimpleSyntax',
                               SimpleSyntaxRemoveCheckbox.Checked,true);
      SaveRecentList(XMLConfig,KeepCombobox.Items,Path+'KeepFilters');
      XMLConfig.SetDeleteValue(Path+'KeepFilter/SimpleSyntax',
                               SimpleSyntaxKeepCheckbox.Checked,true);
      XMLConfig.SetDeleteValue(Path+'KeepTextFiles/Value',
                               KeepTextFilesCheckbox.Checked,true);

      XMLConfig.Flush;
    finally
      XMLConfig.Free;
    end;
  except
    on E: Exception do begin
      DebugLn('ERROR: unable to write clean directory options to "',
        Filename,'": ',E.Message);
    end;
  end;
end;

function TCleanDirectoryDialog.GetConfigFilename: string;
begin
  Result:=AppendPathDelim(GetPrimaryConfigPath)+CleanDirXMLFilename;
end;

function TCleanDirectoryDialog.SearchFilesToDelete(var List: TStrings): boolean;
var
  RemoveFilterRegExpr: TRegExpr;
  KeepFilterRegExpr: TRegExpr;

  function FileMatches(const Filename: string): boolean;
  var
    ShortFilename: String;
  begin
    Result:=false;
    ShortFilename:=ExtractFilename(Filename);
    if (RemoveFilterRegExpr=nil)
    or not RemoveFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
    if (KeepFilterRegExpr<>nil)
    and KeepFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
    if KeepTextFilesCheckbox.Checked and FileIsText(Filename) then exit;
    Result:=true;
  end;

  function SearchInDirectory(const MainDirectory: string;
    Lvl: integer): boolean;
  var
    FileInfo: TSearchRec;
    FullFilename: String;
  begin
    Result:=false;
    if (not DirPathExists(MainDirectory)) or (Lvl>20) then exit;
    if FindFirstUTF8(MainDirectory+GetAllFilesMask,
                          faAnyFile,FileInfo)=0
    then begin
      repeat
        // check if special file
        if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
        then continue;
        FullFilename:=MainDirectory+FileInfo.Name;
        if (FileInfo.Attr and faDirectory)>0 then begin
          if SubDirsCheckbox.Checked then begin
            // search recursively
            if not SearchInDirectory(AppendPathDelim(FullFilename),Lvl+1) then
              break;
          end;
        end else begin
          if FileMatches(FullFilename) then
            List.Add(FullFilename);
        end;
      until FindNextUTF8(FileInfo)<>0;
    end;
    FindCloseUTF8(FileInfo);
    Result:=true;
  end;
  
  function SetupFilter(var Filter: TRegExpr; SimpleSyntax: boolean;
    const FilterAsText: string): boolean;
  var
    Expr: String;
  begin
    Result:=false;
    if FilterAsText='' then begin
      Filter:=nil;
      Result:=true;
      exit;
    end;
    Filter:=TRegExpr.Create;
    if SimpleSyntax then
      Expr:=SimpleSyntaxToRegExpr(FilterAsText)
    else
      Expr:=FilterAsText;
    try
      Filter.Expression:=Expr;
      Result:=true;
    except
      on E: Exception do begin
        MessageDlg('Invalid Mask',
          'The mask "'+FilterAsText+'" is not a valid expression.',
          mtError,[mbCancel],0);
      end;
    end;
  end;

var
  Directory: String;
begin
  Result:=false;
  RemoveFilterRegExpr:=nil;
  KeepFilterRegExpr:=nil;
  List:=nil;

  try
    // get directory
    Directory:=DirCombobox.Text;
    if (Macros<>nil) and (not Macros.SubstituteStr(Directory)) then exit;
    Directory:=AppendPathDelim(Directory);

    // setup filters
    SetupFilter(RemoveFilterRegExpr,SimpleSyntaxRemoveCheckbox.Checked,
      RemoveCombobox.Text);
    SetupFilter(KeepFilterRegExpr,SimpleSyntaxKeepCheckbox.Checked,
      KeepCombobox.Text);

    // search files
    List:=TStringList.Create;
    if not SearchInDirectory(Directory,0) then exit;

    Result:=true;
  finally
    RemoveFilterRegExpr.Free;
    KeepFilterRegExpr.Free;
    if not Result then begin
      List.Free;
      List:=nil;
    end;
  end;
end;

function TCleanDirectoryDialog.DeleteFiles(List: TStrings): boolean;
var
  i: Integer;
  Filename: string;
  MsgResult: TModalResult;
  ShowDeletingFilesDialog: TShowDeletingFilesDialog;
begin
  Result:=false;
  if List.Count=0 then begin
    Result:=true;
    exit;
  end;
  
  // ask user for confirmation
  ShowDeletingFilesDialog:=TShowDeletingFilesDialog.Create(Self);
  try
    ShowDeletingFilesDialog.FileList.Items.AddStrings(List);
    for i := 0 to ShowDeletingFilesDialog.FileList.Count - 1 do
      ShowDeletingFilesDialog.FileList.Checked[i] := True;

    if ShowDeletingFilesDialog.ShowModal<>mrOk then exit;

    // delete all checked files
    for i:=0 to ShowDeletingFilesDialog.FileList.Count-1 do begin
      if ShowDeletingFilesDialog.FileList.Checked[i] then
      begin
        Filename:=ShowDeletingFilesDialog.FileList.Items[i];
        DebugLn('TCleanDirectoryDialog: Deleting file ',Filename);
        if FileExistsUTF8(Filename) then begin
          repeat
            if DeleteFileUTF8(Filename) then begin
              break;
            end else begin
              MsgResult:=MessageDlg(lisErrorDeletingFile,
                Format(lisPkgMangUnableToDeleteFile, ['"', Filename, '"']),
                mtError,[mbAbort,mbIgnore,mbRetry],0);
              if (MsgResult=mrIgnore) then break;
              if MsgResult=mrAbort then exit;
            end;
          until false;
        end;
      end;
    end;

  finally
    ShowDeletingFilesDialog.Free;
  end;

  Result:=true;
end;

procedure TCleanDirectoryDialog.AddDirectory(const Directory: string);
begin
  AddToRecentList(Directory,DirCombobox.Items,20);
end;

end.