* Reverted revision 30557

git-svn-id: trunk@30575 -

packages/fcl-base/Makefile.fpc

@@ -7,7 +7,7 @@ name=fcl-base
 version=3.1.1
 
 [require]
-packages=rtl fpmkunit
+packages=rtl fpmkunit rtl-objpas
 
 [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
-        Synchronize(@T.Timer);
+        Queue(@T.Timer);
       end
     else
       Terminate;  
@@ -268,8 +268,6 @@ 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,9 +170,11 @@ 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);
@@ -193,6 +195,7 @@ 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;
 
@@ -458,6 +461,7 @@ type
   private
     FFixedChar     : boolean;
     FTransliterate : Boolean;
+    FCharSetWidth  : Integer;
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
     function GetAsBoolean: Boolean; override;
@@ -487,6 +491,7 @@ 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,6 +33,7 @@ Constructor TFieldDef.Create(ACollection : TCollection);
 begin
   Inherited Create(ACollection);
   FFieldNo:=Index+1;
+  FCharSetWidth := 1;
 end;
 
 Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
@@ -48,6 +49,10 @@ begin
   FSize:=ASize;
   FRequired:=ARequired;
   FPrecision:=-1;
+  if (ADataType in [ftWideString,ftFixedWideChar,ftWideMemo]) then
+    FCharsetWidth:=2
+  else
+    FCharSetWidth := 1;
   FFieldNo:=AFieldNo;
 end;
 
@@ -71,6 +76,7 @@ begin
       Size := fd.Size;
       Precision := fd.Precision;
       FRequired := fd.Required;
+      FCharSetWidth:=fd.CharsetWidth
     finally
       Collection.EndUpdate;
     end;
@@ -112,6 +118,8 @@ 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;
@@ -124,6 +132,12 @@ begin
   Changed(False);
 end;
 
+procedure TFieldDef.SetCharSetWidth(AValue: Integer);
+begin
+  FCharSetWidth := AValue;
+  Changed(False);
+end;
+
 procedure TFieldDef.SetDataType(AValue: TFieldType);
 begin
   FDataType := AValue;
@@ -1046,6 +1060,10 @@ begin
   FFixedChar := False;
   FTransliterate := False;
   FSize:=20;
+  if Self is TWideStringField then
+    FCharsetWidth := 2
+  else
+    FCharSetWidth := 1;
 end;
 
 procedure TStringField.SetFieldType(AValue: TFieldType);
@@ -1125,7 +1143,7 @@ end;
 function TStringField.GetDefaultWidth: Longint;
 
 begin
-  result:=Size;
+  result:=Size div FCharSetWidth;
 end;
 
 Procedure TStringField.GetText(var AText: string; ADisplayText: Boolean);

packages/fcl-passrc/tests/testpassrc.lpi

@@ -99,6 +99,9 @@
   </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"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -31,7 +31,6 @@
     <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">
@@ -43,29 +42,27 @@
       <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="10"/>
+    <Version Value="11"/>
     <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"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -7,7 +7,6 @@
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
-        <Runnable Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -31,7 +30,6 @@
     <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">
@@ -43,7 +41,6 @@
       <Unit0>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="echo"/>
       </Unit0>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
@@ -55,20 +52,18 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <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="3">
+    <Exceptions Count="4">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -78,6 +73,9 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="EResNotFound"/>
+      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>

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

@@ -35,11 +35,15 @@ Var
   S : TStrings;
 
 begin
+
   S:=TStringList.Create;
   try
+    S.Add('<HTML><HEAD><TITLE>Echo demo</TITLE></HEAD><BODY>');
     // Analyze request.
-    DumpRequest(ARequest,S);
-
+    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>');
     AResponse.Contents:=S;
     Handled:=True;
   finally

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

@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -13,7 +13,6 @@
       <Title Value="Simple HTTP server demo"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -32,7 +31,6 @@
     <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">
@@ -44,7 +42,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <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"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="7"/>
+    <Version Value="9"/>
     <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 Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -33,31 +33,33 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="1">
+    <Units Count="3">
       <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="8"/>
+    <Version Value="11"/>
     <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
-  { you can add units after this };
+  Classes, SysUtils, CustApp, inifiles, process, httpdefs, custcgi, cgiprotocol,
+  httpprotocol;
 
 type
 

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

@@ -106,8 +106,41 @@ procedure GetFormatSettings(out fmts: TFormatSettings);
   end;
 
   function GetLocaleChar(item: cint): char;
+  var
+    p: PChar;
   begin
-    GetLocaleChar := nl_langinfo(item)^;
+    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;
   end;
 
   function SkipModifiers(const s: string; var i: integer): string;

rtl/objpas/sysutils/dati.inc

@@ -61,13 +61,8 @@ 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"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -47,18 +47,12 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <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,8 +19,6 @@
     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}
@@ -48,18 +46,21 @@ 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;
@@ -83,6 +84,7 @@ const
   FPCDate: String = {$I %FPCDATE%};
 
 var
+  UseComments,
   WriteDeclaration,
   UpdateMode,
   SortNodes,
@@ -94,7 +96,7 @@ var
   DisablePrivate,
   DisableFunctionResults: Boolean;
   EmitClassSeparator: Boolean;
-  
+  MaxShortDescrLen : Integer = 60;
   
 Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
 
@@ -192,6 +194,8 @@ 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.
@@ -213,10 +217,11 @@ 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;
 
@@ -242,7 +247,10 @@ Function TSkelEngine.WriteElement(Var F : Text;El : TPasElement; ADocNode : TDoc
             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);
@@ -271,10 +279,15 @@ begin
     Writeln(F,'     Declaration: ',El.GetDeclaration(True),' -->');
     end;
   WriteLn(f,'<element name="', El.FullName, '">');
-  WriteLn(f, '<short></short>');
+  L:=Length(El.DocComment);
+  if NeedComments and (l>0) and (L<=MaxShortDescrLen) then
+    D:=MakeXml(El.DocComment);
+  WriteLn(f, '<short>',D,'</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
@@ -307,6 +320,12 @@ 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
@@ -411,6 +430,7 @@ begin
         begin
         Engine := TSkelEngine.Create;
         Try
+          Engine.NeedComments:=UseComments;
           Engine.SetPackageName(APackageName);
           if UpdateMode then
             For J:=0 to DescrFiles.Count-1 do
@@ -490,6 +510,8 @@ 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,6 +18,7 @@ Const
   ADeprecatedConst = 1 deprecated;
    
 Type
+  // an enumerated type  
   TAnEnumType         = (one,two,three);
   TASetType           = Set of TAnEnumType;
   TAnArrayType        = Array[1..10] of Integer;