← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ide/restrictionbrowser.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/restrictionbrowser.pas
31
31
 
32
32
uses
33
33
  Classes, SysUtils, InterfaceBase, LCLProc, Contnrs, Forms, Controls, Graphics,
34
 
  Dialogs, StdCtrls, ComCtrls, Masks, ExtCtrls, Buttons,
 
34
  Dialogs, StdCtrls, ComCtrls, TreeFilterEdit, ExtCtrls, Buttons,
35
35
  IDEImagesIntf, ObjectInspector,
36
36
  CompatibilityRestrictions, IDEOptionDefs, LazarusIDEStrConsts,
37
37
  EnvironmentOpts, ComponentReg, LazConf;
40
40
  { TRestrictionBrowserView }
41
41
 
42
42
  TRestrictionBrowserView = class(TForm)
43
 
    NameFilterEdit: TEdit;
 
43
    FilterEdit: TTreeFilterEdit;
44
44
    IssueFilterGroupBox: TGroupBox;
45
45
    IssueMemo: TMemo;
 
46
    IssueTreeView: TTreeView;
46
47
    NameLabel: TLabel;
47
 
    IssueTreeView: TTreeView;
 
48
    Panel1: TPanel;
 
49
    Splitter1: TSplitter;
48
50
    procedure FormCreate(Sender: TObject);
49
51
    procedure IssueTreeViewSelectionChanged(Sender: TObject);
50
52
    procedure NameFilterEditChange(Sender: TObject);
53
55
    FClasses: TClassList;
54
56
    FCanUpdate: Boolean;
55
57
    procedure GetComponentClass(const AClass: TComponentClass);
 
58
    procedure UpdateIssueList;
56
59
  public
57
 
    procedure UpdateIssueList;
58
60
    procedure SetIssueName(const AIssueName: String);
59
61
  end;
60
62
  
73
75
  X: Integer;
74
76
begin
75
77
  FIssueList := GetRestrictedList;
76
 
  
77
78
  Name := NonModalIDEWindowNames[nmiwIssueBrowser];
78
79
  Caption := lisMenuViewRestrictionBrowser;
79
 
 
80
 
  IssueFilterGroupBox.Caption := lisFilter;
 
80
  IssueFilterGroupBox.Caption := lisIssues;
81
81
  NameLabel.Caption := lisCodeToolsDefsName;
82
82
  IssueTreeView.Images := IDEImages.Images_16;
83
 
  
84
83
  X := 10;
85
84
  // create widget set filter buttons
86
85
  for P := Low(TLCLPlatform) to High(TLCLPlatform) do
95
94
      GroupIndex := Integer(P) + 1;
96
95
      Down := True;
97
96
      AllowAllUp := True;
98
 
      
99
97
      try
100
98
        IDEImages.Images_16.GetBitmap(
101
99
               IDEImages.LoadImage(16, 'issue_'+LCLPlatformDirNames[P]), Glyph);
102
100
      except
103
101
        DebugLn('Restriction Browser: Unable to load image for ' + LCLPlatformDirNames[P] + '!');
104
102
      end;
105
 
      
106
103
      ShowHint := True;
107
104
      Hint := LCLPlatformDisplayNames[P];
108
105
      OnClick := @NameFilterEditChange;
109
 
      
110
106
      Parent := IssueFilterGroupBox;
111
107
      Inc(X, Width);
112
108
    end;
113
109
  end;
114
 
  
115
110
  FCanUpdate := True;
116
111
  UpdateIssueList;
117
112
end;
 
113
 
118
114
procedure TRestrictionBrowserView.IssueTreeViewSelectionChanged(Sender: TObject);
119
115
var
120
116
  Issue: TRestriction;
124
120
    IssueMemo.Clear;
125
121
    Exit;
126
122
  end;
127
 
 
128
123
  Issue := PRestriction(IssueTreeView.Selected.Data)^;
129
124
  IssueMemo.Text := Issue.Short + LineEnding + LineEnding + Issue.Description;
130
125
end;
141
136
 
142
137
procedure TRestrictionBrowserView.UpdateIssueList;
143
138
var
144
 
  IssueClass: String;
145
 
  IssueProperty: String;
146
 
  IssueMask: TMaskList;
147
 
  S, M: String;
148
139
  I, ID: PtrInt;
149
140
  Issues: TStringList;
150
 
  Issue: TRestriction;
151
 
  C: TClass;
152
 
  AddParentClass: Boolean;
153
141
  P: TLCLPlatform;
154
142
  WidgetSetFilter: TLCLPlatforms;
155
143
  Component: TComponent;
156
144
begin
157
145
  if not FCanUpdate then Exit;
158
 
  S := Trim(NameFilterEdit.Text);
159
 
  IssueClass := '';
160
 
  IssueProperty := '';
161
 
  
162
146
  WidgetSetFilter := [];
163
147
  for P := Low(TLCLPlatform) to High(TLCLPlatform) do
164
148
  begin
165
149
    Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
166
 
    if Component is TSpeedButton then
167
 
      if (Component as TSpeedButton).Down then Include(WidgetSetFilter, P);
168
 
  end;
169
 
  
170
 
  I := Pos('.', S);
171
 
  if I = 0 then IssueClass := S
172
 
  else
173
 
  begin
174
 
    IssueClass := Copy(S, 0, I - 1);
175
 
    IssueProperty := Copy(S, I + 1, MaxInt);
176
 
  end;
177
 
  
178
 
  if (IssueProperty = '') and (IssueClass = '') then
179
 
    M := '*'
180
 
  else
181
 
  begin
182
 
    if IssueClass = '' then
183
 
      M := '*.' + IssueProperty + '*'
184
 
    else
185
 
    begin
186
 
      // find parent classes
187
 
      M := '';
188
 
      FClasses := TClassList.Create;
189
 
      try
190
 
        IDEComponentPalette.IterateRegisteredClasses(@GetComponentClass);
191
 
        
192
 
        FClasses.Add(TCustomForm);
193
 
        FClasses.Add(TForm);
194
 
        FClasses.Add(TDataModule);
195
 
        FClasses.Add(TFrame);
196
 
        
197
 
        for I := 0 to FClasses.Count - 1 do
198
 
        begin
199
 
          C := FClasses[I];
200
 
          AddParentClass := False;
201
 
          while C <> nil do
202
 
          begin
203
 
            if AddParentClass or (Copy(C.ClassName, 0, Length(IssueClass)) = IssueClass) then
204
 
            begin
205
 
              if M <> '' then M := M + ';';
206
 
              M := M + C.ClassName + ';' + C.ClassName + '.' + IssueProperty + '*';
207
 
              AddParentClass := True;
208
 
            end;
209
 
            
210
 
            C := C.ClassParent;
211
 
          end;
212
 
        end;
213
 
        
214
 
        if FClasses.Count = 0 then
215
 
          M := IssueClass + '*;' + IssueClass + '*.' + IssueProperty + '*';
216
 
          
217
 
        if (Copy('TWidgetSet', 0, Length(IssueClass)) = IssueClass) then
218
 
          M := M + ';TWidgetSet';
219
 
      finally
220
 
        FClasses.Free;
221
 
      end;
222
 
    end;
223
 
  end;
224
 
  
225
 
  IssueMask := TMaskList.Create(M);
 
150
    Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
 
151
    if (Component as TSpeedButton).Down then
 
152
      Include(WidgetSetFilter, P);
 
153
  end;
226
154
  Issues := TStringList.Create;
227
155
  try
228
156
    for I := 0 to High(FIssueList) do
229
 
    begin
230
 
      Issue := FIssueList[I];
231
 
      if Issue.WidgetSet in WidgetSetFilter then
232
 
        if IssueMask.Matches(Issue.Name)  then
233
 
          Issues.AddObject(Issue.Name, TObject(I));
234
 
    end;
235
 
    
 
157
      if FIssueList[I].WidgetSet in WidgetSetFilter then
 
158
        Issues.AddObject(FIssueList[I].Name, TObject(I));
236
159
    Issues.Sort;
237
 
 
238
160
    IssueTreeView.BeginUpdate;
239
161
    try
240
162
      IssueTreeView.Items.Clear;
241
 
      
242
163
      for I := 0 to Issues.Count - 1 do
243
164
      begin
244
165
        with IssueTreeView.Items.AddChild(nil, Issues[I]) do
245
166
        begin
246
167
          ID := PtrInt(Issues.Objects[I]);
247
 
          
248
168
          ImageIndex := IDEImages.LoadImage(16,
249
169
              'issue_'+LCLPlatformDirNames[FIssueList[ID].WidgetSet]);
250
170
          StateIndex := ImageIndex;
251
171
          SelectedIndex := ImageIndex;
252
 
          
253
172
          Data := @FIssueList[ID];
254
173
        end;
255
 
        if NameFilterEdit.Text = Issues[I] then
256
 
        begin
257
 
          IssueTreeView.Selected := IssueTreeView.Items[I];
258
 
        end;
259
174
      end;
260
175
    finally
261
176
      IssueTreeView.EndUpdate;
262
177
    end;
263
178
  finally
264
179
    Issues.Free;
265
 
    IssueMask.Free;
266
180
  end;
267
 
  
268
181
  if IssueTreeView.Items.Count > 0 then
269
182
  begin
270
183
    if IssueTreeView.Selected = nil then
281
194
begin
282
195
  FCanUpdate := False;
283
196
  try
284
 
    NameFilterEdit.Text := AIssueName;
285
 
 
 
197
    FilterEdit.Text := AIssueName;
286
198
    if AIssueName <> '' then
287
199
    begin
288
200
      for P := Low(TLCLPlatform) to High(TLCLPlatform) do
289
201
      begin
290
202
        Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
291
 
        if Component is TSpeedButton then
292
 
          (Component as TSpeedButton).Down := True;
 
203
        Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
 
204
        (Component as TSpeedButton).Down := True;
293
205
      end;
294
206
    end;
295
207
  finally