← Back to branch summary

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

« back to all changes in this revision

Viewing changes to converter/missingpropertiesdlg.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/missingpropertiesdlg.pas
33
33
 
34
34
uses
35
35
  // FCL+LCL
36
 
  Classes, SysUtils, Math, LCLProc, Forms, Controls, Grids, LResources,
 
36
  Classes, SysUtils, Math, LCLProc, Forms, Controls, Grids, LResources, LConvEncoding,
37
37
  Graphics, Dialogs, Buttons, StdCtrls, ExtCtrls, contnrs, FileUtil,
38
38
  // components
39
39
  SynHighlighterLFM, SynEdit, SynEditMiscClasses, LFMTrees,
44
44
  CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
45
45
  EditorOptions, CheckLFMDlg, IDEMsgIntf,
46
46
  // Converter
47
 
  ConverterTypes, ConvertSettings, ReplaceNamesUnit, ConvCodeTool;
 
47
  ConverterTypes, ConvertSettings, ReplaceNamesUnit,
 
48
  ConvCodeTool, FormFileConv, UsedUnits;
48
49
 
49
50
type
50
51
 
54
55
  TDFMConverter = class
55
56
  private
56
57
    fOrigFormat: TLRSStreamOriginalFormat;
 
58
    fIDEMsgWindow: TIDEMessagesWindowInterface;
57
59
    function GetLFMFilename(const DfmFilename: string; KeepCase: boolean): string;
58
60
 
59
61
  public
60
 
    constructor Create;
 
62
    constructor Create(aIDEMsgWindow: TIDEMessagesWindowInterface);
61
63
    destructor Destroy; override;
62
 
    function ConvertDfmToLfm(const DfmFilename: string): TModalResult;
 
64
    function ConvertDfmToLfm(const aFilename: string): TModalResult;
63
65
    function Convert(const DfmFilename: string): TModalResult;
64
66
  end;
65
67
 
69
71
  private
70
72
    fCTLink: TCodeToolLink;
71
73
    fSettings: TConvertSettings;
 
74
    fUsedUnitsTool: TUsedUnitsTool;
72
75
    // List of property values which need to be adjusted.
73
76
    fHasMissingProperties: Boolean;         // LFM file has unknown properties.
74
77
    fHasMissingObjectTypes: Boolean;        // LFM file has unknown object types.
77
80
    fTypeReplaceGrid: TStringGrid;
78
81
    function ReplaceAndRemoveAll: TModalResult;
79
82
    function ReplaceTopOffsets(aSrcOffsets: TList): TModalResult;
 
83
    function AddNewProps(aNewProps: TList): TModalResult;
80
84
    // Fill StringGrids with missing properties and types from fLFMTree.
81
85
    procedure FillReplaceGrids;
82
86
  protected
89
93
    function Repair: TModalResult;
90
94
  public
91
95
    property Settings: TConvertSettings read fSettings write fSettings;
 
96
    property UsedUnitsTool: TUsedUnitsTool read fUsedUnitsTool write fUsedUnitsTool;
92
97
  end;
93
98
 
94
99
 
125
130
  end;
126
131
 
127
132
 
128
 
function ConvertDfmToLfm(const DfmFilename: string): TModalResult;
129
 
 
130
 
 
131
133
implementation
132
134
 
133
135
{$R *.lfm}
134
136
 
135
 
function ConvertDfmToLfm(const DfmFilename: string): TModalResult;
136
 
var
137
 
  DFMConverter: TDFMConverter;
138
 
begin
139
 
  DFMConverter:=TDFMConverter.Create;
140
 
  try     Result:=DFMConverter.ConvertDfmToLfm(DfmFilename);
141
 
  finally DFMConverter.Free;
142
 
  end;
143
 
end;
144
 
 
145
137
function IsMissingType(LFMError: TLFMError): boolean;
146
138
begin
147
139
  with LFMError do
152
144
 
153
145
{ TDFMConverter }
154
146
 
155
 
constructor TDFMConverter.Create;
 
147
constructor TDFMConverter.Create(aIDEMsgWindow: TIDEMessagesWindowInterface);
156
148
begin
157
149
  inherited Create;
 
150
  fIDEMsgWindow:=aIDEMsgWindow;
158
151
end;
159
152
 
160
153
destructor TDFMConverter.Destroy;
163
156
end;
164
157
 
165
158
function TDFMConverter.Convert(const DfmFilename: string): TModalResult;
 
159
var
 
160
  s: String;
166
161
begin
167
162
  Result:=ConvertDfmToLfm(DfmFilename);
168
163
  if Result=mrOK then begin
169
164
    if fOrigFormat=sofBinary then
170
 
      ShowMessage(Format('File %s is successfully converted to text format.',
171
 
                         [DfmFilename]))
172
 
    else
173
 
      ShowMessage(Format('File %s syntax is correct.', [DfmFilename]));
 
165
      s:=Format('File %s is converted to text format.', [DfmFilename]);
 
166
    if Assigned(fIDEMsgWindow) then
 
167
      IDEMessagesWindow.AddMsg(s, '', -1)
 
168
    else begin
 
169
      if s='' then
 
170
        s:=Format('File %s syntax is correct.', [DfmFilename]);
 
171
      ShowMessage(s);
 
172
    end;
174
173
  end;
175
174
end;
176
175
 
187
186
    Result:='';
188
187
end;
189
188
 
190
 
function TDFMConverter.ConvertDfmToLfm(const DfmFilename: string): TModalResult;
 
189
function TDFMConverter.ConvertDfmToLfm(const aFilename: string): TModalResult;
191
190
var
192
191
  DFMStream, LFMStream: TMemoryStream;
193
192
begin
197
196
  try
198
197
    // Note: The file is copied from DFM file earlier.
199
198
    try
200
 
      DFMStream.LoadFromFile(UTF8ToSys(DfmFilename));
 
199
      DFMStream.LoadFromFile(UTF8ToSys(aFilename));
201
200
    except
202
201
      on E: Exception do begin
203
202
        Result:=QuestionDlg(lisCodeToolsDefsReadError, Format(
204
 
          lisUnableToReadFileError, ['"', DfmFilename, '"', #13, E.Message]),
 
203
          lisUnableToReadFileError, ['"', aFilename, '"', #13, E.Message]),
205
204
          mtError,[mrIgnore,mrAbort],0);
206
205
        if Result=mrIgnore then // The caller will continue like nothing happened.
207
206
          Result:=mrOk;
214
213
    except
215
214
      on E: Exception do begin
216
215
        Result:=QuestionDlg(lisFormatError,
217
 
          Format(lisUnableToConvertFileError, ['"',DfmFilename,'"',#13,E.Message]),
 
216
          Format(lisUnableToConvertFileError, ['"',aFilename,'"',#13,E.Message]),
218
217
          mtError,[mrIgnore,mrAbort],0);
219
218
        if Result=mrIgnore then
220
219
          Result:=mrOk;
223
222
    end;
224
223
    // converting dfm file, without renaming unit -> keep case...
225
224
    try
226
 
      LFMStream.SaveToFile(UTF8ToSys(DfmFilename));
 
225
      LFMStream.SaveToFile(UTF8ToSys(aFilename));
227
226
    except
228
227
      on E: Exception do begin
229
228
        Result:=MessageDlg(lisCodeToolsDefsWriteError,
230
 
          Format(lisUnableToWriteFileError, ['"',DfmFilename,'"',#13,E.Message]),
 
229
          Format(lisUnableToWriteFileError, ['"',aFilename,'"',#13,E.Message]),
231
230
          mtError,[mbIgnore,mbAbort],0);
232
231
        if Result=mrIgnore then
233
232
          Result:=mrOk;
298
297
            AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
299
298
            IDEMessagesWindow.AddMsg(Format(
300
299
                      'Replaced type "%s" with "%s".',[OldIdent, NewIdent]),'',-1);
 
300
            if Assigned(fUsedUnitsTool) then begin
 
301
              // ToDo: This is a test and will be replaced by configurable unit names.
 
302
              if NewIdent='TRichMemo' then
 
303
                fUsedUnitsTool.AddUnitIfNeeded('RichMemo');
 
304
            end;
301
305
            Result:=mrRetry;
302
306
          end;
303
307
        end
340
344
 
341
345
function TLFMFixer.ReplaceTopOffsets(aSrcOffsets: TList): TModalResult;
342
346
// Replace top coordinates of controls in visual containers.
343
 
// Returns mrOK if no types were changed, and mrCancel if there was an error.
344
347
var
345
348
  TopOffs: TSrcPropOffset;
346
349
  VisOffs: TVisualOffset;
347
 
  OldNum, Ofs, NewNum, Len, ind, i: integer;
 
350
  OldNum, NewNum, Len, ind, i: integer;
348
351
begin
349
352
  Result:=mrOK;
350
353
  // Add offset to top coordinates.
351
 
  for i := aSrcOffsets.Count-1 downto 0 do begin
 
354
  for i:=aSrcOffsets.Count-1 downto 0 do begin
352
355
    TopOffs:=TSrcPropOffset(aSrcOffsets[i]);
353
356
    if fSettings.CoordOffsets.Find(TopOffs.ParentType, ind) then begin
354
357
      VisOffs:=fSettings.CoordOffsets[ind];
360
363
      except on EConvertError do
361
364
        OldNum:=0;
362
365
      end;
363
 
      Ofs:=VisOffs.ByProperty(TopOffs.PropName);
364
 
      NewNum:=OldNum-Ofs;
 
366
      NewNum:=OldNum-VisOffs.ByProperty(TopOffs.PropName);
365
367
      if NewNum<0 then
366
368
        NewNum:=0;
367
369
      fLFMBuffer.Replace(TopOffs.StartPos, Len, IntToStr(NewNum));
371
373
  end;
372
374
end;
373
375
 
 
376
function TLFMFixer.AddNewProps(aNewProps: TList): TModalResult;
 
377
// Add new property to the lfm file.
 
378
var
 
379
  Entry: TAddPropEntry;
 
380
  i: integer;
 
381
begin
 
382
  Result:=mrOK;
 
383
  for i:=aNewProps.Count-1 downto 0 do begin
 
384
    Entry:=TAddPropEntry(aNewProps[i]);
 
385
    fLFMBuffer.Replace(Entry.StartPos, Entry.EndPos-Entry.StartPos,Entry.NewText);
 
386
    IDEMessagesWindow.AddMsg(Format('Added property "%s" for %s.',
 
387
                                   [Entry.NewText, Entry.ParentType]),'',-1);
 
388
  end;
 
389
end;
 
390
 
374
391
procedure TLFMFixer.FillReplaceGrids;
375
392
var
376
393
  PropUpdater: TGridUpdater;
393
410
          if NewIdent<>'' then
394
411
            fHasMissingObjectTypes:=true;
395
412
        end
396
 
        else if fSettings.UnknownPropsMode<>rlDisabled then begin
 
413
        else if fSettings.PropReplaceMode<>rlDisabled then begin
397
414
          OldIdent:=CurError.Node.GetIdentifier;
398
415
          PropUpdater.AddUnique(OldIdent);           // Add each property only once.
399
416
          fHasMissingProperties:=true;
426
443
    fPropReplaceGrid:=FixLFMDialog.PropReplaceGrid;
427
444
    fTypeReplaceGrid:=FixLFMDialog.TypeReplaceGrid;
428
445
    LoadLFM;
429
 
    if ((fSettings.UnknownPropsMode=rlAutomatic) or not fHasMissingProperties)
430
 
    and not fHasMissingObjectTypes then
 
446
    if ((fSettings.PropReplaceMode=rlAutomatic) or not fHasMissingProperties)
 
447
    and ((fSettings.TypeReplaceMode=raAutomatic) or not fHasMissingObjectTypes) then
431
448
      Result:=ReplaceAndRemoveAll  // Can return mrRetry.
432
449
    else begin
433
450
      // Cursor is earlier set to HourGlass. Show normal cursor while in dialog.
447
464
function TLFMFixer.Repair: TModalResult;
448
465
var
449
466
  ConvTool: TConvDelphiCodeTool;
450
 
  ValueTreeNodes: TObjectList;
 
467
  FormFileTool: TFormFileConverter;
 
468
  SrcCoordOffs: TObjectList;
 
469
  SrcNewProps: TObjectList;
451
470
  LoopCount: integer;
452
471
begin
453
472
  Result:=mrCancel;
455
474
  if not fLFMTree.ParseIfNeeded then exit;
456
475
  // Change a type that main form inherits from to a fall-back type if needed.
457
476
  ConvTool:=TConvDelphiCodeTool.Create(fCTLink);
458
 
  ValueTreeNodes:=TObjectList.Create;
459
477
  try
460
478
    if not ConvTool.FixMainClassAncestor(TLFMObjectNode(fLFMTree.Root).TypeName,
461
479
                                         fSettings.ReplaceTypes) then exit;
462
 
    LoopCount:=0;
463
 
    repeat
464
 
      if CodeToolBoss.CheckLFM(fPascalBuffer,fLFMBuffer,fLFMTree,
465
 
          fRootMustBeClassInUnit,fRootMustBeClassInIntf,fObjectsMustExists) then
466
 
        Result:=mrOk
467
 
      else                     // Rename/remove properties and types interactively.
468
 
        Result:=ShowRepairLFMWizard;  // Can return mrRetry.
469
 
      Inc(LoopCount);
470
 
    until (Result in [mrOK, mrCancel]) or (LoopCount=10);
471
 
    // Show remaining errors to user.
472
 
    WriteLFMErrors;
473
 
    if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin
474
 
      // Fix top offsets of some components in visual containers
475
 
      if ConvTool.CheckTopOffsets(fLFMBuffer, fLFMTree,
476
 
                                  fSettings.CoordOffsets, ValueTreeNodes) then
477
 
        Result:=ReplaceTopOffsets(ValueTreeNodes)
478
 
      else
479
 
        Result:=mrCancel;
480
 
    end;
481
480
  finally
482
 
    ValueTreeNodes.Free;
483
481
    ConvTool.Free;
484
482
  end;
 
483
  LoopCount:=0;
 
484
  repeat
 
485
    if CodeToolBoss.CheckLFM(fPascalBuffer,fLFMBuffer,fLFMTree,
 
486
        fRootMustBeClassInUnit,fRootMustBeClassInIntf,fObjectsMustExist) then
 
487
      Result:=mrOk
 
488
    else                     // Rename/remove properties and types interactively.
 
489
      Result:=ShowRepairLFMWizard;  // Can return mrRetry.
 
490
    Inc(LoopCount);
 
491
  until (Result in [mrOK, mrCancel]) or (LoopCount=10);
 
492
  // Show remaining errors to user.
 
493
  WriteLFMErrors;
 
494
  if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin
 
495
    // Fix top offsets of some components in visual containers
 
496
    FormFileTool:=TFormFileConverter.Create(fCTLink, fLFMBuffer);
 
497
    SrcCoordOffs:=TObjectList.Create;
 
498
    SrcNewProps:=TObjectList.Create;
 
499
    try
 
500
      FormFileTool.VisOffsets:=fSettings.CoordOffsets;
 
501
      FormFileTool.SrcCoordOffs:=SrcCoordOffs;
 
502
      FormFileTool.SrcNewProps:=SrcNewProps;
 
503
      Result:=FormFileTool.Convert;
 
504
      if Result=mrOK then begin
 
505
        Result:=ReplaceTopOffsets(SrcCoordOffs);
 
506
        if Result=mrOK then
 
507
          Result:=AddNewProps(SrcNewProps);
 
508
      end;
 
509
    finally
 
510
      SrcNewProps.Free;
 
511
      SrcCoordOffs.Free;
 
512
      FormFileTool.Free;
 
513
    end;
 
514
  end;
485
515
end;
486
516
 
487
517
 
506
536
begin
507
537
  Caption:=lisFixLFMFile;
508
538
  Position:=poScreenCenter;
509
 
  //  IDEDialogLayoutList.ApplyLayout(Self,600,400);
510
539
  NoteLabel.Caption:=lisLFMFileContainsInvalidProperties;
511
540
  ErrorsGroupBox.Caption:=lisErrors;
512
541
  LFMGroupBox.Caption:=lisLFMFile;