← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ide/fpcsrcscan.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
http://bugs.debian.org/708695
[ 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:
ide/fpcsrcscan.pas
41
41
 
42
42
  TFPCSrcScan = class(TThread)
43
43
  protected
 
44
    fLogMsg: string;
44
45
    Files: TStringList;
45
46
    procedure Execute; override;
46
47
    procedure OnFilesGathered; // main thread, called after thread has collected Files
 
48
    procedure MainThreadLog;
 
49
    procedure Log(Msg: string);
47
50
  public
48
51
    Directory: string;
49
52
    Scans: TFPCSrcScans;
71
74
 
72
75
implementation
73
76
 
74
 
{ TFPCSrcScan }
75
 
 
76
 
procedure TFPCSrcScan.Execute;
77
 
begin
78
 
  try
79
 
    // scan fpc source directory, check for terminated
80
 
    Files:=GatherFilesInFPCSources(Directory,nil);
81
 
    //debugln(['TFPCSrcScan.Execute ',Files<>nil]);
82
 
    // let main thread update the codetools fpc source cache
83
 
    Synchronize(@OnFilesGathered);
84
 
  except
85
 
    on E: Exception do begin
86
 
      debugln(['TFPCSrcScan.Execute error: ',E.Message]);
87
 
    end;
88
 
  end;
89
 
end;
90
 
 
91
 
procedure TFPCSrcScan.OnFilesGathered;
 
77
procedure ApplyFPCSrcFiles(FPCSrcDir: string; var Files: TStringList);
92
78
var
93
79
  SrcCache: TFPCSourceCache;
94
80
begin
95
 
  //debugln(['TFPCSrcScan.OnFilesGathered ',Directory,' FileCount=',Files.Count]);
 
81
  debugln(['ApplyFPCSrcFiles ',FPCSrcDir,' FileCount=',Files.Count]);
96
82
  // copy Files to codetools cache
97
83
  if CodeToolBoss<>nil then
98
84
  begin
99
 
    SrcCache:=CodeToolBoss.FPCDefinesCache.SourceCaches.Find(Directory,true);
 
85
    SrcCache:=CodeToolBoss.FPCDefinesCache.SourceCaches.Find(FPCSrcDir,true);
 
86
    debugln(['ApplyFPCSrcFiles SrcCache.Update ...']);
100
87
    SrcCache.Update(Files);
101
88
 
102
 
    //debugln(['TFPCSrcScan.OnFilesGathered BuildBoss.RescanCompilerDefines ...']);
 
89
    debugln(['ApplyFPCSrcFiles BuildBoss.RescanCompilerDefines ...']);
103
90
    if BuildBoss<>nil then
104
 
      BuildBoss.RescanCompilerDefines(false,false,false);
 
91
      BuildBoss.RescanCompilerDefines(false,false,false,true);
105
92
  end;
106
93
  FreeAndNil(Files);
107
 
  // delete item in progress window
108
 
  //debugln(['TFPCSrcScan.OnFilesGathered closing progress item ...']);
109
 
  FreeAndNil(ProgressItem);
110
 
  Scans.Remove(Self);
111
 
  //debugln(['TFPCSrcScan.OnFilesGathered END']);
 
94
end;
 
95
 
 
96
{ TFPCSrcScan }
 
97
 
 
98
procedure TFPCSrcScan.Execute;
 
99
begin
 
100
  try
 
101
    Log('TFPCSrcScan.Execute START '+Directory);
 
102
    // scan fpc source directory, check for terminated
 
103
    Files:=GatherFilesInFPCSources(Directory,nil);
 
104
    Log('TFPCSrcScan.Execute found some files: '+dbgs((Files<>nil) and (Files.Count>0)));
 
105
  except
 
106
    on E: Exception do begin
 
107
      Log('TFPCSrcScan.Execute error: '+E.Message);
 
108
    end;
 
109
  end;
 
110
  if Files=nil then
 
111
    Files:=TStringList.Create;
 
112
  // let main thread update the codetools fpc source cache
 
113
  Synchronize(@OnFilesGathered);
 
114
end;
 
115
 
 
116
procedure TFPCSrcScan.OnFilesGathered;
 
117
begin
 
118
  try
 
119
    ApplyFPCSrcFiles(Directory,Files);
 
120
    // delete item in progress window
 
121
    debugln(['TFPCSrcScan.OnFilesGathered closing progress item ...']);
 
122
    FreeAndNil(ProgressItem);
 
123
    Scans.Remove(Self);
 
124
    debugln(['TFPCSrcScan.OnFilesGathered END']);
 
125
  except
 
126
    on E: Exception do
 
127
      debugln(['TFPCSrcScan.OnFilesGathered ERROR: ',E.Message]);
 
128
  end;
 
129
end;
 
130
 
 
131
procedure TFPCSrcScan.MainThreadLog;
 
132
begin
 
133
  debugln(fLogMsg);
 
134
end;
 
135
 
 
136
procedure TFPCSrcScan.Log(Msg: string);
 
137
begin
 
138
  fLogMsg:=Msg;
 
139
  Synchronize(@MainThreadLog);
112
140
end;
113
141
 
114
142
{ TFPCSrcScans }
183
211
 
184
212
procedure TFPCSrcScans.Scan(Directory: string);
185
213
var
 
214
{$IFDEF DisableMultiThreading}
 
215
  Files: TStringList;
 
216
{$ELSE}
186
217
  i: Integer;
187
218
  Item: TFPCSrcScan;
 
219
{$ENDIF}
188
220
begin
189
 
  EnterCriticalsection;
190
 
  try
191
 
    // check if already scanning that directory
192
 
    for i:=0 to Count-1 do
193
 
      if CompareFilenames(Directory,Items[i].Directory)=0 then exit;
194
 
    // create thread and create progress window
195
 
    Item:=TFPCSrcScan.Create(true);
196
 
    Item.FreeOnTerminate:=true;
197
 
    Item.Scans:=Self;
198
 
    Item.Directory:=Directory;
199
 
    fItems.Add(Item);
200
 
  finally
201
 
    LeaveCriticalsection;
202
 
  end;
203
 
  Item.ProgressItem:=CreateProgressItem('FPCSrcScan',
204
 
    Format(lisCreatingFileIndexOfFPCSources, [Directory]),
205
 
    lisTheFileIndexIsNeededForFunctionsLikeFindDeclaratio);
206
 
  Item.Resume;
 
221
  {$IFDEF DisableMultiThreading}
 
222
  // scan fpc source directory, check for terminated
 
223
  Files:=GatherFilesInFPCSources(Directory,nil);
 
224
  if Files=nil then
 
225
    Files:=TStringList.Create;
 
226
  ApplyFPCSrcFiles(Directory,Files);
 
227
  {$ELSE}
 
228
    EnterCriticalsection;
 
229
    try
 
230
      // check if already scanning that directory
 
231
      for i:=0 to Count-1 do
 
232
        if CompareFilenames(Directory,Items[i].Directory)=0 then exit;
 
233
      // create thread and create progress window
 
234
      Item:=TFPCSrcScan.Create(true);
 
235
      Item.FreeOnTerminate:=true;
 
236
      Item.Scans:=Self;
 
237
      Item.Directory:=Directory;
 
238
      fItems.Add(Item);
 
239
    finally
 
240
      LeaveCriticalsection;
 
241
    end;
 
242
    Item.ProgressItem:=CreateProgressItem('FPCSrcScan',
 
243
      Format(lisCreatingFileIndexOfFPCSources, [Directory]),
 
244
      lisTheFileIndexIsNeededForFunctionsLikeFindDeclaratio);
 
245
    {$IF defined(VER2_4_2) or defined(VER2_4_3)}
 
246
    Item.Resume;
 
247
    {$ELSE}
 
248
    Item.Start;
 
249
    {$ENDIF}
 
250
  {$ENDIF}
207
251
end;
208
252
 
209
253
end.