lazarus/components/favorites/favorites_impl.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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************

  Author: Ondrej Pokorny

  Abstract:
    Adds favorite projects list into the drop-down menu of "Open" toolbar button.
}
unit favorites_impl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  // LCL
  Graphics, ComCtrls, Menus, ImgList,
  // LazUtils
  LazFileUtils, Laz2_XMLCfg, LazUTF8,
  // IdeIntf
  ToolBarIntf, IDEImagesIntf, LazIDEIntf, ProjectIntf, IDEOptionsIntf,
  IDECommands, IDEUtils,
  // Favorites
  favoritesstr;

type
  TFavoritesHandler = class
  private
    FOldToolButtonClass: TIDEToolButtonClass;
    FFavoriteProjects: TStringListUTF8Fast;
    FConfig: TXMLConfig;

    procedure AddToRecentProjectFiles(Sender: TObject; AFileName: string;
      var AAllow: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
  public
    procedure LoadFromConfig;
    procedure SaveToConfig;
    function IsInFavoriteProjects(const aFileName: string): Boolean;
    procedure AddToFavoriteProjects(const aFileName: string);
    procedure RemoveFromFavoriteProjects(const aFileName: string);
  end;

  TFileNameMenuItem = class(TMenuItem)
  public
    FileName: string;
  end;

  TOpenFileFavToolButton = class(TIDEToolButton)
  private
    FOrigButton: TIDEToolButton;
    FOrigOnPopup: TNotifyEvent;
    FIndex: TStringList;
    FAddImageIndex, FRemoveImageIndex: Integer;

    procedure RefreshMenu(Sender: TObject);
    procedure mnuFavoriteFile(Sender: TObject);
    procedure mnuAddRemoveActiveProject(Sender: TObject);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoOnAdded; override;
  end;


procedure Register;

implementation

var
  FavHandler: TFavoritesHandler = nil;

procedure Register;
begin
  FavHandler := TFavoritesHandler.Create;
end;

{ TOpenFileFavToolButton }

constructor TOpenFileFavToolButton.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  FIndex := TStringList.Create;

  if FavHandler.FOldToolButtonClass<>nil then
    FOrigButton := FavHandler.FOldToolButtonClass.Create(Self)
  else
    FOrigButton := TIDEToolButton.Create(Self);
end;

destructor TOpenFileFavToolButton.Destroy;
begin
  FIndex.Free;

  inherited Destroy;
end;

procedure TOpenFileFavToolButton.DoOnAdded;
var
  xGlyphs: TLCLGlyphs;
begin
  inherited DoOnAdded;

  FOrigButton.DoOnAdded;

  if FOrigButton.DropdownMenu<>nil then
    DropdownMenu := FOrigButton.DropdownMenu
  else
    DropdownMenu := TPopupMenu.Create(Self);

  if DropdownMenu.Images=nil then
    DropdownMenu.Images := LCLGlyphs;
  xGlyphs := DropdownMenu.Images as TLCLGlyphs;

  FAddImageIndex := xGlyphs.GetImageIndex('laz_add');
  FRemoveImageIndex := xGlyphs.GetImageIndex('laz_delete');

  FOrigOnPopup := DropdownMenu.OnPopup;
  DropdownMenu.OnPopup := @RefreshMenu;
  Style := tbsDropDown;
end;

procedure TOpenFileFavToolButton.mnuAddRemoveActiveProject(Sender: TObject);
var
  xFileName: string;
begin
  xFileName := (Sender as TFileNameMenuItem).FileName;
  if FavHandler.IsInFavoriteProjects(xFileName) then
  begin
    FavHandler.RemoveFromFavoriteProjects(xFileName);
    IDEEnvironmentOptions.AddToRecentProjectFiles(xFileName);
  end else
  begin
    FavHandler.AddToFavoriteProjects(xFileName);
    IDEEnvironmentOptions.RemoveFromRecentProjectFiles(xFileName);
  end;
end;

procedure TOpenFileFavToolButton.mnuFavoriteFile(Sender: TObject);
begin
  LazarusIDE.DoOpenProjectFile((Sender as TFileNameMenuItem).FileName,[ofAddToRecent]);
end;

procedure TOpenFileFavToolButton.RefreshMenu(Sender: TObject);
var
  xM, xSep: TMenuItem;
  xFavoriteFile: string;
  xMI, xAddToFav: TFileNameMenuItem;
  xProj: TLazProject;
  xMIndex: Integer;
begin
  if Assigned(FOrigOnPopup) then
    FOrigOnPopup(Sender);

  xM := DropdownMenu.Items;

  xMIndex := 0;
  for xFavoriteFile in FavHandler.FFavoriteProjects do
  begin
    xMI := TFileNameMenuItem.Create(Self);
    xMI.FileName := xFavoriteFile;
    xMI.Caption := xFavoriteFile;
    xMI.OnClick := @mnuFavoriteFile;
    if FilenameExtIn(xFavoriteFile,['.lpi','.lpr']) then
      xMI.ImageIndex := LoadProjectIconIntoImages(xFavoriteFile, DropdownMenu.Images, FIndex);

    xM.Insert(xMIndex, xMI);
    Inc(xMIndex);
  end;

  xProj := LazarusIDE.ActiveProject;
  if (xProj<>nil) and FileExists(xProj.ProjectInfoFile) then
  begin
    xAddToFav := TFileNameMenuItem.Create(Self);
    xAddToFav.FileName := xProj.ProjectInfoFile;
    if not FavHandler.IsInFavoriteProjects(xProj.ProjectInfoFile) then
    begin
      xAddToFav.Caption := Format(sAddToFavoritesS, [xProj.ProjectInfoFile]);
      xAddToFav.ImageIndex := FAddImageIndex;
    end else
    begin
      xAddToFav.Caption := Format(sRemoveFromFavoritesS, [xProj.ProjectInfoFile]);
      xAddToFav.ImageIndex := FRemoveImageIndex;
    end;
    xAddToFav.OnClick := @mnuAddRemoveActiveProject;
    xM.Insert(xMIndex, xAddToFav);
    Inc(xMIndex);
  end;

  if xMIndex > 0 then
  begin
    xSep := TMenuItem.Create(Self);
    xSep.Caption := '-';
    xM.Insert(xMIndex, xSep);
    Inc(xMIndex);
  end;
end;

{ TFavoritesHandler }

constructor TFavoritesHandler.Create;
var
  I: Integer;
  xToolButton: TIDEButtonCommand;
begin
  IDEEnvironmentOptions.AddHandlerAddToRecentProjectFiles(@AddToRecentProjectFiles);
  FFavoriteProjects := TStringListUTF8Fast.Create;
  FFavoriteProjects.Duplicates := dupIgnore;
  FFavoriteProjects.CaseSensitive := False;
  FFavoriteProjects.Sorted := True;
  FConfig := TXMLConfig.Create(AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+'favorites.xml');
  LoadFromConfig;

  xToolButton := IDEToolButtonCategories.FindItemByCommand(ecOpen);
  FOldToolButtonClass := xToolButton.ToolButtonClass;
  xToolButton.ToolButtonClass := TOpenFileFavToolButton;

  for I := 0 to FFavoriteProjects.Count-1 do
    IDEEnvironmentOptions.RemoveFromRecentProjectFiles(FFavoriteProjects[I]);
end;

procedure TFavoritesHandler.AddToFavoriteProjects(const aFileName: string);
begin
  FFavoriteProjects.Add(aFileName);
end;

procedure TFavoritesHandler.AddToRecentProjectFiles(Sender: TObject;
  AFileName: string; var AAllow: Boolean);
begin
  if IsInFavoriteProjects(AFileName) then
    AAllow := False;
end;

destructor TFavoritesHandler.Destroy;
begin
  SaveToConfig;
  FFavoriteProjects.Free;
  FConfig.Free;

  inherited Destroy;
end;

function TFavoritesHandler.IsInFavoriteProjects(const aFileName: string
  ): Boolean;
var
  I: Integer;
begin
  for I := 0 to FFavoriteProjects.Count-1 do
  if SameFileName(aFileName, FFavoriteProjects[I]) then
    Exit(True);
  Result := False;
end;

procedure TFavoritesHandler.LoadFromConfig;
var
  I: Integer;
  xItem: string;
begin
  I := 1;
  while True do
  begin
    xItem := FConfig.GetValue('projects/item'+IntToStr(I), '');
    if xItem = '' then
      Break;
    if FileExists(xItem) then
      FFavoriteProjects.Add(xItem);
    Inc(I);
  end;
end;

procedure TFavoritesHandler.RemoveFromFavoriteProjects(const aFileName: string);
var
  xIndex: Integer;
begin
  xIndex := FFavoriteProjects.IndexOf(aFileName);
  if xIndex >= 0 then
    FFavoriteProjects.Delete(xIndex);
end;

procedure TFavoritesHandler.SaveToConfig;
var
  I: Integer;
  xItem: string;
begin
  I := 1;
  FConfig.DeletePath('projects');
  for xItem in FFavoriteProjects do
  begin
    FConfig.SetValue('projects/item'+IntToStr(I), xItem);
    Inc(I);
  end;
end;

finalization
  FreeAndNil(FavHandler);
end.