source: trunk/Components/ACLLanguageUnit.pas@ 226

Unit ACLLanguageUnit;

// NewView - a new OS/2 Help Viewer
// Copyright 2003-2006 Aaron Lawrence
// Copyright 2006-2007 Ronald Brill (rbri at rbri dot de)
// This software is released under the GNU Public License - see readme.txt

// Helper functions for i18n

Interface

uses
  OS2Def,
  Classes,
  Forms,
  FileUtilsUnit;


const
  LANGUAGE_DELIMITER = '_';
  LANGUAGE_FILE_EXTENSION = FILE_EXTENSION_DELIMITER + 'lng';
  LANGUAGE_COMMENT_CHAR = '#';
  LANGUAGE_ENVIRONMENT_VAR_LANG = 'LANG';
  LANGUAGE_ENVIRONMENT_VAR_OSDIR = 'OSDIR';
  LANGUAGE_ENVIRONMENT_VAR_ULSPATH = 'ULSPATH';
  LANGUAGE_DEFAULT_LANGUAGE = 'EN_US';
  LANGUAGE_DEFAULT_MARKER = '***';
  LANGUAGE_LABEL_DELIMITER = '.';


type
  TLanguageItem = record
    pValue: pString;
    wasUsed: boolean;
    isDefault: boolean;
  end;
  TPLanguageItem = ^TLanguageItem;

  TLanguageItemList = class
  protected
    translationsList : TStringList;
    procedure setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
  public
    constructor Create;
    destructor Destroy; override;

    function getValue(const aLabel : String; const aDefaultValue : String) : String;
    procedure setValue(const aLabel : String; const aValue : String);
    procedure saveTo(const aTextFile : TextFile);
  end;


  TLanguageFile = class
  protected
    languageItems : TLanguageItemList;
    fileName: string;

    procedure LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);

  public
    constructor Create(const aFileName : String);
    destructor Destroy; override;

    // if anApplyFlag is true, then the component and it's
    // owned components will be updated. If false, then
    // it will only be checked and missing items noted.

    // For convenience in loading strings manually, related to the component
    procedure LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);


    // write the current transations to a file
    procedure writeToFile(const aFileName : String);

    // If anApplyFlag is true, then assign aValue the translation
    // for aLabel. Or, if not found, use aDefaultValue.
    // If anApplyFlag is false, just look it up but don't assign to
    // aValue
    procedure LL( const anApplyFlag: boolean;
                  Var aValue: string;
                  const aLabel: string;
                  const aDefaultValue: string );

  end;


  // callback for when language events occur
  // If apply is true, then the specified language has been loaded
  // If apply is false, then the specified language file is being
  // saved, so you should access any strings you need,
  // but not actually change anything
  TLanguageEvent = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean) of object;

  // non-object version
  TLanguageProc = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean);


var
  g_CurrentLanguageFile: TLanguageFile;

  // Register that you want to know when the current language changes
  // Will immediately call you back, if there is a current language
  procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);

  // Register a procedure callback (not-object)
  procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);


  // Register a procedure that will be called only when a language file
  // is being updated (use to load forms if needed)
  procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);


  // Change current language to given, and tell everybody who has registered
  procedure ApplyLanguage(aLanguage: TLanguageFile);

  // Tell everybody who has registered to access the given file,
  // but don't apply strings from it
  procedure UpdateLanguage(aLanguage: TLanguageFile);


  // Load and apply specified language file
  procedure LoadLanguage(const aFilePath: String);


  // load a language from the standard location.
  // anAppName is a short name for the app, e.g. 'newview'
  // language spec is e.g. 'es' or 'es_es'
  function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string): boolean;


  // load default language based on LANG environment var
  procedure LoadDefaultLanguage(const anAppName: string);


Implementation

uses
  Dos, SysUtils,
  StdCtrls,
  Buttons,
  ExtCtrls,
  TabCtrls,
  Dialogs,
  Coolbar2,
  Multicolumnlistbox,
  ACLUtility,
  FileUtilsUnit,
  StringUtilsUnit,
  DebugUnit;

var
  g_LanguageCallbacks: TList;
  g_LanguageUpdateCallbacks: TList;


  // -----------------
  // TLanguageItemList
  // -----------------

  constructor TLanguageItemList.Create;
  begin
    // LogEvent(LogI18n, 'TLanguageItemList.Create');
    // setup our memory
    translationsList := TStringList.Create;
    translationsList.Sorted := true; // for lookup speed
    translationsList.CaseSensitive := true; // also for speed. We manually convert to uppercase.
    translationsList.Duplicates := dupAccept;
  end;


  destructor TLanguageItemList.Destroy;
  var
    i: longint;
    tmpPLanguageItem: TPLanguageItem;
  begin
    // LogEvent(LogI18n, 'TLanguageItemList.Destroy');
    for i := 0 to translationsList.Count - 1 do
    begin
      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);

      // free the parts of the item
      DisposeStr(tmpPLanguageItem^.pValue);
      Dispose(tmpPLanguageItem);
    end;

    translationsList.Destroy;
  end;


  function TLanguageItemList.getValue(const aLabel : String; const aDefaultValue : String) : String;
  var
    tmpPosition : LongInt;
    tmpFound : Boolean;
    tmpPLanguageItem : TPLanguageItem;
  begin
    tmpFound := translationsList.Find(UpperCase(aLabel), tmpPosition);

    if not tmpFound then
    begin
      setValueWithFlags(aLabel, aDefaultValue, true);
      result := '';

      // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ') [' + aDefaultValue + ']->' + result);
      exit;
    end;

    tmpPLanguageItem := TPLanguageItem(translationsList.Objects[tmpPosition]);

    // mark as used
    tmpPLanguageItem^.wasUsed := true;

    if tmpPLanguageItem^.isDefault then
    begin
      result := '';

      // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
      exit;
    end;

    result := tmpPLanguageItem^.pValue^;
    // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
  end;


  procedure TLanguageItemList.setValue(const aLabel : String; const aValue : String);
  begin
    setValueWithFlags(aLabel, aValue, false);
  end;


  procedure TLanguageItemList.setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
  var
    tmpPLanguageItem: TPLanguageItem;
  begin
    // LogEvent(LogI18n, 'TLanguageItemList.setValueWithFlags(' + aLabel + ')->' + aValue + '[' + BoolToStr(aDefaultFlag) + ']');

    New(tmpPLanguageItem);
    tmpPLanguageItem^.pValue := NewStr(aValue);
    tmpPLanguageItem^.wasUsed := false;
    tmpPLanguageItem^.isDefault := aDefaultFlag;

    translationsList.AddObject(UpperCase(aLabel), TObject(tmpPLanguageItem));
  end;


  procedure TLanguageItemList.saveTo(const aTextFile : TextFile);
  var
    i : integer;
    tmpPLanguageItem: TPLanguageItem;
    tmpLabel : String;
    tmpQuotedValue : String;
    tmpUnusedHeaderFlag : boolean;
  begin
    // used first
    for i := 0 to translationsList.Count - 1 do
    begin
      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
      if tmpPLanguageItem^.wasUsed then
      begin
        tmpLabel := translationsList.Names[i];

        tmpQuotedValue := tmpPLanguageItem^.pValue^;
        tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
        tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);

        if tmpPLanguageItem^.isDefault then
        begin
          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
        end
        else
        begin
          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
        end;
      end;
    end;


    // unused at the end
    tmpUnusedHeaderFlag := false;
    for i := 0 to translationsList.Count - 1 do
    begin
      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
      if not tmpPLanguageItem^.wasUsed then
      begin
        if not tmpUnusedHeaderFlag then
        begin
          tmpUnusedHeaderFlag := true;

          Writeln(aTextFile, '# **********************************************************');
          Writeln(aTextFile, '# * The following items are no longer needed.              *');
          Writeln(aTextFile, '# * You can delete them after checking they are of no use. *');
          Writeln(aTextFile, '# **********************************************************');
        end;

        tmpLabel := translationsList.Names[i];

        tmpQuotedValue := tmpPLanguageItem^.pValue^;
        tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
        tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);

        if tmpPLanguageItem^.isDefault then
        begin
          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
        end
        else
        begin
          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
        end;
      end;
    end;
  end;


  // -----------------
  // TLanguageCallback
  // -----------------

Type
  TLanguageCallback = class
    FCallbackMethod: TLanguageEvent;
    FCallbackProc: TLanguageProc;
    constructor CreateMethod( CallbackMethod: TLanguageEvent );
    constructor CreateProc( CallbackProc: TLanguageProc );
  end;


  constructor TLanguageCallback.CreateMethod(CallbackMethod: TLanguageEvent);
  begin
    FCallbackMethod := CallbackMethod;
    FCallbackProc := nil;
  end;


  constructor TLanguageCallback.CreateProc(aCallbackProc: TLanguageProc);
  begin
    FCallbackProc := CallbackProc;
    FCallbackMethod := nil;
  end;


  procedure AddLanguageCallback(aCallbackObject: TLanguageCallback);
  begin
    if g_LanguageCallbacks = nil then
    begin
      g_LanguageCallbacks := TList.Create;
    end;

    g_LanguageCallbacks.Add(aCallbackObject);
  end;


  procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
  begin
    AddLanguageCallback( TLanguageCallback.CreateMethod(aCallbackEvent) );

    if g_CurrentLanguageFile <> nil then
    begin
      aCallbackEvent(g_CurrentLanguageFile, true);
    end;
  end;


  procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
  begin
    AddLanguageCallback( TLanguageCallback.CreateProc(aCallbackProc) );

    if g_CurrentLanguageFile <> nil then
    begin
      aCallbackProc(g_CurrentLanguageFile, true);
    end;
  end;


  procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
  begin
    if g_LanguageUpdateCallbacks = nil then
    begin
      g_LanguageUpdateCallbacks := TList.Create;
    end;

    g_LanguageUpdateCallbacks.Add(TObject(aCallbackProc));
    // since this is for when updating a language only, we don't immediately call it
  end;


  procedure ApplyLanguage(aLanguage: TLanguageFile);
  var
    i: longint;
    tmpCallback: TLanguageCallback;
  begin
    if g_CurrentLanguageFile <> nil then
    begin
      g_CurrentLanguageFile.Destroy;
    end;

    g_CurrentLanguageFile := aLanguage;

    // do language callbacks to everyone
    for i := 0 to g_LanguageCallbacks.Count - 1 do
    begin
      tmpCallback := g_LanguageCallbacks[i];

      if Assigned(tmpCallback.FCallbackMethod) then
      begin
        tmpCallback.FCallbackMethod(g_CurrentLanguageFile, true);
      end;

      if Assigned(tmpCallback.FCallbackProc) then
      begin
        tmpCallback.FCallbackProc(g_CurrentLanguageFile, true);
      end;
    end;
  end;


  procedure UpdateLanguage(aLanguage: TLanguageFile);
  var
    i: longint;
    tmpCallback : TLanguageCallback;
    tmpUpdateProc : TProcedure;
  begin
    if g_LanguageUpdateCallbacks <> nil then
    begin
      // first call all update callbacks so dynamically created
      // things can be loaded (i.e. forms)
      // Note: this will cause them to load their strings from
      // the current language if any. This is fine, necessary even.
      for i := 0 to g_LanguageUpdateCallbacks.Count - 1 do
      begin
        tmpUpdateProc := TProcedure(g_LanguageUpdateCallbacks[i]);
        tmpUpdateProc;
      end;
    end;

    if g_LanguageCallbacks <> nil then
    begin
      // now call the language events
      for i := 0 to g_LanguageCallbacks.Count - 1 do
      begin
        tmpCallback := g_LanguageCallbacks[i];
        if Assigned(tmpCallback.FCallbackMethod) then
        begin
          tmpCallback.FCallbackMethod(aLanguage, false);
        end;
        if Assigned(tmpCallback.FCallbackProc) then
        begin
          tmpCallback.FCallbackProc(aLanguage, false);
        end;
      end;
    end;
  end;


  constructor TLanguageFile.Create( const aFileName : String);
  var
    tmpTextFile : TextFile;
    tmpLine : string;
    tmpLabel : string;
    tmpValue : string;
    tmpLineParts : TStringList;
  begin
    filename := aFileName;

    languageItems := TLanguageItemList.Create;

    if not FileExists(aFileName) then
    begin
      exit;
    end;

    // read the file
    FileMode := fmInput;
    AssignFile(tmpTextFile, aFileName);
    Reset(tmpTextFile);

    tmpLineParts := TStringList.Create;

    while not Eof(tmpTextFile) do
    begin
      ReadLn(tmpTextFile, tmpLine);

      tmpLineParts.clear;
      StrExtractStringsQuoted(tmpLineParts, tmpLine);

      if tmpLineParts.count > 0 then
      begin
        tmpLabel := tmpLineParts[0];

        // TODO trim leading blanks
        if tmpLabel[1] <> LANGUAGE_COMMENT_CHAR then
        begin
          // Got a name, read the value and store.
          tmpValue := '';
          if tmpLineParts.count > 0 then
          begin
            tmpValue := tmpLineParts[1];
          end;

          languageItems.setValue(UpperCase(tmpLabel), tmpValue);
        end;
      end;
    end;

    tmpLineParts.Destroy;
    CloseFile(tmpTextFile);
  end;


  destructor TLanguageFile.Destroy;
  begin
    languageItems.Destroy;
  end;


  procedure TLanguageFile.LL( const anApplyFlag: boolean;
                              Var aValue: string;
                              const aLabel: string;
                              const aDefaultValue: string );
  begin
    // LogEvent(LogI18n, 'TLanguageFile.LL(' + BoolToStr(Apply) + ')');

    if anApplyFlag then
    begin
      aValue := languageItems.getValue(UpperCase(aLabel), aDefaultValue)
    end
    else
    begin
      languageItems.getValue(UpperCase(aLabel), aDefaultValue)
    end
  end;


  procedure TLanguageFile.LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
  begin
    LoadComponentLanguageInternal(aComponent, '', anApplyFlag);
  end;


  procedure TLanguageFile.writeToFile(const aFileName : String);
  var
    tmpBackupFilename: string;
    tmpFile: TextFile;
  begin
    tmpBackupFilename := ChangeFileExt(aFileName, '.bak' );
    if FileExists(tmpBackupFilename) then
    begin
      if not DeleteFile(tmpBackupFilename) then
      begin
        raise Exception.Create( 'Unable to delete backup language file: ' + tmpBackupFilename);
      end;
    end;

    if FileExists(aFileName) then
      begin
      if not CopyFile(aFileName, tmpBackupFilename ) then
      begin
        raise Exception.Create( 'Unable to copy to backup language file: ' + tmpBackupFilename);
      end;
    end;

    AssignFile(tmpFile, aFileName);
    ReWrite(tmpFile);

    languageItems.saveTo(tmpFile);

    CloseFile(tmpFile);
  end;

  procedure TLanguageFile.LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
  var
    i : longint;
    tmpComponentPath: string;
    tmpValue: string;

    tmpMenuItem: TMenuItem;
    tmpButton: TButton;
    tmpLabel: TLabel;
    tmpRadioGroup: TRadioGroup;
    tmpTabSet: TTabSet;
    tmpTabbedNotebook: TTabbedNotebook;
    tmpForm: TForm;
    tmpRadioButton: TRadioButton;
    tmpCheckBox: TCheckBox;
    tmpCoolBar2: TCoolBar2;
    tmpGroupBox: TGroupBox;
    tmpMultiColumnListBox: TMultiColumnListBox;
    tmpSystemOpenDialog: TSystemOpenDialog;
    tmpSystemSaveDialog: TSystemSaveDialog;
  Begin
    tmpComponentPath := aPath + aComponent.Name + LANGUAGE_LABEL_DELIMITER;

    // Components sorted with most common at top, ish...
    if aComponent is TMenuItem then
    begin
      tmpMenuItem := TMenuItem(aComponent);

      // skip separators
      if tmpMenuItem.Caption <> '-' then
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpMenuItem.Caption);
        if '' <> tmpValue then tmpMenuItem.Caption := tmpValue;

        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpMenuItem.Hint);
        if '' <> tmpValue then tmpMenuItem.Hint := tmpValue;
      end;
    end

    else if aComponent is TButton then
    begin
      tmpButton := TButton(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpButton.Caption);
      if '' <> tmpValue then tmpButton.Caption := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpButton.Hint);
      if '' <> tmpValue then tmpButton.Hint := tmpValue;
    end

    else if aComponent is TLabel then
    begin
      tmpLabel := TLabel(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpLabel.Caption);
      if '' <> tmpValue then tmpLabel.Caption := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpLabel.Hint);
      if '' <> tmpValue then tmpLabel.Hint := tmpValue;
    end

    else if aComponent is TRadioGroup then
    begin
      tmpRadioGroup := TRadioGroup(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpRadioGroup.Caption);
      if '' <> tmpValue then tmpRadioGroup.Caption := tmpValue;

      for i := 0 to tmpRadioGroup.Items.Count - 1 do
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Item' + IntToStr(i)), tmpRadioGroup.Items[i]);
        if '' <> tmpValue then tmpRadioGroup.Items[i] := tmpValue;
      end;
    end

    else if aComponent is TTabSet then
    begin
      tmpTabSet := TTabSet(aComponent);

      for i := 0 to tmpTabSet.Tabs.Count - 1 do
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i)), tmpTabSet.Tabs[i]);
        if '' <> tmpValue then tmpTabSet.Tabs[i] := tmpValue;
      end;
    end

    else if aComponent is TTabbedNotebook then
    begin
      tmpTabbedNotebook := TTabbedNotebook(aComponent);
      for i := 0 to tmpTabbedNotebook.Pages.Count - 1 do
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i) + '.Caption'), tmpTabbedNotebook.Pages[i]);
        if '' <> tmpValue then tmpTabbedNotebook.Pages[i] := tmpValue;

        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i) + '.Hint'), tmpTabbedNotebook.Pages.Pages[i].Hint);
        if '' <> tmpValue then tmpTabbedNotebook.Pages.Pages[i].Hint := tmpValue;
      end;
    end

    else if aComponent is TForm then
    begin
      tmpForm := TForm(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpForm.Caption);
      if '' <> tmpValue then tmpForm.Caption := tmpValue;

      // load owned controls
      for i := 0 to aComponent.ComponentCount - 1 do
      begin
        LoadComponentLanguageInternal(aComponent.Components[i], tmpComponentPath, aDoUpdates );
      end;
    end

    else if aComponent is TRadioButton then
    begin
      tmpRadioButton := TRadioButton(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpRadioButton.Caption);
      if '' <> tmpValue then tmpRadioButton.Caption := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpRadioButton.Hint);
      if '' <> tmpValue then tmpRadioButton.Hint := tmpValue;
    end

    else if aComponent is TCheckBox then
    begin
      tmpCheckBox := TCheckBox(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpCheckBox.Caption);
      if '' <> tmpValue then tmpCheckBox.Caption := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpCheckBox.Hint);
      if '' <> tmpValue then tmpCheckBox.Hint := tmpValue;
    end

    else if aComponent is TCoolBar2 then
    begin
      tmpCoolBar2 := TCoolBar2(aComponent);
      for i := 0 to tmpCoolBar2.Sections.Count - 1 do
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Item' + IntToStr(i)), tmpCoolBar2.Sections[i].Text);
        if '' <> tmpValue then tmpCoolBar2.Sections[i].Text := tmpValue;
      end;
    end

    else if aComponent is TGroupBox then
    begin
      tmpGroupBox := TGroupBox(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpGroupBox.Caption);
      if '' <> tmpValue then tmpGroupBox.Caption := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpGroupBox.Hint);
      if '' <> tmpValue then tmpGroupBox.Hint := tmpValue;
    end

    else if aComponent is TMultiColumnListBox then
    begin
      tmpMultiColumnListBox := TMultiColumnListBox(aComponent);

      for i := 0 to tmpMultiColumnListBox.HeaderColumns.Count - 1 do
      begin
        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Column' + IntToStr(i)), tmpMultiColumnListBox.HeaderColumns[i].Text);
        if '' <> tmpValue then tmpMultiColumnListBox.HeaderColumns[i].Text := tmpValue;
      end;
    end

    else if aComponent is TSystemOpenDialog then
    begin
      tmpSystemOpenDialog := TSystemOpenDialog(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'OKName'), tmpSystemOpenDialog.OKName);
      if '' <> tmpValue then tmpSystemOpenDialog.OKName := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Title'), tmpSystemOpenDialog.Title);
      if '' <> tmpValue then tmpSystemOpenDialog.Title := tmpValue;
    end

    else if aComponent is TSystemSaveDialog then
    begin
      tmpSystemSaveDialog := TSystemSaveDialog(aComponent);

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'OKName'), tmpSystemSaveDialog.OKName);
      if '' <> tmpValue then tmpSystemSaveDialog.OKName := tmpValue;

      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Title'), tmpSystemSaveDialog.Title);
      if '' <> tmpValue then tmpSystemSaveDialog.Title := tmpValue;
    end;
  end;


  procedure LoadLanguage(const aFilePath: String);
  var
    tmpNewLanguage: TLanguageFile;
  begin
    LogEvent(LogI18n, 'LoadLanguage(' + aFilePath + ')');
    try
      tmpNewLanguage := TLanguageFile.Create(aFilePath);
    except
      // TODO more log output
      exit;
    end;

    ApplyLanguage(tmpNewLanguage);
  end;


  function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string) : boolean;
  var
    tmpFilePath: string;
    tmpFileName: string;
    tmpOSDir: string;
  begin
    // Filenames loaded will be <AppName>.<Language>.lng
    tmpFilename := anAppName + LANGUAGE_DELIMITER + aLanguageSpec + LANGUAGE_FILE_EXTENSION;

    // eCS 1.1+ look in x:\ecs\lang
    tmpOSDir := GetEnv(LANGUAGE_ENVIRONMENT_VAR_OSDIR);
    if tmpOSDir <> '' then
    begin
      tmpFilePath := AddDirectorySeparator(tmpOSDir) + 'lang\' + tmpFileName;
      if FileExists(tmpFilePath) then
      begin
        LoadLanguage(tmpFilePath);
        result := true;
        exit;
      end;
    end;

    // something or rather, maybe: look in %ULSPATH%
    if SearchPath(LANGUAGE_ENVIRONMENT_VAR_ULSPATH, tmpFilename, tmpFilepath ) then
    begin
      LoadLanguage(tmpFilePath);
      result := true;
      exit;
    end;

    // Standalone/compatibility: look in own dir
    tmpFilePath := GetApplicationDir + tmpFileName;

    if FileExists(tmpFilePath) then
    begin
      LoadLanguage(tmpFilePath);
      result := true;
      exit;
    end;

    result := false;
  end;


  Procedure LoadDefaultLanguage(const anAppName: string);
  var
    tmpLanguageVar: string;
    tmpMajorLanguage: string;
    tmpMinorLanguage: string;
    tmpParts : TStringList;

  begin
    tmpLanguageVar := GetEnv(LANGUAGE_ENVIRONMENT_VAR_LANG);
    LogEvent(LogI18n, LANGUAGE_ENVIRONMENT_VAR_LANG + '=' + tmpLanguageVar);

    if tmpLanguageVar = '' then
    begin
      tmpLanguageVar := DEFAULT_LANGUAGE;
    end;

    tmpParts := TStringList.Create;
    StrExtractStrings(tmpParts, tmpLanguageVar, ['_'], #0);

    tmpMajorLanguage := '';
    if tmpParts.count > 0 then
    begin
      tmpMajorLanguage := tmpParts[0];
    end;

    // note there might be some other stuff on the end of LANG
    // such as ES_ES_EURO...

    if tmpParts.count > 1 then
    begin
      tmpMinorLanguage := tmpParts[1];

      LogEvent(LogI18n, 'try loading ' + tmpMajorLanguage + '_' + tmpMinorLanguage);
      if LoadLanguageForSpec(anAppName, tmpMajorLanguage + '_' + tmpMinorLanguage) then
      begin
        // found a specifc language
        LogEvent(LogI18n, ' translation for ' + tmpMajorLanguage + '_' + tmpMinorLanguage + ' sucessfully loaded');
        tmpParts.Destroy;
        exit;
      end;
    end;

    // try generic language?
    LogEvent(LogI18n, 'try loading (major only) ' + tmpMajorLanguage);
    if LoadLanguageForSpec(anAppName, tmpMajorLanguage) then
    begin
      LogEvent(LogI18n, 'translation for ''' + tmpMajorLanguage + ''' sucessfully loaded');
      tmpParts.Destroy;
      exit;
    end;

    LogEvent(LogI18n, 'No language found, using default ' + tmpMajorLanguage);
    LoadLanguage('');

    tmpParts.Destroy;
  end;


  Initialization
    g_LanguageCallbacks := nil;
    g_CurrentLanguageFile := nil;
    g_LanguageUpdateCallbacks := nil;


  Finalization
    DestroyListAndObjects(g_LanguageUpdateCallbacks);
    DestroyListAndObjects(g_LanguageCallbacks);
    if nil <> g_CurrentLanguageFile then g_CurrentLanguageFile.Destroy;

End.