1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     TShortCutGrabBox - a control to edit a shortcut
25     TShortCutDialog - a dialog to edit ide shortcuts
26 }
27 unit KeyMapShortCutDlg;
28 
29 {$mode objfpc}{$H+}
30 
31 interface
32 
33 uses
34   Classes, SysUtils, LCLProc, Forms, Controls, Graphics, Dialogs,
35   ExtCtrls, StdCtrls, LCLType,
36   PropEdits, IDECommands, IDEWindowIntf, IDEDialogs,
37   KeyMapping, LazarusIDEStrConsts, Buttons, ButtonPanel;
38 
39 type
40 
41   { TShortCutDialog }
42 
43   TShortCutDialog = class(TForm)
44     BtnPanel: TButtonPanel;
45     PrimaryGroupBox: TGroupBox;
46     SecondaryGroupBox: TGroupBox;
47     procedure CancelButtonClick(Sender: TObject);
48     procedure FormCreate(Sender: TObject);
49     procedure FormShow(Sender: TObject);
50     procedure OkButtonClick(Sender: TObject);
51   private
52     FKeyCommandRelationList: TKeyCommandRelationList;
53     FPrimaryKey1Box: TShortCutGrabBox;
54     FPrimaryKey2Box: TShortCutGrabBox;
55     FRelationIndex: integer;
56     FSecondaryKey1Box: TShortCutGrabBox;
57     FSecondaryKey2Box: TShortCutGrabBox;
58     FShowSecondary: boolean;
59     FShowSequence: boolean;
GetPrimaryShortCutnull60     function GetPrimaryShortCut: TIDEShortCut;
GetSecondaryShortCutnull61     function GetSecondaryShortCut: TIDEShortCut;
62     procedure SetPrimaryShortCut(const AValue: TIDEShortCut);
63     procedure SetSecondaryShortCut(const AValue: TIDEShortCut);
64     procedure SetShowSecondary(const AValue: boolean);
65     procedure SetShowSequence(const AValue: boolean);
ResolveConflictsnull66     function ResolveConflicts(Key: TIDEShortCut; Scope: TIDECommandScope): TModalResult;
67     procedure UpdateCaptions;
68   public
69     procedure ClearKeys;
70     procedure SetRelation(AKeyCommandRelationList: TKeyCommandRelationList;
71                           Index: integer);
72     property KeyCommandRelationList: TKeyCommandRelationList
73                      read FKeyCommandRelationList write FKeyCommandRelationList;
74     property RelationIndex: integer read FRelationIndex write FRelationIndex;
75     property ShowSecondary: boolean read FShowSecondary write SetShowSecondary;
76     property ShowSequence: boolean read FShowSequence write SetShowSequence;
77     property PrimaryKey1Box: TShortCutGrabBox read FPrimaryKey1Box;
78     property PrimaryKey2Box: TShortCutGrabBox read FPrimaryKey2Box;
79     property SecondaryKey1Box: TShortCutGrabBox read FSecondaryKey1Box;
80     property SecondaryKey2Box: TShortCutGrabBox read FSecondaryKey2Box;
81     property PrimaryShortCut: TIDEShortCut read GetPrimaryShortCut write SetPrimaryShortCut;
82     property SecondaryShortCut: TIDEShortCut read GetSecondaryShortCut write SetSecondaryShortCut;
83   end;
84 
ShowKeyMappingEditFormnull85 function ShowKeyMappingEditForm(Index: integer;
86                 AKeyCommandRelationList: TKeyCommandRelationList): TModalResult;
87 
88 implementation
89 
90 {$R *.lfm}
91 
ShowKeyMappingEditFormnull92 function ShowKeyMappingEditForm(Index: integer;
93   AKeyCommandRelationList: TKeyCommandRelationList): TModalResult;
94 var
95   ShortCutDialog: TShortCutDialog;
96 begin
97   ShortCutDialog:=TShortCutDialog.Create(nil);
98   try
99     ShortCutDialog.ShowSecondary:=true;
100     ShortCutDialog.ShowSequence:=true;
101     ShortCutDialog.SetRelation(AKeyCommandRelationList,Index);
102     Result:=ShortCutDialog.ShowModal;
103   finally
104     ShortCutDialog.Free;
105   end;
106 end;
107 
108 
109 { TShortCutDialog }
110 
111 procedure TShortCutDialog.FormCreate(Sender: TObject);
112 begin
113   Caption := srkmEditForCmd;
114   BtnPanel.OKButton.OnClick := @OkButtonClick;
115   BtnPanel.CancelButton.OnClick := @CancelButtonClick;
116 
117   IDEDialogLayoutList.ApplyLayout(Self, 480, 480);
118 
119   FShowSecondary:=true;
120   FShowSequence:=true;
121 
122   FPrimaryKey1Box:=TShortCutGrabBox.Create(Self);
123   with FPrimaryKey1Box do begin
124     Name:='FPrimaryKey1Box';
125     Align:=alClient;
126     AutoSize:=true;
127     BorderSpacing.Around:=6;
128     Parent:=PrimaryGroupBox;
129   end;
130   FPrimaryKey2Box:=TShortCutGrabBox.Create(Self);
131   with FPrimaryKey2Box do begin
132     Name:='FPrimaryKey2Box';
133     Align:=alBottom;
134     AutoSize:=true;
135     BorderSpacing.Around:=6;
136     Parent:=PrimaryGroupBox;
137   end;
138   PrimaryGroupBox.AutoSize:=true;
139 
140   FSecondaryKey1Box:=TShortCutGrabBox.Create(Self);
141   with FSecondaryKey1Box do begin
142     Name:='FSecondaryKey1Box';
143     Align:=alClient;
144     AutoSize:=true;
145     BorderSpacing.Around:=6;
146     Parent:=SecondaryGroupBox;
147   end;
148   FSecondaryKey2Box:=TShortCutGrabBox.Create(Self);
149   with FSecondaryKey2Box do begin
150     Name:='FSecondaryKey2Box';
151     Align:=alBottom;
152     AutoSize:=true;
153     BorderSpacing.Around:=6;
154     Parent:=SecondaryGroupBox;
155   end;
156   SecondaryGroupBox.AutoSize:=true;
157 
158   UpdateCaptions;
159   ClearKeys;
160 end;
161 
162 procedure TShortCutDialog.FormShow(Sender: TObject);
163 begin
164   FPrimaryKey1Box.GrabButton.SetFocus;
165 end;
166 
167 procedure TShortCutDialog.CancelButtonClick(Sender: TObject);
168 begin
169   IDEDialogLayoutList.SaveLayout(Self);
170 end;
171 
172 procedure TShortCutDialog.OkButtonClick(Sender: TObject);
173 var
174   NewKeyA: TIDEShortCut;
175   NewKeyB: TIDEShortCut;
176   CurRelation: TKeyCommandRelation;
177 begin
178   IDEDialogLayoutList.SaveLayout(Self);
179 
180   if KeyCommandRelationList=nil then begin
181     ModalResult:=mrOk;
182     exit;
183   end;
184 
185   // set defaults
186   NewKeyA:=PrimaryShortCut;
187   NewKeyB:=SecondaryShortCut;
188 
189   //debugln('TShortCutDialog.OkButtonClick A ShortcutA=',KeyAndShiftStateToEditorKeyString(NewKeyA),' ShortcutB=',KeyAndShiftStateToEditorKeyString(NewKeyB));
190 
191   // get old relation
192   CurRelation:=KeyCommandRelationList.Relations[RelationIndex];
193 
194   case ResolveConflicts(NewKeyA,CurRelation.Category.Scope) of
195     mrCancel:   begin
196         debugln('TShortCutDialog.OkButtonClick ResolveConflicts failed for key1');
197         exit;
198       end;
199     mrRetry: begin
200         ModalResult:=mrNone;
201         exit;
202       end;
203   end;
204 
205   //debugln('TShortCutDialog.OkButtonClick B ShortcutA=',KeyAndShiftStateToEditorKeyString(NewKeyA),' ShortcutB=',KeyAndShiftStateToEditorKeyString(NewKeyB));
206 
207   if (NewKeyA.Key1=NewKeyB.Key1) and (NewKeyA.Shift1=NewKeyB.Shift1) and
208      (NewKeyA.Key2=NewKeyB.Key2) and (NewKeyA.Shift2=NewKeyB.Shift2) then
209   begin
210     NewKeyB.Key1:=VK_UNKNOWN;
211     NewKeyB.Shift1:=[];
212     NewKeyB.Key2:=VK_UNKNOWN;
213     NewKeyB.Shift2:=[];
214   end
215   else
216   case ResolveConflicts(NewKeyB,CurRelation.Category.Scope) of
217     mrCancel:   begin
218         debugln('TShortCutDialog.OkButtonClick ResolveConflicts failed for key1');
219         exit;
220       end;
221     mrRetry: begin
222         ModalResult:=mrNone;
223         exit;
224       end;
225   end;
226 
227   //debugln('TShortCutDialog.OkButtonClick C ShortcutA=',KeyAndShiftStateToEditorKeyString(NewKeyA),' ShortcutB=',KeyAndShiftStateToEditorKeyString(NewKeyB));
228 
229   if NewKeyA.Key1=VK_UNKNOWN then
230   begin
231     NewKeyA:=NewKeyB;
232     NewKeyB.Key1:=VK_UNKNOWN;
233     NewKeyB.Shift1:=[];
234     NewKeyB.Key2:=VK_UNKNOWN;
235     NewKeyB.Shift2:=[];
236   end;
237 
238   //debugln('TShortCutDialog.OkButtonClick D ShortcutA=',KeyAndShiftStateToEditorKeyString(NewKeyA),' ShortcutB=',KeyAndShiftStateToEditorKeyString(NewKeyB));
239 
240   CurRelation.ShortcutA:=NewKeyA;
241   CurRelation.ShortcutB:=NewKeyB;
242 
243   //debugln('TShortCutDialog.OkButtonClick B ShortcutA=',KeyAndShiftStateToEditorKeyString(NewKeyA),' ShortcutB=',KeyAndShiftStateToEditorKeyString(NewKeyB));
244   ModalResult:=mrOk;
245 end;
246 
247 procedure TShortCutDialog.SetShowSecondary(const AValue: boolean);
248 begin
249   if FShowSecondary=AValue then exit;
250   FShowSecondary:=AValue;
251   SecondaryGroupBox.Visible:=FShowSecondary;
252 end;
253 
254 procedure TShortCutDialog.SetShowSequence(const AValue: boolean);
255 begin
256   if FShowSequence=AValue then exit;
257   FShowSequence:=AValue;
258   FPrimaryKey2Box.Visible:=FShowSequence;
259   FSecondaryKey2Box.Visible:=FShowSequence;
260   // With a single key GrabBox focus OK button after keypress.
261   if not (FShowSecondary or FShowSequence) then
262     FPrimaryKey1Box.MainOkButton:=BtnPanel.OKButton;
263   UpdateCaptions;
264 end;
265 
266 procedure TShortCutDialog.SetPrimaryShortCut(const AValue: TIDEShortCut);
267 var
268   APrimaryShortCut: TIDEShortCut;
269 begin
270   APrimaryShortCut:=GetPrimaryShortCut;
271   if CompareIDEShortCuts(@APrimaryShortCut,@AValue)=0 then exit;
272   PrimaryKey1Box.Key:=AValue.Key1;
273   PrimaryKey1Box.ShiftState:=AValue.Shift1;
274   PrimaryKey2Box.Key:=AValue.Key2;
275   PrimaryKey2Box.ShiftState:=AValue.Shift2;
276 end;
277 
TShortCutDialog.GetPrimaryShortCutnull278 function TShortCutDialog.GetPrimaryShortCut: TIDEShortCut;
279 begin
280   Result.Key1:=PrimaryKey1Box.Key;
281   Result.Shift1:=PrimaryKey1Box.ShiftState;
282   Result.Key2:=PrimaryKey2Box.Key;
283   Result.Shift2:=PrimaryKey2Box.ShiftState;
284 end;
285 
TShortCutDialog.GetSecondaryShortCutnull286 function TShortCutDialog.GetSecondaryShortCut: TIDEShortCut;
287 begin
288   Result.Key1:=SecondaryKey1Box.Key;
289   Result.Shift1:=SecondaryKey1Box.ShiftState;
290   Result.Key2:=SecondaryKey2Box.Key;
291   Result.Shift2:=SecondaryKey2Box.ShiftState;
292 end;
293 
294 procedure TShortCutDialog.SetSecondaryShortCut(const AValue: TIDEShortCut);
295 var
296   ASecondaryShortCut: TIDEShortCut;
297 begin
298   ASecondaryShortCut:=SecondaryShortCut;
299   if CompareIDEShortCuts(@ASecondaryShortCut,@AValue)=0 then exit;
300   SecondaryKey1Box.Key:=AValue.Key1;
301   SecondaryKey1Box.ShiftState:=AValue.Shift1;
302   SecondaryKey2Box.Key:=AValue.Key2;
303   SecondaryKey2Box.ShiftState:=AValue.Shift2;
304 end;
305 
TShortCutDialog.ResolveConflictsnull306 function TShortCutDialog.ResolveConflicts(Key: TIDEShortCut;
307   Scope: TIDECommandScope): TModalResult;
308 type
309   TConflictType = (ctNone,ctConflictKeyA,ctConflictKeyB);
310 var
311   ConflictRelation: TKeyCommandRelation;
312   ConflictName: String;
313   CurRelation: TKeyCommandRelation;
314   CurName: String;
315   j: integer;
316   conflictType: TConflictType;
317 begin
318   Result:=mrOK;
319   // search for conflict
320   CurRelation:=KeyCommandRelationList.Relations[RelationIndex];
321   if Key.Key1=VK_UNKNOWN then
322     exit;
323   //Try to find an IDE command that conflicts
324   for j:=0 to KeyCommandRelationList.RelationCount-1 do begin
325     conflictType:=ctNone;
326     ConflictRelation:=KeyCommandRelationList.Relations[j];
327     with ConflictRelation do
328     begin
329       if (j=RelationIndex) then continue;
330 
331       if not Category.ScopeIntersects(Scope) then continue;
332 
333       if ((Key.Key1=ShortcutA.Key1) and (Key.Shift1=ShortcutA.Shift1))
334       and (((Key.Key2=ShortcutA.Key2) and (Key.Shift2=ShortcutA.Shift2))
335             or (Key.Key2=VK_UNKNOWN) or (ShortcutA.Key2=VK_UNKNOWN))
336       then begin
337         conflictType:=ctConflictKeyA; // ShortcutA bites
338       end
339       else if ((Key.Key1=ShortcutB.Key1) and (Key.Shift1=ShortcutB.Shift1))
340       and (((Key.Key2=ShortcutB.Key2) and (Key.Shift2=ShortcutB.Shift2))
341            or (Key.Key2=VK_UNKNOWN) or (ShortcutB.Key2=VK_UNKNOWN))
342       then begin
343         conflictType:=ctConflictKeyB; // ShortcutB bites
344       end;
345     end;
346     if (conflictType<>ctNone) then begin
347       CurName:=CurRelation.GetCategoryAndName;
348       ConflictName:=ConflictRelation.GetCategoryAndName;
349       if conflictType=ctConflictKeyA then
350         ConflictName:=ConflictName
351                   +' ('+KeyAndShiftStateToEditorKeyString(ConflictRelation.ShortcutA)+')'
352       else
353         ConflictName:=ConflictName
354                  +' ('+KeyAndShiftStateToEditorKeyString(ConflictRelation.ShortcutB)+')';
355       case IDEMessageDialog(lisPEConflictFound,
356          Format(lisTheKeyIsAlreadyAssignedToRemoveTheOldAssignmentAnd,
357                 [KeyAndShiftStateToEditorKeyString(Key),
358                  LineEnding, ConflictName, LineEnding, LineEnding, CurName]),
359          mtConfirmation, [mbYes, mbNo, mbCancel])
360       of
361         mrYes:    Result:=mrOK;
362         mrCancel: Result:=mrCancel;
363         else      Result:=mrRetry;
364       end;
365       if Result=mrOK then begin
366         if (conflictType=ctConflictKeyA) then
367           ConflictRelation.ShortcutA:=ConflictRelation.ShortcutB;
368         ConflictRelation.ClearShortcutB;
369       end
370       else
371         break;
372     end;
373   end;
374 end;
375 
376 procedure TShortCutDialog.UpdateCaptions;
377 begin
378   if ShowSequence then begin
379     PrimaryGroupBox.Caption:=lisKeyOr2KeySequence;
380     SecondaryGroupBox.Caption:=lisAlternativeKeyOr2KeySequence;
381   end else begin
382     PrimaryGroupBox.Caption:=lisEdtExtToolKey;
383     SecondaryGroupBox.Caption:=lisAlternativeKey;
384   end;
385 end;
386 
387 procedure TShortCutDialog.ClearKeys;
388 begin
389   PrimaryShortCut:=CleanIDEShortCut;
390   SecondaryShortCut:=CleanIDEShortCut;
391 end;
392 
393 procedure TShortCutDialog.SetRelation(
394   AKeyCommandRelationList: TKeyCommandRelationList; Index: integer);
395 var
396   CurRelation: TKeyCommandRelation;
397 begin
398   KeyCommandRelationList:=AKeyCommandRelationList;
399   RelationIndex:=Index;
400   CurRelation:=AKeyCommandRelationList.Relations[RelationIndex];
401   PrimaryShortCut:=CurRelation.ShortcutA;
402   SecondaryShortCut:=CurRelation.ShortcutB;
403   Caption:=srkmCommand+' "'+CurRelation.LocalizedName+'"';
404 end;
405 
406 end.
407 
408