* Reverted revision 30575 (forgor -depth=immediate

git-svn-id: trunk@30576 -

packages/fcl-base/Makefile.fpc

@@ -7,7 +7,7 @@ name=fcl-base
 version=3.1.1
 
 [require]
-packages=rtl fpmkunit rtl-objpas
+packages=rtl fpmkunit
 
 [install]
 fpcpackage=y

packages/fcl-base/src/fptimer.pp

@@ -238,7 +238,7 @@ begin
       until (SleepTime<=0) or Terminated;
       T:=Timer;
       If Assigned(T) and not terminated then
-        Queue(@T.Timer);
+        Synchronize(@T.Timer);
       end
     else
       Terminate;  
@@ -268,6 +268,8 @@ begin
   FThread.FTimerDriver:=Nil;
   FThread.Terminate; // Will free itself.
   CheckSynchronize; // make sure thread is not stuck at synchronize call.
+  If Assigned(FThread) then
+    Fthread.WaitFor;  
 end;
 
 

packages/fcl-db/src/base/db.pas

@@ -170,11 +170,9 @@ type
     FPrecision : Longint;
     FRequired : Boolean;
     FSize : Integer;
-    FCharSetWidth: Integer;
     FAttributes : TFieldAttributes;
     Function GetFieldClass : TFieldClass;
     procedure SetAttributes(AValue: TFieldAttributes);
-    procedure SetCharSetWidth(AValue: Integer);
     procedure SetDataType(AValue: TFieldType);
     procedure SetPrecision(const AValue: Longint);
     procedure SetSize(const AValue: Integer);
@@ -195,7 +193,6 @@ type
     property DataType: TFieldType read FDataType write SetDataType;
     property Precision: Longint read FPrecision write SetPrecision;
     property Size: Integer read FSize write SetSize;
-    property CharSetWidth: Integer read FCharSetWidth write SetCharSetWidth default 1;
   end;
   TFieldDefClass = Class of TFieldDef;
 
@@ -461,7 +458,6 @@ type
   private
     FFixedChar     : boolean;
     FTransliterate : Boolean;
-    FCharSetWidth  : Integer;
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
     function GetAsBoolean: Boolean; override;
@@ -491,7 +487,6 @@ type
   published
     property EditMask;
     property Size default 20;
-    property CharSetWidth: Integer read FCharSetWidth write FCharSetWidth default 1;
   end;
 
 { TWideStringField }

packages/fcl-db/src/base/fields.inc

@@ -33,7 +33,6 @@ Constructor TFieldDef.Create(ACollection : TCollection);
 begin
   Inherited Create(ACollection);
   FFieldNo:=Index+1;
-  FCharSetWidth := 1;
 end;
 
 Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
@@ -49,10 +48,6 @@ begin
   FSize:=ASize;
   FRequired:=ARequired;
   FPrecision:=-1;
-  if (ADataType in [ftWideString,ftFixedWideChar,ftWideMemo]) then
-    FCharsetWidth:=2
-  else
-    FCharSetWidth := 1;
   FFieldNo:=AFieldNo;
 end;
 
@@ -76,7 +71,6 @@ begin
       Size := fd.Size;
       Precision := fd.Precision;
       FRequired := fd.Required;
-      FCharSetWidth:=fd.CharsetWidth
     finally
       Collection.EndUpdate;
     end;
@@ -118,8 +112,6 @@ begin
       TBCDField(Result).Precision:=FPrecision;
     if (Result is TFmtBCDField) then
       TFmtBCDField(Result).Precision:=FPrecision;
-    if Result is TStringField then
-      TStringField(Result).CharSetWidth := FCharSetWidth;
   except
     Result.Free;
     Raise;
@@ -132,12 +124,6 @@ begin
   Changed(False);
 end;
 
-procedure TFieldDef.SetCharSetWidth(AValue: Integer);
-begin
-  FCharSetWidth := AValue;
-  Changed(False);
-end;
-
 procedure TFieldDef.SetDataType(AValue: TFieldType);
 begin
   FDataType := AValue;
@@ -1060,10 +1046,6 @@ begin
   FFixedChar := False;
   FTransliterate := False;
   FSize:=20;
-  if Self is TWideStringField then
-    FCharsetWidth := 2
-  else
-    FCharSetWidth := 1;
 end;
 
 procedure TStringField.SetFieldType(AValue: TFieldType);
@@ -1143,7 +1125,7 @@ end;
 function TStringField.GetDefaultWidth: Longint;
 
 begin
-  result:=Size div FCharSetWidth;
+  result:=Size;
 end;
 
 Procedure TStringField.GetText(var AText: string; ADisplayText: Boolean);

packages/fcl-passrc/tests/testpassrc.lpi

@@ -99,9 +99,6 @@
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
-    <Target>
-      <Filename Value="testpassrc"/>
-    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="../src"/>

packages/fcl-web/examples/echo/cgi/echo.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="UTF-8"?>
+<?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -31,6 +31,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -42,27 +43,29 @@
       <Unit0>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="echo"/>
       </Unit0>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="EchoModule"/>
-        <HasResources Value="True"/>
         <ResourceBaseClass Value="DataModule"/>
         <UnitName Value="wmecho"/>
       </Unit1>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="11"/>
+    <Version Value="10"/>
     <PathDelim Value="\"/>
-    <Target>
-      <Filename Value="echo.cgi" ApplyConventions="False"/>
-    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\webmodule"/>
     </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-web/examples/echo/fcgi/echo.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="UTF-8"?>
+<?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -7,6 +7,7 @@
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
+        <Runnable Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -30,6 +31,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -41,6 +43,7 @@
       <Unit0>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="echo"/>
       </Unit0>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
@@ -52,18 +55,20 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="11"/>
+    <Version Value="10"/>
     <PathDelim Value="\"/>
-    <Target>
-      <Filename Value="echo.fcgi"/>
-    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\webmodule"/>
     </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="4">
+    <Exceptions Count="3">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -73,9 +78,6 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
-      <Item4>
-        <Name Value="EResNotFound"/>
-      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>

packages/fcl-web/examples/echo/webmodule/wmecho.pas

@@ -35,15 +35,11 @@ Var
   S : TStrings;
 
 begin
-
   S:=TStringList.Create;
   try
-    S.Add('<HTML><HEAD><TITLE>Echo demo</TITLE></HEAD><BODY>');
     // Analyze request.
-    DumpRequest(ARequest,S,True);
-    S.Add('<H1>Extra headers (may or may not be passed):</H1>');
-    S.Add('Do not track header (DNT):  '+ARequest.GetCustomHeader('DNT'));
-    S.Add('</BODY></HTML>');
+    DumpRequest(ARequest,S);
+
     AResponse.Contents:=S;
     Handled:=True;
   finally

packages/fcl-web/examples/httpserver/simplehttpserver.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="UTF-8"?>
+<?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -13,6 +13,7 @@
       <Title Value="Simple HTTP server demo"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -31,6 +32,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <Units Count="1">
@@ -42,7 +44,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="11"/>
+    <Version Value="10"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
     </SearchPaths>

packages/fcl-web/examples/httpserver/simplehttpserver.pas

@@ -2,7 +2,7 @@ program simplehttpserver;
 
 {$mode objfpc}{$H+}
 {$define UseCThreads}
-{$linklib pthread}
+
 uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,

packages/fcl-web/tests/testcgiapp.lpi

@@ -1,26 +1,26 @@
-<?xml version="1.0" encoding="UTF-8"?>
+<?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="7"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
       <Title Value="CGI Test environment"/>
       <ResourceType Value="res"/>
+      <Icon Value="0"/>
     </General>
     <VersionInfo>
       <Language Value=""/>
       <CharSet Value=""/>
-      <StringTable ProductVersion=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
     </VersionInfo>
-    <BuildModes Count="1">
-      <Item1 Name="default" Default="True"/>
-    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -33,33 +33,31 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="3">
+    <Units Count="1">
       <Unit0>
         <Filename Value="testcgiapp.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="testcgiapp"/>
       </Unit0>
-      <Unit1>
-        <Filename Value="../src/base/cgiprotocol.pp"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="cgiprotocol"/>
-      </Unit1>
-      <Unit2>
-        <Filename Value="../src/base/httpprotocol.pp"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="httpprotocol"/>
-      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="11"/>
+    <Version Value="8"/>
     <Target>
       <Filename Value="testcgiapp"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-web/tests/testcgiapp.pp

@@ -3,8 +3,8 @@ program testcgiapp;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, SysUtils, CustApp, inifiles, process, httpdefs, custcgi, cgiprotocol,
-  httpprotocol;
+  Classes, SysUtils, CustApp, inifiles, process, httpdefs,custcgi
+  { you can add units after this };
 
 type
 

packages/rtl-extra/src/unix/clocale.pp

@@ -106,41 +106,8 @@ procedure GetFormatSettings(out fmts: TFormatSettings);
   end;
 
   function GetLocaleChar(item: cint): char;
-  var
-    p: PChar;
   begin
-    p := nl_langinfo(item);
-    Result := p^;
-    if (ord(Result)>127) and (DefaultSystemCodePage=CP_UTF8) then begin
-      Result := #0;
-      case p^ of
-      #$C2:
-        case p[1] of
-        #$A0: Result:=' '; // non breakable space
-        #$B7: Result:='.'; // middle stop
-        end;
-      #$CB:
-        if p[1]=#$99 then Result:=''''; // dot above, italian handwriting
-      #$D9:
-        case p[1] of
-        #$AB: Result:=','; // arabic decimal separator, persian thousand separator
-        #$AC: Result:=''''; // arabic thousand separator
-        end;
-      #$E2:
-        case p[1] of
-        #$80:
-          case p[2] of
-          #$82, // long space
-          #$83, // long space
-          #$89, // thin space
-          #$AF: // narrow non breakable space
-            Result := ' ';
-          #$94: Result := '-'; // persian decimal mark
-          end;
-        #$8E: if p[2]=#$96 then Result := ''''; // codepoint 9110 decimal separator
-        end;
-      end;
-    end;
+    GetLocaleChar := nl_langinfo(item)^;
   end;
 
   function SkipModifiers(const s: string; var i: integer): string;

rtl/objpas/sysutils/dati.inc

@@ -61,8 +61,13 @@ begin
     D:=D-0.5
   else
     D:=D+0.5;
-  result.Time := Abs(Trunc(D)) Mod MSecsPerDay;
+  Result.Time := Abs(Trunc(D)) Mod MSecsPerDay;
   result.Date := DateDelta + Trunc(D) div MSecsPerDay;
+  if D<0 then
+    begin
+    Result.Time:=MSecsPerDay-Result.time;
+    Result.Date:=Result.Date-1;
+    end;
 end;
 
 {   TimeStampToDateTime converts TimeStamp to a TDateTime value   }

utils/fpdoc/dglobals.pp

@@ -23,7 +23,7 @@ unit dGlobals;
 
 interface
 
-uses Classes, DOM, PasTree, PParser, StrUtils, uriparser;
+uses Classes, DOM, PasTree, PParser, StrUtils,uriparser;
 
 Const
   CacheSize = 20;

utils/fpdoc/makeskel.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="UTF-8"?>
+<?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -47,12 +47,18 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="11"/>
+    <Version Value="10"/>
     <Parsing>
       <SyntaxOptions>
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">

utils/fpdoc/makeskel.pp

@@ -19,6 +19,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 
+
+{%RunCommand $MakeExe($(EdFile)) --package=fpvectorial --input=/home/felipe/Programas/fpctrunk/packages/fpvectorial/src/fpvectorial.pas}
 program MakeSkel;
 
 {$mode objfpc}
@@ -46,21 +48,18 @@ type
   Private
     FEl : TPasElement;
     FNode : TDocNode;
-  Public
+  Public  
     Constructor Create(AnElement : TPasElement; ADocNode : TDocNode);
     Property Element : TPasElement Read FEl;
     Property DocNode : TDocNode Read FNode;
   end;
 
-  { TSkelEngine }
-
   TSkelEngine = class(TFPDocEngine)
   Private
     FEmittedList, 
     FNodeList,
     FModules : TStringList;
     Procedure  DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
-    Function MakeXML(S : String) : String;
   public
     Destructor Destroy; override;
     Function MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
@@ -84,7 +83,6 @@ const
   FPCDate: String = {$I %FPCDATE%};
 
 var
-  UseComments,
   WriteDeclaration,
   UpdateMode,
   SortNodes,
@@ -96,7 +94,7 @@ var
   DisablePrivate,
   DisableFunctionResults: Boolean;
   EmitClassSeparator: Boolean;
-  MaxShortDescrLen : Integer = 60;
+  
   
 Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
 
@@ -194,8 +192,6 @@ Var
 begin
   Result := AClass.Create(AName, AParent);
   Result.Visibility:=AVisibility;
-  if NeedComments and assigned(CurrentParser) then
-    Result.DocComment:=CurrentParser.SavedComments;
   // Let function/procedure arguments and function results
   // inherit visibility from their parents if visDefault visibility is
   // specified.
@@ -217,11 +213,10 @@ begin
     DN:=Nil;  
   // See if we need to write documentation for it
   If MustWriteElement(Result,False) then
-    FNodeList.AddObject(Result.PathName,TNodePair.Create(Result,DN))
+    FNodeList.AddObject(Result.PathName,TNodePair.Create(Result,DN));
 end;
 
-Function TSkelEngine.WriteElement(Var F: Text; El: TPasElement;
-  ADocNode: TDocNode): Boolean;
+Function TSkelEngine.WriteElement(Var F : Text;El : TPasElement; ADocNode : TDocNode) : Boolean;
 
   Function WriteOnlyShort(APasElement : TPasElement) : Boolean;
 
@@ -247,10 +242,7 @@ Function TSkelEngine.WriteElement(Var F: Text; El: TPasElement;
             or WriteOnlyShort(El) 
             or EL.InheritsFrom(TPasProcedure) 
   end;
-
-Var
-  l : Integer;
-  D : string;
+    
 begin
   // Check again, this time with full declaration.
   Result:=MustWriteElement(El,True);
@@ -279,15 +271,10 @@ begin
     Writeln(F,'     Declaration: ',El.GetDeclaration(True),' -->');
     end;
   WriteLn(f,'<element name="', El.FullName, '">');
-  L:=Length(El.DocComment);
-  if NeedComments and (l>0) and (L<=MaxShortDescrLen) then
-    D:=MakeXml(El.DocComment);
-  WriteLn(f, '<short>',D,'</short>');
+  WriteLn(f, '<short></short>');
   if Not WriteOnlyShort(El) then
     begin
     WriteLn(f, '<descr>');
-    if NeedComments and (l>0) and (L>MaxShortDescrLen) then
-      Writeln(F,MakeXml(El.DocComment));
     WriteLn(f, '</descr>');
     if not (DisableErrors or IsTypeVarConst(El)) then
       begin
@@ -320,12 +307,6 @@ begin
     end;
 end;
 
-Function TSkelEngine.MakeXML(S: String): String;
-begin
-  Result:=StringReplace(s,'>','&gt;',[rfReplaceAll]);
-  Result:=StringReplace(Result,'<','&lt;',[rfReplaceAll]);
-end;
-
 procedure TSkelEngine.WriteUnReferencedNodes;
 
 begin
@@ -430,7 +411,6 @@ begin
         begin
         Engine := TSkelEngine.Create;
         Try
-          Engine.NeedComments:=UseComments;
           Engine.SetPackageName(APackageName);
           if UpdateMode then
             For J:=0 to DescrFiles.Count-1 do
@@ -510,8 +490,6 @@ var
 begin
   if (s = '-h') or (s = '--help') then
     CmdLineAction := actionHelp
-  else if s = '--use-comments' then
-    UseComments:=True
   else if s = '--update' then
     UpdateMode := True
   else if s = '--disable-arguments' then

utils/fpdoc/testunit.pp

@@ -18,7 +18,6 @@ Const
   ADeprecatedConst = 1 deprecated;
    
 Type
-  // an enumerated type  
   TAnEnumType         = (one,two,three);
   TASetType           = Set of TAnEnumType;
   TAnArrayType        = Array[1..10] of Integer;