[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 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.

> +                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>

Attachment: pgpxdcrIxheQY.pgp
Description: PGP signature