1 (*
2 This Source Code Form is subject to the terms of the Mozilla Public
3 License, v. 2.0. If a copy of the MPL was not distributed with this
4 file, You can obtain one at http://mozilla.org/MPL/2.0/.
5
6 Copyright (c) Alexey Torgashin
7 *)
8 unit formkeys;
9
10 {$mode objfpc}{$H+}
11
12 interface
13
14 uses
15 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel,
16 StdCtrls, Menus, ExtCtrls, IniFiles,
17 LclType, LclProc, LazUTF8, LazFileUtils,
18 ATSynEdit_Keymap,
19 proc_globdata,
20 proc_customdialog,
21 proc_msg;
22
23 type
24 { TfmKeys }
25
26 TfmKeys = class(TForm)
27 bAdd1: TButton;
28 bAdd2: TButton;
29 bClear1: TButton;
30 bClear2: TButton;
31 bSet1: TButton;
32 bSet2: TButton;
33 bCancelInput: TButton;
34 chkForLexer: TCheckBox;
35 LabelDupInfo: TLabel;
36 labelKey1: TLabel;
37 labelKey2: TLabel;
38 panelInput: TPanel;
39 panelBtn: TButtonPanel;
40 panelPress: TPanel;
41 TimerAdd: TTimer;
42 procedure bAdd1Click(Sender: TObject);
43 procedure bAdd2Click(Sender: TObject);
44 procedure bCancelInputClick(Sender: TObject);
45 procedure bClear1Click(Sender: TObject);
46 procedure bClear2Click(Sender: TObject);
47 procedure bSet1Click(Sender: TObject);
48 procedure bSet2Click(Sender: TObject);
49 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
50 procedure FormShow(Sender: TObject);
51 procedure HelpButtonClick(Sender: TObject);
52 procedure OKButtonClick(Sender: TObject);
53 procedure TimerAddTimer(Sender: TObject);
54 private
55 { private declarations }
56 FKeyPressed: integer;
57 procedure UpdateState;
58 procedure AddHotkey(var K: TATKeyArray);
GetHotkeynull59 function GetHotkey: integer;
60 procedure Localize;
61 public
62 { public declarations }
63 Keymap: TATKeymap;
64 LexerName: string;
65 CommandCode: integer;
66 Keys1, Keys2: TATKeyArray;
67 end;
68
69 var
70 fmKeys: TfmKeys;
71
72 implementation
73
74 {$R *.lfm}
75
76 { TfmKeys }
77
78 procedure TfmKeys.Localize;
79 const
80 section = 'd_keys';
81 var
82 ini: TIniFile;
83 fn: string;
84 begin
85 fn:= GetAppLangFilename;
86 if not FileExists(fn) then exit;
87 ini:= TIniFile.Create(fn);
88 try
89 Caption:= ini.ReadString(section, '_', Caption);
90 with panelBtn.OKButton do Caption:= msgButtonOk;
91 with panelBtn.CancelButton do Caption:= msgButtonCancel;
92 bCancelInput.Caption:= msgButtonCancel;
93
94 with bSet1 do Caption:= ini.ReadString(section, 'set', Caption);
95 with bClear1 do Caption:= ini.ReadString(section, 'clr', Caption);
96 with bAdd1 do Caption:= ini.ReadString(section, 'ex', Caption);
97
98 bSet2.Caption:= bSet1.Caption;
99 bClear2.Caption:= bClear1.Caption;
100 bAdd2.Caption:= bAdd1.Caption;
101
102 with panelPress do Caption:= ini.ReadString(section, 'wait', Caption);
103 with chkForLexer do Caption:= ini.ReadString(section, 'lex', Caption);
104 finally
105 FreeAndNil(ini);
106 end;
107 end;
108
109 procedure TfmKeys.FormShow(Sender: TObject);
110 begin
111 Localize;
112 DoForm_ScaleAuto(Self, true);
113 UpdateFormOnTop(Self);
114
115 //OK btn needs confirmtion
116 panelBtn.OKButton.ModalResult:= mrNone;
117
118 UpdateState;
119
120 //if no hotkeys, user wants to add it, so auto-press Extend here
121 if (Keys1.Length=0) and (Keys2.Length=0) then
122 TimerAdd.Enabled:= true;
123 end;
124
125 procedure TfmKeys.HelpButtonClick(Sender: TObject);
126 begin
127 ModalResult:= mrNo;
128 end;
129
130 procedure TfmKeys.OKButtonClick(Sender: TObject);
131 var
132 Item: TATKeymapItem;
133 SDesc: string;
134 N: integer;
135 begin
136 //don't check for duplicates, if "For current kexer" checked
137 //to fix https://github.com/Alexey-T/CudaText/issues/1656
138 if chkForLexer.Checked then
139 begin
140 ModalResult:= mrOk;
141 exit;
142 end;
143
144 Item:= TATKeymapItem.Create;
145 try
146 Item.Command:= CommandCode;
147 Item.Keys1:= Keys1;
148 Item.Keys2:= Keys2;
149
150 N:= TKeymapHelper.CheckDuplicateForCommand(Item, LexerName, false);
151 if N=0 then
152 begin
153 ModalResult:= mrOk;
154 exit;
155 end;
156
157 N:= Keymap.IndexOf(N);
158 if N>=0 then
159 SDesc:= Keymap.Items[N].Name
160 else
161 SDesc:= '??';
162
163 if MsgBox(
164 Format(msgConfirmHotkeyBusy, [SDesc]),
165 MB_OKCANCEL or MB_ICONWARNING) = ID_OK then
166 begin
167 TKeymapHelper.CheckDuplicateForCommand(Item, LexerName, true);
168 ModalResult:= mrOk;
169 end;
170 finally
171 Item.Free;
172 end;
173 end;
174
175 procedure TfmKeys.TimerAddTimer(Sender: TObject);
176 begin
177 TimerAdd.Enabled:= false;
178 bAdd1.Click;
179 end;
180
181 procedure TfmKeys.bClear1Click(Sender: TObject);
182 begin
183 Keys1.Clear;
184 UpdateState;
185 end;
186
187 procedure TfmKeys.bClear2Click(Sender: TObject);
188 begin
189 Keys2.Clear;
190 UpdateState;
191 end;
192
193 procedure TfmKeys.bSet1Click(Sender: TObject);
194 begin
195 Keys1.Clear;
196 AddHotkey(Keys1);
197 UpdateState;
198 end;
199
200 procedure TfmKeys.bSet2Click(Sender: TObject);
201 begin
202 Keys2.Clear;
203 AddHotkey(Keys2);
204 UpdateState;
205 end;
206
207 procedure TfmKeys.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
208 begin
209 if not panelPress.Visible then exit;
210
211 if not AppKeyIsAllowedAsCustomHotkey(Key, Shift) then
212 begin
213 Key:= 0;
214 exit
215 end;
216
217 FKeyPressed:= ShortCut(Key, Shift);
218 key:= 0;
219 end;
220
221 procedure TfmKeys.bAdd1Click(Sender: TObject);
222 begin
223 AddHotkey(Keys1);
224 UpdateState;
225 end;
226
227 procedure TfmKeys.bAdd2Click(Sender: TObject);
228 begin
229 AddHotkey(Keys2);
230 UpdateState;
231 end;
232
233 procedure TfmKeys.bCancelInputClick(Sender: TObject);
234 begin
235 FKeyPressed:= -1;
236 end;
237
238 procedure TfmKeys.AddHotkey(var K: TATKeyArray);
239 var
240 newkey, index, i: integer;
241 begin
242 newkey:= GetHotkey;
243 if newkey=0 then exit;
244
245 index:= -1;
246 for i:= 0 to High(K.Data) do
247 if K.Data[i]=0 then
248 begin index:= i; break end;
249 if index<0 then exit;
250
251 K.Data[index]:= newkey;
252 end;
253
GetHotkeynull254 function TfmKeys.GetHotkey: integer;
255 begin
256 Result:= 0;
257
258 panelPress.Align:= alClient;
259 panelInput.Hide;
260 panelBtn.Hide;
261 panelPress.Show;
262
263 try
264 FKeyPressed:= 0;
265 repeat
266 Application.ProcessMessages;
267 if Application.Terminated then Break;
268 if ModalResult=mrCancel then Break;
269 if FKeyPressed<>0 then
270 begin
271 //value -1 means "cancel input"
272 if FKeyPressed>0 then
273 Result:= FKeyPressed;
274 Break;
275 end;
276 until false;
277 finally
278 panelPress.Hide;
279 panelBtn.Show;
280 panelInput.Show;
281 end;
282 end;
283
284 procedure TfmKeys.UpdateState;
285 var
286 Item: TATKeymapItem;
287 SDesc: string;
288 N: integer;
289 begin
290 labelKey1.caption:= '1) '+Keys1.ToString;
291 labelKey2.caption:= '2) '+Keys2.ToString;
292
293 bClear1.Enabled:= Keys1.Length>0;
294 bClear2.Enabled:= Keys2.Length>0;
295 bAdd1.Enabled:= (Keys1.Length>0) and (Keys1.Length<Length(TATKeyArray.Data));
296 bAdd2.Enabled:= (Keys2.Length>0) and (Keys2.Length<Length(TATKeyArray.Data));
297
298 if bSet1.Visible and bSet1.CanFocus then
299 ActiveControl:= bSet1;
300
301 //check dups
302 Item:= TATKeymapItem.Create;
303 try
304 Item.Command:= CommandCode;
305 Item.Keys1:= Keys1;
306 Item.Keys2:= Keys2;
307
308 N:= TKeymapHelper.CheckDuplicateForCommand(Item, LexerName, false);
309 if N>0 then
310 begin
311 N:= Keymap.IndexOf(N);
312 if N>=0 then
313 SDesc:= Keymap.Items[N].Name
314 else
315 SDesc:= '??';
316
317 LabelDupInfo.Show;
318 LabelDupInfo.Caption:= Format(msgStatusHotkeyBusy, [SDesc]);
319 end
320 else
321 LabelDupInfo.Hide;
322 finally
323 Item.Free;
324 end;
325 end;
326
327 end.
328
329