~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/fppkg/src/fppkg_mainfrm.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
{ Main form for the lazarus package manager
 
2
 
 
3
  Copyright (C) 2011 Darius Blaszyk
 
4
 
 
5
  This library is free software; you can redistribute it and/or modify it
 
6
  under the terms of the GNU Library General Public License as published by
 
7
  the Free Software Foundation; either version 2 of the License, or (at your
 
8
  option) any later version with the following modification:
 
9
 
 
10
  As a special exception, the copyright holders of this library give you
 
11
  permission to link this library with independent modules to produce an
 
12
  executable, regardless of the license terms of these independent modules,and
 
13
  to copy and distribute the resulting executable under terms of your choice,
 
14
  provided that you also meet, for each linked independent module, the terms
 
15
  and conditions of the license of that module. An independent module is a
 
16
  module which is not derived from or based on this library. If you modify
 
17
  this library, you may extend this exception to your version of the library,
 
18
  but you are not obligated to do so. If you do not wish to do so, delete this
 
19
  exception statement from your version.
 
20
 
 
21
  This program is distributed in the hope that it will be useful, but WITHOUT
 
22
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
23
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
 
24
  for more details.
 
25
 
 
26
  You should have received a copy of the GNU Library General Public License
 
27
  along with this library; if not, write to the Free Software Foundation,
 
28
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
29
}
 
30
unit fppkg_mainfrm;
 
31
 
 
32
{$mode objfpc}{$H+}
 
33
 
 
34
{$IFDEF VER2_4}{$ERROR This package requires at least fpc 2.5.1}{$ENDIF}
 
35
 
 
36
interface
 
37
 
 
38
uses
 
39
  Classes, SysUtils, Forms, Controls, StdCtrls, ComCtrls, ExtCtrls, Buttons,
 
40
  Menus, CheckLst, Dialogs, fppkg_const,
 
41
  fppkg_optionsfrm, fppkg_details,
 
42
  //IDE interface
 
43
  {$IFDEF LazarusIDEPackage}
 
44
    IDEIntf, PackageIntf, IDECommands, contnrs, fppkg_lpk,
 
45
  {$ENDIF}
 
46
  // Repository handler objects
 
47
  fprepos,
 
48
  pkgmessages, pkgglobals, pkgoptions, pkgrepos, laz_pkgrepos,
 
49
  // Package Handler components
 
50
  pkghandler, laz_pkghandler, laz_pkgcommands, pkgcommands,
 
51
  //downloader
 
52
  pkgfphttp;
 
53
 
 
54
type
 
55
  TFppkgConfigOptions = record
 
56
    ConfigFile: string;
 
57
  end;
 
58
 
 
59
  { TFppkgForm }
 
60
 
 
61
  TFppkgForm = class(TForm)
 
62
    CategoriesLabel: TLabel;
 
63
    CategoryCheckListBox: TCheckListBox;
 
64
    FilterPanel: TPanel;
 
65
    MenuItem5: TMenuItem;
 
66
    miCleanMessages: TMenuItem;
 
67
    OutputMemo: TMemo;
 
68
    MenuItem3: TMenuItem;
 
69
    MenuItem4: TMenuItem;
 
70
    miShowDetails: TMenuItem;
 
71
    miSeparator: TMenuItem;
 
72
    PackageListView: TListView;
 
73
    PackageSupportImages: TImageList;
 
74
    MainMenu: TMainMenu;
 
75
    MenuItem1: TMenuItem;
 
76
    MenuItem2: TMenuItem;
 
77
    miExit: TMenuItem;
 
78
    miSelect: TMenuItem;
 
79
    miUnselect: TMenuItem;
 
80
    miFile: TMenuItem;
 
81
    PackagePopupMenu: TPopupMenu;
 
82
    Panel: TPanel;
 
83
    SearchEdit: TEdit;
 
84
    Splitter1: TSplitter;
 
85
    StatusBar1: TStatusBar;
 
86
    SupportCheckGroup: TCheckGroup;
 
87
    ToolbarImages: TImageList;
 
88
    SearchLabel: TLabel;
 
89
    SearchPanel: TPanel;
 
90
    SearchButton: TSpeedButton;
 
91
    ToolBar: TToolBar;
 
92
    BuildButton: TToolButton;
 
93
    CompileButton: TToolButton;
 
94
    FixBrokenButton: TToolButton;
 
95
    UpdateButton: TToolButton;
 
96
    InstallButton: TToolButton;
 
97
    CleanButton: TToolButton;
 
98
    ArchiveButton: TToolButton;
 
99
    DownloadButton: TToolButton;
 
100
    VertSplitter: TSplitter;
 
101
    procedure ArchiveButtonClick(Sender: TObject);
 
102
    procedure BuildButtonClick(Sender: TObject);
 
103
    procedure CategoryCheckListBoxClickCheck(Sender: TObject);
 
104
    procedure CleanButtonClick(Sender: TObject);
 
105
    procedure CompileButtonClick(Sender: TObject);
 
106
    procedure DownloadButtonClick(Sender: TObject);
 
107
    procedure FixBrokenButtonClick(Sender: TObject);
 
108
    procedure FormCreate(Sender: TObject);
 
109
    procedure FormDestroy(Sender: TObject);
 
110
    procedure InstallButtonClick(Sender: TObject);
 
111
    procedure MenuItem4Click(Sender: TObject);
 
112
    procedure miClearMemoClick(Sender: TObject);
 
113
    procedure miCleanMessagesClick(Sender: TObject);
 
114
    procedure PackageListViewDblClick(Sender: TObject);
 
115
    procedure MenuItem2Click(Sender: TObject);
 
116
    procedure miExitClick(Sender: TObject);
 
117
    procedure miSelectClick(Sender: TObject);
 
118
    procedure miUnselectClick(Sender: TObject);
 
119
    procedure SearchButtonClick(Sender: TObject);
 
120
    procedure SearchEditKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
 
121
    procedure SupportCheckGroupItemClick(Sender: TObject; Index: integer);
 
122
    procedure UpdateButtonClick(Sender: TObject);
 
123
  private
 
124
    { private declarations }
 
125
    SearchPhrases: TStrings;
 
126
 
 
127
    function FindSearchPhrase(pkg: TLazPackageData): boolean;
 
128
    function FindCategory(pkg: TLazPackageData): boolean;
 
129
    function FindSupport(pkg: TLazPackageData): boolean;
 
130
    procedure GetSelectedPackages(var s: TStrings);
 
131
 
 
132
    procedure MaybeCreateLocalDirs;
 
133
    procedure DoRun(cfg: TFppkgConfigOptions; ParaAction: string; ParaPackages: TStrings);
 
134
    procedure LoadCompilerDefaults;
 
135
 
 
136
    procedure UpdatePackageListView;
 
137
    procedure ListPackages;
 
138
  public
 
139
    { public declarations }
 
140
  end;
 
141
 
 
142
var
 
143
  FppkgForm: TFppkgForm;
 
144
  FppkgCfg: TFppkgConfigOptions;
 
145
 
 
146
implementation
 
147
 
 
148
{$R *.lfm}
 
149
 
 
150
uses
 
151
  Masks, fppkg_aboutfrm;
 
152
 
 
153
procedure LazLog(Level: TLogLevel; const Msg: string);
 
154
var
 
155
  Prefix : string;
 
156
begin
 
157
  if not(Level in LogLevels) then
 
158
    exit;
 
159
  Prefix:='';
 
160
  case Level of
 
161
    vlWarning :
 
162
      Prefix:=SWarning;
 
163
    vlError :
 
164
      Prefix:=SError;
 
165
{    vlInfo :
 
166
      Prefix:='I: ';
 
167
    vlCommands :
 
168
      Prefix:='C: ';
 
169
    vlDebug :
 
170
      Prefix:='D: '; }
 
171
  end;
 
172
 
 
173
  if Assigned(FppkgForm) then
 
174
    FppkgForm.OutputMemo.Lines.Add(DateTimeToStr(Now) + ' ' + Prefix + ' ' + Msg);
 
175
end;
 
176
 
 
177
procedure LazError(const Msg: String);
 
178
begin
 
179
  ShowMessage(Msg);
 
180
end;
 
181
 
 
182
{ TFppkgForm }
 
183
 
 
184
procedure TFppkgForm.FixBrokenButtonClick(Sender: TObject);
 
185
var
 
186
  s: TStrings;
 
187
begin
 
188
  s := TStringList.Create;
 
189
  DoRun(FppkgCfg, 'laz_fixbroken', s);
 
190
  ListPackages;
 
191
  UpdatePackageListView;
 
192
  s.Free;
 
193
end;
 
194
 
 
195
procedure TFppkgForm.CleanButtonClick(Sender: TObject);
 
196
var
 
197
  s: TStrings;
 
198
begin
 
199
  s := TStringList.Create;
 
200
 
 
201
  GetSelectedPackages(s);
 
202
 
 
203
  if s.Count = 0 then
 
204
    Error(SErrNoPackageSpecified)
 
205
  else
 
206
    DoRun(FppkgCfg, 'clean', s);
 
207
 
 
208
  s.Free;
 
209
end;
 
210
 
 
211
procedure TFppkgForm.CompileButtonClick(Sender: TObject);
 
212
var
 
213
  s: TStrings;
 
214
begin
 
215
  s := TStringList.Create;
 
216
 
 
217
  GetSelectedPackages(s);
 
218
 
 
219
  if s.Count = 0 then
 
220
    Error(SErrNoPackageSpecified)
 
221
  else
 
222
    DoRun(FppkgCfg, 'compile', s);
 
223
 
 
224
  s.Free;
 
225
end;
 
226
 
 
227
procedure TFppkgForm.DownloadButtonClick(Sender: TObject);
 
228
var
 
229
  s: TStrings;
 
230
begin
 
231
  s := TStringList.Create;
 
232
 
 
233
  GetSelectedPackages(s);
 
234
 
 
235
  if s.Count = 0 then
 
236
    Error(SErrNoPackageSpecified)
 
237
  else
 
238
    DoRun(FppkgCfg, 'download', s);
 
239
 
 
240
  s.Free;
 
241
end;
 
242
 
 
243
procedure TFppkgForm.ArchiveButtonClick(Sender: TObject);
 
244
var
 
245
  s: TStrings;
 
246
begin
 
247
  s := TStringList.Create;
 
248
 
 
249
  GetSelectedPackages(s);
 
250
 
 
251
  if s.Count = 0 then
 
252
    Error(SErrNoPackageSpecified)
 
253
  else
 
254
    DoRun(FppkgCfg, 'archive', s);
 
255
 
 
256
  s.Free;
 
257
end;
 
258
 
 
259
procedure TFppkgForm.BuildButtonClick(Sender: TObject);
 
260
var
 
261
  s: TStrings;
 
262
begin
 
263
  s := TStringList.Create;
 
264
 
 
265
  GetSelectedPackages(s);
 
266
 
 
267
  if s.Count = 0 then
 
268
    Error(SErrNoPackageSpecified)
 
269
  else
 
270
    DoRun(FppkgCfg, 'build', s);
 
271
 
 
272
  s.Free;
 
273
end;
 
274
 
 
275
procedure TFppkgForm.CategoryCheckListBoxClickCheck(Sender: TObject);
 
276
begin
 
277
  UpdatePackageListView;
 
278
end;
 
279
 
 
280
procedure TFppkgForm.FormCreate(Sender: TObject);
 
281
begin
 
282
  //setup log callback function
 
283
  LogHandler := @LazLog;
 
284
 
 
285
  //setup error callback function
 
286
  ErrorHandler := @LazError;
 
287
  SetDefaultRepositoryClass(TLazFPRepository);
 
288
 
 
289
 
 
290
  Caption := rsFreePascalPackageManagerForLazarus;
 
291
 
 
292
  SupportCheckGroup.Checked[0] := True;
 
293
  SupportCheckGroup.Checked[1] := True;
 
294
  SupportCheckGroup.Checked[2] := True;
 
295
 
 
296
  SearchPhrases := TStringList.Create;
 
297
  SearchPhrases.Delimiter := ' ';
 
298
 
 
299
  ListPackages;
 
300
 
 
301
  UpdatePackageListView;
 
302
end;
 
303
 
 
304
procedure TFppkgForm.FormDestroy(Sender: TObject);
 
305
begin
 
306
  FreeAndNil(AvailableRepository);
 
307
  SearchPhrases.Free;
 
308
end;
 
309
 
 
310
procedure TFppkgForm.InstallButtonClick(Sender: TObject);
 
311
var
 
312
  s: TStrings;
 
313
  {$IFDEF LazarusIDEPackage}
 
314
    P: TLazFPPackage;
 
315
    RebuildLazarus: boolean;
 
316
    PkgFlags: TPkgInstallInIDEFlags;
 
317
    APackage: TIDEPackage;
 
318
    InstPackages: TObjectList;
 
319
    i, j, k: integer;
 
320
    LPKFile: string;
 
321
  {$ENDIF}
 
322
begin
 
323
  s := TStringList.Create;
 
324
 
 
325
  GetSelectedPackages(s);
 
326
 
 
327
  if s.Count = 0 then
 
328
    Error(SErrNoPackageSpecified)
 
329
  else
 
330
  begin
 
331
    DoRun(FppkgCfg, 'install', s);
 
332
    ListPackages;
 
333
    UpdatePackageListView;
 
334
 
 
335
    {$IFDEF LazarusIDEPackage}
 
336
    RebuildLazarus := False;
 
337
    InstPackages:=TObjectList.create;
 
338
    try
 
339
      PkgFlags := [piiifQuiet];
 
340
      for i:=0 to s.Count-1 do
 
341
      begin
 
342
        P := InstalledRepository.FindPackage(s.Strings[i]) as TLazFPPackage;
 
343
        if P.HasLazarusPackageFiles then
 
344
          for j := 0 to p.LazarusPackageFiles.Count-1 do
 
345
          begin
 
346
            LPKFile := P.LazarusPackageFiles.Strings[j];
 
347
 
 
348
            //make sure to determine if the IDE needs to be rebuilt
 
349
            if LPKStatus(LPKFile) in [lpDesigntime, lpBoth] then
 
350
            begin
 
351
              RebuildLazarus := True;
 
352
              PkgFlags := PkgFlags + [piiifRebuildIDE];
 
353
            end;
 
354
 
 
355
            //add LPK file to IDE
 
356
            {$note what's the modal result doing here?}
 
357
 
 
358
            PackageEditingInterface.DoOpenPackageFile(LPKFile,[pofRevert,pofDoNotOpenEditor],true);
 
359
            APackage := nil;
 
360
            for k := 0 to PackageEditingInterface.GetPackageCount-1 do
 
361
              if PackageEditingInterface.GetPackages(k).Filename = LPKFile then
 
362
                begin
 
363
                  APackage := PackageEditingInterface.GetPackages(k);
 
364
                  break;
 
365
                end;
 
366
            if not assigned(APackage) then
 
367
              raise exception.create('Failed to find just installed package. Something went wrong.');
 
368
            InstPackages.Add(APackage);
 
369
          end;
 
370
      end;
 
371
 
 
372
      if InstPackages.Count>0 then
 
373
        PackageEditingInterface.InstallPackages(InstPackages,PkgFlags);
 
374
    finally
 
375
      InstPackages.Free;
 
376
    end;
 
377
    if RebuildLazarus then
 
378
      ExecuteIDECommand(Self, ecBuildLazarus);
 
379
    {$ENDIF}
 
380
  end;
 
381
  s.Free;
 
382
end;
 
383
 
 
384
procedure TFppkgForm.MenuItem4Click(Sender: TObject);
 
385
begin
 
386
  if not Assigned(FppkgAboutForm) then
 
387
    FppkgAboutForm := TFppkgAboutForm.Create(Self);
 
388
 
 
389
  FppkgAboutForm.ShowModal;
 
390
  FreeAndNil(FppkgAboutForm);
 
391
end;
 
392
 
 
393
procedure TFppkgForm.miClearMemoClick(Sender: TObject);
 
394
begin
 
395
  OutputMemo.Clear;
 
396
end;
 
397
 
 
398
procedure TFppkgForm.miCleanMessagesClick(Sender: TObject);
 
399
begin
 
400
  OutputMemo.Clear;
 
401
end;
 
402
 
 
403
procedure TFppkgForm.PackageListViewDblClick(Sender: TObject);
 
404
begin
 
405
  //only for selected items show details
 
406
  if not Assigned(PackageListView.Selected) then
 
407
    exit;
 
408
 
 
409
  if not Assigned(PkgDetailsForm) then
 
410
    PkgDetailsForm := TPkgDetailsForm.Create(Self);
 
411
 
 
412
  PkgDetailsForm.PackageName := PackageListView.Selected.Caption;
 
413
  PkgDetailsForm.ShowModal;
 
414
 
 
415
  FreeAndNil(PkgDetailsForm);
 
416
end;
 
417
 
 
418
procedure TFppkgForm.MenuItem2Click(Sender: TObject);
 
419
begin
 
420
  if not Assigned(OptionsForm) then
 
421
    OptionsForm := TOptionsForm.Create(Self);
 
422
 
 
423
  OptionsForm.ShowModal;
 
424
 
 
425
  //to be sure setup the view again
 
426
  UpdatePackageListView;
 
427
end;
 
428
 
 
429
procedure TFppkgForm.miExitClick(Sender: TObject);
 
430
begin
 
431
  Close;
 
432
end;
 
433
 
 
434
procedure TFppkgForm.miSelectClick(Sender: TObject);
 
435
var
 
436
  i: integer;
 
437
begin
 
438
  for i := 0 to PackageListView.Items.Count - 1 do
 
439
    if PackageListView.Items[i].Selected then
 
440
      PackageListView.Items[i].Checked := True;
 
441
end;
 
442
 
 
443
procedure TFppkgForm.miUnselectClick(Sender: TObject);
 
444
var
 
445
  i: integer;
 
446
begin
 
447
  for i := 0 to PackageListView.Items.Count - 1 do
 
448
    if PackageListView.Items[i].Selected then
 
449
      PackageListView.Items[i].Checked := False;
 
450
end;
 
451
 
 
452
procedure TFppkgForm.SearchButtonClick(Sender: TObject);
 
453
begin
 
454
  SearchPhrases.DelimitedText := SearchEdit.Text;
 
455
  UpdatePackageListView;
 
456
end;
 
457
 
 
458
procedure TFppkgForm.SearchEditKeyUp(Sender: TObject; var Key: word;
 
459
  Shift: TShiftState);
 
460
begin
 
461
  if Key = 13 then
 
462
  begin
 
463
    SearchPhrases.DelimitedText := SearchEdit.Text;
 
464
    UpdatePackageListView;
 
465
  end;
 
466
end;
 
467
 
 
468
procedure TFppkgForm.SupportCheckGroupItemClick(Sender: TObject; Index: integer);
 
469
begin
 
470
  UpdatePackageListView;
 
471
end;
 
472
 
 
473
procedure TFppkgForm.UpdateButtonClick(Sender: TObject);
 
474
var
 
475
  s: TStrings;
 
476
begin
 
477
  s := TStringList.Create;
 
478
  DoRun(FppkgCfg, 'update', s);
 
479
  UpdatePackageListView;
 
480
  s.Free;
 
481
end;
 
482
 
 
483
procedure TFppkgForm.MaybeCreateLocalDirs;
 
484
begin
 
485
  ForceDirectories(GlobalOptions.BuildDir);
 
486
  ForceDirectories(GlobalOptions.ArchivesDir);
 
487
  ForceDirectories(GlobalOptions.CompilerConfigDir);
 
488
end;
 
489
 
 
490
function TFppkgForm.FindSearchPhrase(pkg: TLazPackageData): boolean;
 
491
var
 
492
  i: integer;
 
493
  searchmask: string;
 
494
begin
 
495
  Result := False;
 
496
 
 
497
  if SearchPhrases.Count = 0 then
 
498
    Result := True;
 
499
 
 
500
  for i := 0 to SearchPhrases.Count - 1 do
 
501
  begin
 
502
    searchmask := LowerCase('*' + SearchPhrases[i] + '*');
 
503
 
 
504
    if MatchesMask(LowerCase(pkg.Description), searchmask) or
 
505
      MatchesMask(LowerCase(pkg.Category), searchmask) or
 
506
      MatchesMask(LowerCase(pkg.Keywords), searchmask) or
 
507
      MatchesMask(LowerCase(pkg.Name), searchmask) then
 
508
    begin
 
509
      Result := True;
 
510
      exit;
 
511
    end;
 
512
  end;
 
513
end;
 
514
 
 
515
function TFppkgForm.FindCategory(pkg: TLazPackageData): boolean;
 
516
var
 
517
  i: integer;
 
518
  searchmask: string;
 
519
begin
 
520
  Result := False;
 
521
 
 
522
  for i := 0 to CategoryCheckListBox.Count - 1 do
 
523
  begin
 
524
    if CategoryCheckListBox.Checked[i] then
 
525
    begin
 
526
      //determine the searchmask
 
527
      if CategoryCheckListBox.Items[i] = 'All' then
 
528
        searchmask := '*'
 
529
      else
 
530
      if CategoryCheckListBox.Items[i] = 'Unknown' then
 
531
        searchmask := ''
 
532
      else
 
533
        searchmask := CategoryCheckListBox.Items[i];
 
534
 
 
535
      if MatchesMask(pkg.Category, searchmask) then
 
536
      begin
 
537
        Result := True;
 
538
        exit;
 
539
      end;
 
540
    end;
 
541
  end;
 
542
end;
 
543
 
 
544
function TFppkgForm.FindSupport(pkg: TLazPackageData): boolean;
 
545
begin
 
546
  Result := False;
 
547
 
 
548
  //FPC
 
549
  Result := Result or (SupportCheckGroup.Checked[0] and (pkg.Category = 'FPC'));
 
550
 
 
551
  //Lazarus
 
552
  Result := Result or (SupportCheckGroup.Checked[1] and (pkg.Category = 'Lazarus'));
 
553
 
 
554
  //Rest
 
555
  Result := Result or (SupportCheckGroup.Checked[2] and
 
556
    ((pkg.Category <> 'FPC') and (pkg.Category <> 'Lazarus')));
 
557
end;
 
558
 
 
559
procedure TFppkgForm.GetSelectedPackages(var s: TStrings);
 
560
var
 
561
  i: integer;
 
562
begin
 
563
  for i := 0 to PackageListView.Items.Count - 1 do
 
564
    if PackageListView.Items[i].Checked then
 
565
      s.Add(PackageListView.Items[i].Caption);
 
566
end;
 
567
 
 
568
procedure TFppkgForm.LoadCompilerDefaults;
 
569
var
 
570
  S: string;
 
571
begin
 
572
  // Load default compiler config
 
573
  S := GlobalOptions.CompilerConfigDir + GlobalOptions.CompilerConfig;
 
574
  CompilerOptions.UpdateLocalRepositoryOption;
 
575
  if FileExists(S) then
 
576
  begin
 
577
    pkgglobals.Log(vlDebug, SLogLoadingCompilerConfig, [S]);
 
578
    CompilerOptions.LoadCompilerFromFile(S);
 
579
  end
 
580
  else
 
581
  begin
 
582
    // Generate a default configuration if it doesn't exists
 
583
    if GlobalOptions.CompilerConfig = 'default' then
 
584
    begin
 
585
      pkgglobals.Log(vlDebug, SLogGeneratingCompilerConfig, [S]);
 
586
      CompilerOptions.InitCompilerDefaults;
 
587
      CompilerOptions.SaveCompilerToFile(S);
 
588
      if CompilerOptions.SaveInifileChanges then
 
589
        CompilerOptions.SaveCompilerToFile(S);
 
590
    end
 
591
    else
 
592
      Error(SErrMissingCompilerConfig, [S]);
 
593
  end;
 
594
  // Log compiler configuration
 
595
  CompilerOptions.LogValues(vlDebug, '');
 
596
  // Load FPMake compiler config, this is normally the same config as above
 
597
  S := GlobalOptions.CompilerConfigDir + GlobalOptions.FPMakeCompilerConfig;
 
598
  FPMakeCompilerOptions.UpdateLocalRepositoryOption;
 
599
  if FileExists(S) then
 
600
  begin
 
601
    pkgglobals.Log(vlDebug, SLogLoadingFPMakeCompilerConfig, [S]);
 
602
    FPMakeCompilerOptions.LoadCompilerFromFile(S);
 
603
    if FPMakeCompilerOptions.SaveInifileChanges then
 
604
      FPMakeCompilerOptions.SaveCompilerToFile(S);
 
605
  end
 
606
  else
 
607
    Error(SErrMissingCompilerConfig, [S]);
 
608
  // Log compiler configuration
 
609
  FPMakeCompilerOptions.LogValues(vlDebug, 'fpmake-building ');
 
610
end;
 
611
 
 
612
procedure TFppkgForm.DoRun(cfg: TFppkgConfigOptions; ParaAction: string;
 
613
  ParaPackages: TStrings);
 
614
var
 
615
  ActionPackage: TFPPackage;
 
616
  OldCurrDir: string;
 
617
  i: integer;
 
618
  SL: TStringList;
 
619
begin
 
620
  OldCurrDir := GetCurrentDir;
 
621
  try
 
622
    LoadGlobalDefaults(cfg.ConfigFile);
 
623
    //ProcessCommandLine(true);
 
624
 
 
625
    // Scan is special, it doesn't need a valid local setup
 
626
    if (ParaAction = 'laz_scan') then
 
627
    begin
 
628
      RebuildRemoteRepository;
 
629
      ListRemoteRepository;
 
630
      SaveRemoteRepository;
 
631
      exit;
 
632
    end;
 
633
 
 
634
    MaybeCreateLocalDirs;
 
635
    if not GlobalOptions.SkipConfigurationFiles then
 
636
      LoadCompilerDefaults
 
637
    else
 
638
    begin
 
639
      FPMakeCompilerOptions.InitCompilerDefaults;
 
640
      CompilerOptions.InitCompilerDefaults;
 
641
    end;
 
642
 
 
643
    // The command-line is parsed for the second time, to make it possible
 
644
    // to override the values in the compiler-configuration file. (like prefix)
 
645
    //ProcessCommandLine(false);
 
646
 
 
647
    // If CompilerVersion, CompilerOS or CompilerCPU is still empty, use the
 
648
    // compiler-executable to get them
 
649
    FPMakeCompilerOptions.CheckCompilerValues;
 
650
    CompilerOptions.CheckCompilerValues;
 
651
 
 
652
    LoadLocalAvailableMirrors;
 
653
 
 
654
    // Load local repository, update first if this is a new installation
 
655
    // errors will only be reported as warning. The user can be bootstrapping
 
656
    // and do an update later
 
657
    if not FileExists(GlobalOptions.LocalPackagesFile) then
 
658
    begin
 
659
      try
 
660
        laz_pkghandler.Laz_ExecuteAction('', 'laz_update');
 
661
      except
 
662
        on E: Exception do
 
663
          pkgglobals.Log(vlWarning, E.Message);
 
664
      end;
 
665
    end;
 
666
    LoadLocalAvailableRepository;
 
667
    FindInstalledPackages(FPMakeCompilerOptions, True);
 
668
    CheckFPMakeDependencies;
 
669
    // We only need to reload the status when we use a different
 
670
    // configuration for compiling fpmake
 
671
    if GlobalOptions.CompilerConfig <> GlobalOptions.FPMakeCompilerConfig then
 
672
      FindInstalledPackages(CompilerOptions, True);
 
673
 
 
674
    // Check for broken dependencies
 
675
    if not GlobalOptions.AllowBroken and
 
676
      (((ParaAction = 'laz_fixbroken') and (ParaPackages.Count > 0)) or
 
677
      (ParaAction = 'laz_compile') or (ParaAction = 'laz_build') or
 
678
      (ParaAction = 'laz_install') or (ParaAction = 'laz_archive')) then
 
679
    begin
 
680
      pkgglobals.Log(vlDebug, SLogCheckBrokenDependenvies);
 
681
      SL := TStringList.Create;
 
682
      if FindBrokenPackages(SL) then
 
683
        Error(SErrBrokenPackagesFound);
 
684
      FreeAndNil(SL);
 
685
    end;
 
686
 
 
687
    if ParaPackages.Count = 0 then
 
688
    begin
 
689
      ActionPackage := AvailableRepository.AddPackage(CurrentDirPackageName);
 
690
      laz_pkghandler.Laz_ExecuteAction(CurrentDirPackageName, ParaAction);
 
691
    end
 
692
    else
 
693
    begin
 
694
      // Process packages
 
695
      for i := 0 to ParaPackages.Count - 1 do
 
696
      begin
 
697
        if sametext(ExtractFileExt(ParaPackages[i]), '.zip') and
 
698
          FileExists(ParaPackages[i]) then
 
699
        begin
 
700
          ActionPackage := AvailableRepository.AddPackage(CmdLinePackageName);
 
701
          ActionPackage.LocalFileName := ExpandFileName(ParaPackages[i]);
 
702
          laz_pkghandler.Laz_ExecuteAction(CmdLinePackageName, ParaAction);
 
703
        end
 
704
        else
 
705
        begin
 
706
          pkgglobals.Log(vlDebug, SLogCommandLineAction,['[' + ParaPackages[i] + ']', ParaAction]);
 
707
          laz_pkghandler.Laz_ExecuteAction(ParaPackages[i], ParaAction);
 
708
        end;
 
709
      end;
 
710
    end;
 
711
 
 
712
    // Recompile all packages dependent on this package
 
713
    if (ParaAction = 'install') and not GlobalOptions.SkipFixBrokenAfterInstall then
 
714
      laz_pkghandler.Laz_ExecuteAction('', 'fixbroken');
 
715
 
 
716
  except
 
717
    On E: Exception do
 
718
    begin
 
719
      Error(SErrException);
 
720
      Error(E.Message);
 
721
      exit;
 
722
    end;
 
723
  end;
 
724
  SetCurrentDir(OldCurrDir);
 
725
end;
 
726
 
 
727
function PkgColumnValue(AName: string; pkg: TLazPackageData): string;
 
728
begin
 
729
  if AName = 'Name' then
 
730
    Result := pkg.Name;
 
731
  if AName = 'Installed' then
 
732
    Result := pkg.InstalledVersion;
 
733
  if AName = 'Available' then
 
734
    Result := pkg.AvialableVersion;
 
735
  if AName = 'Description' then
 
736
    Result := pkg.Description;
 
737
  if AName = 'State' then
 
738
    Result := pkg.State;
 
739
  if AName = 'Keywords' then
 
740
    Result := pkg.Keywords;
 
741
  if AName = 'Category' then
 
742
    Result := pkg.Category;
 
743
  if AName = 'Support' then
 
744
    Result := pkg.Support;
 
745
  if AName = 'Author' then
 
746
    Result := pkg.Author;
 
747
  if AName = 'License' then
 
748
    Result := pkg.License;
 
749
  if AName = 'HomepageURL' then
 
750
    Result := pkg.HomepageURL;
 
751
  if AName = 'DownloadURL' then
 
752
    Result := pkg.DownloadURL;
 
753
  if AName = 'FileName' then
 
754
    Result := pkg.FileName;
 
755
  if AName = 'Email' then
 
756
    Result := pkg.Email;
 
757
  if AName = 'OS' then
 
758
    Result := pkg.OS;
 
759
  if AName = 'CPU' then
 
760
    Result := pkg.CPU;
 
761
end;
 
762
 
 
763
procedure TFppkgForm.UpdatePackageListView;
 
764
var
 
765
  i, c: integer;
 
766
  li: TListItem;
 
767
  pkg: TLazPackageData;
 
768
  col: TListColumn;
 
769
  f: boolean;
 
770
begin
 
771
  //setup the package listview
 
772
  PackageListView.BeginUpdate;
 
773
 
 
774
  //setup columns
 
775
  PackageListView.Columns.Clear;
 
776
  for c := 0 to LazPkgOptions.PkgColumnCount - 1 do
 
777
    if LazPkgOptions.PkgColumns[c].Visible then
 
778
    begin
 
779
      col := PackageListView.Columns.Add;
 
780
      col.Caption := LazPkgOptions.PkgColumns[c].Name;
 
781
      col.AutoSize := True;
 
782
    end;
 
783
 
 
784
  PackageListView.Clear;
 
785
 
 
786
  for i := 0 to Laz_Packages.Count - 1 do
 
787
  begin
 
788
    pkg := Laz_Packages.PkgData[i];
 
789
 
 
790
    if FindSearchPhrase(pkg) and FindCategory(pkg) and FindSupport(pkg) then
 
791
    begin
 
792
      li := PackageListView.Items.Add;
 
793
 
 
794
      f := False;
 
795
      for c := 0 to LazPkgOptions.PkgColumnCount - 1 do
 
796
      begin
 
797
        if LazPkgOptions.PkgColumns[c].Visible then
 
798
          if not f then
 
799
          begin
 
800
            li.Caption := PkgColumnValue(LazPkgOptions.PkgColumns[c].Name, pkg);
 
801
            f := True;
 
802
          end
 
803
          else
 
804
            li.SubItems.Add(PkgColumnValue(LazPkgOptions.PkgColumns[c].Name, pkg));
 
805
      end;
 
806
 
 
807
      //add images to supported packages
 
808
      if LowerCase(pkg.Support) = 'fpc' then
 
809
        li.ImageIndex := FPC_SUPPORTED
 
810
      else
 
811
      if LowerCase(pkg.Support) = 'lazarus' then
 
812
        li.ImageIndex := LAZARUS_SUPPORTED
 
813
      else
 
814
        li.ImageIndex := COMMUNITY_SUPPORTED;
 
815
    end;
 
816
  end;
 
817
 
 
818
  PackageListView.EndUpdate;
 
819
end;
 
820
 
 
821
procedure TFppkgForm.ListPackages;
 
822
var
 
823
  s: TStringList;
 
824
  i: integer;
 
825
  pkg: TLazPackageData;
 
826
  cat: string;
 
827
begin
 
828
  //update the package list
 
829
  s := TStringList.Create;
 
830
  DoRun(FppkgCfg, 'laz_list', s);
 
831
  s.Free;
 
832
 
 
833
  //setup the categories listview
 
834
  CategoryCheckListBox.Clear;
 
835
  CategoryCheckListBox.Items.Add('All');
 
836
  for i := 0 to Laz_Packages.Count - 1 do
 
837
  begin
 
838
    pkg := Laz_Packages.PkgData[i];
 
839
 
 
840
    if pkg.Category = '' then
 
841
      cat := 'Unknown'
 
842
    else
 
843
      cat := pkg.Category;
 
844
 
 
845
    if CategoryCheckListBox.Items.IndexOf(cat) = -1 then
 
846
      CategoryCheckListBox.Items.Add(cat);
 
847
  end;
 
848
 
 
849
  //check all the items
 
850
  for i := 0 to CategoryCheckListBox.Count - 1 do
 
851
    CategoryCheckListBox.Checked[i] := True;
 
852
end;
 
853
 
 
854
end.
 
855