lazarus/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, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
  StdCtrls, FileUtil, LCLProc, Laz_XMLCfg,
  SynRegExpr, LazarusIDEStrConsts, LazConf, IDEProcs, TransferMacros;

type

  { TCleanDirectoryDialog }

  TCleanDirectoryDialog = class(TForm)
    KeepTextFilesCheckbox: TCHECKBOX;
    SubDirsCheckbox: TCHECKBOX;
    SimpleSyntaxKeepCheckbox: TCHECKBOX;
    KeepCombobox: TCOMBOBOX;
    KeepGroupbox: TGROUPBOX;
    SimpleSyntaxRemoveCheckbox: TCHECKBOX;
    RemoveCombobox: TCOMBOBOX;
    DirCombobox: TCOMBOBOX;
    DirGroupbox: TGROUPBOX;
    RemoveGroupbox: TGROUPBOX;
    OkButton: TBUTTON;
    CancelButton: TBUTTON;
    procedure CleanDirectoryDialogCreate(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;
  
  { TShowDeletingFilesDialog }

  TShowDeletingFilesDialog = class(TForm)
    FilesListBox: TListBox;
    OkButton: TBUTTON;
    CancelButton: TBUTTON;
  public
    constructor Create(TheOwner: TComponent); override;
  end;

function ShowCleanDirectoryDialog(const DefaultDirectory: string;
  Macros: TTransferMacroList): TModalResult;


implementation


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;
  OkButton.Caption:=lisLazBuildOk;
  CancelButton.Caption:=dlgCancel;
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|ppw|ppl|o|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 SysUtils.FindFirst(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 SysUtils.FindNext(FileInfo)<>0;
    end;
    SysUtils.FindClose(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.FilesListBox.Items.Assign(List);
    if ShowDeletingFilesDialog.ShowModal<>mrOk then exit;
  finally
    ShowDeletingFilesDialog.Free;
  end;

  // delete them all
  for i:=0 to List.Count-1 do begin
    Filename:=List[i];
    DebugLn('TCleanDirectoryDialog: Deleting file ',Filename);
    if FileExists(Filename) then begin
      repeat
        if DeleteFile(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;
  Result:=true;
end;

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

{ TShowDeletingFilesDialog }

constructor TShowDeletingFilesDialog.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  Caption:=lisDeleteAllTheseFiles;
  Width:=400;
  Height:=350;
  Position:=poScreenCenter;
  
  FilesListBox:=TListBox.Create(Self);
  with FilesListBox do begin
    Name:='FilesListBox';
    Parent:=Self;
    Height:=Self.ClientHeight-40;
    Align:=alTop;
    Anchors:=[akLeft,akTop,akBottom,akRight];
  end;
  
  OkButton:=TButton.Create(Self);
  with OkButton do begin
    Name:='OkButton';
    Parent:=Self;
    Left:=20;
    Top:=Self.ClientHeight-35;
    Width:=100;
    Height:=25;
    Anchors:=[akLeft,akBottom];
    Caption:=dlgEdDelete;
    ModalResult:=mrOk;
  end;
  
  CancelButton:=TButton.Create(Self);
  with CancelButton do begin
    Name:='CancelButton';
    Parent:=Self;
    Left:=150;
    Top:=Self.ClientHeight-35;
    Width:=100;
    Height:=25;
    Anchors:=[akLeft,akBottom];
    Caption:=dlgCancel;
    ModalResult:=mrCancel;
  end;
end;

initialization
  {$I cleandirdlg.lrs}

end.