--- Merging r13753 into '.':

U    rtl/win/systhrd.inc
--- Merging r13771 into '.':
 U   tests/test/packages/fcl-db/tdb4.pp
 U   packages/objcrtl/fpmake.pp
--- Merging r13793 into '.':
U    packages/fcl-net/src/servlets.pp
--- Merging r13823 into '.':
U    utils/h2pas/h2pas.pas
U    utils/h2pas/h2pas.y
--- Merging r13849 into '.':
U    packages/libxml/src/xmlxsd.pas
--- Merging r13850 into '.':
U    packages/fcl-web/src/httpdefs.pp
--- Merging r13855 into '.':
U    packages/fcl-db/src/datadict/fpddfb.pp
--- Merging r13879 into '.':
U    tests/test/packages/win-base/tdispvar1.pp
--- Merging r13897 into '.':
U    packages/fcl-db/src/codegen/fpcgtiopf.pp
U    packages/fcl-db/src/codegen/fpddcodegen.pp
--- Merging r13905 into '.':
U    packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc
--- Merging r13907 into '.':
U    packages/postgres/src/postgres3dyn.pp
--- Merging r13939 into '.':
U    rtl/objpas/classes/writer.inc
--- Merging r14115 into '.':
G    rtl/objpas/classes/writer.inc

# revisions: 13753,13771,13793,13823,13849,13850,13855,13879,13897,13905,13907,13939,14115
------------------------------------------------------------------------
r13753 | michael | 2009-09-21 11:34:53 +0200 (Mon, 21 Sep 2009) | 1 line
Changed paths:
   M /trunk/rtl/win/systhrd.inc

* Added comment in SysRelocateThreadVar, not working in Windows Vista
------------------------------------------------------------------------
------------------------------------------------------------------------
r13771 | mazen | 2009-09-28 13:25:25 +0200 (Mon, 28 Sep 2009) | 2 lines
Changed paths:
   M /trunk/packages/objcrtl/fpmake.pp
   M /trunk/tests/test/packages/fcl-db/tdb4.pp

* Source coude don't need to be executable (removes Debian lintian error).

------------------------------------------------------------------------
------------------------------------------------------------------------
r13793 | jonas | 2009-10-02 15:42:30 +0200 (Fri, 02 Oct 2009) | 3 lines
Changed paths:
   M /trunk/packages/fcl-net/src/servlets.pp

  * made FPathInfo field of TServletRequest  protected instead of private,
    because it's exposed by a property in a derived class

------------------------------------------------------------------------
------------------------------------------------------------------------
r13823 | florian | 2009-10-09 14:57:50 +0200 (Fri, 09 Oct 2009) | 1 line
Changed paths:
   M /trunk/utils/h2pas/h2pas.pas
   M /trunk/utils/h2pas/h2pas.y

* output style more like the coding style fpc sources commonly are using
------------------------------------------------------------------------
------------------------------------------------------------------------
r13849 | ivost | 2009-10-12 12:15:04 +0200 (Mon, 12 Oct 2009) | 2 lines
Changed paths:
   M /trunk/packages/libxml/src/xmlxsd.pas

* fixed bug in timezone to string conversion

------------------------------------------------------------------------
------------------------------------------------------------------------
r13850 | joost | 2009-10-12 16:41:05 +0200 (Mon, 12 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/httpdefs.pp

 * Added THTTPHeader.HTTPXRequestedWith property
------------------------------------------------------------------------
------------------------------------------------------------------------
r13855 | michael | 2009-10-13 20:56:49 +0200 (Tue, 13 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/datadict/fpddfb.pp

* Position keeps increasing in firebird, but can have missing positions when a field is dropped
------------------------------------------------------------------------
------------------------------------------------------------------------
r13879 | pierre | 2009-10-17 09:27:23 +0200 (Sat, 17 Oct 2009) | 1 line
Changed paths:
   M /trunk/tests/test/packages/win-base/tdispvar1.pp

 * fix problem if OpenOffice is not installed
------------------------------------------------------------------------
------------------------------------------------------------------------
r13897 | michael | 2009-10-17 16:05:11 +0200 (Sat, 17 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/codegen/fpcgtiopf.pp
   M /trunk/packages/fcl-db/src/codegen/fpddcodegen.pp

* Patch from Graeme Geldenhuys to fix some minor issues in code generation (bug ID 13779)
------------------------------------------------------------------------
------------------------------------------------------------------------
r13905 | marco | 2009-10-17 23:12:34 +0200 (Sat, 17 Oct 2009) | 2 lines
Changed paths:
   M /trunk/packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc

 * patch from 14800, check for interface not null assertion

------------------------------------------------------------------------
------------------------------------------------------------------------
r13907 | marco | 2009-10-18 12:56:08 +0200 (Sun, 18 Oct 2009) | 2 lines
Changed paths:
   M /trunk/packages/postgres/src/postgres3dyn.pp

 * pqsetdb was not exported in -dyn variant Mantis #14430

------------------------------------------------------------------------
------------------------------------------------------------------------
r13939 | michael | 2009-10-24 14:34:26 +0200 (Sat, 24 Oct 2009) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/writer.inc

* Patch from Mattias Gaertner to fix property overrides. (bug ID 14885)
------------------------------------------------------------------------
------------------------------------------------------------------------
r14115 | marco | 2009-11-08 15:21:03 +0100 (Sun, 08 Nov 2009) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/classes/writer.inc

 * non-resolved methods are not written. Mantis 13846(laz) / 14798(fpc) 

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14670 -

packages/fcl-db/src/codegen/fpcgtiopf.pp

@@ -340,7 +340,7 @@ begin
   EndMethod(Strings,S);
   // AcceptVisitor
   S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
-  AddLn(Strings,'Result:=Result and (Visited.ObjectState in [posCreate,posdelete,posUpdate]);');
+  AddLn(Strings,'Result:=Result and (Visited.ObjectState in [posCreate,posDelete,posUpdate]);');
   DecIndent;
   EndMethod(Strings,S);
   S:=BeginSetupParams(Strings,C,ObjectClassName,True);
@@ -431,7 +431,7 @@ begin
   // Common setup case
   If (V in [voCreate,voUpdate]) and (UseCommonSetupParams) then
     A:=Format('TUpdateCreate%sVisitor',[StripType(ObjectClassName)])
-  else If (V in [voCreate,voDelete,voUpdate,voCommonSetupParams]) then
+  else If (V in [voCreate,voDelete,voUpdate,voCommonSetupParams,voSingleSaveVisitor]) then
     A:='TtiVisitorUpdate'
   else
     A:='TtiVisitorSelect';
@@ -1226,7 +1226,7 @@ begin
 end;
 
 Initialization
-  RegisterCodeGenerator('tiOPF','tiOPF class and visitors for the data',TTiOPFCodeGenerator);
+  RegisterCodeGenerator('tiOPF','tiOPF classes and hard-coded visitors for the data',TTiOPFCodeGenerator);
 
 Finalization
   UnRegisterCodeGenerator(TTiOPFCodeGenerator);

packages/fcl-db/src/codegen/fpddcodegen.pp

@@ -1279,6 +1279,8 @@ begin
     begin
     Addln(Strings,'Unit '+CodeOptions.UnitName+';');
     Addln(Strings);
+    Addln(Strings, '{$mode objfpc}{$H+}');
+    Addln(Strings);
     Addln(Strings,'Interface');
     Addln(Strings);
     S:=GetInterfaceUsesClause;

packages/fcl-db/src/datadict/fpddfb.pp

@@ -459,7 +459,7 @@ Var
 
   {Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
 
-  function ImportFieldDef : boolean;
+  function ImportFieldDef(APosition : Integer) : boolean;
   var FD : TDDFieldDef;
       n, s : string;
   begin
@@ -497,7 +497,7 @@ Var
         FD.Required:=false
     else
       FD.Required:=false;
-    FD.index := FPosition.AsInteger;
+    FD.index := APosition;
     s := trim(FDomainName.asstring);
     if copy(s, 1, 4) <> 'RDB$' then
       FD.DomainName := s
@@ -513,7 +513,7 @@ Var
     BindFields;
     while not Q.eof do
       begin
-      if ImportFieldDef then
+      if ImportFieldDef(Result) then
         inc (result);
       Q.Next;
       end;

packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc

@@ -16,6 +16,7 @@
     class procedure CheckNull(obj: IUnknown; msg: string = ''); overload;
     class procedure CheckNull(obj: TObject; msg: string = ''); overload;
     class procedure CheckNotNull(obj: TObject; msg: string = ''); overload;
+    class procedure CheckNotNull(obj: IUnknown; msg: string = ''); overload; virtual;
     class procedure CheckIs(obj :TObject; pClass: TClass; msg: string = ''); overload;
     class procedure CheckSame(expected, actual: TObject; msg: string = ''); overload;
     class procedure FailNotEquals(expected, actual: string; msg: string = ''; errorAddr: Pointer = nil); virtual;
@@ -120,6 +121,11 @@ begin
   AssertNotNull(msg, obj);
 end;
 
+class procedure TAssert.CheckNotNull(obj: IUnknown; msg: string);
+begin
+  AssertNotNullIntf(msg, obj);
+end;
+
 class procedure TAssert.CheckIs(obj: TObject; pClass: TClass; msg: string);
 begin
   Assert(pClass <> nil);

packages/fcl-net/src/servlets.pp

@@ -35,8 +35,10 @@ type
   TServletRequest = class
   private
     FInputStream: TStream;
-    FScheme, FPathInfo: String;
+    FScheme: String;
   protected
+    FPathInfo: String;
+
     function GetContentLength: Integer; virtual; abstract;
     function GetContentType: String; virtual; abstract;
     function GetProtocol: String; virtual; abstract;

packages/fcl-web/src/httpdefs.pp

@@ -171,7 +171,8 @@ type
   private
     FContentFields: TStrings;
     FCookieFields: TStrings;
-    FHTTPVersion : String;
+    FHTTPVersion: String;
+    FHTTPXRequestedWith: String;
     FFields : THttpFields;
     FQueryFields: TStrings;
     function GetSetField(AIndex: Integer): String;
@@ -249,6 +250,7 @@ type
     Property Query : String Index 33 read GetFieldValue Write SetFieldValue;
     Property Host : String Index 34 Read GetFieldValue Write SetFieldValue;
     Property Content : String Index 35 Read GetFieldValue Write SetFieldValue;
+    Property HTTPXRequestedWith : String Index 36 read GetFieldValue Write SetFieldValue;
     // Lists
     Property CookieFields : TStrings Read FCookieFields Write SetCookieFields;
     Property ContentFields: TStrings read FContentFields;
@@ -604,6 +606,7 @@ begin
   else
     case Index of
       0  : Result:=FHTTPVersion;
+      36 : Result:=FHTTPXRequestedWith;
     else
       Result := '';
     end;
@@ -633,6 +636,7 @@ begin
       28 : ; // Property RemoteHost : String Index 28 read  GetFieldValue Write SetFieldValue;
       29 : ; // Property ScriptName : String Index 29 read  GetFieldValue Write SetFieldValue;
       30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30
+      36 : FHTTPXRequestedWith:=Value;
     end;
 end;
 

packages/libxml/src/xmlxsd.pas

@@ -363,7 +363,9 @@ begin
       tzUser:
         begin
           if Timezone^.Hour >= 0 then
-            Result := Result + '+';
+            Result := Result + '+'
+          else
+            Result := Result + '-';
           Result := Result + Format('%2.2d:%2.2u', [Timezone^.Hour, Timezone^.Minute]);
         end;
     end;
@@ -390,7 +392,9 @@ begin
       tzUser:
         begin
           if Timezone^.Hour >= 0 then
-            Result := Result + '+';
+            Result := Result + '+'
+          else
+            Result := Result + '-';
           Result := Result + Format('%2.2d:%2.2u', [Timezone^.Hour, Timezone^.Minute]);
         end;
     end;

packages/objcrtl/fpmake.pp

@@ -212,6 +212,8 @@ var
 Procedure InitialisePostgres3;
 Procedure ReleasePostgres3;
 
+function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
+
 var Postgres3LibraryHandle : TLibHandle;
 
 implementation

rtl/objpas/classes/writer.inc

@@ -953,7 +953,7 @@ begin
         if (not Handled) and
           (MethodValue.Code <> DefMethodValue.Code) and
           ((not Assigned(MethodValue.Code)) or
-          ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
+          ((Length(FLookupRoot.MethodName(MethodValue.Code)) > 0))) then
         begin
           Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
           if Assigned(MethodValue.Code) then
@@ -1040,11 +1040,14 @@ begin
              (ObjValue is TComponent) then
           begin
             //writeln('TWriter.WriteProperty AncestorObj=',TComponent(AncestorObj).Name,' OwnerFit=',TComponent(AncestorObj).Owner = FRootAncestor,' ',TComponent(ObjValue).Name,' OwnerFit=',TComponent(ObjValue).Owner = Root);
-            if (TComponent(AncestorObj).Owner <> FRootAncestor) or
-             (TComponent(ObjValue).Owner <> Root) or
-             (UpperCase(TComponent(AncestorObj).Name) <> UpperCase(TComponent(ObjValue).Name)) then
+            if (AncestorObj<> ObjValue) and
+             (TComponent(AncestorObj).Owner = FRootAncestor) and
+             (TComponent(ObjValue).Owner = Root) and
+             (UpperCase(TComponent(AncestorObj).Name) = UpperCase(TComponent(ObjValue).Name)) then
             begin
-              AncestorObj := nil;
+              // different components, but with the same name
+              // treat it like an override
+              AncestorObj := ObjValue;
             end;
           end;
         end else

rtl/win/systhrd.inc

@@ -107,7 +107,8 @@ CONST
       begin	    
 {$ifdef dummy}
         { it least in the on windows 7 x64, this still doesn't not work, fs:(0x2c) is
-          self referencing on this system (FK) }
+          self referencing on this system (FK) 
+          MVC: It also does not work on Windows Vista 32-bit, Home Premium, SP 1. Results in a crash}
         asm
           movl TLSKey,%edx
           movl %fs:(0x2c),%eax

tests/test/packages/fcl-db/tdb4.pp

@@ -12,10 +12,21 @@ uses
 var StarOffice : Variant;
 	Document : Variant;
 
-function TSampleCode_Connect() : boolean;
+function TSampleCode_Connect(OleName : string) : boolean;
 begin
     if  VarIsEmpty(StarOffice) then
-        StarOffice := CreateOleObject('com.sun.star.ServiceManager');
+      begin
+        try
+          Writeln('Trying to connect to ',OleName);
+          StarOffice := CreateOleObject(OleName);
+        except
+          on e : exception do
+            begin
+              StarOffice:=Unassigned;
+              Writeln('Connection to ',OleName,' failed: ',e.message);
+            end;
+          end;
+      end;
 
     Result := not (VarIsEmpty(StarOffice) or VarIsNull(StarOffice));
 end;
@@ -61,7 +72,18 @@ begin
 end;
 
 begin
-	CoInitialize(nil);
-	TSampleCode_Connect();
-        TSampleCode_CreateDocument(false);
+  CoInitialize(nil);
+  if TSampleCode_Connect('com.sun.star.ServiceManager') then
+    begin
+      if TSampleCode_CreateDocument(false) then
+        Document.Close(false);
+
+    end;
+  StarOffice:=Unassigned;
+  if TSampleCode_Connect('com.sun.star.ServiceManager.NonExisting.Variant.Just.To.Test') then
+    begin
+      if TSampleCode_CreateDocument(false) then
+        Document.Close(false);
+    end;
+  CoUnInitialize;
 end.

utils/h2pas/h2pas.pas

@@ -319,7 +319,7 @@ program h2pas;
          flag_index:=0;
          writeln(outfile);
          writeln(outfile,aktspace,'const');
-         shift(3);
+         shift(2);
          while not eof(tempfile) do
            begin
               readln(tempfile,line);
@@ -362,7 +362,7 @@ program h2pas;
                         write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
                         writeln(implemfile,';');
                         writeln(implemfile,aktspace,'begin');
-                        shift(3);
+                        shift(2);
                         write(implemfile,aktspace,name,':=(a.flag',flag_index);
                         writeln(implemfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
                         popshift;
@@ -385,7 +385,7 @@ program h2pas;
                         write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
                         writeln(implemfile,');');
                         writeln(implemfile,aktspace,'begin');
-                        shift(3);
+                        shift(2);
                         write(implemfile,aktspace,'a.flag',flag_index,':=');
                         write(implemfile,'a.flag',flag_index,' or ');
                         writeln(implemfile,'((__',name,' shl bp_',ph,'_',name,') and bm_',ph,'_',name,');');
@@ -563,8 +563,6 @@ program h2pas;
                end;
              t_funcname :
                begin
-                  if not compactmode then
-                   shift(2);
                   if if_nb>0 then
                     begin
                        writeln(outfile,aktspace,'var');
@@ -581,7 +579,7 @@ program h2pas;
                        if_nb:=0;
                     end;
                   writeln(outfile,aktspace,'begin');
-                  shift(3);
+                  shift(2);
                   write(outfile,aktspace);
                   write_all_ifexpr(outfile,p^.p2);
                   write_expr(outfile,p^.p1);
@@ -1059,7 +1057,7 @@ program h2pas;
                         writeln(outfile,'packed record')
                       else
                         writeln(outfile,'record');
-                      shift(3);
+                      shift(2);
                       hp1:=p^.p1;
 
                       (* walk through all members *)
@@ -1192,7 +1190,7 @@ program h2pas;
                         writeln(outfile,'record');
                       shift(2);
                       writeln(outfile,aktspace,'case longint of');
-                      shift(3);
+                      shift(2);
                       l:=0;
                       hp1:=p^.p1;
 
@@ -1623,7 +1621,7 @@ begin
          end;
          block_type:=bt_var;
          
-         shift(3);
+         shift(2);
          
          IsExtern:=assigned(yyv[yysp-4])and(yyv[yysp-4]^.str='extern');
          (* walk through all declarations *)
@@ -1807,7 +1805,7 @@ begin
          end;
          block_type:=bt_var;
          
-         shift(3);
+         shift(2);
          
          IsExtern:=assigned(yyv[yysp-5])and(yyv[yysp-5]^.str='extern');
          (* walk through all declarations *)
@@ -1849,7 +1847,7 @@ begin
          writeln(outfile,aktspace,'type');
          block_type:=bt_type;
          end;
-         shift(3);
+         shift(2);
          if ( yyv[yysp-1]^.p2  <> nil ) then
          begin
          (* write new type name *)
@@ -1905,7 +1903,7 @@ begin
          TN:=TypeName(yyv[yysp-1]^.p);
          if Uppercase(tn)<>Uppercase(pn) then
          begin
-         shift(3);
+         shift(2);
          writeln(outfile,aktspace,PN,' = ',TN,';');
          popshift;
          end;
@@ -1926,7 +1924,7 @@ begin
          block_type:=bt_type;
          end;
          no_pop:=assigned(yyv[yysp-7]) and (yyv[yysp-7]^.str='no_pop');
-         shift(3);
+         shift(2);
          (* walk through all declarations *)
          hp:=yyv[yysp-6];
          if assigned(hp) then
@@ -1974,7 +1972,7 @@ begin
          else
          writeln(outfile);
          no_pop:=assigned(yyv[yysp-2]) and (yyv[yysp-2]^.str='no_pop');
-         shift(3);
+         shift(2);
          (* Get the name to write the type definition for, try
          to use the tag name first *)
          if assigned(yyv[yysp-3]^.p2) then
@@ -2051,7 +2049,7 @@ begin
          end
          else
          writeln(outfile);
-         shift(3);
+         shift(2);
          (* write as pointer *)
          writeln(outfile,'(* generic typedef  *)');
          writeln(outfile,aktspace,yyv[yysp-1]^.p,' = pointer;');
@@ -2090,6 +2088,9 @@ begin
          writeln(implemfile,aktspace,'{ return type might be wrong }   ');
          end;
          end;
+         if block_type<>bt_func then
+         writeln(outfile);
+         
          block_type:=bt_func;
          write(outfile,aktspace,'function ',yyv[yysp-5]^.p);
          write(implemfile,aktspace,'function ',yyv[yysp-5]^.p);
@@ -2158,11 +2159,12 @@ begin
          begin
          if block_type<>bt_const then
          begin
+         if block_type<>bt_func then
          writeln(outfile);
          writeln(outfile,aktspace,'const');
          end;
          block_type:=bt_const;
-         shift(3);
+         shift(2);
          write(outfile,aktspace,yyv[yysp-3]^.p);
          write(outfile,' = ');
          flush(outfile);
@@ -2176,6 +2178,8 @@ begin
          end
          else
          begin
+         if block_type<>bt_func then
+         writeln(outfile);
          if not stripinfo then
          begin
          writeln (outfile,aktspace,'{ was #define dname def_expr }');
@@ -2187,11 +2191,9 @@ begin
          shift(2);
          if not assigned(yyv[yysp-1]^.p3) then
          begin
-         writeln(outfile,' : longint;');
-         writeln(outfile,aktspace,'  { return type might be wrong }');
+         writeln(outfile,' : longint; { return type might be wrong }');
          flush(outfile);
-         writeln(implemfile,' : longint;');
-         writeln(implemfile,aktspace,'  { return type might be wrong }');
+         writeln(implemfile,' : longint; { return type might be wrong }');
          end
          else
          begin

utils/h2pas/h2pas.y

@@ -315,7 +315,7 @@ program h2pas;
          flag_index:=0;
          writeln(outfile);
          writeln(outfile,aktspace,'const');
-         shift(3);
+         shift(2);
          while not eof(tempfile) do
            begin
               readln(tempfile,line);
@@ -358,7 +358,7 @@ program h2pas;
                         write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
                         writeln(implemfile,';');
                         writeln(implemfile,aktspace,'begin');
-                        shift(3);
+                        shift(2);
                         write(implemfile,aktspace,name,':=(a.flag',flag_index);
                         writeln(implemfile,' and bm_',ph,'_',name,') shr bp_',ph,'_',name,';');
                         popshift;
@@ -381,7 +381,7 @@ program h2pas;
                         write_p_a_def(implemfile,hp3^.p1^.p1,hp2^.p1);
                         writeln(implemfile,');');
                         writeln(implemfile,aktspace,'begin');
-                        shift(3);
+                        shift(2);
                         write(implemfile,aktspace,'a.flag',flag_index,':=');
                         write(implemfile,'a.flag',flag_index,' or ');
                         writeln(implemfile,'((__',name,' shl bp_',ph,'_',name,') and bm_',ph,'_',name,');');
@@ -559,8 +559,6 @@ program h2pas;
                end;
              t_funcname :
                begin
-                  if not compactmode then
-                   shift(2);
                   if if_nb>0 then
                     begin
                        writeln(outfile,aktspace,'var');
@@ -577,7 +575,7 @@ program h2pas;
                        if_nb:=0;
                     end;
                   writeln(outfile,aktspace,'begin');
-                  shift(3);
+                  shift(2);
                   write(outfile,aktspace);
                   write_all_ifexpr(outfile,p^.p2);
                   write_expr(outfile,p^.p1);
@@ -1055,7 +1053,7 @@ program h2pas;
                         writeln(outfile,'packed record')
                       else
                         writeln(outfile,'record');
-                      shift(3);
+                      shift(2);
                       hp1:=p^.p1;
 
                       (* walk through all members *)
@@ -1188,7 +1186,7 @@ program h2pas;
                         writeln(outfile,'record');
                       shift(2);
                       writeln(outfile,aktspace,'case longint of');
-                      shift(3);
+                      shift(2);
                       l:=0;
                       hp1:=p^.p1;
 
@@ -1545,7 +1543,7 @@ declaration :
                end;
              block_type:=bt_var;
 
-             shift(3);
+             shift(2);
 
              IsExtern:=assigned($1)and($1^.str='extern');
              (* walk through all declarations *)
@@ -1728,7 +1726,7 @@ declaration :
                end;
              block_type:=bt_var;
 
-             shift(3);
+             shift(2);
 
              IsExtern:=assigned($1)and($1^.str='extern');
              (* walk through all declarations *)
@@ -1769,7 +1767,7 @@ declaration :
             writeln(outfile,aktspace,'type');
             block_type:=bt_type;
          end;
-       shift(3);
+       shift(2);
        if ( yyv[yysp-1]^.p2  <> nil ) then
          begin
            (* write new type name *)
@@ -1824,7 +1822,7 @@ declaration :
        TN:=TypeName($4^.p);
        if Uppercase(tn)<>Uppercase(pn) then
         begin
-          shift(3);
+          shift(2);
           writeln(outfile,aktspace,PN,' = ',TN,';');
           popshift;
         end;
@@ -1844,7 +1842,7 @@ declaration :
             block_type:=bt_type;
          end;
        no_pop:=assigned($4) and ($4^.str='no_pop');
-       shift(3);
+       shift(2);
        (* walk through all declarations *)
        hp:=$5;
        if assigned(hp) then
@@ -1891,7 +1889,7 @@ declaration :
        else
          writeln(outfile);
        no_pop:=assigned($3) and ($3^.str='no_pop');
-       shift(3);
+       shift(2);
        (* Get the name to write the type definition for, try
           to use the tag name first *)
        if assigned($2^.p2) then
@@ -1967,7 +1965,7 @@ declaration :
          end
        else
          writeln(outfile);
-       shift(3);
+       shift(2);
        (* write as pointer *)
        writeln(outfile,'(* generic typedef  *)');
        writeln(outfile,aktspace,$2^.p,' = pointer;');
@@ -2007,6 +2005,9 @@ define_dec :
              writeln(implemfile,aktspace,'{ return type might be wrong }   ');
            end;
         end;
+       if block_type<>bt_func then
+         writeln(outfile);
+
        block_type:=bt_func;
        write(outfile,aktspace,'function ',$2^.p);
        write(implemfile,aktspace,'function ',$2^.p);
@@ -2072,11 +2073,12 @@ define_dec :
          begin
             if block_type<>bt_const then
               begin
-                 writeln(outfile);
-                 writeln(outfile,aktspace,'const');
+                if block_type<>bt_func then
+                  writeln(outfile);
+                writeln(outfile,aktspace,'const');
               end;
             block_type:=bt_const;
-            shift(3);
+            shift(2);
             write(outfile,aktspace,$2^.p);
             write(outfile,' = ');
             flush(outfile);
@@ -2090,6 +2092,8 @@ define_dec :
          end
        else
          begin
+            if block_type<>bt_func then
+              writeln(outfile);
             if not stripinfo then
              begin
                writeln (outfile,aktspace,'{ was #define dname def_expr }');
@@ -2101,11 +2105,9 @@ define_dec :
             shift(2);
             if not assigned($4^.p3) then
               begin
-                 writeln(outfile,' : longint;');
-                 writeln(outfile,aktspace,'  { return type might be wrong }');
+                 writeln(outfile,' : longint; { return type might be wrong }');
                  flush(outfile);
-                 writeln(implemfile,' : longint;');
-                 writeln(implemfile,aktspace,'  { return type might be wrong }');
+                 writeln(implemfile,' : longint; { return type might be wrong }');
               end
             else
               begin