Ignore:
Timestamp:
Sep 9, 2007, 1:58:38 PM (18 years ago)
Author:
RBRi
Message:

refactoring
unused things removed, unit tests written, save translations improved

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Components/ACLLanguageUnit.pas

    r220 r226  
    11Unit ACLLanguageUnit;
     2
     3// NewView - a new OS/2 Help Viewer
     4// Copyright 2003-2006 Aaron Lawrence
     5// Copyright 2006-2007 Ronald Brill (rbri at rbri dot de)
     6// This software is released under the GNU Public License - see readme.txt
     7
     8// Helper functions for i18n
    29
    310Interface
    … …  
    613  OS2Def,
    714  Classes,
    8   Forms;
     15  Forms,
     16  FileUtilsUnit;
     17
     18
     19const
     20  LANGUAGE_DELIMITER = '_';
     21  LANGUAGE_FILE_EXTENSION = FILE_EXTENSION_DELIMITER + 'lng';
     22  LANGUAGE_COMMENT_CHAR = '#';
     23  LANGUAGE_ENVIRONMENT_VAR_LANG = 'LANG';
     24  LANGUAGE_ENVIRONMENT_VAR_OSDIR = 'OSDIR';
     25  LANGUAGE_ENVIRONMENT_VAR_ULSPATH = 'ULSPATH';
     26  LANGUAGE_DEFAULT_LANGUAGE = 'EN_US';
     27  LANGUAGE_DEFAULT_MARKER = '***';
     28  LANGUAGE_LABEL_DELIMITER = '.';
     29
    930
    1031type
    1132  TLanguageItem = record
    12     pValue: pstring;
    13     Used: boolean;
    14   end;
    15   TPLanguageItem = ^ TLanguageItem;
     33    pValue: pString;
     34    wasUsed: boolean;
     35    isDefault: boolean;
     36  end;
     37  TPLanguageItem = ^TLanguageItem;
     38
     39  TLanguageItemList = class
     40  protected
     41    translationsList : TStringList;
     42    procedure setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
     43  public
     44    constructor Create;
     45    destructor Destroy; override;
     46
     47    function getValue(const aLabel : String; const aDefaultValue : String) : String;
     48    procedure setValue(const aLabel : String; const aValue : String);
     49    procedure saveTo(const aTextFile : TextFile);
     50  end;
     51
    1652
    1753  TLanguageFile = class
    1854  protected
    19     FItems: TStringList;
    20     FFilename: string;
    21     FPrefix: string;
    22 
    23     // only if saving...
    24     FOutputFile: TextFile;
    25     FSaving: boolean;
    26 
    27     procedure GetValue( const Index: longint;
    28                         var Value: string );
    29 
    30     procedure LoadComponentLanguageInternal( Component: TComponent;
    31                                              const Path: string;
    32                                              const DoUpdates: boolean );
    33 
    34     procedure SaveItem( const Name: string;
    35                         const Value: string;
    36                         const Marker: string; );
     55    languageItems : TLanguageItemList;
     56    fileName: string;
     57
     58    procedure LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
    3759
    3860  public
    39     constructor Create( const Filename: string );
     61    constructor Create(const aFileName : String);
    4062    destructor Destroy; override;
    4163
    42     // if DoUpdates is true, then the component and it's
     64    // if anApplyFlag is true, then the component and it's
    4365    // owned components will be updated. If false, then
    4466    // it will only be checked and missing items noted.
    4567
    46     // Also sets Prefix to name of component with a dot, for convenience
    47     // in loading strings manually, related to the component
    48     procedure LoadComponentLanguage( Component: TComponent;
    49                                      DoUpdates: boolean );
    50 
    51     // Starts saving to the file
    52     procedure StartUpdate;
    53     procedure EndUpdate;
    54 
    55     // Looks for <prefix>.<name>
    56     function GetString( const Name: string;
    57                         const Default: string ): string;
    58 
    59     // If apply is true, then assign S the string called title
    60     // Or, if not found, use Default.
    61     // If apply is false, just look it up but don't assign to S
    62     procedure LL( const Apply: boolean;
    63                   Var S: string;
    64                   const Title: string;
    65                   const Default: string );
    66 
    67     property Prefix: string read FPrefix write FPrefix;
    68 
    69   end;
     68    // For convenience in loading strings manually, related to the component
     69    procedure LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
     70
     71
     72    // write the current transations to a file
     73    procedure writeToFile(const aFileName : String);
     74
     75    // If anApplyFlag is true, then assign aValue the translation
     76    // for aLabel. Or, if not found, use aDefaultValue.
     77    // If anApplyFlag is false, just look it up but don't assign to
     78    // aValue
     79    procedure LL( const anApplyFlag: boolean;
     80                  Var aValue: string;
     81                  const aLabel: string;
     82                  const aDefaultValue: string );
     83
     84  end;
     85
    7086
    7187  // callback for when language events occur
    … …  
    7490  // saved, so you should access any strings you need,
    7591  // but not actually change anything
    76   TLanguageEvent = procedure( Language: TLanguageFile;
    77                               Apply: boolean ) of object;
     92  TLanguageEvent = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean) of object;
    7893
    7994  // non-object version
    80   TLanguageProc = procedure( Language: TLanguageFile;
    81                              Apply: boolean );
     95  TLanguageProc = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean);
     96
    8297
    8398var
    8499  g_CurrentLanguageFile: TLanguageFile;
    85100
    86 // Register that you want to know when the current language changes
    87 // Will immediately call you back, if there is a current language
    88 procedure RegisterForLanguages( Callback: TLanguageEvent );
    89 
    90 // Register a procedure callback (not-object)
    91 procedure RegisterProcForLanguages( Callback: TLanguageProc );
    92 
    93 
    94 // Register a procedure that will be called only when a language file
    95 // is being updated (use to load forms if needed)
    96 procedure RegisterUpdateProcForLanguages( Callback: TProcedure );
    97 
    98 
    99 // Change current language to given, and tell everybody who has registered
    100 procedure ApplyLanguage( Language: TLanguageFile );
    101 
    102 // Tell everybody who has registered to access the given file,
    103 // but don't apply strings from it
    104 procedure UpdateLanguage( Language: TLanguageFile );
    105 
    106 // Load a string.
    107 // If Language is nil then just assign default.
    108 // If apply is true, then assign S the string called title
    109 // Or, if not found, use Default.
    110 // If apply is false, just look it up but don't assign to S
    111 procedure LoadString( Language: TLanguageFile;
    112                       const Apply: boolean;
    113                       Var S: string;
    114                       const Title: string;
    115                       const Default: string );
    116 
    117 // Load and apply specified language file
    118 procedure LoadLanguage( const FilePath: string );
    119 
    120 // load a language from the standard location.
    121 // AppName is a short name for the app, e.g. 'newview'
    122 // language spec is e.g. 'es' or 'es_es'
    123 function LoadAutoLanguage( const AppName: string;
    124                            const LanguageSpec: string ): boolean;
    125 
    126 // load default language based on LANG environment var
    127 Procedure LoadDefaultLanguage( const AppName: string );
     101  // Register that you want to know when the current language changes
     102  // Will immediately call you back, if there is a current language
     103  procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
     104
     105  // Register a procedure callback (not-object)
     106  procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
     107
     108
     109  // Register a procedure that will be called only when a language file
     110  // is being updated (use to load forms if needed)
     111  procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
     112
     113
     114  // Change current language to given, and tell everybody who has registered
     115  procedure ApplyLanguage(aLanguage: TLanguageFile);
     116
     117  // Tell everybody who has registered to access the given file,
     118  // but don't apply strings from it
     119  procedure UpdateLanguage(aLanguage: TLanguageFile);
     120
     121
     122  // Load and apply specified language file
     123  procedure LoadLanguage(const aFilePath: String);
     124
     125
     126  // load a language from the standard location.
     127  // anAppName is a short name for the app, e.g. 'newview'
     128  // language spec is e.g. 'es' or 'es_es'
     129  function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string): boolean;
     130
     131
     132  // load default language based on LANG environment var
     133  procedure LoadDefaultLanguage(const anAppName: string);
     134
    128135
    129136Implementation
    130137
    131138uses
    132   Dos, SysUtils, // system
     139  Dos, SysUtils,
    133140  StdCtrls,
    134141  Buttons,
    … …  
    147154  g_LanguageUpdateCallbacks: TList;
    148155
     156
     157  // -----------------
     158  // TLanguageItemList
     159  // -----------------
     160
     161  constructor TLanguageItemList.Create;
     162  begin
     163    // LogEvent(LogI18n, 'TLanguageItemList.Create');
     164    // setup our memory
     165    translationsList := TStringList.Create;
     166    translationsList.Sorted := true; // for lookup speed
     167    translationsList.CaseSensitive := true; // also for speed. We manually convert to uppercase.
     168    translationsList.Duplicates := dupAccept;
     169  end;
     170
     171
     172  destructor TLanguageItemList.Destroy;
     173  var
     174    i: longint;
     175    tmpPLanguageItem: TPLanguageItem;
     176  begin
     177    // LogEvent(LogI18n, 'TLanguageItemList.Destroy');
     178    for i := 0 to translationsList.Count - 1 do
     179    begin
     180      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
     181
     182      // free the parts of the item
     183      DisposeStr(tmpPLanguageItem^.pValue);
     184      Dispose(tmpPLanguageItem);
     185    end;
     186
     187    translationsList.Destroy;
     188  end;
     189
     190
     191  function TLanguageItemList.getValue(const aLabel : String; const aDefaultValue : String) : String;
     192  var
     193    tmpPosition : LongInt;
     194    tmpFound : Boolean;
     195    tmpPLanguageItem : TPLanguageItem;
     196  begin
     197    tmpFound := translationsList.Find(UpperCase(aLabel), tmpPosition);
     198
     199    if not tmpFound then
     200    begin
     201      setValueWithFlags(aLabel, aDefaultValue, true);
     202      result := '';
     203
     204      // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ') [' + aDefaultValue + ']->' + result);
     205      exit;
     206    end;
     207
     208    tmpPLanguageItem := TPLanguageItem(translationsList.Objects[tmpPosition]);
     209
     210    // mark as used
     211    tmpPLanguageItem^.wasUsed := true;
     212
     213    if tmpPLanguageItem^.isDefault then
     214    begin
     215      result := '';
     216
     217      // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
     218      exit;
     219    end;
     220
     221    result := tmpPLanguageItem^.pValue^;
     222    // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
     223  end;
     224
     225
     226  procedure TLanguageItemList.setValue(const aLabel : String; const aValue : String);
     227  begin
     228    setValueWithFlags(aLabel, aValue, false);
     229  end;
     230
     231
     232  procedure TLanguageItemList.setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
     233  var
     234    tmpPLanguageItem: TPLanguageItem;
     235  begin
     236    // LogEvent(LogI18n, 'TLanguageItemList.setValueWithFlags(' + aLabel + ')->' + aValue + '[' + BoolToStr(aDefaultFlag) + ']');
     237
     238    New(tmpPLanguageItem);
     239    tmpPLanguageItem^.pValue := NewStr(aValue);
     240    tmpPLanguageItem^.wasUsed := false;
     241    tmpPLanguageItem^.isDefault := aDefaultFlag;
     242
     243    translationsList.AddObject(UpperCase(aLabel), TObject(tmpPLanguageItem));
     244  end;
     245
     246
     247  procedure TLanguageItemList.saveTo(const aTextFile : TextFile);
     248  var
     249    i : integer;
     250    tmpPLanguageItem: TPLanguageItem;
     251    tmpLabel : String;
     252    tmpQuotedValue : String;
     253    tmpUnusedHeaderFlag : boolean;
     254  begin
     255    // used first
     256    for i := 0 to translationsList.Count - 1 do
     257    begin
     258      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
     259      if tmpPLanguageItem^.wasUsed then
     260      begin
     261        tmpLabel := translationsList.Names[i];
     262
     263        tmpQuotedValue := tmpPLanguageItem^.pValue^;
     264        tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
     265        tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);
     266
     267        if tmpPLanguageItem^.isDefault then
     268        begin
     269          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
     270        end
     271        else
     272        begin
     273          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
     274        end;
     275      end;
     276    end;
     277
     278
     279    // unused at the end
     280    tmpUnusedHeaderFlag := false;
     281    for i := 0 to translationsList.Count - 1 do
     282    begin
     283      tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
     284      if not tmpPLanguageItem^.wasUsed then
     285      begin
     286        if not tmpUnusedHeaderFlag then
     287        begin
     288          tmpUnusedHeaderFlag := true;
     289
     290          Writeln(aTextFile, '# **********************************************************');
     291          Writeln(aTextFile, '# * The following items are no longer needed.              *');
     292          Writeln(aTextFile, '# * You can delete them after checking they are of no use. *');
     293          Writeln(aTextFile, '# **********************************************************');
     294        end;
     295
     296        tmpLabel := translationsList.Names[i];
     297
     298        tmpQuotedValue := tmpPLanguageItem^.pValue^;
     299        tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
     300        tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);
     301
     302        if tmpPLanguageItem^.isDefault then
     303        begin
     304          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
     305        end
     306        else
     307        begin
     308          WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
     309        end;
     310      end;
     311    end;
     312  end;
     313
     314
     315  // -----------------
     316  // TLanguageCallback
     317  // -----------------
     318
    149319Type
    150320  TLanguageCallback = class
    … …  
    155325  end;
    156326
    157 constructor TLanguageCallback.CreateMethod( CallbackMethod: TLanguageEvent );
    158 begin
    159   FCallbackMethod := CallbackMethod;
    160   FCallbackProc := nil;
    161 end;
    162 
    163 constructor TLanguageCallback.CreateProc( CallbackProc: TLanguageProc );
    164 begin
    165   FCallbackProc := CallbackProc;
    166   FCallbackMethod := nil;
    167 end;
    168 
    169 procedure AddLanguageCallback( CallbackObject: TLanguageCallback );
    170 begin
    171   if g_LanguageCallbacks = nil then
    172     g_LanguageCallbacks := TList.Create;
    173 
    174   g_LanguageCallbacks.Add( CallbackObject );
    175 end;
    176 
    177 procedure RegisterForLanguages( Callback: TLanguageEvent );
    178 begin
    179   AddLanguageCallback( TLanguageCallback.CreateMethod( Callback ) );
    180 
    181   if g_CurrentLanguageFile <> nil then
    182     Callback( g_CurrentLanguageFile, true );
    183 end;
    184 
    185 procedure RegisterProcForLanguages( Callback: TLanguageProc );
    186 begin
    187   AddLanguageCallback( TLanguageCallback.CreateProc( Callback ) );
    188 
    189   if g_CurrentLanguageFile <> nil then
    190     Callback( g_CurrentLanguageFile, true );
    191 end;
    192 
    193 procedure RegisterUpdateProcForLanguages( Callback: TProcedure );
    194 begin
    195   if g_LanguageUpdateCallbacks = nil then
    196     g_LanguageUpdateCallbacks := TList.Create;
    197 
    198   g_LanguageUpdateCallbacks.Add( TObject( Callback ) );
    199   // since this is for when updating a language only, we don't immediately call it
    200 end;
    201 
    202 procedure ApplyLanguage( Language: TLanguageFile );
    203 var
    204   i: longint;
    205   Callback: TLanguageCallback;
    206 begin
    207   if g_CurrentLanguageFile <> nil then
    208     g_CurrentLanguageFile.Destroy;
    209 
    210   g_CurrentLanguageFile := Language;
    211 
    212   // do language callbacks to everyone
    213   for i := 0 to g_LanguageCallbacks.Count - 1 do
    214   begin
    215     Callback := g_LanguageCallbacks[ i ];
    216     if Assigned( Callback.FCallbackMethod ) then
    217       Callback.FCallbackMethod( g_CurrentLanguageFile, true );
    218     if Assigned( Callback.FCallbackProc ) then
    219       Callback.FCallbackProc( g_CurrentLanguageFile, true );
    220   end;
    221 end;
    222 
    223 procedure UpdateLanguage( Language: TLanguageFile );
    224 var
    225   i: longint;
    226   Callback: TLanguageCallback;
    227   UpdateProc: TProcedure;
    228 begin
    229   if g_LanguageUpdateCallbacks <> nil then
    230   begin
    231     // first call all update callbacks so dynamically created
    232     // things can be loaded (i.e. forms)
    233     // Note: this will cause them to load their strings from
    234     // the current language if any. This is fine, necessary even.
    235     for i := 0 to g_LanguageUpdateCallbacks.Count - 1 do
    236     begin
    237       UpdateProc := TProcedure( g_LanguageUpdateCallbacks[ i ] );
    238       UpdateProc;
    239     end;
    240   end;
    241 
    242   Language.StartUpdate;
    243 
    244   if g_LanguageCallbacks <> nil then
    245   begin
    246     // now call the language events
     327
     328  constructor TLanguageCallback.CreateMethod(CallbackMethod: TLanguageEvent);
     329  begin
     330    FCallbackMethod := CallbackMethod;
     331    FCallbackProc := nil;
     332  end;
     333
     334
     335  constructor TLanguageCallback.CreateProc(aCallbackProc: TLanguageProc);
     336  begin
     337    FCallbackProc := CallbackProc;
     338    FCallbackMethod := nil;
     339  end;
     340
     341
     342  procedure AddLanguageCallback(aCallbackObject: TLanguageCallback);
     343  begin
     344    if g_LanguageCallbacks = nil then
     345    begin
     346      g_LanguageCallbacks := TList.Create;
     347    end;
     348
     349    g_LanguageCallbacks.Add(aCallbackObject);
     350  end;
     351
     352
     353  procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
     354  begin
     355    AddLanguageCallback( TLanguageCallback.CreateMethod(aCallbackEvent) );
     356
     357    if g_CurrentLanguageFile <> nil then
     358    begin
     359      aCallbackEvent(g_CurrentLanguageFile, true);
     360    end;
     361  end;
     362
     363
     364  procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
     365  begin
     366    AddLanguageCallback( TLanguageCallback.CreateProc(aCallbackProc) );
     367
     368    if g_CurrentLanguageFile <> nil then
     369    begin
     370      aCallbackProc(g_CurrentLanguageFile, true);
     371    end;
     372  end;
     373
     374
     375  procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
     376  begin
     377    if g_LanguageUpdateCallbacks = nil then
     378    begin
     379      g_LanguageUpdateCallbacks := TList.Create;
     380    end;
     381
     382    g_LanguageUpdateCallbacks.Add(TObject(aCallbackProc));
     383    // since this is for when updating a language only, we don't immediately call it
     384  end;
     385
     386
     387  procedure ApplyLanguage(aLanguage: TLanguageFile);
     388  var
     389    i: longint;
     390    tmpCallback: TLanguageCallback;
     391  begin
     392    if g_CurrentLanguageFile <> nil then
     393    begin
     394      g_CurrentLanguageFile.Destroy;
     395    end;
     396
     397    g_CurrentLanguageFile := aLanguage;
     398
     399    // do language callbacks to everyone
    247400    for i := 0 to g_LanguageCallbacks.Count - 1 do
    248401    begin
    249       Callback := g_LanguageCallbacks[ i ];
    250       if Assigned( Callback.FCallbackMethod ) then
    251         Callback.FCallbackMethod( Language, false );
    252       if Assigned( Callback.FCallbackProc ) then
    253         Callback.FCallbackProc( Language, false );
    254     end;
    255   end;
    256 
    257   Language.EndUpdate;
    258 end;
    259 
    260 constructor TLanguageFile.Create( const Filename: string );
    261 var
    262   F: TextFile;
    263   tmpLine: string;
    264   Name: string;
    265   Value: string;
    266   pItem: TPLanguageItem;
    267   tmpLineParts : TStringList;
    268 begin
    269   FSaving := false;
    270 
    271   FFilename := Filename;
    272 
    273   FPrefix := '';
    274 
    275   FItems := TStringList.Create;
    276   FItems.Sorted := true; // for lookup speed
    277   FItems.CaseSensitive := true; // also for speed. We manually convert to uppercase.
    278   FItems.Duplicates := dupAccept;
    279 
    280   if not FileExists( Filename ) then
    281     exit;
    282 
    283   FileMode := fmInput;
    284   AssignFile( F, Filename );
    285   Reset( F );
    286 
    287   tmpLineParts := TStringList.Create;
    288 
    289   while not Eof( F ) do
    290   begin
    291     ReadLn( F, tmpLine);
    292 
    293     tmpLineParts.clear;
    294     StrExtractStringsQuoted(tmpLineParts, tmpLine);
    295 
    296     if tmpLineParts.count > 0 then
    297     begin
    298       Name := tmpLineParts[0];
    299 
    300       if Name[ 1 ] <> '#' then
    301       begin
    302         // Got a name, read the value and store.
    303         value := '';
    304         if tmpLineParts.count > 0 then
     402      tmpCallback := g_LanguageCallbacks[i];
     403
     404      if Assigned(tmpCallback.FCallbackMethod) then
     405      begin
     406        tmpCallback.FCallbackMethod(g_CurrentLanguageFile, true);
     407      end;
     408
     409      if Assigned(tmpCallback.FCallbackProc) then
     410      begin
     411        tmpCallback.FCallbackProc(g_CurrentLanguageFile, true);
     412      end;
     413    end;
     414  end;
     415
     416
     417  procedure UpdateLanguage(aLanguage: TLanguageFile);
     418  var
     419    i: longint;
     420    tmpCallback : TLanguageCallback;
     421    tmpUpdateProc : TProcedure;
     422  begin
     423    if g_LanguageUpdateCallbacks <> nil then
     424    begin
     425      // first call all update callbacks so dynamically created
     426      // things can be loaded (i.e. forms)
     427      // Note: this will cause them to load their strings from
     428      // the current language if any. This is fine, necessary even.
     429      for i := 0 to g_LanguageUpdateCallbacks.Count - 1 do
     430      begin
     431        tmpUpdateProc := TProcedure(g_LanguageUpdateCallbacks[i]);
     432        tmpUpdateProc;
     433      end;
     434    end;
     435
     436    if g_LanguageCallbacks <> nil then
     437    begin
     438      // now call the language events
     439      for i := 0 to g_LanguageCallbacks.Count - 1 do
     440      begin
     441        tmpCallback := g_LanguageCallbacks[i];
     442        if Assigned(tmpCallback.FCallbackMethod) then
    305443        begin
    306           value := tmpLineParts[1];
     444          tmpCallback.FCallbackMethod(aLanguage, false);
    307445        end;
    308 
    309         New( pItem );
    310         pItem ^. pValue := NewStr( Value );
    311         pItem ^. Used := false;
    312         FItems.AddObject( UpperCase( Name ),
    313                           TObject( pItem ) );
    314       end;
    315     end;
    316   end;
    317 
    318   tmpLineParts.Destroy;
    319   CloseFile( F );
    320 end;
    321 
    322 destructor TLanguageFile.Destroy;
    323 var
    324   i: longint;
    325   pItem: TPLanguageItem;
    326 begin
    327   for i := 0 to FItems.Count - 1 do
    328   begin
    329     pItem := TPLanguageItem( FItems.Objects[ i ] );
    330     DisposeStr( pItem ^. pValue );
    331     Dispose( pItem );
    332   end;
    333   FItems.Destroy;
    334 end;
    335 
    336 procedure TLanguageFile.GetValue( const Index: longint;
    337                                   var Value: string );
    338 var
    339   pItem: TPLanguageItem;
    340 begin
    341   pItem := TPLanguageItem( FItems.Objects[ Index ] );
    342   pItem ^. Used := true;
    343   Value := pItem ^. pValue ^;
    344 end;
    345 
    346 // Magical procedure that does certain things...
    347 // If Apply is true, then it looks up title
    348 // and if found, assigns it's value to S
    349 // If not found, then assigns Default to S
    350 // If Apply is false, then does lookup only, does not assign S
    351 // In either case, if the string is not found,
    352 // it will be added to missing items list
    353 procedure TLanguageFile.LL( const Apply: boolean;
    354                             Var S: string;
    355                             const Title: string;
    356                             const Default: string );
    357 begin
    358   if Apply then
    359     S := GetString( Title, Default )
    360   else
    361     GetString( Title, Default );
    362 end;
    363 
    364 procedure TLanguageFile.LoadComponentLanguage( Component: TComponent;
    365                                                DoUpdates: boolean );
    366 begin
    367   LoadComponentLanguageInternal( Component, '', DoUpdates );
    368   Prefix := Component.Name + '.';
    369 end;
    370 
    371 procedure TLanguageFile.StartUpdate;
    372 var
    373   BackupFilename: string;
    374 begin
    375   BackupFilename := ChangeFileExt( FFilename, '.bak' );
    376   if FileExists( BackupFilename ) then
    377     if not DeleteFile( BackupFilename ) then
    378       raise Exception.Create( 'Unable to delete backup language file: '
    379                               + BackupFilename );
    380   if FileExists( FFilename ) then
    381     // backup
    382     if not CopyFile( FFilename, BackupFilename ) then
    383       raise Exception.Create( 'Unable to copy to backup language file: '
    384                               + BackupFilename );
    385 
    386   AssignFile( FOutputFile, FFilename );
    387 
    388   Rewrite( FOutputFile );
    389 
    390   FSaving := true;
    391 end;
    392 
    393 procedure TLanguageFile.EndUpdate;
    394 var
    395   i: longint;
    396   pItem: TPLanguageItem;
    397   Notified: boolean;
    398 begin
    399   Notified := false;
    400 
    401   for i := 0 to FItems.Count - 1 do
    402   begin
    403     pItem := TPLanguageItem( FItems.Objects[ i ] );
    404     if not pItem ^. Used then
    405     begin
    406       if not Notified then
    407       begin
    408         Writeln( FOutputFile,
    409                  '# *** The following items are no longer needed.' );
    410         Writeln( FOutputFile,
    411                  '# You can delete them after checking they are of no use.' );
    412         Notified := true;
    413       end;
    414 
    415       SaveItem( '# ' + FItems[ i ],
    416                 pItem ^. pValue^,
    417                 '' );
    418     end;
    419   end;
    420 
    421   FSaving := false;
    422   CloseFile( FOutputFile );
    423 end;
    424 
    425 procedure TLanguageFile.SaveItem( const Name: string;
    426                                   const Value: string;
    427                                   const Marker: string );
    428 
    429 var
    430   tmpQuotedValue : string;
    431 begin
    432   tmpQuotedValue := StrEscapeAllCharsBy(Value, [], '"');
    433   tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);
    434   WriteLn( FOutputFile, Name + ' ' + tmpQuotedValue + ' ' + Marker );
    435 end;
    436 
    437 procedure TLanguageFile.LoadComponentLanguageInternal( Component: TComponent;
    438                                                        const Path: string;
    439                                                        const DoUpdates: boolean );
    440 var
    441   i : longint;
    442   ComponentPath: string;
    443   Value: string;
    444 
    445   MenuItem: TMenuItem;
    446   Button: TButton;
    447   TheLabel: TLabel;
    448   RadioGroup: TRadioGroup;
    449   TabSet: TTabSet;
    450   TabbedNotebook: TTabbedNotebook;
    451   Form: TForm;
    452   RadioButton: TRadioButton;
    453   CheckBox: TCheckBox;
    454   CoolBar2: TCoolBar2;
    455   GroupBox: TGroupBox;
    456   MultiColumnListBox: TMultiColumnListBox;
    457   SystemOpenDialog: TSystemOpenDialog;
    458   SystemSaveDialog: TSystemSaveDialog;
    459 
    460   // searches for componentpath + name, sets value if found
    461   function FindIt( const Name: string;
    462                    const Default: string ): boolean;
    463   var
    464     Index: longint;
    465   begin
    466     result := FItems.Find( UpperCase( ComponentPath + Name ), Index );
    467 
    468     if result then
    469     begin
    470       GetValue( Index, Value );
    471       if FSaving then
    472         // save the specified value
    473         SaveItem( ComponentPath + Name, Value, '' );
     446        if Assigned(tmpCallback.FCallbackProc) then
     447        begin
     448          tmpCallback.FCallbackProc(aLanguage, false);
     449        end;
     450      end;
     451    end;
     452  end;
     453
     454
     455  constructor TLanguageFile.Create( const aFileName : String);
     456  var
     457    tmpTextFile : TextFile;
     458    tmpLine : string;
     459    tmpLabel : string;
     460    tmpValue : string;
     461    tmpLineParts : TStringList;
     462  begin
     463    filename := aFileName;
     464
     465    languageItems := TLanguageItemList.Create;
     466
     467    if not FileExists(aFileName) then
     468    begin
     469      exit;
     470    end;
     471
     472    // read the file
     473    FileMode := fmInput;
     474    AssignFile(tmpTextFile, aFileName);
     475    Reset(tmpTextFile);
     476
     477    tmpLineParts := TStringList.Create;
     478
     479    while not Eof(tmpTextFile) do
     480    begin
     481      ReadLn(tmpTextFile, tmpLine);
     482
     483      tmpLineParts.clear;
     484      StrExtractStringsQuoted(tmpLineParts, tmpLine);
     485
     486      if tmpLineParts.count > 0 then
     487      begin
     488        tmpLabel := tmpLineParts[0];
     489
     490        // TODO trim leading blanks
     491        if tmpLabel[1] <> LANGUAGE_COMMENT_CHAR then
     492        begin
     493          // Got a name, read the value and store.
     494          tmpValue := '';
     495          if tmpLineParts.count > 0 then
     496          begin
     497            tmpValue := tmpLineParts[1];
     498          end;
     499
     500          languageItems.setValue(UpperCase(tmpLabel), tmpValue);
     501        end;
     502      end;
     503    end;
     504
     505    tmpLineParts.Destroy;
     506    CloseFile(tmpTextFile);
     507  end;
     508
     509
     510  destructor TLanguageFile.Destroy;
     511  begin
     512    languageItems.Destroy;
     513  end;
     514
     515
     516  procedure TLanguageFile.LL( const anApplyFlag: boolean;
     517                              Var aValue: string;
     518                              const aLabel: string;
     519                              const aDefaultValue: string );
     520  begin
     521    // LogEvent(LogI18n, 'TLanguageFile.LL(' + BoolToStr(Apply) + ')');
     522
     523    if anApplyFlag then
     524    begin
     525      aValue := languageItems.getValue(UpperCase(aLabel), aDefaultValue)
    474526    end
    475527    else
    476528    begin
    477       if FSaving then
    478         // save the default.
    479         SaveItem( ComponentPath + Name, Default, '***' );
    480     end;
    481 
    482     if result then
    483       // found
    484       if not DoUpdates then
    485         // not doing updates, so pretend we didn't, so we don't apply it
    486         // (this is a local hack only)
    487         result := false;
    488   end;
    489 
    490 Begin
    491   ComponentPath := Path + Component.Name + '.';
    492 
    493   // Components sorted with most common at top, ish...
    494 
    495   if Component is TMenuItem then
    496   begin
    497     MenuItem := TMenuItem( Component );
    498     if MenuItem.Caption <> '-' then
    499     begin
     529      languageItems.getValue(UpperCase(aLabel), aDefaultValue)
     530    end
     531  end;
     532
     533
     534  procedure TLanguageFile.LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
     535  begin
     536    LoadComponentLanguageInternal(aComponent, '', anApplyFlag);
     537  end;
     538
     539
     540  procedure TLanguageFile.writeToFile(const aFileName : String);
     541  var
     542    tmpBackupFilename: string;
     543    tmpFile: TextFile;
     544  begin
     545    tmpBackupFilename := ChangeFileExt(aFileName, '.bak' );
     546    if FileExists(tmpBackupFilename) then
     547    begin
     548      if not DeleteFile(tmpBackupFilename) then
     549      begin
     550        raise Exception.Create( 'Unable to delete backup language file: ' + tmpBackupFilename);
     551      end;
     552    end;
     553
     554    if FileExists(aFileName) then
     555      begin
     556      if not CopyFile(aFileName, tmpBackupFilename ) then
     557      begin
     558        raise Exception.Create( 'Unable to copy to backup language file: ' + tmpBackupFilename);
     559      end;
     560    end;
     561
     562    AssignFile(tmpFile, aFileName);
     563    ReWrite(tmpFile);
     564
     565    languageItems.saveTo(tmpFile);
     566
     567    CloseFile(tmpFile);
     568  end;
     569
     570  procedure TLanguageFile.LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
     571  var
     572    i : longint;
     573    tmpComponentPath: string;
     574    tmpValue: string;
     575
     576    tmpMenuItem: TMenuItem;
     577    tmpButton: TButton;
     578    tmpLabel: TLabel;
     579    tmpRadioGroup: TRadioGroup;
     580    tmpTabSet: TTabSet;
     581    tmpTabbedNotebook: TTabbedNotebook;
     582    tmpForm: TForm;
     583    tmpRadioButton: TRadioButton;
     584    tmpCheckBox: TCheckBox;
     585    tmpCoolBar2: TCoolBar2;
     586    tmpGroupBox: TGroupBox;
     587    tmpMultiColumnListBox: TMultiColumnListBox;
     588    tmpSystemOpenDialog: TSystemOpenDialog;
     589    tmpSystemSaveDialog: TSystemSaveDialog;
     590  Begin
     591    tmpComponentPath := aPath + aComponent.Name + LANGUAGE_LABEL_DELIMITER;
     592
     593    // Components sorted with most common at top, ish...
     594    if aComponent is TMenuItem then
     595    begin
     596      tmpMenuItem := TMenuItem(aComponent);
     597
    500598      // skip separators
    501       if FindIt(  'Caption', MenuItem.Caption ) then
    502         MenuItem.Caption := Value;
    503       if FindIt( 'Hint', MenuItem.Hint ) then
    504         MenuItem.Hint := Value;
    505     end;
    506   end
    507 
    508   else if Component is TButton then
    509   begin
    510     Button := TButton( Component );
    511     if FindIt( 'Caption', Button.Caption ) then
    512       Button.Caption := Value;
    513     if FindIt( 'Hint', Button.Hint ) then
    514       Button.Hint := Value;
    515   end
    516 
    517   else if Component is TLabel then
    518   begin
    519     TheLabel := TLabel( Component );
    520     if FindIt( 'Caption', TheLabel.Caption ) then
    521       TheLabel.Caption := Value;
    522     if FindIt( 'Hint', TheLabel.Hint ) then
    523       TheLabel.Hint := Value;
    524   end
    525 
    526   else if Component is TRadioGroup then
    527   begin
    528     RadioGroup := TRadioGroup( Component );
    529     if FindIt( 'Caption', RadioGroup.Caption ) then
    530       RadioGroup.Caption := Value;
    531     for i := 0 to RadioGroup.Items.Count - 1 do
    532       if FindIt( 'Item' + IntToStr( i ),
    533                  RadioGroup.Items[ i ] ) then
    534         RadioGroup.Items[ i ] := Value;
    535   end
    536 
    537   else if Component is TTabSet then
    538   begin
    539     TabSet := TTabSet( Component );
    540     for i := 0 to TabSet.Tabs.Count - 1 do
    541       if FindIt( 'Tab' + IntToStr( i ),
    542                  TabSet.Tabs[ i ] ) then
    543         TabSet.Tabs[ i ] := Value;
    544   end
    545 
    546   else if Component is TTabbedNotebook then
    547   begin
    548     TabbedNotebook := TTabbedNotebook( Component );
    549     for i := 0 to TabbedNotebook.Pages.Count - 1 do
    550     begin
    551       if FindIt( 'Tab' + IntToStr( i ) + '.Caption',
    552                  TabbedNotebook.Pages[ i ] ) then
    553         TabbedNotebook.Pages[ i ] := Value;
    554 
    555       if FindIt( 'Tab' + IntToStr( i ) + '.Hint',
    556                  TabbedNotebook.Pages.Pages[ i ].Hint ) then
    557         TabbedNotebook.Pages.Pages[ i ].Hint := Value;
    558     end;
    559   end
    560 
    561   else if Component is TForm then
    562   begin
    563     Form := TForm( Component );
    564     if FindIt( 'Caption', Form.Caption ) then
    565       Form.Caption := Value;
    566 
    567     // load owned controls
    568     for i := 0 to Component.ComponentCount - 1 do
    569       LoadComponentLanguageInternal( Component.Components[ i ],
    570                                      ComponentPath,
    571                                      DoUpdates );
    572 
    573   end
    574 
    575   else if Component is TRadioButton then
    576   begin
    577     RadioButton := TRadioButton( Component );
    578     if FindIt( 'Caption', RadioButton.Caption ) then
    579       RadioButton.Caption := Value;
    580     if FindIt( 'Hint', RadioButton.Hint ) then
    581       RadioButton.Hint := Value;
    582   end
    583 
    584   else if Component is TCheckBox then
    585   begin
    586     CheckBox := TCheckBox( Component );
    587     if FindIt( 'Caption', CheckBox.Caption ) then
    588       CheckBox.Caption := Value;
    589     if FindIt( 'Hint', CheckBox.Hint ) then
    590       CheckBox.Hint := Value;
    591   end
    592 
    593   else if Component is TCoolBar2 then
    594   begin
    595     CoolBar2 := TCoolBar2( Component );
    596     for i := 0 to CoolBar2.Sections.Count - 1 do
    597     begin
    598       if FindIt( 'Item' + IntToStr( i ),
    599                  CoolBar2.Sections[ i ].Text ) then
    600         CoolBar2.Sections[ i ].Text := Value;
    601 //      if FindIt( 'Hint' + IntToStr( i ) ) then
    602 //        TCoolBar2( Component ).Sections[ i ].Hint := Value;
    603     end;
    604   end
    605 
    606   else if Component is TGroupBox then
    607   begin
    608     GroupBox := TGroupBox( Component );
    609     if FindIt( 'Caption', GroupBox.Caption ) then
    610       GroupBox.Caption := Value;
    611     if FindIt( 'Hint', GroupBox.Hint ) then
    612       GroupBox.Hint := Value;
    613   end
    614   else if Component is TMultiColumnListBox then
    615   begin
    616     MultiColumnListBox := TMultiColumnListBox( Component );
    617     for i := 0 to MultiColumnListBox.HeaderColumns.Count - 1 do
    618       if FindIt( 'Column' + IntToStr( i ),
    619                  MultiColumnListBox.HeaderColumns[ i ].Text ) then
    620         MultiColumnListBox.HeaderColumns[ i ].Text := Value;
    621   end
    622   else if Component is TSystemOpenDialog then
    623   begin
    624     SystemOpenDialog := TSystemOpenDialog( Component );
    625     if FindIt( 'OKName', SystemOpenDialog.OKName ) then
    626       SystemOpenDialog.OKName := Value;
    627     if FindIt( 'Title', SystemOpenDialog.Title ) then
    628       SystemOpenDialog.Title := Value;
    629   end
    630   else if Component is TSystemSaveDialog then
    631   begin
    632     SystemSaveDialog := TSystemSaveDialog( Component );
    633     if FindIt( 'OKName', SystemSaveDialog.OKName ) then
    634       SystemSaveDialog.OKName := Value;
    635     if FindIt( 'Title', SystemSaveDialog.Title ) then
    636       SystemSaveDialog.Title := Value;
    637 
    638   end;
    639 
    640 end;
    641 
    642 function TLanguageFile.GetString( const Name: string;
    643                                   const Default: string ): string;
    644 var
    645   Index: longint;
    646   Found: boolean;
    647 begin
    648   Found := FItems.Find( UpperCase( Prefix + Name ), Index );
    649 
    650   if Found then
    651   begin
    652     GetValue( Index, Result );
    653     if FSaving then
    654       SaveItem( Prefix + Name, Result, '' );
    655   end
    656   else
    657   begin
    658     Result := Default;
    659     if FSaving then
    660       SaveItem( Prefix + Name, Default, '***' );
    661   end;
    662 
    663 end;
    664 
    665 procedure LoadString( Language: TLanguageFile;
    666                       const Apply: boolean;
    667                       Var S: string;
    668                       const Title: string;
    669                       const Default: string );
    670 begin
    671   if Language = nil then
    672   begin
    673     if Apply then
    674     begin
    675       S := Default
    676     end
    677   end
    678   else
    679   begin
    680     Language.LL( Apply, S, Title, Default );
    681   end;
    682 end;
    683 
    684 procedure LoadLanguage( const FilePath: string );
    685 var
    686   NewLanguage: TLanguageFile;
    687 begin
    688   try
    689     NewLanguage := TLanguageFile.Create( FilePath );
    690   except
    691     exit;
    692   end;
    693 
    694   ApplyLanguage( NewLanguage );
    695 
    696 end;
    697 
    698 function LoadAutoLanguage( const AppName: string;
    699                            const LanguageSpec: string ): boolean;
    700 var
    701   FilePath: string;
    702   Filename: string;
    703   OSDir: string;
    704 begin
    705   // Filenames loaded will be <AppName>.<Language>.lng
    706   Filename :=   AppName
    707               + '_'
    708               + LanguageSpec
    709               + '.lng';
    710 
    711   // eCS 1.1+ look in x:\ecs\lang
    712   OSDir := GetEnv( 'OSDIR' );
    713   if OSDir <> '' then
    714   begin
    715     FilePath := AddDirectorySeparator( OSDir )
    716                 + 'lang\'
    717                 + Filename;
    718     if FileExists( FilePath ) then
    719     begin
    720       LoadLanguage( FilePath );
     599      if tmpMenuItem.Caption <> '-' then
     600      begin
     601        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpMenuItem.Caption);
     602        if '' <> tmpValue then tmpMenuItem.Caption := tmpValue;
     603
     604        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpMenuItem.Hint);
     605        if '' <> tmpValue then tmpMenuItem.Hint := tmpValue;
     606      end;
     607    end
     608
     609    else if aComponent is TButton then
     610    begin
     611      tmpButton := TButton(aComponent);
     612
     613      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpButton.Caption);
     614      if '' <> tmpValue then tmpButton.Caption := tmpValue;
     615
     616      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpButton.Hint);
     617      if '' <> tmpValue then tmpButton.Hint := tmpValue;
     618    end
     619
     620    else if aComponent is TLabel then
     621    begin
     622      tmpLabel := TLabel(aComponent);
     623
     624      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpLabel.Caption);
     625      if '' <> tmpValue then tmpLabel.Caption := tmpValue;
     626
     627      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpLabel.Hint);
     628      if '' <> tmpValue then tmpLabel.Hint := tmpValue;
     629    end
     630
     631    else if aComponent is TRadioGroup then
     632    begin
     633      tmpRadioGroup := TRadioGroup(aComponent);
     634
     635      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpRadioGroup.Caption);
     636      if '' <> tmpValue then tmpRadioGroup.Caption := tmpValue;
     637
     638      for i := 0 to tmpRadioGroup.Items.Count - 1 do
     639      begin
     640        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Item' + IntToStr(i)), tmpRadioGroup.Items[i]);
     641        if '' <> tmpValue then tmpRadioGroup.Items[i] := tmpValue;
     642      end;
     643    end
     644
     645    else if aComponent is TTabSet then
     646    begin
     647      tmpTabSet := TTabSet(aComponent);
     648
     649      for i := 0 to tmpTabSet.Tabs.Count - 1 do
     650      begin
     651        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i)), tmpTabSet.Tabs[i]);
     652        if '' <> tmpValue then tmpTabSet.Tabs[i] := tmpValue;
     653      end;
     654    end
     655
     656    else if aComponent is TTabbedNotebook then
     657    begin
     658      tmpTabbedNotebook := TTabbedNotebook(aComponent);
     659      for i := 0 to tmpTabbedNotebook.Pages.Count - 1 do
     660      begin
     661        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i) + '.Caption'), tmpTabbedNotebook.Pages[i]);
     662        if '' <> tmpValue then tmpTabbedNotebook.Pages[i] := tmpValue;
     663
     664        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Tab' + IntToStr(i) + '.Hint'), tmpTabbedNotebook.Pages.Pages[i].Hint);
     665        if '' <> tmpValue then tmpTabbedNotebook.Pages.Pages[i].Hint := tmpValue;
     666      end;
     667    end
     668
     669    else if aComponent is TForm then
     670    begin
     671      tmpForm := TForm(aComponent);
     672
     673      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpForm.Caption);
     674      if '' <> tmpValue then tmpForm.Caption := tmpValue;
     675
     676      // load owned controls
     677      for i := 0 to aComponent.ComponentCount - 1 do
     678      begin
     679        LoadComponentLanguageInternal(aComponent.Components[i], tmpComponentPath, aDoUpdates );
     680      end;
     681    end
     682
     683    else if aComponent is TRadioButton then
     684    begin
     685      tmpRadioButton := TRadioButton(aComponent);
     686
     687      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpRadioButton.Caption);
     688      if '' <> tmpValue then tmpRadioButton.Caption := tmpValue;
     689
     690      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpRadioButton.Hint);
     691      if '' <> tmpValue then tmpRadioButton.Hint := tmpValue;
     692    end
     693
     694    else if aComponent is TCheckBox then
     695    begin
     696      tmpCheckBox := TCheckBox(aComponent);
     697
     698      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpCheckBox.Caption);
     699      if '' <> tmpValue then tmpCheckBox.Caption := tmpValue;
     700
     701      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpCheckBox.Hint);
     702      if '' <> tmpValue then tmpCheckBox.Hint := tmpValue;
     703    end
     704
     705    else if aComponent is TCoolBar2 then
     706    begin
     707      tmpCoolBar2 := TCoolBar2(aComponent);
     708      for i := 0 to tmpCoolBar2.Sections.Count - 1 do
     709      begin
     710        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Item' + IntToStr(i)), tmpCoolBar2.Sections[i].Text);
     711        if '' <> tmpValue then tmpCoolBar2.Sections[i].Text := tmpValue;
     712      end;
     713    end
     714
     715    else if aComponent is TGroupBox then
     716    begin
     717      tmpGroupBox := TGroupBox(aComponent);
     718
     719      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Caption'), tmpGroupBox.Caption);
     720      if '' <> tmpValue then tmpGroupBox.Caption := tmpValue;
     721
     722      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Hint'), tmpGroupBox.Hint);
     723      if '' <> tmpValue then tmpGroupBox.Hint := tmpValue;
     724    end
     725
     726    else if aComponent is TMultiColumnListBox then
     727    begin
     728      tmpMultiColumnListBox := TMultiColumnListBox(aComponent);
     729
     730      for i := 0 to tmpMultiColumnListBox.HeaderColumns.Count - 1 do
     731      begin
     732        tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Column' + IntToStr(i)), tmpMultiColumnListBox.HeaderColumns[i].Text);
     733        if '' <> tmpValue then tmpMultiColumnListBox.HeaderColumns[i].Text := tmpValue;
     734      end;
     735    end
     736
     737    else if aComponent is TSystemOpenDialog then
     738    begin
     739      tmpSystemOpenDialog := TSystemOpenDialog(aComponent);
     740
     741      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'OKName'), tmpSystemOpenDialog.OKName);
     742      if '' <> tmpValue then tmpSystemOpenDialog.OKName := tmpValue;
     743
     744      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Title'), tmpSystemOpenDialog.Title);
     745      if '' <> tmpValue then tmpSystemOpenDialog.Title := tmpValue;
     746    end
     747
     748    else if aComponent is TSystemSaveDialog then
     749    begin
     750      tmpSystemSaveDialog := TSystemSaveDialog(aComponent);
     751
     752      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'OKName'), tmpSystemSaveDialog.OKName);
     753      if '' <> tmpValue then tmpSystemSaveDialog.OKName := tmpValue;
     754
     755      tmpValue := languageItems.getValue(UpperCase(tmpComponentPath + 'Title'), tmpSystemSaveDialog.Title);
     756      if '' <> tmpValue then tmpSystemSaveDialog.Title := tmpValue;
     757    end;
     758  end;
     759
     760
     761  procedure LoadLanguage(const aFilePath: String);
     762  var
     763    tmpNewLanguage: TLanguageFile;
     764  begin
     765    LogEvent(LogI18n, 'LoadLanguage(' + aFilePath + ')');
     766    try
     767      tmpNewLanguage := TLanguageFile.Create(aFilePath);
     768    except
     769      // TODO more log output
     770      exit;
     771    end;
     772
     773    ApplyLanguage(tmpNewLanguage);
     774  end;
     775
     776
     777  function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string) : boolean;
     778  var
     779    tmpFilePath: string;
     780    tmpFileName: string;
     781    tmpOSDir: string;
     782  begin
     783    // Filenames loaded will be <AppName>.<Language>.lng
     784    tmpFilename := anAppName + LANGUAGE_DELIMITER + aLanguageSpec + LANGUAGE_FILE_EXTENSION;
     785
     786    // eCS 1.1+ look in x:\ecs\lang
     787    tmpOSDir := GetEnv(LANGUAGE_ENVIRONMENT_VAR_OSDIR);
     788    if tmpOSDir <> '' then
     789    begin
     790      tmpFilePath := AddDirectorySeparator(tmpOSDir) + 'lang\' + tmpFileName;
     791      if FileExists(tmpFilePath) then
     792      begin
     793        LoadLanguage(tmpFilePath);
     794        result := true;
     795        exit;
     796      end;
     797    end;
     798
     799    // something or rather, maybe: look in %ULSPATH%
     800    if SearchPath(LANGUAGE_ENVIRONMENT_VAR_ULSPATH, tmpFilename, tmpFilepath ) then
     801    begin
     802      LoadLanguage(tmpFilePath);
    721803      result := true;
    722804      exit;
    723805    end;
    724   end;
    725 
    726   // something or rather, maybe: look in %ULSPATH%
    727   if SearchPath( 'ULSPATH',
    728                  Filename,
    729                  Filepath ) then
    730   begin
    731     LoadLanguage( FilePath );
    732     result := true;
    733     exit;
    734   end;
    735 
    736   // Standalone/compatibility: look in own dir
    737   FilePath := GetApplicationDir
    738               + Filename;
    739 
    740   if FileExists( FilePath ) then
    741   begin
    742     LoadLanguage( FilePath );
    743     result := true;
    744     exit;
    745   end;
    746 
    747   Result := false;
    748 end;
    749 
    750 Procedure LoadDefaultLanguage( const AppName: string );
    751 var
    752   LanguageVar: string;
    753   MajorLanguage: string;
    754   MinorLanguage: string;
    755   tmpParts : TStringList;
    756 
    757 begin
    758   LanguageVar := GetEnv( 'LANG' );
    759   LogEvent(LogI18n, 'LANG=' + LanguageVar);
    760 
    761   if LanguageVar = '' then
    762   begin
    763     LanguageVar := 'EN_US';
    764   end;
    765 
    766   tmpParts := TStringList.Create;
    767   StrExtractStrings(tmpParts, LanguageVar, ['_'], #0);
    768 
    769   MajorLanguage := '';
    770   if tmpParts.count > 0 then
    771   begin
    772     MajorLanguage := tmpParts[0];
    773   end;
    774 
    775   // note there might be some other stuff on the end of LANG
    776   // such as ES_ES_EURO...
    777 
    778   if tmpParts.count > 1 then
    779   begin
    780     MinorLanguage := tmpParts[1];
    781 
    782     LogEvent(LogI18n, 'try loading ' + MajorLanguage + '_' + MinorLanguage);
    783     if LoadAutoLanguage(AppName, MajorLanguage + '_' + MinorLanguage) then
    784     begin
    785       // found a specifc language
    786       LogEvent(LogI18n, ' translation for ' + MajorLanguage + '_' + MinorLanguage + ' sucessfully loaded');
     806
     807    // Standalone/compatibility: look in own dir
     808    tmpFilePath := GetApplicationDir + tmpFileName;
     809
     810    if FileExists(tmpFilePath) then
     811    begin
     812      LoadLanguage(tmpFilePath);
     813      result := true;
     814      exit;
     815    end;
     816
     817    result := false;
     818  end;
     819
     820
     821  Procedure LoadDefaultLanguage(const anAppName: string);
     822  var
     823    tmpLanguageVar: string;
     824    tmpMajorLanguage: string;
     825    tmpMinorLanguage: string;
     826    tmpParts : TStringList;
     827
     828  begin
     829    tmpLanguageVar := GetEnv(LANGUAGE_ENVIRONMENT_VAR_LANG);
     830    LogEvent(LogI18n, LANGUAGE_ENVIRONMENT_VAR_LANG + '=' + tmpLanguageVar);
     831
     832    if tmpLanguageVar = '' then
     833    begin
     834      tmpLanguageVar := DEFAULT_LANGUAGE;
     835    end;
     836
     837    tmpParts := TStringList.Create;
     838    StrExtractStrings(tmpParts, tmpLanguageVar, ['_'], #0);
     839
     840    tmpMajorLanguage := '';
     841    if tmpParts.count > 0 then
     842    begin
     843      tmpMajorLanguage := tmpParts[0];
     844    end;
     845
     846    // note there might be some other stuff on the end of LANG
     847    // such as ES_ES_EURO...
     848
     849    if tmpParts.count > 1 then
     850    begin
     851      tmpMinorLanguage := tmpParts[1];
     852
     853      LogEvent(LogI18n, 'try loading ' + tmpMajorLanguage + '_' + tmpMinorLanguage);
     854      if LoadLanguageForSpec(anAppName, tmpMajorLanguage + '_' + tmpMinorLanguage) then
     855      begin
     856        // found a specifc language
     857        LogEvent(LogI18n, ' translation for ' + tmpMajorLanguage + '_' + tmpMinorLanguage + ' sucessfully loaded');
     858        tmpParts.Destroy;
     859        exit;
     860      end;
     861    end;
     862
     863    // try generic language?
     864    LogEvent(LogI18n, 'try loading (major only) ' + tmpMajorLanguage);
     865    if LoadLanguageForSpec(anAppName, tmpMajorLanguage) then
     866    begin
     867      LogEvent(LogI18n, 'translation for ''' + tmpMajorLanguage + ''' sucessfully loaded');
    787868      tmpParts.Destroy;
    788869      exit;
    789870    end;
    790   end;
    791 
    792   // try generic language?
    793   LogEvent(LogI18n, 'try loading (major only) ' + MajorLanguage);
    794   if LoadAutoLanguage( AppName, MajorLanguage ) then
    795   begin
    796       LogEvent(LogI18n, 'translation for ' + MajorLanguage + 'sucessfully loaded');
    797       tmpParts.Destroy;
    798       exit;
    799   end;
    800 
    801   LogEvent(LogI18n, 'No language found, using default ' + MajorLanguage);
    802   LoadLanguage( '' );
    803 
    804   tmpParts.Destroy;
    805 end;
    806 
    807 
    808 Initialization
    809   g_LanguageCallbacks := nil;
    810   g_CurrentLanguageFile := nil;
    811 
    812 Finalization
    813   DestroyListAndObjects( g_LanguageCallbacks );
    814   if g_LanguageUpdateCallbacks <> nil then
    815     g_LanguageUpdateCallbacks.Destroy;
     871
     872    LogEvent(LogI18n, 'No language found, using default ' + tmpMajorLanguage);
     873    LoadLanguage('');
     874
     875    tmpParts.Destroy;
     876  end;
     877
     878
     879  Initialization
     880    g_LanguageCallbacks := nil;
     881    g_CurrentLanguageFile := nil;
     882    g_LanguageUpdateCallbacks := nil;
     883
     884
     885  Finalization
     886    DestroyListAndObjects(g_LanguageUpdateCallbacks);
     887    DestroyListAndObjects(g_LanguageCallbacks);
     888    if nil <> g_CurrentLanguageFile then g_CurrentLanguageFile.Destroy;
    816889
    817890End.
Note: See TracChangeset for help on using the changeset viewer.