/usr/src/castle-game-engine-5.2.0/components/castlelclrecentfiles.pas is in castle-game-engine-src 5.2.0-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | {
Copyright 2006-2014 Michalis Kamburelis.
This file is part of "Castle Game Engine".
"Castle Game Engine" is free software; see the file COPYING.txt,
included in this distribution, for details about the copyright.
"Castle Game Engine" 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.
----------------------------------------------------------------------------
}
{ Manage a list of recently opened files, and show a menu in Lazarus menu.
See TRecentFiles class. }
unit CastleLCLRecentFiles;
interface
uses Menus, CastleRecentFiles;
type
{ Manage a list of recently opened files, and show a menu in Lazarus. }
TCastleRecentFiles = class(TRecentFiles)
private
FNextMenuItem: TMenuItem;
FirstSeparator: TMenuItem;
procedure SetNextMenuItem(Value: TMenuItem);
protected
procedure MenuCreate; override;
{ Destroy the menu. Internal (do not call this directly, it's only called
by parent class).
Note that it doesn't read URLs list at all, it only
depends on FirstSeparator value. }
procedure MenuDestroy; override;
public
{ Determines the placement of "recent files" list inside your menu.
If this is not @nil then each update to the recent files
list (for example by @link(Add) method) will result in the menu
items right before NextMenuItem to be updated.
Also changing the value of this property will result in one-time
update of the menu. Menu at the place of old NextMenuItem
will be removed and menu at the place of new NextMenuItem will
get created.
Usually NextMenuItem should be the separator that divides
the print and properties menu sections and the close menu sections.
That's consistent with other GNOME programs, and this is what we usually
try to follow. }
property NextMenuItem: TMenuItem read FNextMenuItem write SetNextMenuItem;
end;
procedure Register;
implementation
uses SysUtils, Classes, CastleLCLUtils, CastleURIUtils;
procedure Register;
begin
RegisterComponents('Castle', [TCastleRecentFiles]);
end;
{ TMenuRecentItem ------------------------------------------------------------ }
type
TMenuRecentItem = class(TMenuItem)
private
FURL: string;
public
{ Constructor. Number is 1-based number of this recent file entry. }
constructor Create(AOwner: TComponent;
const Number: Integer; const AURL: string); reintroduce;
public
OnOpenRecent: TOnOpenRecent;
property URL: string read FURL;
procedure Click; override;
end;
constructor TMenuRecentItem.Create(AOwner: TComponent;
const Number: Integer; const AURL: string);
var
S: string;
begin
FURL := AURL;
if Number <= 9 then
S := '&' + IntToStr(Number) else
if Number = 10 then
S := '1&0' else
S := IntToStr(Number);
S += '. ' + SQuoteLCLCaption(URICaption(URL));
inherited Create(AOwner);
Caption := S;
end;
procedure TMenuRecentItem.Click;
begin
inherited;
if Assigned(OnOpenRecent) then
OnOpenRecent(URL);
end;
{ TCastleRecentFiles -------------------------------------------------------------- }
procedure TCastleRecentFiles.MenuCreate;
var
I: Integer;
ParentMenu: TMenuItem;
Position: Cardinal;
MenuRecentOpen: TMenuRecentItem;
begin
inherited;
{ Add recent files menu }
if (NextMenuItem <> nil) and (NextMenuItem.Parent <> nil) and
{ When URLs.Count = 0 then we don't want to add anything,
even FirstSeparator. }
(URLs.Count > 0) then
begin
ParentMenu := NextMenuItem.Parent;
Position := NextMenuItem.MenuIndex;
FirstSeparator := TMenuItem.Create(nil);
FirstSeparator.Caption := '-';
ParentMenu.Insert(Position, FirstSeparator);
for I := 0 to URLs.Count - 1 do
begin
MenuRecentOpen := TMenuRecentItem.Create(nil, I+1, URLs[I]);
MenuRecentOpen.OnOpenRecent := OnOpenRecent;
ParentMenu.Insert(Position + Cardinal(I) + 1, MenuRecentOpen);
end;
end;
end;
procedure TCastleRecentFiles.MenuDestroy;
var
ParentMenu: TMenuItem;
Position: Cardinal;
begin
{ Remove recent files menu from old NextMenuItem }
if (NextMenuItem <> nil) and
{ Checks for below are to safeguard against cases
when you could assign NextMenuItem before it had
any ParentMenu, or if you somehow rearranged your menu,
or if URLs list was empty when you assigned NextMenuItem
(in this case FirstSeparator is left nil, but later it should
be created after the 1st add). }
(NextMenuItem.Parent <> nil) and
(FirstSeparator <> nil) and
(NextMenuItem.Parent = FirstSeparator.Parent) then
begin
ParentMenu := NextMenuItem.Parent;
Position := FirstSeparator.MenuIndex;
Assert(ParentMenu[Position] = FirstSeparator);
FirstSeparator := nil;
repeat
ParentMenu.Delete(Position);
until (ParentMenu[Position] = NextMenuItem);
end;
inherited;
end;
procedure TCastleRecentFiles.SetNextMenuItem(Value: TMenuItem);
begin
if Value <> FNextMenuItem then
begin
MenuDestroy;
FNextMenuItem := Value;
MenuCreate;
end;
end;
end.
|