diff --git a/src/createcatsrc.c b/src/createcatsrc.c index 44a89b6..46dae52 100644 --- a/src/createcatsrc.c +++ b/src/createcatsrc.c @@ -38,6 +38,7 @@ enum StringTypes TYPE_OBERON, /* Produce Oberon strings */ TYPE_E, /* Produce E strings. (Oops, thought it allows only 32 bit integers? ;-) */ + TYPE_PASCAL, /* Produce Pascal strings */ TYPE_NONE /* Simple strings */ }; @@ -94,6 +95,7 @@ int CalcRealLength(char *source) TYPE_ASSEMBLER create Assembler strings TYPE_OBERON create Oberon strings TYPE_E create E strings + TYPE_PASCAL create Pascal strings TYPE_NONE create simple strings */ void InitCatStringOutput(FILE *fp) @@ -111,6 +113,7 @@ void InitCatStringOutput(FILE *fp) break; case TYPE_E: + case TYPE_PASCAL: putc('\'', fp); case TYPE_ASSEMBLER: @@ -137,6 +140,7 @@ void SeparateCatStringOutput(void) break; case TYPE_E: + case TYPE_PASCAL: if(!LongStrings) { fputs("\' +\n\t\'", OutputFile); @@ -220,6 +224,11 @@ void WriteBinChar(int c) ++OutputLen; OutputMode = OutputMode_Bin; break; + case TYPE_PASCAL: + fprintf(OutputFile, "'#%d'", c); + ++OutputLen; + OutputMode = OutputMode_Bin; + break; case TYPE_ASSEMBLER: switch(OutputMode) @@ -271,6 +280,7 @@ void WriteAsciiChar(int c) break; case TYPE_E: + case TYPE_PASCAL: switch(c) { case '\'': @@ -332,6 +342,7 @@ void TerminateCatStringOutput(void) break; case TYPE_E: + case TYPE_PASCAL: putc('\'', OutputFile); break; @@ -530,6 +541,11 @@ void CreateSourceFile(char *SourceFile, char *TemplateFile, char *CDFile) OutputType = TYPE_E; ++currentline; } + else if(Strnicmp(currentline, "pascal", 6) == 0) + { + OutputType = TYPE_PASCAL; + currentline += 6; + } else if(Strnicmp(currentline, "none", 4) == 0) { OutputType = TYPE_NONE; diff --git a/src/sd/FPCUnit.sd b/src/sd/FPCUnit.sd new file mode 100644 index 0000000..8f5872c --- /dev/null +++ b/src/sd/FPCUnit.sd @@ -0,0 +1,101 @@ +##rem $Id$ +##shortstrings +##stringtype pascal +{$mode objfpc} +unit %blocale; + +interface + +{**************************************************************** + + This file was created automatically by '%fv' + from "%f0". + + Do NOT edit by hand! + +****************************************************************} + +uses + Exec, Locale, Utility; + +const + %i = %d;\n %i_STR = %s;\n + +procedure CloseCatalog; +procedure OpenCatalog(Loc: PLocale); +function GetLocString(Num: LongInt): STRPTR; + +implementation + +const + Builtinlanguage = %l; + Version = %v; + Catalog: PCatalog = NIL; + +type + TAppString = record + id: LongInt; + str: STRPTR; + end; + + TAppStringArray = array[0..%n] of TAppString; + +const + AppStrings: TAppStringArray = ( + (id: %i; str: %i_STR ), + (id: 0; str: '' ) + ); + +procedure CloseCatalog; +begin + if assigned(LocaleBase) and assigned(Catalog) then + begin + Locale.CloseCatalog(Catalog); + Catalog := nil; + end; +end; + +procedure OpenCatalog(loc: PLocale); +var + tags: array[0..7] of PtrUInt; +begin + CloseCatalog; + if not assigned(Catalog) and assigned(LocaleBase) then + begin + tags[0] := OC_BuiltInLanguage; + tags[1] := 0; //AsTag(PChar(builtinlanguage)); + tags[2] := OC_Version; + tags[3] := Version; + tags[4] := TAG_END; + + Catalog := Locale.OpenCatalogA(loc, PChar('%b.catalog'), @tags); + end; +end; + +function GetLocString(Num: LongInt): STRPTR; +var + i: LongInt; + Default: STRPTR; +begin + Default:=nil; + + for i := 0 to High(Appstrings)-1 do + begin + if AppStrings[i].id = Num then + begin + Default:=AppStrings[i].str; + break; + end; + end; + + if assigned(LocaleBase) then + GetLocString := Locale.GetCatalogStr(Catalog, Num, Default) + else + GetLocString := Default; +end; + +initialization + OpenCatalog(nil); +finalization + CloseCatalog; +end.