[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [tyndur-devel] [PATCH 1/3] Pascal-RTL: Unterstuetzung fuer mehrsprachige Programme
On Sun, Sep 27, 2009 at 01:30:47AM +0200, Antoine Kaufmann wrote:
> On Sat, Sep 26 16:35, Kevin Wolf wrote:
> > + Pascal-RTL: Unit multilang
> >
> > Signed-off-by: Kevin Wolf <kevin@xxxxxxxxxx>
> > ---
> > src/modules/pas/include/tms.h | 48 +++++++++
> > src/modules/pas/lib/tyndur/Makefile.all | 1 +
> > src/modules/pas/lib/tyndur/multilang.pas | 166 ++++++++++++++++++++++++++++++
> > 3 files changed, 215 insertions(+), 0 deletions(-)
> > create mode 100644 src/modules/pas/include/tms.h
> > create mode 100644 src/modules/pas/lib/tyndur/multilang.pas
> >
> > diff --git a/src/modules/pas/include/tms.h b/src/modules/pas/include/tms.h
> > new file mode 100644
> > index 0000000..c7a6823
> > --- /dev/null
> > +++ b/src/modules/pas/include/tms.h
> > @@ -0,0 +1,48 @@
> > +/*
> > + * Copyright (c) 2009 The tyndur Project. All rights reserved.
> > + *
> > + * This code is derived from software contributed to the tyndur Project
> > + * by Kevin Wolf.
> > + *
> > + * Redistribution and use in source and binary forms, with or without
> > + * modification, are permitted provided that the following conditions
> > + * are met:
> > + * 1. Redistributions of source code must retain the above copyright
> > + * notice, this list of conditions and the following disclaimer.
> > + * 2. Redistributions in binary form must reproduce the above copyright
> > + * notice, this list of conditions and the following disclaimer in the
> > + * documentation and/or other materials provided with the distribution.
> > + *
> > + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
> > + * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
> > + * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
> > + * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
> > + * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
> > + * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
> > + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
> > + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
> > + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
> > + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
> > + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
> > + */
> > +
> > +#ifndef _TMS_H_
> > +#define _TMS_H_
> > +
> > +struct tms_strings {
> > + void* resstr;
> > + char* translation;
> > +} __attribute__((packed));
> > +
> > +struct tms_lang {
> > + char* lang;
> > + int numbers;
> > + int (*get_number)(int);
> > +
> > + const struct tms_strings* strings;
> > +};
> > +
> > +#define LANGUAGE(x) \
> > + static const void* __attribute__((section("tmslang"), used)) __lang = (x);
> > +
> > +#endif
> > diff --git a/src/modules/pas/lib/tyndur/Makefile.all b/src/modules/pas/lib/tyndur/Makefile.all
> > index aacb99c..9ca455a 100644
> > --- a/src/modules/pas/lib/tyndur/Makefile.all
> > +++ b/src/modules/pas/lib/tyndur/Makefile.all
> > @@ -1 +1,2 @@
> > cp libptyndur.a tyndur.ppu ../units
> > +cp libpmultilang.a multilang.ppu ../units
> > diff --git a/src/modules/pas/lib/tyndur/multilang.pas b/src/modules/pas/lib/tyndur/multilang.pas
> > new file mode 100644
> > index 0000000..112e2ba
> > --- /dev/null
> > +++ b/src/modules/pas/lib/tyndur/multilang.pas
> > @@ -0,0 +1,166 @@
> > +unit multilang;
> > +{$MODE ObjFPC}
> > +{$H+}
> > +
> > +interface
> > +
> > + type
> > + TLanguage = Pointer;
> > +
> > + function NumLanguages: integer;
> > + function GetLanguage(name: String): TLanguage;
> > + function GetLanguageById(id: integer): TLanguage;
> > + function GetLanguageName(lang: TLanguage): String;
> > + procedure SetLanguage(lang: TLanguage);
> > +
> > + function FormatNum(const fmt: String; const args: array of const): String;
> > +
> > +implementation
> > +
> > + uses sysutils;
> > +
> > + type
> > + tres = packed record
> > + name: AnsiString;
> > + value: AnsiString;
> > + end;
> > +
> > + tms_dict = packed record
> > + resstr: ^tres;
> > + translation: PChar;
> > + end;
> > + ptms_dict = ^tms_dict;
> > +
> > + type
> > + TGetNumber = function(n: integer): integer; cdecl;
> > + TLanguageData = record
> > + lang: PChar;
> > + numbers: integer;
> > + get_number: TGetNumber;
> > + strings: ptms_dict;
> > + end;
> > + PLanguage = ^TLanguageData;
> > + PPLanguage = ^PLanguage;
> > +
> > + var
> > + lang: PPLanguage;
> > + num_lang: integer;
> > + cur_lang: PLanguage;
> > +
> > +
> > + function LoadTranslation(name, value: AnsiString; Hash: Longint; arg: Pointer): AnsiString;
> > + var
> > + dict: ptms_dict;
> > + i: integer;
> > + begin
> > + dict := arg;
> > + i := 0;
> > + while dict[i].resstr <> nil do begin
> > + if Pointer(name) = Pointer(dict[i].resstr^.name) then begin
> > + exit(dict[i].translation);
> > + end;
> > + Inc(i);
> > + end;
> > +
> > + exit(value);
> > + end;
> > +
> > + function NumLanguages: integer;
> > + begin
> > + exit(num_lang);
> > + end;
> > +
> > + function GetLanguage(name: String): TLanguage;
> > + var
> > + i: integer;
> > + begin
> > + for i := 0 to num_lang - 1 do begin
> > + if lang[i]^.lang = name then begin
> > + exit(lang[i]);
> > + end;
> > + end;
> > +
> > + exit(nil);
> > + end;
> > +
> > + function GetLanguageById(id: integer): TLanguage;
> > + begin
> > + exit(lang[id]);
> > + end;
> > +
> > + function GetLanguageName(lang: TLanguage): String;
> > + var
> > + ldata: PLanguage;
> > + begin
> > + ldata := lang;
> > + exit(ldata^.lang);
> > + end;
> > +
> > + procedure SetLanguage(lang: TLanguage);
> > + begin
> > + cur_lang := lang;
> > + SetResourceStrings(@LoadTranslation, cur_lang^.strings);
> > + end;
> > +
> > + function FormatNum(const fmt: String; const args: array of const): String;
> > + var
> > + s: String;
> > + i, j, outi: integer;
> > + num, value, number: integer;
> > + colon: integer;
> > + begin
> > + s := '';
> > + SetLength(s, Length(fmt));
> > +
> > + outi := 1;
> > + i := 1;
> > + while i <= Length(fmt) do begin
> > + if (fmt[i] = '%') and (fmt[i + 1] = '[') then begin
> > +
> > + // Nummer des Arguments bestimmen
> > + colon := Pos(':', PChar(@fmt[i + 2]));
> > + num := StrToInt(Copy(fmt, i + 2, colon - 1));
>
> Hm ich glaube wenn da der Formatstring kaputt ist dürfte das rot geben,
> oder? Also ohne Doppelpunkt. Ich glaube an Fehlerbehandlung fehlt da
> weiter unten auch noch ein Bisschen was.
Wir sind hier doch nicht in C ;-)
Pos gibt 0 zurück, weil kein Doppelpunkt, damit baut Copy einen leeren
String und StrToInt wirft einen EConvertError. Was eigentlich gar nicht
so doof ist.
Gefährlich wird es eigentlich immer nur, wenn da was von PChar steht.
Aber die Stellen müssten eigentlich alle gut sein. Läuft halt ein
bisschen auf Garbage In, Garbage Out raus...
>
> > + value := args[num].VInteger;
> > + number := cur_lang^.get_number(value);
> > +
> > + // Start-Doppelpunkt finden
> > + Inc(i, 2 + colon);
> > + for j := 1 to cur_lang^.get_number(value) do begin
> > + colon := Pos(':', PChar(@fmt[i]));
> > + Inc(i, colon);
> > + end;
> > +
> > + // Wort kopieren
> > + if number = cur_lang^.numbers - 1 then begin
> > + colon := Pos(']', PChar(@fmt[i]));
> > + end else begin
> > + colon := Pos(':', PChar(@fmt[i]));
> > + end;
> > + Move(fmt[i], s[outi], colon - 1);
> > + Inc(outi, colon - 1);
> > +
> > + // Ende des Ausdrucks suchen
> > + Inc(i, Pos(']', PChar(@fmt[i])));
> > + end else begin
> > + s[outi] := fmt[i];
> > + Inc(outi);
> > + Inc(i);
> > + end;
> > + end;
> > +
> > + SetLength(s, outi - 1);
> > + exit(Format(s, args));
> > + end;
> > +
> > +
> > +var
> > + tmslang_start: PLanguage; external name '__start_tmslang';
> > + tmslang_end: PLanguage; external name '__stop_tmslang';
> > +
> > +initialization
> > +
> > + lang := @tmslang_start;
> > + num_lang := PPLanguage(@tmslang_end) - PPLanguage(@tmslang_start);
> > +
> > +end.
> > +
>
> Das ist zwar wirres Zeug, aber ich glaube so irgendwie mit etwas Glück
> könnte das schon funktionieren. ;-)
>
> --
> Antoine Kaufmann
> <toni@xxxxxxxxxxxxxxxx>
> _______________________________________________
> tyndur-devel mailing list
> tyndur-devel@xxxxxxxxxx
> http://list.tyndur.org/mailman/listinfo/tyndur-devel