source: cprs/branches/tmg-cprs/dklang-package-3.01/DKL_Expt.pas@ 951

Last change on this file since 951 was 468, checked in by Kevin Toppenberg, 16 years ago

CPRS v1.0.26.76
File size: 18.9 KB
Line 
1///*********************************************************************************************************************
2/// $Id: DKL_Expt.pas,v 1.20 2006/08/10 16:35:03 dale Exp $
3///---------------------------------------------------------------------------------------------------------------------
4/// DKLang Localization Package
5/// Copyright 2002-2006 DK Software, http://www.dk-soft.org
6///*********************************************************************************************************************
7///
8/// The contents of this package are subject to the Mozilla Public License
9/// Version 1.1 (the "License"); you may not use this file except in compliance
10/// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
11///
12/// Alternatively, you may redistribute this library, use and/or modify it under the
13/// terms of the GNU Lesser General Public License as published by the Free Software
14/// Foundation; either version 2.1 of the License, or (at your option) any later
15/// version. You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/
16///
17/// Software distributed under the License is distributed on an "AS IS" basis,
18/// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
19/// specific language governing rights and limitations under the License.
20///
21/// The initial developer of the original code is Dmitry Kann, http://www.dk-soft.org/
22///
23///**********************************************************************************************************************
24// Declarations of the core IDE integration component - DKLang Expert
25//
26unit DKL_Expt;
27
28{$INCLUDE TntCompilers.inc}
29
30interface
31uses Classes, ToolsAPI, DesignEditors;
32
33 // Creates DKLang expert instance
34 function DKLang_CreateExpert: IOTAWizard;
35
36type
37 // TDKLanguageController component editor
38 TDKLangControllerEditor = class(TComponentEditor)
39 public
40 procedure ExecuteVerb(Index: Integer); override;
41 function GetVerb(Index: Integer): string; override;
42 function GetVerbCount: Integer; override;
43 end;
44
45const
46 SDKLExpt_ConstantResFileEnding = '.dkl_const.res';
47
48resourcestring
49 SDKLExptErr_CannotObtainNTAIntf = 'Cannot obtain INTAServices interface';
50 SDKLExptErr_CannotObtainOTAIntf = 'Cannot obtain IOTAServices interface';
51 SDKLExptErr_CannotObtainModSvcIntf = 'Cannot obtain IOTAModuleServices interface';
52 SDKLExptErr_CannotFindProjectMenu = 'Cannot locate ''ProjectMenu'' submenu item';
53 SDKLExptErr_CannotFindProject = 'No active project found';
54 SDKLExptErr_CannotSaveLangSource = 'Failed to update project language source. Check whether project is open and active';
55
56 SDKLExptMsg_LCsUpdated = '%d language controllers have updated the project language source.';
57
58 SDKLExptMenuItem_EditConstants = 'Edit pro&ject constants...';
59 SDKLExptMenuItem_UpdateLangSource = 'Update project lan&guage source';
60
61implementation //=======================================================================================================
62uses
63 SysUtils, Windows, Registry, Menus, Graphics, Dialogs, DesignIntf, TypInfo, Forms, RTLConsts,
64 DKLang, DKL_ConstEditor, DKL_ResFile;
65
66 {$IFNDEF COMPILER_7_UP}
67
68 // The below functions were introduced only in Delphi 7
69
70 function GetActiveProjectGroup: IOTAProjectGroup;
71 var
72 ModuleServices: IOTAModuleServices;
73 i: Integer;
74 begin
75 ModuleServices := BorlandIDEServices as IOTAModuleServices;
76 for i := 0 to ModuleServices.ModuleCount-1 do
77 if Supports(ModuleServices.Modules[i], IOTAProjectGroup, Result) then Exit;
78 Result := nil;
79 end;
80
81 function GetActiveProject: IOTAProject;
82 var ProjectGroup: IOTAProjectGroup;
83 begin
84 ProjectGroup := GetActiveProjectGroup;
85 if ProjectGroup=nil then Result := nil else Result := ProjectGroup.ActiveProject;
86 end;
87
88 {$ENDIF}
89
90 // Returns the current active project, if any; raises an exception otherwise
91 function GetActualProject: IOTAProject;
92 begin
93 Result := GetActiveProject;
94 if Result=nil then DKLangError(SDKLExptErr_CannotFindProject);
95 end;
96
97 // Stores the LSObject's language source data in the current project's language source file. Returns True if
98 // succeeded
99 function UpdateProjectLangSource(LSObject: IDKLang_LanguageSourceObject): Boolean;
100 var Proj: IOTAProject;
101 begin
102 // If a project is open
103 Proj := GetActiveProject;
104 Result := Proj<>nil;
105 if Result then UpdateLangSourceFile(ChangeFileExt(Proj.FileName, '.'+SDKLang_LangSourceExtension), LSObject, []);
106 end;
107
108 // Finds first TDKLanguageController instance among components owned by RootComp, if any, and calls
109 // UpdateProjectLangSource(). Returns True if succeeded
110 function LC_UpdateProjectLangSource(RootComp: TComponent): Boolean;
111 var
112 i: Integer;
113 LC: TDKLanguageController;
114 begin
115 Result := False;
116 if RootComp<>nil then
117 for i := 0 to RootComp.ComponentCount-1 do
118 // If found
119 if RootComp.Components[i] is TDKLanguageController then begin
120 LC := TDKLanguageController(RootComp.Components[i]);
121 if dklcoAutoSaveLangSource in LC.Options then begin
122 UpdateProjectLangSource(LC);
123 Result := True;
124 end;
125 Break;
126 end;
127 end;
128
129type
130 TDKLang_Expert = class;
131
132 //===================================================================================================================
133 // TDKLang_FormNotifier
134 //===================================================================================================================
135
136 TDKLang_FormNotifier = class(TNotifierObject, IOTANotifier, IOTAFormNotifier)
137 private
138 // The module with which the notifier is associated
139 FModule: IOTAModule;
140 // IOTANotifier
141 procedure Destroyed;
142 // IOTAFormNotifier
143 procedure FormActivated;
144 procedure FormSaving;
145 procedure ComponentRenamed(ComponentHandle: TOTAHandle; const OldName, NewName: String);
146 public
147 constructor Create(AModule: IOTAModule);
148 end;
149
150 //===================================================================================================================
151 // TDKLang_OTAIDENotifier
152 //===================================================================================================================
153
154 TDKLang_OTAIDENotifier = class(TNotifierObject, IOTAIDENotifier)
155 private
156 // Expert owner
157 FExpert: TDKLang_Expert;
158 // IOTAIDENotifier
159 procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
160 procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
161 procedure AfterCompile(Succeeded: Boolean);
162 public
163 constructor Create(AExpert: TDKLang_Expert);
164 end;
165
166 //===================================================================================================================
167 // TDKLang_Expert
168 //===================================================================================================================
169
170 TDKLang_Expert = class(TNotifierObject, IOTAWizard)
171 private
172 // IDE interface
173 FNTAServices: INTAServices;
174 FOTAServices: IOTAServices;
175 FModServices: IOTAModuleServices;
176 // OTA notifier index
177 FOTANotifierIndex: Integer;
178 // Menu item owner
179 FMenuOwner: TComponent;
180 // Menu items
181 FItem_EditConstants: TMenuItem;
182 FItem_UpdateLangSource: TMenuItem;
183 // Adds and returns a menu item
184 function NewMenuItem(const sCaption: String; Menu: TMenuItem; AOnClick: TNotifyEvent): TMenuItem;
185 // Menu item click events
186 procedure ItemClick_EditConstants(Sender: TObject);
187 procedure ItemClick_UpdateLangSource(Sender: TObject);
188 // Invokes the constant editor for editing constant data in the project resources. Returns True if user saved the
189 // changes
190 function EditConstantsResource: Boolean;
191 // Callback function for obtaining current language ID
192 function GetLangIDCallback: LANGID;
193 // IOTAWizard
194 function GetIDString: string;
195 function GetName: string;
196 function GetState: TWizardState;
197 procedure Execute;
198 public
199 constructor Create;
200 destructor Destroy; override;
201 end;
202
203 //===================================================================================================================
204 // TDKLang_FormNotifier
205 //===================================================================================================================
206
207 procedure TDKLang_FormNotifier.ComponentRenamed(ComponentHandle: TOTAHandle; const OldName, NewName: String);
208 begin
209 { stub }
210 end;
211
212 constructor TDKLang_FormNotifier.Create(AModule: IOTAModule);
213 begin
214 inherited Create;
215 FModule := AModule;
216 end;
217
218 procedure TDKLang_FormNotifier.Destroyed;
219 begin
220 FModule := nil;
221 end;
222
223 procedure TDKLang_FormNotifier.FormActivated;
224 begin
225 { stub }
226 end;
227
228 procedure TDKLang_FormNotifier.FormSaving;
229 var
230 i: Integer;
231 NTAFormEditor: INTAFormEditor;
232 begin
233 if FModule=nil then Exit;
234 // Find the FormEditor interface for the module
235 for i := 0 to FModule.ModuleFileCount-1 do
236 if Supports(FModule.ModuleFileEditors[i], INTAFormEditor, NTAFormEditor) then begin
237 LC_UpdateProjectLangSource(NTAFormEditor.FormDesigner.Root);
238 Break;
239 end;
240 end;
241
242 //===================================================================================================================
243 // TDKLang_OTAIDENotifier
244 //===================================================================================================================
245
246 procedure TDKLang_OTAIDENotifier.AfterCompile(Succeeded: Boolean);
247 begin
248 { stub }
249 end;
250
251 procedure TDKLang_OTAIDENotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
252 begin
253 { stub }
254 end;
255
256 constructor TDKLang_OTAIDENotifier.Create(AExpert: TDKLang_Expert);
257 begin
258 inherited Create;
259 FExpert := AExpert;
260 end;
261
262 procedure TDKLang_OTAIDENotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
263 var
264 Module: IOTAModule;
265 OTAFormEditor: IOTAFormEditor;
266 i: Integer;
267 begin
268 if NotifyCode=ofnFileOpened then begin
269 // Find the module by file name and install the notifier on IOTAFormEditor interface
270 Module := FExpert.FModServices.FindModule(FileName);
271 if Module<>nil then
272 for i := 0 to Module.ModuleFileCount-1 do
273 if Supports(Module.ModuleFileEditors[i], IOTAFormEditor, OTAFormEditor) then
274 OTAFormEditor.AddNotifier(TDKLang_FormNotifier.Create(Module));
275 end;
276 end;
277
278 //===================================================================================================================
279 // TDKLang_Expert
280 //===================================================================================================================
281
282 constructor TDKLang_Expert.Create;
283 var
284 mi, miTest: TMenuItem;
285 i: Integer;
286 begin
287 inherited Create;
288 // Obtain needed IDE interfaces
289 if not Supports(BorlandIDEServices, INTAServices, FNTAServices) then DKLangError(SDKLExptErr_CannotObtainNTAIntf);
290 if not Supports(BorlandIDEServices, IOTAServices, FOTAServices) then DKLangError(SDKLExptErr_CannotObtainOTAIntf);
291 if not Supports(BorlandIDEServices, IOTAModuleServices, FModServices) then DKLangError(SDKLExptErr_CannotObtainModSvcIntf);
292 // Register OTA services notifier
293 FOTANotifierIndex := FOTAServices.AddNotifier(TDKLang_OTAIDENotifier.Create(Self));
294 // Find 'Project' menu
295 mi := nil;
296 for i := 0 to FNTAServices.MainMenu.Items.Count-1 do begin
297 miTest := FNTAServices.MainMenu.Items[i];
298 if SameText(miTest.Name, 'ProjectMenu') then begin
299 mi := miTest;
300 Break;
301 end;
302 end;
303 if mi=nil then DKLangError(SDKLExptErr_CannotFindProjectMenu);
304 // Create a dummy menu item owner component
305 FMenuOwner := TComponent.Create(nil);
306 // Insert a separator
307 NewMenuItem('-', mi, nil);
308 // Create menu items
309 FItem_EditConstants := NewMenuItem(SDKLExptMenuItem_EditConstants, mi, ItemClick_EditConstants);
310 FItem_UpdateLangSource := NewMenuItem(SDKLExptMenuItem_UpdateLangSource, mi, ItemClick_UpdateLangSource);
311 // Set the designtime flag
312 IsDesignTime := True;
313 end;
314
315 destructor TDKLang_Expert.Destroy;
316 begin
317 // Clear the designtime flag
318 IsDesignTime := False;
319 // Remove menu items
320 FMenuOwner.Free;
321 // Release the OTA notifier
322 if FOTAServices<>nil then FOTAServices.RemoveNotifier(FOTANotifierIndex);
323 inherited Destroy;
324 end;
325
326 function TDKLang_Expert.EditConstantsResource: Boolean;
327 var
328 sResFileName: String;
329 ResFile: TDKLang_ResFile;
330 ConstantResEntry: TDKLang_ResEntry;
331 Consts: TDKLang_Constants;
332 bErase: Boolean;
333
334 // Returns file name for constant resource file
335 function GetResFileName: String;
336 begin
337 Result := ChangeFileExt(GetActualProject.FileName, SDKLExpt_ConstantResFileEnding)
338 end;
339
340 begin
341 // Determine the constant resource file name
342 sResFileName := GetResFileName;
343 // Create the resource file
344 ResFile := TDKLang_ResFile.Create;
345 try
346 // Load the resource file if it exists
347 if FileExists(sResFileName) then ResFile.LoadFromFile(sResFileName);
348 // Create constant list object
349 Consts := TDKLang_Constants.Create(GetLangIDCallback);
350 try
351 // Try to find the constant resource entry
352 ConstantResEntry := ResFile.FindEntry(IntToStr(Integer(RT_RCDATA)), SDKLang_ConstResourceName);
353 // If constant resource exists, load the constant list from it
354 if ConstantResEntry<>nil then Consts.AsRawString := ConstantResEntry.RawData;
355 bErase := ConstantResEntry<>nil;
356 Result := EditConstants(Consts, bErase);
357 // If changes made
358 if Result then
359 // If user clicked 'Erase'
360 if bErase then begin
361 if ConstantResEntry<>nil then ResFile.RemoveEntry(ConstantResEntry);
362 // Else save the constants back to the resources
363 end else begin
364 // Create an entry if it didn't exist
365 if ConstantResEntry=nil then begin
366 ConstantResEntry := TDKLang_ResEntry.Create;
367 try
368 ConstantResEntry.ResType := IntToStr(Integer(RT_RCDATA));
369 ConstantResEntry.Name := SDKLang_ConstResourceName;
370 ResFile.AddEntry(ConstantResEntry);
371 except
372 ConstantResEntry.Free;
373 raise;
374 end;
375 end;
376 // Update the data
377 ConstantResEntry.RawData := Consts.AsRawString;
378 // Save the resource file
379 ResFile.SaveToFile(sResFileName);
380 // Update the project language source file if needed
381 if Consts.AutoSaveLangSource and not UpdateProjectLangSource(Consts) then DKLangError(SDKLExptErr_CannotSaveLangSource);
382 end;
383 finally
384 Consts.Free;
385 end;
386 finally
387 ResFile.Free;
388 end;
389 end;
390
391 procedure TDKLang_Expert.Execute;
392 begin
393 { stub }
394 end;
395
396 function TDKLang_Expert.GetIDString: string;
397 begin
398 Result := 'DKSoftware.DKLang_IDE_Expert';
399 end;
400
401 function TDKLang_Expert.GetLangIDCallback: LANGID;
402 begin
403 Result := GetThreadLocale; // Implicit LCID to LANGID conversion
404 end;
405
406 function TDKLang_Expert.GetName: string;
407 begin
408 Result := 'DKLang IDE Expert';
409 end;
410
411 function TDKLang_Expert.GetState: TWizardState;
412 begin
413 Result := [wsEnabled];
414 end;
415
416 procedure TDKLang_Expert.ItemClick_EditConstants(Sender: TObject);
417 begin
418 EditConstantsResource;
419 end;
420
421 procedure TDKLang_Expert.ItemClick_UpdateLangSource(Sender: TObject);
422 var
423 Proj: IOTAProject;
424 i, iMod, iLCUpdated: Integer;
425 ModuleInfo: IOTAModuleInfo;
426 Module: IOTAModule;
427 NTAFormEditor: INTAFormEditor;
428 begin
429 iLCUpdated := 0;
430 // Iterate through project modules to discover form editors
431 Proj := GetActualProject;
432 for iMod := 0 to Proj.GetModuleCount-1 do begin
433 ModuleInfo := Proj.GetModule(iMod);
434 if (ModuleInfo.ModuleType=omtForm) and (ModuleInfo.FormName<>'') then begin
435 Module := ModuleInfo.OpenModule;
436 if Module<>nil then
437 for i := 0 to Module.ModuleFileCount-1 do
438 if Supports(Module.ModuleFileEditors[i], INTAFormEditor, NTAFormEditor) then begin
439 if LC_UpdateProjectLangSource(NTAFormEditor.FormDesigner.Root) then Inc(iLCUpdated);
440 Break;
441 end;
442 end;
443 end;
444 // Show info
445 ShowMessage(Format(SDKLExptMsg_LCsUpdated, [iLCUpdated]));
446 end;
447
448 function TDKLang_Expert.NewMenuItem(const sCaption: String; Menu: TMenuItem; AOnClick: TNotifyEvent): TMenuItem;
449 begin
450 Result := TMenuItem.Create(FMenuOwner);
451 with Result do begin
452 Caption := sCaption;
453 OnClick := AOnClick;
454 end;
455 Menu.Add(Result);
456 end;
457
458 //===================================================================================================================
459 // TDKLangControllerEditor
460 //===================================================================================================================
461
462 procedure TDKLangControllerEditor.ExecuteVerb(Index: Integer);
463 var LC: TDKLanguageController;
464 begin
465 LC := Component as TDKLanguageController;
466 case Index of
467 // Save the controller's data into project language source file
468 0: if not UpdateProjectLangSource(LC) then DKLangError(SDKLExptErr_CannotSaveLangSource);
469 // Save the controller's data into selected language source file
470 1:
471 with TSaveDialog.Create(nil) do
472 try
473 DefaultExt := SDKLang_LangSourceExtension;
474 Filter := 'Language source files (*.'+SDKLang_LangSourceExtension+')|*.'+SDKLang_LangSourceExtension+'|All files (*.*)|*.*';
475 Options := [ofHideReadOnly, ofEnableSizing, ofOverwritePrompt, ofPathMustExist];
476 Title := 'Select a language source file';
477 if Execute then UpdateLangSourceFile(FileName, LC, []);
478 finally
479 Free;
480 end;
481 end;
482 end;
483
484 function TDKLangControllerEditor.GetVerb(Index: Integer): string;
485 begin
486 case Index of
487 0: Result := 'Save data to pro&ject language source';
488 1: Result := 'Save data as lan&guage source...';
489 else Result := '';
490 end;
491 end;
492
493 function TDKLangControllerEditor.GetVerbCount: Integer;
494 begin
495 Result := 2;
496 end;
497
498 //===================================================================================================================
499
500 function DKLang_CreateExpert: IOTAWizard;
501 begin
502 Result := TDKLang_Expert.Create;
503 end;
504
505end.
Note: See TracBrowser for help on using the repository browser.