1 {
2 /***************************************************************************
3 sortselectiondlg.pas
4 --------------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 Abstract:
31 TSortSelectionDialog is a dialog to setup the parameters for sorting
32 text selection.
33 SortText is the function to sort the text.
34 }
35 unit SortSelectionDlg;
36
37 {$mode objfpc}{$H+}
38
39 interface
40
41 uses
42 SysUtils, Laz_AVL_Tree,
43 // LCL
44 LCLProc, Forms, Controls, StdCtrls, ExtCtrls, ButtonPanel,
45 // Codetools
46 BasicCodeTools,
47 // SynEdit
48 SynEdit, SynEditHighlighter,
49 // IdeIntf
50 TextTools, IDEWindowIntf,
51 // IDE
52 LazarusIDEStrConsts, EditorOptions, MiscOptions, SourceMarks;
53
54 type
55 TSortSelDlgState = (
56 ssdPreviewNeedsUpdate,
57 ssdSortedTextNeedsUpdate
58 );
59 TSortSelDlgStates = set of TSortSelDlgState;
60
61 { TSortSelectionDialog }
62
63 TSortSelectionDialog = class(TForm)
64 ButtonPanel: TButtonPanel;
65 OptionsCheckGroup: TCheckGroup;
66 PreviewGroupBox: TGroupBox;
67 PreviewSynEdit: TSynEdit;
68 DirectionRadioGroup: TRadioGroup;
69 DomainRadioGroup: TRadioGroup;
70 procedure DirectionRadioGroupClick(Sender: TObject);
71 procedure DomainRadioGroupClick(Sender: TObject);
72 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
73 procedure FormCreate(Sender: TObject);
74 procedure OptionsCheckGroupItemClick(Sender: TObject; Index: integer);
75 private
76 FCaseSensitive: boolean;
77 FDirection: TSortDirection;
78 FDomain: TSortDomain;
79 FIgnoreSpace: boolean;
80 FStates: TSortSelDlgStates;
81 FTheText: string;
82 FUpdateCount: integer;
83 FSortedText: string;
GetSortedTextnull84 function GetSortedText: string;
85 procedure SetCaseSensitive(const AValue: boolean);
86 procedure SetDirection(const AValue: TSortDirection);
87 procedure SetDomain(const AValue: TSortDomain);
88 procedure SetIgnoreSpace(const AValue: boolean);
89 procedure SetTheText(const AValue: string);
90 public
91 procedure BeginUpdate;
92 procedure EndUpdate;
93 procedure UpdatePreview;
94 public
95 property CaseSensitive: boolean read FCaseSensitive write SetCaseSensitive;
96 property Direction: TSortDirection read FDirection write SetDirection;
97 property Domain: TSortDomain read FDomain write SetDomain;
98 property IgnoreSpace: boolean read FIgnoreSpace write SetIgnoreSpace;
99 property TheText: string read FTheText write SetTheText;
100 property SortedText: string read GetSortedText;
101 end;
102
ShowSortSelectionDialognull103 function ShowSortSelectionDialog(const TheText: string;
104 Highlighter: TSynCustomHighlighter;
105 out SortedText: string): TModalResult;
SortTextnull106 function SortText(const TheText: string; Direction: TSortDirection;
107 Domain: TSortDomain; CaseSensitive, IgnoreSpace: boolean): string;
108
109 implementation
110
111 {$R *.lfm}
112
ShowSortSelectionDialognull113 function ShowSortSelectionDialog(const TheText: string;
114 Highlighter: TSynCustomHighlighter; out SortedText: string): TModalResult;
115 var
116 SortSelectionDialog: TSortSelectionDialog;
117 begin
118 SortedText:='';
119 SortSelectionDialog:=TSortSelectionDialog.Create(nil);
120 try
121 SortSelectionDialog.BeginUpdate;
122 SortSelectionDialog.TheText:=TheText;
123 SortSelectionDialog.PreviewSynEdit.Highlighter:=Highlighter;
124 EditorOpts.SetMarkupColor(Highlighter, ahaTextBlock, SortSelectionDialog.PreviewSynEdit.SelectedColor);
125 EditorOpts.ApplyFontSettingsTo(SortSelectionDialog.PreviewSynEdit);
126 SortSelectionDialog.UpdatePreview;
127 SortSelectionDialog.EndUpdate;
128 Result:=SortSelectionDialog.ShowModal;
129 if Result=mrOk then
130 SortedText:=SortSelectionDialog.SortedText;
131 IDEDialogLayoutList.SaveLayout(SortSelectionDialog);
132 finally
133 SortSelectionDialog.Free;
134 end;
135 end;
136
ShowSortSelectionDialogBasenull137 function ShowSortSelectionDialogBase(const TheText: string;
138 Highlighter: TObject; var SortedText: string): TModalResult;
139 begin
140 Result:=ShowSortSelectionDialog(TheText,Highlighter as TSynCustomHighlighter,
141 SortedText);
142 end;
143
144 type
145 TTextBlockCompareSettings = class
146 public
147 CaseSensitive: boolean;
148 IgnoreSpace: boolean;
149 Ascending: boolean;
150 end;
151
152 TTextBlock = class
153 public
154 Settings: TTextBlockCompareSettings;
155 Start: PChar;
156 Len: integer;
157 constructor Create(TheSettings: TTextBlockCompareSettings;
158 NewStart: PChar; NewLen: integer);
159 end;
160
161 { TTextBlock }
162
163 constructor TTextBlock.Create(TheSettings: TTextBlockCompareSettings;
164 NewStart: PChar; NewLen: integer);
165 begin
166 Settings:=TheSettings;
167 Start:=NewStart;
168 Len:=NewLen;
169 end;
170
CompareTextBlocknull171 function CompareTextBlock(Data1, Data2: Pointer): integer;
172 var
173 Block1: TTextBlock;
174 Block2: TTextBlock;
175 Settings: TTextBlockCompareSettings;
176 begin
177 Block1:=TTextBlock(Data1);
178 Block2:=TTextBlock(Data2);
179 Settings:=Block1.Settings;
180 Result:=CompareText(Block1.Start,Block1.Len,Block2.Start,Block2.Len,
181 Settings.CaseSensitive,Settings.IgnoreSpace);
182 if not Settings.Ascending then
183 Result:=-Result;
184 end;
185
SortTextnull186 function SortText(const TheText: string; Direction: TSortDirection;
187 Domain: TSortDomain; CaseSensitive, IgnoreSpace: boolean): string;
188 const
189 IdentChars = ['_','a'..'z','A'..'Z'];
190 SpaceChars = [' ',#9];
191 var
192 Settings: TTextBlockCompareSettings;
193 Tree: TAVLTree;// tree of TTextBlock
194 StartPos: Integer;
195 EndPos: Integer;
196 ANode: TAVLTreeNode;
197 ABlock: TTextBlock;
198 TxtLen: integer;
199 LastNode: TAVLTreeNode;
200 LastBlock: TTextBlock;
201 LastChar: Char;
202 Last2Char: Char;
203 HeaderIndent: Integer;
204 CurIndent: Integer;
205 CurPos: Integer;
206 begin
207 Result:=TheText;
208 if Result='' then exit;
209 // create compare settings
210 Settings:=TTextBlockCompareSettings.Create;
211 Settings.CaseSensitive:=CaseSensitive;
212 Settings.IgnoreSpace:=IgnoreSpace;
213 Settings.Ascending:=(Direction=sdAscending);
214 // create AVL tree
215 Tree:=TAVLTree.Create(@CompareTextBlock);
216
217 // collect text blocks
218 TxtLen:=length(TheText);
219 case Domain of
220
221 sdParagraphs:
222 begin
223 // paragraphs:
224 // A paragraph is here a header line and all the lines to the next header
225 // line. A header line has the same indent as the first selected line.
226
227 // find indent in first line
228 HeaderIndent:=0;
229 while (HeaderIndent<TxtLen) and (TheText[HeaderIndent+1] in SpaceChars) do
230 inc(HeaderIndent);
231
232 // split text into blocks
233 StartPos:=1;
234 EndPos:=StartPos;
235 while EndPos<=TxtLen do begin
236 CurPos:=EndPos;
237 // find indent of current line
238 while (CurPos<=TxtLen) and (TheText[CurPos] in SpaceChars) do
239 inc(CurPos);
240 CurIndent:=CurPos-EndPos;
241 if CurIndent=HeaderIndent then begin
242 // new block
243 if EndPos>StartPos then
244 Tree.Add(
245 TTextBlock.Create(Settings,@TheText[StartPos],EndPos-StartPos));
246 StartPos:=EndPos;
247 end;
248 EndPos:=CurPos;
249 // add line to block
250 // read line
251 while (EndPos<=TxtLen) and (not (TheText[EndPos] in [#10,#13])) do
252 inc(EndPos);
253 // read line end
254 if (EndPos<=TxtLen) then begin
255 inc(EndPos);
256 if (EndPos<=TxtLen) and (TheText[EndPos] in [#10,#13])
257 and (TheText[EndPos]<>TheText[EndPos-1]) then
258 inc(EndPos);
259 end;
260 end;
261 if EndPos>StartPos then
262 Tree.Add(TTextBlock.Create(Settings,@TheText[StartPos],EndPos-StartPos));
263 end;
264
265 sdWords, sdLines:
266 begin
267 StartPos:=1;
268 while StartPos<=TxtLen do begin
269 EndPos:=StartPos+1;
270 while (EndPos<=TxtLen) do begin
271 case Domain of
272 sdWords:
273 // check if word start
274 if (TheText[EndPos] in IdentChars)
275 and (EndPos>1)
276 and (not (TheText[EndPos-1] in IdentChars))
277 then
278 break;
279
280 sdLines:
281 // check if LineEnd
282 if (TheText[EndPos] in [#10,#13]) then begin
283 inc(EndPos);
284 if (EndPos<=TxtLen) and (TheText[EndPos] in [#10,#13])
285 and (TheText[EndPos]<>TheText[EndPos-1]) then
286 inc(EndPos);
287 break;
288 end;
289
290 end;
291 inc(EndPos);
292 end;
293 if EndPos>TxtLen then EndPos:=TxtLen+1;
294 if EndPos>StartPos then
295 Tree.Add(TTextBlock.Create(Settings,@TheText[StartPos],EndPos-StartPos));
296 StartPos:=EndPos;
297 end;
298 end;
299
300 else
301 DebugLn('ERROR: Domain not implemented');
302 end;
303
304 // build sorted text
305 Result:='';
306 ANode:=Tree.FindHighest;
307 while ANode<>nil do begin
308 ABlock:=TTextBlock(ANode.Data);
309 Result:=Result+copy(TheText,ABlock.Start-PChar(TheText)+1,ABlock.Len);
310 case Domain of
311 sdLines,sdParagraphs:
312 if not (Result[length(Result)] in [#10,#13]) then begin
313 // this was the last line before the sorting
314 // if it moved, then copy the line end of the new last line
315 LastNode:=Tree.FindLowest;
316 LastBlock:=TTextBlock(LastNode.Data);
317 LastChar:=PChar(LastBlock.Start+LastBlock.Len-1)^;
318 if LastChar in [#10,#13] then begin
319 if (LastBlock.Len>1) then begin
320 Last2Char:=PChar(LastBlock.Start+LastBlock.Len-2)^;
321 if Last2Char in [#10,#13] then
322 Result:=Result+Last2Char;
323 end;
324 Result:=Result+LastChar;
325 end;
326
327 end;
328 end;
329 ANode:=Tree.FindPrecessor(ANode);
330 end;
331
332 // clean up
333 Tree.FreeAndClear;
334 Tree.Free;
335 Settings.Free;
336 end;
337
338 { TSortSelectionDialog }
339
340 procedure TSortSelectionDialog.DirectionRadioGroupClick(Sender: TObject);
341 begin
342 if DirectionRadioGroup.ItemIndex=0 then
343 Direction:=sdAscending
344 else
345 Direction:=sdDescending;
346 end;
347
348 procedure TSortSelectionDialog.DomainRadioGroupClick(Sender: TObject);
349 begin
350 case DomainRadioGroup.ItemIndex of
351 0: Domain:=sdLines;
352 1: Domain:=sdWords;
353 2: Domain:=sdParagraphs;
354 else
355 Domain:=sdLines;
356 end;
357 end;
358
359 procedure TSortSelectionDialog.FormClose(Sender: TObject; var CloseAction:
360 TCloseAction);
361 begin
362 MiscellaneousOptions.SortSelDirection:=Direction;
363 MiscellaneousOptions.SortSelDomain:=Domain;
364 MiscellaneousOptions.Save;
365 end;
366
367 procedure TSortSelectionDialog.FormCreate(Sender: TObject);
368 begin
369 FCaseSensitive:=false;
370 FIgnoreSpace:=true;
371 FDirection:=MiscellaneousOptions.SortSelDirection;
372 FDomain:=MiscellaneousOptions.SortSelDomain;
373 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
374
375 IDEDialogLayoutList.ApplyLayout(Self,600,450);
376 Caption:=lisSortSelSortSelection;
377
378 PreviewGroupBox.Caption:=lisSortSelPreview;
379
380 with DirectionRadioGroup do begin
381 Caption:=dlgDirection;
382 ChildSizing.EnlargeHorizontal:=crsAnchorAligning;
383 with Items do begin
384 BeginUpdate;
385 Add(lisSortSelAscending);
386 Add(lisSortSelDescending);
387 case FDirection of
388 sdAscending: ItemIndex:=0;
389 else ItemIndex:=1;
390 end;
391 EndUpdate;
392 end;
393 end;
394
395 with DomainRadioGroup do begin
396 Caption:=lisSortSelDomain;
397 ChildSizing.EnlargeHorizontal:=crsAnchorAligning;
398 with Items do begin
399 BeginUpdate;
400 Add(lisSortSelLines);
401 Add(lisSortSelWords);
402 Add(lisSortSelParagraphs);
403 case FDomain of
404 sdLines: ItemIndex:=0;
405 sdWords: ItemIndex:=1;
406 else ItemIndex:=2;
407 end;
408 EndUpdate;
409 end;
410 end;
411
412 with OptionsCheckGroup do begin
413 Caption:=lisSortSelOptions;
414 ChildSizing.EnlargeHorizontal:=crsAnchorAligning;
415 with Items do begin
416 BeginUpdate;
417 Add(lisSortSelCaseSensitive);
418 Add(lisSortSelIgnoreSpace);
419 EndUpdate;
420 Checked[0]:=FCaseSensitive;
421 Checked[1]:=FIgnoreSpace;
422 end;
423 end;
424
425 ButtonPanel.OKButton.Caption:=lisSortSelSort;
426 end;
427
428 procedure TSortSelectionDialog.OptionsCheckGroupItemClick(Sender: TObject;
429 Index: integer);
430 begin
431 case Index of
432 0: CaseSensitive:=OptionsCheckGroup.Checked[0];
433 1: IgnoreSpace:=OptionsCheckGroup.Checked[1];
434 end;
435 end;
436
437 procedure TSortSelectionDialog.SetDirection(const AValue: TSortDirection);
438 begin
439 if FDirection=AValue then exit;
440 FDirection:=AValue;
441 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
442 UpdatePreview;
443 end;
444
TSortSelectionDialog.GetSortedTextnull445 function TSortSelectionDialog.GetSortedText: string;
446 begin
447 if ssdSortedTextNeedsUpdate in FStates then begin
448 FSortedText:=SortText(TheText,Direction,Domain,CaseSensitive,IgnoreSpace);
449 Exclude(FStates,ssdSortedTextNeedsUpdate);
450 end;
451 Result:=FSortedText;
452 end;
453
454 procedure TSortSelectionDialog.SetCaseSensitive(const AValue: boolean);
455 begin
456 if FCaseSensitive=AValue then exit;
457 FCaseSensitive:=AValue;
458 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
459 if (OptionsCheckGroup<>nil) then
460 OptionsCheckGroup.Checked[0]:=FCaseSensitive;
461 UpdatePreview;
462 end;
463
464 procedure TSortSelectionDialog.SetDomain(const AValue: TSortDomain);
465 begin
466 if FDomain=AValue then exit;
467 FDomain:=AValue;
468 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
469 UpdatePreview;
470 end;
471
472 procedure TSortSelectionDialog.SetIgnoreSpace(const AValue: boolean);
473 begin
474 if FIgnoreSpace=AValue then exit;
475 FIgnoreSpace:=AValue;
476 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
477 if (OptionsCheckGroup<>nil) then
478 OptionsCheckGroup.Checked[1]:=FIgnoreSpace;
479 UpdatePreview;
480 end;
481
482 procedure TSortSelectionDialog.SetTheText(const AValue: string);
483 begin
484 if FTheText=AValue then exit;
485 FTheText:=AValue;
486 FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
487 UpdatePreview;
488 end;
489
490 procedure TSortSelectionDialog.BeginUpdate;
491 begin
492 inc(FUpdateCount);
493 end;
494
495 procedure TSortSelectionDialog.EndUpdate;
496 begin
497 dec(FUpdateCount);
498 if (FUpdateCount=0) then begin
499 if ssdSortedTextNeedsUpdate in FStates then
500 Include(FStates,ssdPreviewNeedsUpdate);
501 if (ssdPreviewNeedsUpdate in FStates) then UpdatePreview;
502 end;
503 end;
504
505 procedure TSortSelectionDialog.UpdatePreview;
506 begin
507 if FUpdateCount>0 then
508 Include(FStates,ssdPreviewNeedsUpdate)
509 else begin
510 Exclude(FStates,ssdPreviewNeedsUpdate);
511 PreviewSynEdit.Text:=SortedText;
512 end;
513 end;
514
515 initialization
516 TextTools.ShowSortSelectionDialogFunc:=@ShowSortSelectionDialogBase;
517 TextTools.SortTextFunc:=@SortText;
518
519 end.
520
521