///*********************************************************************************************************************
///  $Id: DKL_Expt.pas,v 1.20 2006/08/10 16:35:03 dale Exp $
///---------------------------------------------------------------------------------------------------------------------
///  DKLang Localization Package
///  Copyright 2002-2006 DK Software, http://www.dk-soft.org
///*********************************************************************************************************************
///
/// The contents of this package are subject to the Mozilla Public License
/// Version 1.1 (the "License"); you may not use this file except in compliance
/// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
///
/// Alternatively, you may redistribute this library, use and/or modify it under the
/// terms of the GNU Lesser General Public License as published by the Free Software
/// Foundation; either version 2.1 of the License, or (at your option) any later
/// version. You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/
///
/// Software distributed under the License is distributed on an "AS IS" basis,
/// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
/// specific language governing rights and limitations under the License.
///
/// The initial developer of the original code is Dmitry Kann, http://www.dk-soft.org/
///
///**********************************************************************************************************************
// Declarations of the core IDE integration component - DKLang Expert
//
unit DKL_Expt;

{$INCLUDE TntCompilers.inc}

interface
uses Classes, ToolsAPI, DesignEditors;

   // Creates DKLang expert instance
  function DKLang_CreateExpert: IOTAWizard;

type
   // TDKLanguageController component editor
  TDKLangControllerEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
  end;

const
  SDKLExpt_ConstantResFileEnding     = '.dkl_const.res';

resourcestring
  SDKLExptErr_CannotObtainNTAIntf    = 'Cannot obtain INTAServices interface';
  SDKLExptErr_CannotObtainOTAIntf    = 'Cannot obtain IOTAServices interface';
  SDKLExptErr_CannotObtainModSvcIntf = 'Cannot obtain IOTAModuleServices interface';
  SDKLExptErr_CannotFindProjectMenu  = 'Cannot locate ''ProjectMenu'' submenu item';
  SDKLExptErr_CannotFindProject      = 'No active project found';
  SDKLExptErr_CannotSaveLangSource   = 'Failed to update project language source. Check whether project is open and active';

  SDKLExptMsg_LCsUpdated             = '%d language controllers have updated the project language source.';

  SDKLExptMenuItem_EditConstants     = 'Edit pro&ject constants...';
  SDKLExptMenuItem_UpdateLangSource  = 'Update project lan&guage source';

implementation //=======================================================================================================
uses
  SysUtils, Windows, Registry, Menus, Graphics, Dialogs, DesignIntf, TypInfo, Forms, RTLConsts, 
  DKLang, DKL_ConstEditor, DKL_ResFile;

  {$IFNDEF COMPILER_7_UP}

     // The below functions were introduced only in Delphi 7

    function GetActiveProjectGroup: IOTAProjectGroup;
    var
      ModuleServices: IOTAModuleServices;
      i: Integer;
    begin
      ModuleServices := BorlandIDEServices as IOTAModuleServices;
      for i := 0 to ModuleServices.ModuleCount-1 do
        if Supports(ModuleServices.Modules[i], IOTAProjectGroup, Result) then Exit;
      Result := nil;
    end;

    function GetActiveProject: IOTAProject;
    var ProjectGroup: IOTAProjectGroup;
    begin
      ProjectGroup := GetActiveProjectGroup;
      if ProjectGroup=nil then Result := nil else Result := ProjectGroup.ActiveProject;
    end;
    
  {$ENDIF}

   // Returns the current active project, if any; raises an exception otherwise
  function GetActualProject: IOTAProject;
  begin
    Result := GetActiveProject;
    if Result=nil then DKLangError(SDKLExptErr_CannotFindProject);
  end;

   // Stores the LSObject's language source data in the current project's language source file. Returns True if
   //   succeeded
  function UpdateProjectLangSource(LSObject: IDKLang_LanguageSourceObject): Boolean;
  var Proj: IOTAProject;
  begin
     // If a project is open
    Proj := GetActiveProject;
    Result := Proj<>nil;
    if Result then UpdateLangSourceFile(ChangeFileExt(Proj.FileName, '.'+SDKLang_LangSourceExtension), LSObject, []);
  end;

   // Finds first TDKLanguageController instance among components owned by RootComp, if any, and calls
   //   UpdateProjectLangSource(). Returns True if succeeded
  function LC_UpdateProjectLangSource(RootComp: TComponent): Boolean;
  var
    i: Integer;
    LC: TDKLanguageController;
  begin
    Result := False;
    if RootComp<>nil then
      for i := 0 to RootComp.ComponentCount-1 do
         // If found
        if RootComp.Components[i] is TDKLanguageController then begin
          LC := TDKLanguageController(RootComp.Components[i]);
          if dklcoAutoSaveLangSource in LC.Options then begin
            UpdateProjectLangSource(LC);
            Result := True;
          end;
          Break;
        end;
  end;

type
  TDKLang_Expert = class;

   //===================================================================================================================
   // TDKLang_FormNotifier
   //===================================================================================================================

  TDKLang_FormNotifier = class(TNotifierObject, IOTANotifier, IOTAFormNotifier)
  private
     // The module with which the notifier is associated
    FModule: IOTAModule;
     // IOTANotifier
    procedure Destroyed;
     // IOTAFormNotifier
    procedure FormActivated;
    procedure FormSaving;
    procedure ComponentRenamed(ComponentHandle: TOTAHandle; const OldName, NewName: String);
  public
    constructor Create(AModule: IOTAModule);
  end;

   //===================================================================================================================
   // TDKLang_OTAIDENotifier
   //===================================================================================================================

  TDKLang_OTAIDENotifier = class(TNotifierObject, IOTAIDENotifier)
  private
     // Expert owner
    FExpert: TDKLang_Expert;
     // IOTAIDENotifier
    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
    procedure AfterCompile(Succeeded: Boolean);
  public
    constructor Create(AExpert: TDKLang_Expert);
  end;

   //===================================================================================================================
   // TDKLang_Expert
   //===================================================================================================================

  TDKLang_Expert = class(TNotifierObject, IOTAWizard)
  private
     // IDE interface
    FNTAServices: INTAServices;
    FOTAServices: IOTAServices;
    FModServices: IOTAModuleServices;
     // OTA notifier index
    FOTANotifierIndex: Integer;
     // Menu item owner
    FMenuOwner: TComponent;
     // Menu items
    FItem_EditConstants: TMenuItem;
    FItem_UpdateLangSource: TMenuItem;
     // Adds and returns a menu item
    function  NewMenuItem(const sCaption: String; Menu: TMenuItem; AOnClick: TNotifyEvent): TMenuItem;
     // Menu item click events
    procedure ItemClick_EditConstants(Sender: TObject);
    procedure ItemClick_UpdateLangSource(Sender: TObject);
     // Invokes the constant editor for editing constant data in the project resources. Returns True if user saved the
     //   changes
    function  EditConstantsResource: Boolean;
     // Callback function for obtaining current language ID
    function  GetLangIDCallback: LANGID;
     // IOTAWizard
    function  GetIDString: string;
    function  GetName: string;
    function  GetState: TWizardState;
    procedure Execute;
  public
    constructor Create;
    destructor Destroy; override;
  end;

   //===================================================================================================================
   // TDKLang_FormNotifier
   //===================================================================================================================

  procedure TDKLang_FormNotifier.ComponentRenamed(ComponentHandle: TOTAHandle; const OldName, NewName: String);
  begin
    { stub }
  end;

  constructor TDKLang_FormNotifier.Create(AModule: IOTAModule);
  begin
    inherited Create;
    FModule := AModule;
  end;

  procedure TDKLang_FormNotifier.Destroyed;
  begin
    FModule := nil;
  end;

  procedure TDKLang_FormNotifier.FormActivated;
  begin
    { stub }
  end;

  procedure TDKLang_FormNotifier.FormSaving;
  var
    i: Integer;
    NTAFormEditor: INTAFormEditor;
  begin
    if FModule=nil then Exit;
     // Find the FormEditor interface for the module
    for i := 0 to FModule.ModuleFileCount-1 do
      if Supports(FModule.ModuleFileEditors[i], INTAFormEditor, NTAFormEditor) then begin
        LC_UpdateProjectLangSource(NTAFormEditor.FormDesigner.Root);
        Break;
      end;
  end;

   //===================================================================================================================
   // TDKLang_OTAIDENotifier
   //===================================================================================================================

  procedure TDKLang_OTAIDENotifier.AfterCompile(Succeeded: Boolean);
  begin
    { stub }
  end;

  procedure TDKLang_OTAIDENotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
  begin
    { stub }
  end;

  constructor TDKLang_OTAIDENotifier.Create(AExpert: TDKLang_Expert);
  begin
    inherited Create;
    FExpert := AExpert;
  end;

  procedure TDKLang_OTAIDENotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
  var
    Module: IOTAModule;
    OTAFormEditor: IOTAFormEditor;
    i: Integer;
  begin
    if NotifyCode=ofnFileOpened then begin
       // Find the module by file name and install the notifier on IOTAFormEditor interface
      Module := FExpert.FModServices.FindModule(FileName);
      if Module<>nil then
        for i := 0 to Module.ModuleFileCount-1 do
          if Supports(Module.ModuleFileEditors[i], IOTAFormEditor, OTAFormEditor) then
            OTAFormEditor.AddNotifier(TDKLang_FormNotifier.Create(Module));
    end;
  end;

   //===================================================================================================================
   // TDKLang_Expert
   //===================================================================================================================

  constructor TDKLang_Expert.Create;
  var
    mi, miTest: TMenuItem;
    i: Integer;
  begin
    inherited Create;
     // Obtain needed IDE interfaces
    if not Supports(BorlandIDEServices, INTAServices,       FNTAServices) then DKLangError(SDKLExptErr_CannotObtainNTAIntf);
    if not Supports(BorlandIDEServices, IOTAServices,       FOTAServices) then DKLangError(SDKLExptErr_CannotObtainOTAIntf);
    if not Supports(BorlandIDEServices, IOTAModuleServices, FModServices) then DKLangError(SDKLExptErr_CannotObtainModSvcIntf);
     // Register OTA services notifier
    FOTANotifierIndex := FOTAServices.AddNotifier(TDKLang_OTAIDENotifier.Create(Self));
     // Find 'Project' menu
    mi := nil;
    for i := 0 to FNTAServices.MainMenu.Items.Count-1 do begin
      miTest := FNTAServices.MainMenu.Items[i];
      if SameText(miTest.Name, 'ProjectMenu') then begin
        mi := miTest;
        Break;
      end;
    end;
    if mi=nil then DKLangError(SDKLExptErr_CannotFindProjectMenu);
     // Create a dummy menu item owner component
    FMenuOwner := TComponent.Create(nil);
     // Insert a separator
    NewMenuItem('-', mi, nil);
     // Create menu items
    FItem_EditConstants    := NewMenuItem(SDKLExptMenuItem_EditConstants,    mi, ItemClick_EditConstants);
    FItem_UpdateLangSource := NewMenuItem(SDKLExptMenuItem_UpdateLangSource, mi, ItemClick_UpdateLangSource);
     // Set the designtime flag
    IsDesignTime := True;
  end;

  destructor TDKLang_Expert.Destroy;
  begin
     // Clear the designtime flag
    IsDesignTime := False;
     // Remove menu items
    FMenuOwner.Free;
     // Release the OTA notifier
    if FOTAServices<>nil then FOTAServices.RemoveNotifier(FOTANotifierIndex);
    inherited Destroy;
  end;

  function TDKLang_Expert.EditConstantsResource: Boolean;
  var
    sResFileName: String;
    ResFile: TDKLang_ResFile;
    ConstantResEntry: TDKLang_ResEntry;
    Consts: TDKLang_Constants;
    bErase: Boolean;

     // Returns file name for constant resource file
    function GetResFileName: String;
    begin
      Result := ChangeFileExt(GetActualProject.FileName, SDKLExpt_ConstantResFileEnding)
    end;

  begin
     // Determine the constant resource file name
    sResFileName := GetResFileName;
     // Create the resource file
    ResFile := TDKLang_ResFile.Create;
    try
       // Load the resource file if it exists
      if FileExists(sResFileName) then ResFile.LoadFromFile(sResFileName);
       // Create constant list object
      Consts := TDKLang_Constants.Create(GetLangIDCallback);
      try
         // Try to find the constant resource entry
        ConstantResEntry := ResFile.FindEntry(IntToStr(Integer(RT_RCDATA)), SDKLang_ConstResourceName);
         // If constant resource exists, load the constant list from it
        if ConstantResEntry<>nil then Consts.AsRawString := ConstantResEntry.RawData;
        bErase := ConstantResEntry<>nil;
        Result := EditConstants(Consts, bErase);
         // If changes made
        if Result then
           // If user clicked 'Erase'
          if bErase then begin
            if ConstantResEntry<>nil then ResFile.RemoveEntry(ConstantResEntry);
           // Else save the constants back to the resources
          end else begin
             // Create an entry if it didn't exist
            if ConstantResEntry=nil then begin
              ConstantResEntry := TDKLang_ResEntry.Create;
              try
                ConstantResEntry.ResType := IntToStr(Integer(RT_RCDATA));
                ConstantResEntry.Name    := SDKLang_ConstResourceName;
                ResFile.AddEntry(ConstantResEntry);
              except
                ConstantResEntry.Free;
                raise;
              end;
            end;
             // Update the data
            ConstantResEntry.RawData := Consts.AsRawString;
             // Save the resource file
            ResFile.SaveToFile(sResFileName);
             // Update the project language source file if needed
            if Consts.AutoSaveLangSource and not UpdateProjectLangSource(Consts) then DKLangError(SDKLExptErr_CannotSaveLangSource);
          end;
      finally
        Consts.Free;
      end;
    finally
      ResFile.Free;
    end;
  end;

  procedure TDKLang_Expert.Execute;
  begin
    { stub }
  end;

  function TDKLang_Expert.GetIDString: string;
  begin
    Result := 'DKSoftware.DKLang_IDE_Expert';
  end;

  function TDKLang_Expert.GetLangIDCallback: LANGID;
  begin
    Result := GetThreadLocale; // Implicit LCID to LANGID conversion 
  end;

  function TDKLang_Expert.GetName: string;
  begin
    Result := 'DKLang IDE Expert';
  end;

  function TDKLang_Expert.GetState: TWizardState;
  begin
    Result := [wsEnabled];
  end;

  procedure TDKLang_Expert.ItemClick_EditConstants(Sender: TObject);
  begin
    EditConstantsResource;
  end;

  procedure TDKLang_Expert.ItemClick_UpdateLangSource(Sender: TObject);
  var
    Proj: IOTAProject;
    i, iMod, iLCUpdated: Integer;
    ModuleInfo: IOTAModuleInfo;
    Module: IOTAModule;
    NTAFormEditor: INTAFormEditor;
  begin
    iLCUpdated := 0;
     // Iterate through project modules to discover form editors
    Proj := GetActualProject;
    for iMod := 0 to Proj.GetModuleCount-1 do begin
      ModuleInfo := Proj.GetModule(iMod);
      if (ModuleInfo.ModuleType=omtForm) and (ModuleInfo.FormName<>'') then begin
        Module := ModuleInfo.OpenModule;
        if Module<>nil then
          for i := 0 to Module.ModuleFileCount-1 do
            if Supports(Module.ModuleFileEditors[i], INTAFormEditor, NTAFormEditor) then begin
              if LC_UpdateProjectLangSource(NTAFormEditor.FormDesigner.Root) then Inc(iLCUpdated);
              Break;
            end;
      end;
    end;
     // Show info
    ShowMessage(Format(SDKLExptMsg_LCsUpdated, [iLCUpdated]));
  end;

  function TDKLang_Expert.NewMenuItem(const sCaption: String; Menu: TMenuItem; AOnClick: TNotifyEvent): TMenuItem;
  begin
    Result := TMenuItem.Create(FMenuOwner);
    with Result do begin
      Caption      := sCaption;
      OnClick      := AOnClick;
    end;
    Menu.Add(Result);
  end;

   //===================================================================================================================
   // TDKLangControllerEditor
   //===================================================================================================================

  procedure TDKLangControllerEditor.ExecuteVerb(Index: Integer);
  var LC: TDKLanguageController;
  begin
    LC := Component as TDKLanguageController;
    case Index of
       // Save the controller's data into project language source file
      0: if not UpdateProjectLangSource(LC) then DKLangError(SDKLExptErr_CannotSaveLangSource);
       // Save the controller's data into selected language source file
      1: 
        with TSaveDialog.Create(nil) do
          try
            DefaultExt := SDKLang_LangSourceExtension;
            Filter     := 'Language source files (*.'+SDKLang_LangSourceExtension+')|*.'+SDKLang_LangSourceExtension+'|All files (*.*)|*.*';
            Options    := [ofHideReadOnly, ofEnableSizing, ofOverwritePrompt, ofPathMustExist];
            Title      := 'Select a language source file';
            if Execute then UpdateLangSourceFile(FileName, LC, []);
          finally
            Free;
          end;
    end;
  end;

  function TDKLangControllerEditor.GetVerb(Index: Integer): string;
  begin
    case Index of
      0:   Result := 'Save data to pro&ject language source';
      1:   Result := 'Save data as lan&guage source...';
      else Result := '';
    end;
  end;

  function TDKLangControllerEditor.GetVerbCount: Integer;
  begin
    Result := 2;
  end;

   //===================================================================================================================

  function DKLang_CreateExpert: IOTAWizard;
  begin
    Result := TDKLang_Expert.Create;
  end;

end.
