← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ide/frames/env_file_filters.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/frames/env_file_filters.pas
 
1
unit env_file_filters;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  Classes, SysUtils, FileUtil, LResources, Forms, Grids, Dialogs, Controls,
 
9
  LCLProc, LCLType, Menus, StdCtrls, LazConfigStorage,
 
10
  IDEOptionsIntf, BaseIDEIntf,
 
11
  EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts;
 
12
 
 
13
const
 
14
  FileDialogFilterConfigFile = 'filefilters.xml';
 
15
type
 
16
 
 
17
  { TFileFiltersOptionsFrame }
 
18
 
 
19
  TFileFiltersOptionsFrame = class(TAbstractIDEOptionsEditor)
 
20
    grdFileFilters: TStringGrid;
 
21
    MenuItem1: TMenuItem;
 
22
    SetDefaultMenuItem: TMenuItem;
 
23
    pmGrid: TPopupMenu;
 
24
    pmiAddRow: TMenuItem;
 
25
    pmiDelRow: TMenuItem;
 
26
    pmiInsRow: TMenuItem;
 
27
    lblTitle: TLabel;
 
28
    procedure grdFileFiltersKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 
29
    procedure pmiAddRowClick(Sender: TObject);
 
30
    procedure pmiDelRowClick(Sender: TObject);
 
31
    procedure pmiInsRowClick(Sender: TObject);
 
32
    procedure SetDefaultMenuItemClick(Sender: TObject);
 
33
  private
 
34
    FList: TStringList;
 
35
    fLoaded: boolean;
 
36
    fSaved: boolean;
 
37
  public
 
38
    constructor Create(TheOwner: TComponent); override;
 
39
    destructor Destroy; override;
 
40
    function GetTitle: String; override;
 
41
    procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
 
42
    procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
 
43
    procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
 
44
    class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
 
45
  end;
 
46
 
 
47
 
 
48
procedure LoadFileDialogFilter;
 
49
procedure SaveFileDialogFilter;
 
50
function GetDefaultFileDialogFilter: string;
 
51
function GetFileDialogFilterFromGrid(Grid: TStringGrid): string;
 
52
procedure LoadGridFromFileDialogFilter(Grid: TStringGrid; Filter: string;
 
53
                                       AddEmptyRow: boolean);
 
54
 
 
55
implementation
 
56
 
 
57
{$R *.lfm}
 
58
 
 
59
const
 
60
  KeyFilter         = 'Filter';
 
61
  KeyFilterCount    = 'Count';
 
62
  KeyFilterName     = 'Name';
 
63
  KeyFilterMask     = 'Mask';
 
64
 
 
65
 
 
66
procedure LoadFileDialogFilter;
 
67
const
 
68
  cFilter = '%s (%s)|%s|';            // each filter is seperated by another | sign
 
69
var
 
70
  cfg: TConfigStorage;
 
71
  cnt: integer;
 
72
  i: integer;
 
73
  lName, lMask: string;
 
74
  Filter: String;
 
75
begin
 
76
  Filter:='';
 
77
  cfg := GetIDEConfigStorage(FileDialogFilterConfigFile, True);
 
78
  try
 
79
    cnt := cfg.GetValue(KeyFilterCount, 0);
 
80
    // read values
 
81
    for i := 1 to cnt do
 
82
    begin
 
83
      lName := cfg.GetValue(KeyFilter+IntToStr(i) + '/' + KeyFilterName, '');
 
84
      lMask := cfg.GetValue(KeyFilter+IntToStr(i) + '/' + KeyFilterMask, '*');
 
85
      if (lName='') or (lMask='') then continue;
 
86
      if Filter<>'' then
 
87
        Filter:=Filter+'|';
 
88
      Filter:=Filter+lName+'|'+lMask;
 
89
    end;
 
90
    if Filter='' then
 
91
      Filter:=GetDefaultFileDialogFilter;
 
92
  finally
 
93
    cfg.Free;
 
94
  end;
 
95
  EnvironmentOptions.FileDialogFilter:=Filter;
 
96
end;
 
97
 
 
98
procedure SaveFileDialogFilter;
 
99
var
 
100
  cfg: TConfigStorage;
 
101
  Cnt: Integer;
 
102
  p: PChar;
 
103
  MaskStart: PChar;
 
104
  CaptionStart: PChar;
 
105
  Filter: String;
 
106
  Caption: String;
 
107
  CurMask: String;
 
108
begin
 
109
  Filter:=EnvironmentOptions.FileDialogFilter;
 
110
  if Filter=GetDefaultFileDialogFilter then
 
111
    Filter:='';
 
112
  cfg := GetIDEConfigStorage(FileDialogFilterConfigFile,false);
 
113
  try
 
114
    Cnt:=0;
 
115
    if Filter<>'' then begin
 
116
      p:=PChar(Filter);
 
117
      while p^<>#0 do
 
118
      begin
 
119
        // caption
 
120
        CaptionStart:=p;
 
121
        while not (p^ in ['|',#0]) do inc(p);
 
122
        if p^=#0 then break;
 
123
        Caption:=copy(Filter,CaptionStart-PChar(Filter)+1,p-CaptionStart);
 
124
        // parse masks
 
125
        inc(p);
 
126
        MaskStart:=p;
 
127
        while not (p^ in ['|',#0]) do inc(p);
 
128
        if p>MaskStart then begin
 
129
          inc(Cnt);
 
130
          CurMask:=copy(Filter,MaskStart-PChar(Filter)+1,p-MaskStart);
 
131
          cfg.SetValue(KeyFilter+IntToStr(Cnt) + '/' + KeyFilterName, Caption);
 
132
          cfg.SetValue(KeyFilter+IntToStr(Cnt) + '/' + KeyFilterMask, CurMask);
 
133
        end;
 
134
        inc(p);
 
135
      end;
 
136
    end;
 
137
    if Cnt>0 then begin
 
138
      cfg.SetValue(KeyFilterCount, Cnt);
 
139
      cfg.WriteToDisk;
 
140
    end else if FileExistsUTF8(cfg.GetFilename) then begin
 
141
      // delete unneeded file
 
142
      DeleteFileUTF8(cfg.GetFilename);
 
143
    end;
 
144
  finally
 
145
    cfg.Free;
 
146
  end;
 
147
end;
 
148
 
 
149
function GetDefaultFileDialogFilter: string;
 
150
begin
 
151
  Result := lisLazarusUnit + ' (*.pas;*.pp)|*.pas;*.pp'
 
152
    + '|' + lisLazarusProject + ' (*.lpi)|*.lpi'
 
153
    + '|' + lisLazarusForm + ' (*.lfm;*.dfm)|*.lfm;*.dfm'
 
154
    + '|' + lisLazarusPackage + ' (*.lpk)|*.lpk'
 
155
    + '|' + lisLazarusProjectSource + ' (*.lpr)|*.lpr'
 
156
    + '|' + lisLazarusOtherFile + ' (*.inc;*.lrs;*.lpl)|*.inc;*.lrs;*.lpl';
 
157
end;
 
158
 
 
159
function GetFileDialogFilterFromGrid(Grid: TStringGrid): string;
 
160
var
 
161
  i: Integer;
 
162
  CurCaption: String;
 
163
  CurMask: String;
 
164
begin
 
165
  Result:='';
 
166
  for i := 1 to Grid.RowCount-1 do
 
167
  begin
 
168
    CurCaption:=Grid.Cells[1, i];
 
169
    CurMask:=Grid.Cells[2, i];
 
170
    CurCaption:=StringReplace(CurCaption,'|',',',[rfReplaceAll]);
 
171
    CurMask:=StringReplace(CurMask,'|',',',[rfReplaceAll]);
 
172
    if (CurCaption='') or (CurMask='') then continue;
 
173
    if Result<>'' then
 
174
      Result:=Result+'|';
 
175
    Result:=Result+CurCaption+'|'+CurMask;
 
176
  end;
 
177
end;
 
178
 
 
179
procedure LoadGridFromFileDialogFilter(Grid: TStringGrid; Filter: string;
 
180
  AddEmptyRow: boolean);
 
181
 
 
182
  procedure ReadList(var Cnt: integer; Scan: boolean);
 
183
  var
 
184
    p: PChar;
 
185
    CaptionStart: PChar;
 
186
    CurCaption: String;
 
187
    MaskStart: PChar;
 
188
    CurMask: String;
 
189
  begin
 
190
    Cnt:=0;
 
191
    if Filter<>'' then begin
 
192
      p:=PChar(Filter);
 
193
      while p^<>#0 do
 
194
      begin
 
195
        // caption
 
196
        CaptionStart:=p;
 
197
        while not (p^ in ['|',#0]) do inc(p);
 
198
        if p^=#0 then break;
 
199
        CurCaption:=copy(Filter,CaptionStart-PChar(Filter)+1,p-CaptionStart);
 
200
        // parse masks
 
201
        repeat
 
202
          inc(p);
 
203
          MaskStart:=p;
 
204
          while not (p^ in ['|',#0]) do inc(p);
 
205
          if p>MaskStart then begin
 
206
            CurMask:=copy(Filter,MaskStart-PChar(Filter)+1,p-MaskStart);
 
207
            inc(Cnt);
 
208
            if not Scan then begin
 
209
              Grid.Cells[1, Cnt] := CurCaption;
 
210
              Grid.Cells[2, Cnt] := CurMask;
 
211
            end;
 
212
          end;
 
213
          if p^='|' then break;
 
214
        until p^=#0;
 
215
        inc(p);
 
216
      end;
 
217
    end;
 
218
 
 
219
  end;
 
220
 
 
221
var
 
222
  Cnt: Integer;
 
223
begin
 
224
  Cnt:=0;
 
225
  ReadList(Cnt,true);
 
226
  Grid.BeginUpdate;
 
227
  try
 
228
    inc(Cnt,Grid.FixedRows);
 
229
    if AddEmptyRow then inc(Cnt);
 
230
    Grid.RowCount := Cnt;
 
231
    if AddEmptyRow then begin
 
232
      Grid.Cells[1, Cnt-1] := '';
 
233
      Grid.Cells[2, Cnt-1] := '';
 
234
    end;
 
235
    ReadList(Cnt,false);
 
236
  finally
 
237
    Grid.EndUpdate(true);
 
238
  end;
 
239
end;
 
240
 
 
241
{ TFileFiltersOptionsFrame }
 
242
 
 
243
procedure TFileFiltersOptionsFrame.grdFileFiltersKeyDown(Sender: TObject; var Key: Word;
 
244
  Shift: TShiftState);
 
245
begin
 
246
  if Key = VK_INSERT then
 
247
    grdFileFilters.RowCount := grdFileFilters.RowCount + 1;
 
248
end;
 
249
 
 
250
procedure TFileFiltersOptionsFrame.pmiAddRowClick(Sender: TObject);
 
251
begin
 
252
  grdFileFilters.RowCount := grdFileFilters.RowCount + 1;
 
253
end;
 
254
 
 
255
procedure TFileFiltersOptionsFrame.pmiDelRowClick(Sender: TObject);
 
256
begin
 
257
  grdFileFilters.DeleteColRow(False, grdFileFilters.Row);
 
258
end;
 
259
 
 
260
procedure TFileFiltersOptionsFrame.pmiInsRowClick(Sender: TObject);
 
261
begin
 
262
  grdFileFilters.InsertColRow(False, grdFileFilters.Row);
 
263
end;
 
264
 
 
265
procedure TFileFiltersOptionsFrame.SetDefaultMenuItemClick(Sender: TObject);
 
266
begin
 
267
  if MessageDlg(lisConfirm,
 
268
    lisResetAllFileFiltersToDefaults, mtConfirmation, [mbCancel, mbOK], 0)<>mrOk
 
269
  then exit;
 
270
  LoadGridFromFileDialogFilter(grdFileFilters,GetDefaultFileDialogFilter,false);
 
271
end;
 
272
 
 
273
constructor TFileFiltersOptionsFrame.Create(TheOwner: TComponent);
 
274
begin
 
275
  inherited Create(TheOwner);
 
276
  FList := TStringList.Create;
 
277
end;
 
278
 
 
279
destructor TFileFiltersOptionsFrame.Destroy;
 
280
begin
 
281
  FList.Free;
 
282
  inherited Destroy;
 
283
end;
 
284
 
 
285
function TFileFiltersOptionsFrame.GetTitle: String;
 
286
begin
 
287
  Result := lisFileFilters;
 
288
end;
 
289
 
 
290
procedure TFileFiltersOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
 
291
begin
 
292
  lblTitle.Caption := lisFileFiltersTitle;
 
293
  grdFileFilters.DefaultColWidth := 40;
 
294
  grdFileFilters.RowCount := 1;
 
295
 
 
296
  grdFileFilters.Columns[0].Title.Caption := lisName;
 
297
  grdFileFilters.Columns[1].Title.Caption := lisFileFiltersMask;
 
298
 
 
299
  pmiAddRow.Caption := lisFileFiltersAddRow;
 
300
  pmiDelRow.Caption := lisFileFiltersDeleteRow;
 
301
  pmiInsRow.Caption := lisFileFiltersInsertRow;
 
302
 
 
303
  SetDefaultMenuItem.Caption := lisFileFiltersSetDefaults;
 
304
end;
 
305
 
 
306
procedure TFileFiltersOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
 
307
begin
 
308
  if fLoaded then exit;
 
309
  fLoaded:=true;
 
310
 
 
311
  LoadGridFromFileDialogFilter(grdFileFilters,EnvironmentOptions.FileDialogFilter,false);
 
312
end;
 
313
 
 
314
procedure TFileFiltersOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
 
315
var
 
316
  Filter: String;
 
317
begin
 
318
  if fSaved then exit;
 
319
  fSaved:=true;
 
320
 
 
321
  Filter:=GetFileDialogFilterFromGrid(grdFileFilters);
 
322
 
 
323
  if EnvironmentOptions.FileDialogFilter<>Filter then begin
 
324
    //debugln(['TFileFiltersOptionsFrame.WriteSettings ']);
 
325
    EnvironmentOptions.FileDialogFilter:=Filter;
 
326
    SaveFileDialogFilter;
 
327
  end;
 
328
end;
 
329
 
 
330
class function TFileFiltersOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
 
331
begin
 
332
  Result := TEnvironmentOptions;
 
333
end;
 
334
 
 
335
initialization
 
336
  RegisterIDEOptionsEditor(GroupEnvironment, TFileFiltersOptionsFrame, EnvOptionsFileFilters);
 
337
 
 
338
end.
 
339