Pascal string type for FlexCat and FPC Unit descriptor

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;

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.