paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-22 19:48:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

favorites: new Favorites IDE extension package

Browse Source 
git-svn-id: trunk@50512 -
This commit is contained in:
ondrej 2015-11-27 05:37:01 +00:00
parent 151f452c84
commit a466814e44
6 changed files with 370 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -1290,6 +1290,10 @@ components/externhelp/languages/externhelpfrm.po svneol=native#text/plain
components/externhelp/languages/externhelpfrm.pt_BR.po svneol=native#text/plain components/externhelp/languages/externhelpfrm.pt_BR.po svneol=native#text/plain
components/externhelp/languages/externhelpfrm.ru.po svneol=native#text/plain components/externhelp/languages/externhelpfrm.ru.po svneol=native#text/plain
components/externhelp/languages/externhelpfrm.uk.po svneol=native#text/plain components/externhelp/languages/externhelpfrm.uk.po svneol=native#text/plain
components/favorites/README.txt svneol=native#text/plain
components/favorites/favorites.lpk svneol=native#text/plain
components/favorites/favorites.pas svneol=native#text/pascal
components/favorites/favorites_impl.pas svneol=native#text/pascal
components/filebrowser/frmconfigfilebrowser.lfm svneol=native#text/plain components/filebrowser/frmconfigfilebrowser.lfm svneol=native#text/plain
components/filebrowser/frmconfigfilebrowser.pp svneol=native#text/plain components/filebrowser/frmconfigfilebrowser.pp svneol=native#text/plain
components/filebrowser/frmfilebrowser.lfm svneol=native#text/plain components/filebrowser/frmfilebrowser.lfm svneol=native#text/plain
@ -7681,6 +7685,7 @@ packager/globallinks/editormacroscript-0.lpl svneol=native#text/pascal
packager/globallinks/educationlaz-1.0.1.lpl svneol=native#text/plain packager/globallinks/educationlaz-1.0.1.lpl svneol=native#text/plain
packager/globallinks/exploreidemenu-0.lpl svneol=native#text/plain packager/globallinks/exploreidemenu-0.lpl svneol=native#text/plain
packager/globallinks/externhelp-1.3.lpl svneol=native#text/plain packager/globallinks/externhelp-1.3.lpl svneol=native#text/plain
packager/globallinks/favorites-0.1.1.lpl svneol=native#text/plain
packager/globallinks/fcl-1.0.1.lpl svneol=native#text/plain packager/globallinks/fcl-1.0.1.lpl svneol=native#text/plain
packager/globallinks/filefindlaz-1.0.2.lpl svneol=native#text/plain packager/globallinks/filefindlaz-1.0.2.lpl svneol=native#text/plain
packager/globallinks/fpcunitconsolerunner-1.lpl svneol=native#text/plain packager/globallinks/fpcunitconsolerunner-1.lpl svneol=native#text/plain

6
components/favorites/README.txt Normal file
View File

@ -0,0 +1,6 @@
IDE add-on for Favorites.
Adds favorite projects list into the drop-down menu of "Open" toolbar button.
Author: Ondrej Pokorny
Documentation: http://wiki.lazarus.freepascal.org/Favorites

55
components/favorites/favorites.lpk Normal file
View File

@ -0,0 +1,55 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="favorites"/>
<Type Value="DesignTime"/>
<Author Value="Ondrej Pokorny"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Description Value="Creates a third section (on the top) in the Open tool button drop-down menu where you can register your favorite projects."/>
<License Value="GPL-2"/>
<Version Minor="1" Release="1"/>
<Files Count="1">
<Item1>
<Filename Value="favorites_impl.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="favorites_impl"/>
</Item1>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/favorites/favorites.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit favorites;
interface
uses
favorites_impl, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('favorites_impl', @favorites_impl.Register);
end;
initialization
RegisterPackage('favorites', @Register);
end.

282
components/favorites/favorites_impl.pas Normal file
View File

@ -0,0 +1,282 @@
{
***************************************************************************
* *
* 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: 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, ToolBarIntf, IDEImagesIntf, Graphics, PackageIntf,
Menus, LazIDEIntf, ProjectIntf, Laz2_XMLCfg, IDEOptionsIntf,
IDECommands, ComCtrls;
type
TFavoritesHandler = class
private
FOldToolButtonClass: TIDEToolButtonClass;
FFavoriteProjects: TStringList;
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;
procedure RefreshMenu(Sender: TObject);
procedure mnuFavoriteFile(Sender: TObject);
procedure mnuAddRemoveActiveProject(Sender: TObject);
public
constructor Create(aOwner: TComponent); 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);
if FavHandler.FOldToolButtonClass<>nil then
FOrigButton := FavHandler.FOldToolButtonClass.Create(Self)
else
FOrigButton := TIDEToolButton.Create(Self);
end;
procedure TOpenFileFavToolButton.DoOnAdded;
begin
inherited DoOnAdded;
FOrigButton.DoOnAdded;
if FOrigButton.DropdownMenu<>nil then
DropdownMenu := FOrigButton.DropdownMenu
else
DropdownMenu := TPopupMenu.Create(Self);
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;
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
xAddToFav.Caption := Format('Add to favorites: %s', [xProj.ProjectInfoFile]) // To-Do: localize
else
xAddToFav.Caption := Format('Remove from favorites: %s', [xProj.ProjectInfoFile]); // To-Do: localize
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 := TStringList.Create;
FFavoriteProjects.Duplicates := dupIgnore;
FFavoriteProjects.CaseSensitive := False;
FFavoriteProjects.Sorted := True;
FConfig := TXMLConfig.Create(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.

1
packager/globallinks/favorites-0.1.1.lpl Normal file
View File

@ -0,0 +1 @@
$(LazarusDir)/components/favorites/favorites.lpk