← Back to branch summary

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

« back to all changes in this revision

Viewing changes to converter/usedunits.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:
converter/usedunits.pas
36
36
  LazarusIDEStrConsts, IDEMsgIntf,
37
37
  // codetools
38
38
  CodeToolManager, StdCodeTools, CodeTree, CodeCache, CodeToolsStructs, AVL_Tree,
39
 
  KeywordFuncLists, SourceChanger,
 
39
  LinkScanner, KeywordFuncLists, SourceChanger, CodeAtom, CodeToolsStrConsts,
40
40
  // Converter
41
41
  ConverterTypes, ConvCodeTool, ConvertSettings, ReplaceNamesUnit;
42
42
 
48
48
 
49
49
  TUsedUnits = class
50
50
  private
51
 
    fCTLink: TCodeToolLink;           // Link to codetools.
52
 
    fUsesSection: TUsesSection;       // Enum used by some codetools funcs.
53
 
    fExistingUnits: TStringList;      // List of units before conversion.
54
 
    fUnitsToAddForLCL: TStringList;   // List of new units for LCL (not for Delphi).
55
 
    fUnitsToRemove: TStringList;      // List of units to remove.
56
 
    // Units to rename. Map old unit name -> new unit name.
57
 
    fUnitsToRename: TStringToStringTree;
58
 
    fUnitsToComment: TStringList;     // List of units to be commented.
59
 
    fMissingUnits: TStringList;       // Units not found in search path.
 
51
    fCTLink: TCodeToolLink;              // Link to codetools.
 
52
    fOwnerTool: TUsedUnitsTool;
 
53
    fUsesSection: TUsesSection;          // Enum used by some codetools funcs.
 
54
    fExistingUnits: TStringList;         // List of units before conversion.
 
55
    fUnitsToAdd: TStringList;            // List of new units to add.
 
56
    fUnitsToAddForLCL: TStringList;      // List of new units for LCL (not for Delphi).
 
57
    fUnitsToRemove: TStringList;         // List of units to remove.
 
58
    fUnitsToRename: TStringToStringTree; // Units to rename. Map old name -> new name.
 
59
    fUnitsToRenameKeys: TStringList;     // List of keys of the above map.
 
60
    fUnitsToRenameVals: TStringList;     // List of values of the above map.
 
61
    fUnitsToFixCase: TStringToStringTree;// Like rename but done for every target.
 
62
    fUnitsToComment: TStringList;        // List of units to be commented.
 
63
    fMissingUnits: TStringList;          // Units not found in search path.
 
64
    function FindMissingUnits(AUnitUpdater: TStringMapUpdater): boolean;
60
65
    procedure ToBeRenamedOrRemoved(AOldName, ANewName: string);
61
66
    procedure FindReplacement(AUnitUpdater: TStringMapUpdater;
62
67
                              AMapToEdit: TStringToStringTree);
63
68
    function AddDelphiAndLCLSections: Boolean;
64
69
    function RemoveUnits: boolean;
65
 
    function RenameUnits: boolean;
66
 
    function AddUnits: boolean;
67
 
    function CommentOutUnits: boolean;
68
70
  protected
69
71
    // This is either the Interface or Implementation node.
70
72
    function ParentBlockNode: TCodeTreeNode; virtual; abstract;
71
73
    // Uses node in either Main or Implementation section.
72
74
    function UsesSectionNode: TCodeTreeNode; virtual; abstract;
73
75
  public
74
 
    constructor Create(ACTLink: TCodeToolLink);
 
76
    constructor Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
75
77
    destructor Destroy; override;
76
78
    procedure CommentAutomatic(ACommentedUnits: TStringList);
77
79
  public
78
 
    property ExistingUnits: TStringList read fExistingUnits;
79
 
    property UnitsToAddForLCL: TStringList read fUnitsToAddForLCL;
80
 
    property MissingUnits: TStringList read fMissingUnits;
81
80
    property UnitsToRemove: TStringList read fUnitsToRemove;
82
81
    property UnitsToRename: TStringToStringTree read fUnitsToRename;
83
 
    property UnitsToComment: TStringList read fUnitsToComment;
 
82
    property UnitsToFixCase: TStringToStringTree read fUnitsToFixCase;
 
83
    property MissingUnits: TStringList read fMissingUnits;
84
84
  end;
85
85
 
86
86
  { TMainUsedUnits }
91
91
    function ParentBlockNode: TCodeTreeNode; override;
92
92
    function UsesSectionNode: TCodeTreeNode; override;
93
93
  public
94
 
    constructor Create(ACTLink: TCodeToolLink);
 
94
    constructor Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
95
95
    destructor Destroy; override;
96
96
  end;
97
97
 
103
103
    function ParentBlockNode: TCodeTreeNode; override;
104
104
    function UsesSectionNode: TCodeTreeNode; override;
105
105
  public
106
 
    constructor Create(ACTLink: TCodeToolLink);
 
106
    constructor Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
107
107
    destructor Destroy; override;
108
108
  end;
109
109
 
112
112
  TUsedUnitsTool = class
113
113
  private
114
114
    fCTLink: TCodeToolLink;
 
115
    fFilename: string;
 
116
    fIsMainFile: Boolean;                 // Main project / package file.
 
117
    fIsConsoleApp: Boolean;
115
118
    fMainUsedUnits: TUsedUnits;
116
119
    fImplUsedUnits: TUsedUnits;
117
 
    fFilename: string;
 
120
    fCheckPackageDependencyEvent: TCheckUnitEvent;
118
121
    function GetMissingUnitCount: integer;
119
 
    function GetMissingUnits: TModalResult;
120
122
  public
121
123
    constructor Create(ACTLink: TCodeToolLink; AFilename: string);
122
124
    destructor Destroy; override;
123
125
    function Prepare: TModalResult;
124
126
    function Convert: TModalResult;
 
127
    function Remove(AUnit: string): TModalResult;
125
128
    procedure MoveMissingToComment(AAllCommentedUnits: TStrings);
 
129
    procedure AddUnitIfNeeded(AUnitName: string);
 
130
    function AddThreadSupport: TModalResult;
126
131
  public
 
132
    property IsMainFile: Boolean read fIsMainFile write fIsMainFile;
 
133
    property IsConsoleApp: Boolean read fIsConsoleApp write fIsConsoleApp;
127
134
    property MainUsedUnits: TUsedUnits read fMainUsedUnits;
128
135
    property ImplUsedUnits: TUsedUnits read fImplUsedUnits;
129
136
    property MissingUnitCount: integer read GetMissingUnitCount;
 
137
    property CheckPackDepEvent: TCheckUnitEvent read fCheckPackageDependencyEvent
 
138
                                               write fCheckPackageDependencyEvent;
130
139
  end;
131
140
 
132
141
 
148
157
 
149
158
{ TUsedUnits }
150
159
 
151
 
constructor TUsedUnits.Create(ACTLink: TCodeToolLink);
 
160
constructor TUsedUnits.Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
152
161
var
153
162
  UsesNode: TCodeTreeNode;
154
163
begin
155
164
  inherited Create;
156
165
  fCTLink:=ACTLink;
 
166
  fOwnerTool:=aOwnerTool;
 
167
  fUnitsToAdd:=TStringList.Create;
157
168
  fUnitsToAddForLCL:=TStringList.Create;
158
169
  fUnitsToRemove:=TStringList.Create;
159
 
  fUnitsToRename:=TStringToStringTree.Create(false);
 
170
  fUnitsToRename:=TStringToStringTree.Create(true);
 
171
  fUnitsToRenameKeys:=TStringList.Create;
 
172
  fUnitsToRenameKeys.CaseSensitive:=false;
 
173
  fUnitsToRenameVals:=TStringList.Create;
 
174
  fUnitsToRenameVals.CaseSensitive:=false;
 
175
  fUnitsToFixCase:=TStringToStringTree.Create(true);
160
176
  fUnitsToComment:=TStringList.Create;
161
177
  fMissingUnits:=TStringList.Create;
162
178
  // Get existing unit names from uses section
174
190
  fExistingUnits.Free;
175
191
  fMissingUnits.Free;
176
192
  fUnitsToComment.Free;
 
193
  fUnitsToFixCase.Free;
 
194
  fUnitsToRenameVals.Free;
 
195
  fUnitsToRenameKeys.Free;
177
196
  fUnitsToRename.Free;
178
197
  fUnitsToRemove.Free;
179
198
  fUnitsToAddForLCL.Free;
 
199
  fUnitsToAdd.Free;
180
200
  inherited Destroy;
181
201
end;
182
202
 
183
 
// function TUsedUnits.GetMissingUnits: TModalResult;  was here.
 
203
function TUsedUnits.FindMissingUnits(AUnitUpdater: TStringMapUpdater): boolean;
 
204
var
 
205
  UsesNode: TCodeTreeNode;
 
206
  InAtom, UnitNameAtom: TAtomPosition;
 
207
  OldUnitName, OldInFilename: String;
 
208
  NewUnitName, NewInFilename: String;
 
209
  AFilename, s, slo: String;
 
210
  x: Integer;
 
211
  OmitUnit: Boolean;
 
212
begin
 
213
  UsesNode:=UsesSectionNode;
 
214
  if UsesNode=nil then exit(true);
 
215
  with fCTLink do begin
 
216
    CodeTool.MoveCursorToUsesStart(UsesNode);
 
217
    repeat
 
218
      // read next unit name
 
219
      CodeTool.ReadNextUsedUnit(UnitNameAtom, InAtom);
 
220
      OldUnitName:=CodeTool.GetAtom(UnitNameAtom);
 
221
      if InAtom.StartPos>0 then
 
222
        OldInFilename:=copy(CodeTool.Src,InAtom.StartPos+1,
 
223
                            InAtom.EndPos-InAtom.StartPos-2)
 
224
      else
 
225
        OldInFilename:='';
 
226
      // find unit file
 
227
      NewUnitName:=OldUnitName;
 
228
      NewInFilename:=OldInFilename;
 
229
      AFilename:=CodeTool.FindUnitCaseInsensitive(NewUnitName,NewInFilename);
 
230
      s:=NewUnitName;
 
231
      if NewInFilename<>'' then
 
232
        s:=s+' in '''+NewInFilename+'''';
 
233
      if AFilename<>'' then begin                         // unit found
 
234
        OmitUnit:=Settings.OmitProjUnits.Find(NewUnitName, x);
 
235
        if (NewUnitName<>OldUnitName) and not OmitUnit then begin
 
236
          // Character case differs and it will not be replaced.
 
237
          fUnitsToFixCase[OldUnitName]:=NewUnitName;      // fix case
 
238
          IDEMessagesWindow.AddMsg(Format(lisConvDelphiFixedUnitCase,
 
239
                                          [OldUnitName, NewUnitName]), '', -1);
 
240
        end;
 
241
        // Report Windows specific units as missing if target is MultiPlatform,
 
242
        //  needed if work-platform is Windows (kind of a hack).
 
243
        slo:=LowerCase(NewUnitName);                        // 'variants' ?
 
244
        if (Settings.MultiPlatform and ((slo='windows') or (slo='shellapi'))) or OmitUnit then
 
245
          fMissingUnits.Add(s);
 
246
      end
 
247
      else begin
 
248
        // Omit Windows specific units from the list if target is "Windows only",
 
249
        //  needed if work-platform is different from Windows (kind of a hack).
 
250
        slo:=LowerCase(NewUnitName);
 
251
        if Settings.MultiPlatform or ((slo<>'windows') and (slo<>'shellapi')) then
 
252
          fMissingUnits.Add(s);
 
253
      end;
 
254
      if CodeTool.CurPos.Flag=cafComma then begin
 
255
        // read next unit name
 
256
        CodeTool.ReadNextAtom;
 
257
      end else if CodeTool.CurPos.Flag=cafSemicolon then begin
 
258
        break;
 
259
      end else
 
260
        CodeTool.RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',CodeTool.GetAtom]);
 
261
    until false;
 
262
  end;
 
263
  Result:=true;
 
264
end;
184
265
 
185
266
procedure TUsedUnits.ToBeRenamedOrRemoved(AOldName, ANewName: string);
186
267
// Replace a unit name with a new name or remove it if there is no new name.
 
268
var
 
269
  UnitInFileName: string;
187
270
begin
188
271
  if ANewName<>'' then begin
189
272
    fUnitsToRename[AOldName]:=ANewName;
190
 
    IDEMessagesWindow.AddMsg(Format(
191
 
      lisConvDelphiReplacedUnitSWithSInUsesSection, [AOldName, ANewName]), '', -1);
 
273
    fUnitsToRenameKeys.Add(AOldName);
 
274
    fUnitsToRenameVals.Add(ANewName);
 
275
    IDEMessagesWindow.AddMsg(Format(lisConvDelphiReplacedUnitInUsesSection,
 
276
                                    [AOldName, ANewName]), '', -1);
 
277
    // If the unit is not found, open the package containing it.
 
278
    UnitInFileName:='';
 
279
    if fCTLink.CodeTool.FindUnitCaseInsensitive(ANewName,UnitInFileName) = '' then
 
280
      if Assigned(fOwnerTool.CheckPackDepEvent) then
 
281
        if not fOwnerTool.CheckPackDepEvent(ANewName) then
 
282
          ;
192
283
  end
193
284
  else begin
194
285
    fUnitsToRemove.Add(AOldName);
195
 
    IDEMessagesWindow.AddMsg(Format(
196
 
        lisConvDelphiRemovedUsedUnitSInUsesSection, [AOldName]), '', -1);
 
286
    IDEMessagesWindow.AddMsg(Format(lisConvDelphiRemovedUnitInUsesSection,
 
287
                                    [AOldName]), '', -1);
197
288
  end;
198
289
end;
199
290
 
207
298
    UnitN:=fMissingUnits[i];
208
299
    if AUnitUpdater.FindReplacement(UnitN, s) then begin
209
300
      // Don't replace Windows unit with LCL units in a console application.
210
 
      if (LowerCase(UnitN)='windows') and fCTLink.IsConsoleApp then
 
301
      if (LowerCase(UnitN)='windows') and fOwnerTool.IsConsoleApp then
211
302
        s:='';
212
303
      if Assigned(AMapToEdit) then
213
304
        AMapToEdit[UnitN]:=s                      // Add for interactive editing.
223
314
  DelphiOnlyUnits: TStringList;  // Delphi specific units.
224
315
  LclOnlyUnits: TStringList;     // LCL specific units.
225
316
 
226
 
  function MoveToDelphi(AUnitName: string; ARenameForLcl: boolean): boolean;
 
317
  function MoveToDelphi(AUnitName: string): boolean;
227
318
  var
228
319
    UsesNode: TCodeTreeNode;
229
320
  begin
230
321
    Result:=True;
231
 
//    if fExistingUnits.Find(AUnitName, ind) then begin
232
 
      fCTLink.ResetMainScanner;
233
 
      fCTLink.CodeTool.BuildTree(fUsesSection=usMain);
234
 
      // Calls either FindMainUsesSection; or FindImplementationUsesSection;
 
322
    with fCTLink do begin
 
323
      ResetMainScanner;
 
324
      if fUsesSection=usMain then
 
325
        CodeTool.BuildTree(lsrMainUsesSectionEnd)
 
326
      else
 
327
        CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
 
328
      // Calls either FindMainUsesSection or FindImplementationUsesSection
235
329
      UsesNode:=UsesSectionNode;
236
330
      Assert(Assigned(UsesNode),
237
331
            'UsesNode should be assigned in AddDelphiAndLCLSections->MoveToDelphi');
238
 
      Result:=fCTLink.CodeTool.RemoveUnitFromUsesSection(UsesNode,
239
 
                                      UpperCaseStr(AUnitName), fCTLink.SrcCache);
240
 
      DelphiOnlyUnits.Add(AUnitName);
241
 
      if ARenameForLcl then
242
 
        LCLOnlyUnits.Add(fUnitsToRename[AUnitName]);
243
 
//    end;
 
332
      Result:=CodeTool.RemoveUnitFromUsesSection(UsesNode,UpperCaseStr(AUnitName),SrcCache);
 
333
    end;
 
334
    DelphiOnlyUnits.Add(AUnitName);
244
335
  end;
245
336
 
246
337
var
247
338
  i, InsPos: Integer;
248
339
  s: string;
249
340
  EndChar: char;
250
 
  RenameList: TStringList;
251
341
  UsesNode: TCodeTreeNode;
252
342
  ParentBlock: TCodeTreeNode;
253
343
begin
254
344
  Result:=False;
255
345
  DelphiOnlyUnits:=TStringList.Create;
256
346
  LclOnlyUnits:=TStringList.Create;
257
 
  RenameList:=TStringList.Create;
258
347
  try
259
348
    // Don't remove the unit names but add to Delphi block instead.
260
349
    for i:=0 to fUnitsToRemove.Count-1 do
261
 
      if not MoveToDelphi(fUnitsToRemove[i], False) then Exit;
 
350
      if not MoveToDelphi(fUnitsToRemove[i]) then Exit;
262
351
    // ... and don't comment the unit names either.
263
352
    for i:=0 to fUnitsToComment.Count-1 do
264
 
      if not MoveToDelphi(fUnitsToComment[i], False) then Exit;
 
353
      if not MoveToDelphi(fUnitsToComment[i]) then Exit;
265
354
    // Add replacement units to LCL block.
266
 
    fUnitsToRename.GetNames(RenameList);
267
 
    for i:=0 to RenameList.Count-1 do
268
 
      if not MoveToDelphi(RenameList[i], True) then Exit;
 
355
    for i:=0 to fUnitsToRenameKeys.Count-1 do begin
 
356
      if not MoveToDelphi(fUnitsToRenameKeys[i]) then Exit;
 
357
      LCLOnlyUnits.Add(fUnitsToRename[fUnitsToRenameKeys[i]]);
 
358
    end;
269
359
    // Additional units for LCL (like Interfaces).
270
360
    LCLOnlyUnits.AddStrings(fUnitsToAddForLCL);
271
361
    // Add LCL and Delphi sections for output.
272
362
    if (LclOnlyUnits.Count=0) and (DelphiOnlyUnits.Count=0) then Exit(True);
273
363
    fCTLink.ResetMainScanner;
274
 
    fCTLink.CodeTool.BuildTree(fUsesSection=usMain);
 
364
    if fUsesSection=usMain then
 
365
      fCTLink.CodeTool.BuildTree(lsrMainUsesSectionEnd)
 
366
    else
 
367
      fCTLink.CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
275
368
    UsesNode:=UsesSectionNode;
276
 
    if Assigned(UsesNode) then begin //uses section exists
 
369
    if Assigned(UsesNode) then begin      //uses section exists
277
370
      EndChar:=',';
278
371
      s:='';
279
 
      //TODO: check for special units
280
372
      fCTLink.CodeTool.MoveCursorToUsesStart(UsesNode);
281
373
      InsPos:=fCTLink.CodeTool.CurPos.StartPos;
282
374
    end
283
 
    else begin                        //uses section does not exist
 
375
    else begin                            //uses section does not exist
284
376
      EndChar:=';';
285
377
      s:=LineEnding;
286
378
      // ParentBlock should never be Nil. UsesNode=Nil only for implementation section.
314
406
    if not fCTLink.SrcCache.Replace(gtNewLine,gtNone,InsPos,InsPos,s) then exit;
315
407
    Result:=fCTLink.SrcCache.Apply;
316
408
  finally
317
 
    RenameList.Free;
 
409
//    RenameList.Free;
318
410
    LclOnlyUnits.Free;
319
411
    DelphiOnlyUnits.Free;
320
412
  end;
341
433
  Result:=false;
342
434
  for i:=0 to fUnitsToRemove.Count-1 do begin
343
435
    fCTLink.ResetMainScanner;
344
 
    fCTLink.CodeTool.BuildTree(fUsesSection=usMain);
 
436
    if fUsesSection=usMain then
 
437
      fCTLink.CodeTool.BuildTree(lsrMainUsesSectionEnd)
 
438
    else
 
439
      fCTLink.CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
345
440
    if not fCTLink.CodeTool.RemoveUnitFromUsesSection(UsesSectionNode,
346
441
                         UpperCaseStr(fUnitsToRemove[i]), fCTLink.SrcCache) then
347
442
      exit;
348
443
    if not fCTLink.SrcCache.Apply then exit;
349
444
  end;
350
 
  //fUnitsToRemove.Clear;
351
 
  Result:=true;
352
 
end;
353
 
 
354
 
function TUsedUnits.RenameUnits: boolean;
355
 
// Rename units
356
 
begin
357
 
  Result:=false;
358
 
  if not fCTLink.CodeTool.ReplaceUsedUnits(fUnitsToRename, fCTLink.SrcCache) then
359
 
    exit;
360
 
  //fUnitsToRename.Clear;
361
 
  Result:=true;
362
 
end;
363
 
 
364
 
function TUsedUnits.AddUnits: boolean;
365
 
var
366
 
  i: Integer;
367
 
begin
368
 
  Result:=false;
369
 
  for i:=0 to fUnitsToAddForLCL.Count-1 do
370
 
    if not fCTLink.CodeTool.AddUnitToSpecificUsesSection(
371
 
                    fUsesSection, fUnitsToAddForLCL[i], '', fCTLink.SrcCache) then exit;
372
 
  Result:=true;
373
 
end;
374
 
 
375
 
function TUsedUnits.CommentOutUnits: boolean;
376
 
// Comment out missing units
377
 
begin
378
 
  Result:=false;
379
 
  if fUnitsToComment.Count>0 then
380
 
    if not fCTLink.CodeTool.CommentUnitsInUsesSections(fUnitsToComment,
381
 
                                                       fCTLink.SrcCache) then
382
 
      exit;
 
445
  fUnitsToRemove.Clear;
383
446
  Result:=true;
384
447
end;
385
448
 
386
449
{ TMainUsedUnits }
387
450
 
388
 
constructor TMainUsedUnits.Create(ACTLink: TCodeToolLink);
 
451
constructor TMainUsedUnits.Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
389
452
begin
390
 
  inherited Create(ACTLink);
 
453
  inherited Create(ACTLink, aOwnerTool);
391
454
  fUsesSection:=usMain;
392
455
end;
393
456
 
408
471
 
409
472
{ TImplUsedUnits }
410
473
 
411
 
constructor TImplUsedUnits.Create(ACTLink: TCodeToolLink);
 
474
constructor TImplUsedUnits.Create(ACTLink: TCodeToolLink; aOwnerTool: TUsedUnitsTool);
412
475
begin
413
 
  inherited Create(ACTLink);
 
476
  inherited Create(ACTLink, aOwnerTool);
414
477
  fUsesSection:=usImplementation;
415
478
end;
416
479
 
436
499
  inherited Create;
437
500
  fCTLink:=ACTLink;
438
501
  fFilename:=AFilename;
439
 
  fCTLink.CodeTool.BuildTree(False);
 
502
  fIsMainFile:=False;
 
503
  fIsConsoleApp:=False;
 
504
  fCTLink.CodeTool.BuildTree(lsrEnd);
440
505
  // These will read uses sections while creating.
441
 
  fMainUsedUnits:=TMainUsedUnits.Create(ACTLink);
442
 
  fImplUsedUnits:=TImplUsedUnits.Create(ACTLink);
 
506
  fMainUsedUnits:=TMainUsedUnits.Create(ACTLink, Self);
 
507
  fImplUsedUnits:=TImplUsedUnits.Create(ACTLink, Self);
443
508
end;
444
509
 
445
510
destructor TUsedUnitsTool.Destroy;
449
514
  inherited Destroy;
450
515
end;
451
516
 
452
 
function TUsedUnitsTool.GetMissingUnits: TModalResult;
453
 
// Get missing unit by codetools.
454
 
// This can be moved to TUsedUnits if codetools is refactored.
455
 
var
456
 
  i: Integer;
457
 
  s: String;
458
 
  AllMissUnits: TStrings;
459
 
begin
460
 
  Result:=mrOk;
461
 
  AllMissUnits:=nil;    // Will be created by FindMissingUnits.
462
 
  try
463
 
    if not fCTLink.CodeTool.FindMissingUnits(AllMissUnits,False,True,fCTLink.SrcCache)
464
 
    then begin
465
 
      Result:=mrCancel;
466
 
      exit;
467
 
    end;
468
 
    if Assigned(AllMissUnits) then begin
469
 
      // Remove Windows specific units from the list if target is "Windows only",
470
 
      //  needed if work-platform is different from Windows (kind of a hack).
471
 
      if fCTLink.Settings.Target=ctLazarusWin then begin
472
 
        for i:=AllMissUnits.Count-1 downto 0 do begin
473
 
          s:=LowerCase(AllMissUnits[i]);
474
 
          if (s='windows') or (s='variants') or (s='shellapi') then
475
 
            AllMissUnits.Delete(i);
476
 
        end;
477
 
      end;
478
 
      // Split AllMissUnits into Main and Implementation
479
 
      for i:=0 to AllMissUnits.Count-1 do begin
480
 
        s:=AllMissUnits[i];
481
 
        if fMainUsedUnits.ExistingUnits.IndexOf(s)<>-1 then
482
 
          fMainUsedUnits.MissingUnits.Add(s);
483
 
        if fImplUsedUnits.ExistingUnits.IndexOf(s)<>-1 then
484
 
          fImplUsedUnits.MissingUnits.Add(s);
485
 
      end;
486
 
    end;
487
 
  finally
488
 
    AllMissUnits.Free;
489
 
  end;
490
 
end;
491
 
 
492
517
function TUsedUnitsTool.Prepare: TModalResult;
493
518
// Find missing units and mark some of them to be replaced later.
494
519
// More units can be marked for add, remove, rename and comment during conversion.
502
527
begin
503
528
  Result:=mrOK;
504
529
  // Add unit 'Interfaces' if project uses 'Forms' and doesn't have 'Interfaces' yet.
505
 
  if fCTLink.IsMainFile then begin
 
530
  if fIsMainFile then begin
506
531
    if ( fMainUsedUnits.fExistingUnits.Find('forms', i)
507
532
      or fImplUsedUnits.fExistingUnits.Find('forms', i) )
508
533
    and (not fMainUsedUnits.fExistingUnits.Find('interfaces', i) )
514
539
    MapToEdit:=Nil;
515
540
    if fCTLink.Settings.UnitsReplaceMode=rlInteractive then
516
541
      MapToEdit:=TStringToStringTree.Create(false);
517
 
    Result:=GetMissingUnits;
 
542
    fCTLink.CodeTool.BuildTree(lsrEnd);
 
543
    if not (fMainUsedUnits.FindMissingUnits(UnitUpdater) and
 
544
            fImplUsedUnits.FindMissingUnits(UnitUpdater)) then begin
 
545
      Result:=mrCancel;
 
546
      exit;
 
547
    end;
518
548
    if Result<>mrOK then exit;
519
549
    // Find replacements for missing units from settings.
520
550
    fMainUsedUnits.FindReplacement(UnitUpdater, MapToEdit);
537
567
        Node:=MapToEdit.Tree.FindSuccessor(Node);
538
568
      end;
539
569
    end;
540
 
//  if not fCodeTool.FixUsedUnitCase(fSrcCache) then exit;
541
570
  finally
542
571
    MapToEdit.Free;      // May be Nil but who cares.
543
572
    UnitUpdater.Free;
546
575
 
547
576
function TUsedUnitsTool.Convert: TModalResult;
548
577
// Add, remove, rename and comment out unit names that were marked earlier.
 
578
var
 
579
  i: Integer;
549
580
begin
550
581
  Result:=mrCancel;
551
 
  if fCTLink.Settings.Target=ctLazarus then begin
552
 
    // One way conversion -> remove and rename units.
553
 
    if not fMainUsedUnits.RemoveUnits then exit;    // Remove
554
 
    if not fImplUsedUnits.RemoveUnits then exit;
555
 
    if not fMainUsedUnits.RenameUnits then exit;    // Rename
556
 
    if not fImplUsedUnits.RenameUnits then exit;
 
582
  with fCTLink do begin
 
583
    // Fix case
 
584
    if not CodeTool.ReplaceUsedUnits(fMainUsedUnits.fUnitsToFixCase, SrcCache) then exit;
 
585
    if not CodeTool.ReplaceUsedUnits(fImplUsedUnits.fUnitsToFixCase, SrcCache) then exit;
 
586
    // Add more units.
 
587
    with fMainUsedUnits do begin
 
588
      for i:=0 to fUnitsToAdd.Count-1 do
 
589
        if not CodeTool.AddUnitToSpecificUsesSection(
 
590
                          fUsesSection, fUnitsToAdd[i], '', SrcCache) then exit;
 
591
    end;
 
592
    with fImplUsedUnits do begin
 
593
      for i:=0 to fUnitsToAdd.Count-1 do
 
594
        if not CodeTool.AddUnitToSpecificUsesSection(
 
595
                          fUsesSection, fUnitsToAdd[i], '', SrcCache) then exit;
 
596
    end;
 
597
    if fIsMainFile or (Settings.MultiPlatform and not Settings.SupportDelphi) then begin
 
598
      // One way conversion (or main file) -> remove and rename units.
 
599
      if not fMainUsedUnits.RemoveUnits then exit;    // Remove
 
600
      if not fImplUsedUnits.RemoveUnits then exit;
 
601
      // Rename
 
602
      if not CodeTool.ReplaceUsedUnits(fMainUsedUnits.fUnitsToRename, SrcCache) then exit;
 
603
      if not CodeTool.ReplaceUsedUnits(fImplUsedUnits.fUnitsToRename, SrcCache) then exit;
 
604
    end;
 
605
    if Settings.SupportDelphi then begin
 
606
      // Support Delphi. Add IFDEF blocks for units.
 
607
      if not fMainUsedUnits.AddDelphiAndLCLSections then exit;
 
608
      if not fImplUsedUnits.AddDelphiAndLCLSections then exit;
 
609
    end
 
610
    else begin // Lazarus only multi- or single-platform -> comment out units if needed.
 
611
      if not CodeTool.CommentUnitsInUsesSections(fMainUsedUnits.fUnitsToComment,
 
612
                                                 SrcCache) then exit;
 
613
      if not CodeTool.CommentUnitsInUsesSections(fImplUsedUnits.fUnitsToComment,
 
614
                                                 SrcCache) then exit;
 
615
      // Add more units meant for only LCL.
 
616
      with fMainUsedUnits do begin
 
617
        for i:=0 to fUnitsToAddForLCL.Count-1 do
 
618
          if not CodeTool.AddUnitToSpecificUsesSection(
 
619
                            fUsesSection, fUnitsToAddForLCL[i], '', SrcCache) then exit;
 
620
      end;
 
621
      with fImplUsedUnits do begin
 
622
        for i:=0 to fUnitsToAddForLCL.Count-1 do
 
623
          if not CodeTool.AddUnitToSpecificUsesSection(
 
624
                            fUsesSection, fUnitsToAddForLCL[i], '', SrcCache) then exit;
 
625
      end;
 
626
    end;
557
627
  end;
558
 
  if fCTLink.Settings.Target in [ctLazarusDelphi, ctLazarusDelphiSameDfm] then begin
559
 
    // Support Delphi. Add IFDEF blocks for units.
560
 
    if not fMainUsedUnits.AddDelphiAndLCLSections then exit;
561
 
    if not fImplUsedUnits.AddDelphiAndLCLSections then exit;
 
628
  Result:=mrOK;
 
629
end;
 
630
 
 
631
function TUsedUnitsTool.Remove(AUnit: string): TModalResult;
 
632
var
 
633
  x: Integer;
 
634
begin
 
635
  Result:=mrIgnore;
 
636
  if fMainUsedUnits.fExistingUnits.Find(AUnit, x) then begin
 
637
    fMainUsedUnits.UnitsToRemove.Add(AUnit);
 
638
    Result:=mrOK;
562
639
  end
563
 
  else begin // [ctLazarus, ctLazarusWin] -> comment out units if needed.
564
 
    if not fMainUsedUnits.CommentOutUnits then exit;
565
 
    if not fImplUsedUnits.CommentOutUnits then exit;
566
 
    if not fMainUsedUnits.AddUnits then exit;       // Add the extra units.
567
 
    if not fImplUsedUnits.AddUnits then exit;
 
640
  else if fImplUsedUnits.fExistingUnits.Find(AUnit, x) then begin
 
641
    fImplUsedUnits.UnitsToRemove.Add(AUnit);
 
642
    Result:=mrOK;
568
643
  end;
569
 
  Result:=mrOK;
570
644
end;
571
645
 
572
646
procedure TUsedUnitsTool.MoveMissingToComment(AAllCommentedUnits: TStrings);
573
647
begin
574
648
  // These units will be commented automatically in one project/package.
575
649
  if Assigned(AAllCommentedUnits) then begin
576
 
    AAllCommentedUnits.AddStrings(fMainUsedUnits.MissingUnits);
577
 
    AAllCommentedUnits.AddStrings(fImplUsedUnits.MissingUnits);
 
650
    AAllCommentedUnits.AddStrings(fMainUsedUnits.fMissingUnits);
 
651
    AAllCommentedUnits.AddStrings(fImplUsedUnits.fMissingUnits);
578
652
  end;
579
653
  // Move all to be commented.
580
 
  fMainUsedUnits.UnitsToComment.AddStrings(fMainUsedUnits.MissingUnits);
581
 
  fMainUsedUnits.MissingUnits.Clear;
582
 
  fImplUsedUnits.UnitsToComment.AddStrings(fImplUsedUnits.MissingUnits);
583
 
  fImplUsedUnits.MissingUnits.Clear;
 
654
  fMainUsedUnits.fUnitsToComment.AddStrings(fMainUsedUnits.fMissingUnits);
 
655
  fMainUsedUnits.fMissingUnits.Clear;
 
656
  fImplUsedUnits.fUnitsToComment.AddStrings(fImplUsedUnits.fMissingUnits);
 
657
  fImplUsedUnits.fMissingUnits.Clear;
 
658
end;
 
659
 
 
660
procedure TUsedUnitsTool.AddUnitIfNeeded(AUnitName: string);
 
661
var
 
662
  i: Integer;
 
663
  UnitInFileName: String;
 
664
  RenameValFound: Boolean;
 
665
begin
 
666
  RenameValFound:=false;
 
667
  for i := 0 to fMainUsedUnits.fUnitsToRenameVals.Count-1 do
 
668
    if Pos(AUnitName, fMainUsedUnits.fUnitsToRenameVals[i]) > 0 then begin
 
669
      RenameValFound:=true;
 
670
      Break;
 
671
    end;
 
672
  if not RenameValFound then
 
673
    for i := 0 to fImplUsedUnits.fUnitsToRenameVals.Count-1 do
 
674
      if Pos(AUnitName, fImplUsedUnits.fUnitsToRenameVals[i]) > 0 then begin
 
675
        RenameValFound:=true;
 
676
        Break;
 
677
      end;
 
678
  if not ( fMainUsedUnits.fExistingUnits.Find(AUnitName, i) or
 
679
           fImplUsedUnits.fExistingUnits.Find(AUnitName, i) or
 
680
          (fMainUsedUnits.fUnitsToAdd.IndexOf(AUnitName) > -1) or RenameValFound)
 
681
  then begin
 
682
    fMainUsedUnits.fUnitsToAdd.Add(AUnitName);
 
683
    IDEMessagesWindow.AddMsg('Added unit '+AUnitName+ ' to uses section', '', -1);
 
684
    // If the unit is not found, open the package containing it.
 
685
    UnitInFileName:='';
 
686
    if fCTLink.CodeTool.FindUnitCaseInsensitive(AUnitName,UnitInFileName) = '' then
 
687
      if Assigned(fCheckPackageDependencyEvent) then
 
688
        if not fCheckPackageDependencyEvent(AUnitName) then
 
689
          ;
 
690
  end;
 
691
end;
 
692
 
 
693
function TUsedUnitsTool.AddThreadSupport: TModalResult;
 
694
// AddUnitToSpecificUsesSection would insert cthreads in the beginning automatically
 
695
// It doesn't work with {$IFDEF UNIX} directive -> use UsesInsertPolicy.
 
696
var
 
697
  i: Integer;
 
698
  OldPolicy: TUsesInsertPolicy;
 
699
begin
 
700
  Result:=mrCancel;
 
701
  if not ( fMainUsedUnits.fExistingUnits.Find('cthreads', i) or
 
702
           fImplUsedUnits.fExistingUnits.Find('cthreads', i) ) then
 
703
    with fCTLink, SrcCache.BeautifyCodeOptions do
 
704
    try
 
705
      OldPolicy:=UsesInsertPolicy;
 
706
      UsesInsertPolicy:=uipFirst;
 
707
      if not CodeTool.AddUnitToSpecificUsesSection(fMainUsedUnits.fUsesSection,
 
708
                           '{$IFDEF UNIX}cthreads{$ENDIF}', '', SrcCache) then exit;
 
709
    finally
 
710
      UsesInsertPolicy:=OldPolicy;
 
711
    end;
 
712
  Result:=mrOK;
584
713
end;
585
714
 
586
715
function TUsedUnitsTool.GetMissingUnitCount: integer;
587
716
begin
588
 
  Result:=fMainUsedUnits.MissingUnits.Count+fImplUsedUnits.MissingUnits.Count;
 
717
  Result:=fMainUsedUnits.fMissingUnits.Count+fImplUsedUnits.fMissingUnits.Count;
589
718
end;
590
719
 
591
720
end.