--- Merging r21867 into '.':

U    rtl/objpas/sysutils/filutilh.inc
U    rtl/objpas/sysutils/sysutils.inc
--- Merging r21962 into '.':
U    rtl/inc/objpas.inc
--- Merging r21969 into '.':
U    packages/fcl-base/src/fptemplate.pp
--- Merging r21977 into '.':
G    packages/fcl-base/src/fptemplate.pp
--- Merging r21982 into '.':
U    rtl/win/wininc/ascfun.inc
--- Merging r21990 into '.':
U    ide/fpmhelp.inc
U    ide/whtmlhlp.pas
--- Merging r22137 into '.':
U    packages/paszlib/src/zipper.pp

# revisions: 21867,21962,21969,21977,21982,21990,22137
r21867 | michael | 2012-07-11 12:42:23 +0200 (Wed, 11 Jul 2012) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/filutilh.inc
   M /trunk/rtl/objpas/sysutils/sysutils.inc

* Implemented overloaded variant of fileage function
r21962 | jonas | 2012-07-24 01:54:44 +0200 (Tue, 24 Jul 2012) | 3 lines
Changed paths:
   M /trunk/rtl/inc/objpas.inc

  * always decrease the refcount of the function result of helpers that return
    interfaces (since that may not have been done yet in case of an optimized
    assignment before r21955, and will never be done as of r21955)
r21969 | jonas | 2012-07-25 13:49:09 +0200 (Wed, 25 Jul 2012) | 5 lines
Changed paths:
   M /trunk/packages/fcl-base/src/fptemplate.pp

  * empty result of IntParseString() in case the input is empty, fixes double
    output lines in generated config files by fpcmkcfg such as mentioned in
    mantis #22505
r21977 | michael | 2012-07-27 13:41:44 +0200 (Fri, 27 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/fptemplate.pp

* Added ParseFiles
r21982 | florian | 2012-07-29 12:34:03 +0200 (Sun, 29 Jul 2012) | 1 line
Changed paths:
   M /trunk/rtl/win/wininc/ascfun.inc

+ patch by CA Gorski adding missing 'kernel32' strings
r21990 | mazen | 2012-07-31 12:37:03 +0200 (Tue, 31 Jul 2012) | 1 line
Changed paths:
   M /trunk/ide/fpmhelp.inc
   M /trunk/ide/whtmlhlp.pas

* Removed error thrown when trying to build help index if the documentation is installed on a read only file system and tries to store the index file in current directory. (Closes Debian bug#662814)
r22137 | michael | 2012-08-20 00:04:54 +0200 (Mon, 20 Aug 2012) | 1 line
Changed paths:
   M /trunk/packages/paszlib/src/zipper.pp

* Patch from Reinier Olieslagers to reinstate endoffile event

git-svn-id: branches/fixes_2_6@22533 -

ide/fpmhelp.inc

@@ -132,13 +132,48 @@ begin
 end;
 
 procedure THelpFilesDialog.HandleEvent(var Event: TEvent);
+  function StoreHtmlIndexFile(const FileName: string; LS: PFPHTMLFileLinkScanner;var Re: Word; SilentFails: Boolean): Boolean;
+  var
+    BS: PBufStream;
+  begin
+    if ExistsFile(FileName) then
+      if ConfirmBox(FormatStrStr(msg_filealreadyexistsoverwrite,FileName),nil,true)<>cmYes then
+        Re:=cmCancel;
+    if Re<>cmCancel then
+    begin
+      PushStatus(FormatStrStr(msg_storinghtmlindexinfile,FileName));
+      New(BS, Init(FileName, stCreate, 4096));
+      if Assigned(BS)=false then
+        begin
+          if not SilentFails then
+          begin
+            ErrorBox(FormatStrStr(msg_cantcreatefile,FileName),nil);
+          end;
+          Re:=cmCancel;
+        end
+      else
+        begin
+          LS^.StoreDocuments(BS^);
+          if BS^.Status<>stOK then
+            begin
+              if not SilentFails then
+              begin
+                ErrorBox(FormatStrInt(msg_errorstoringindexdata,BS^.Status),nil);
+              end;
+              Re:=cmCancel;
+            end;
+          Dispose(BS, Done);
+        end;
+      PopStatus;
+    end;
+  StoreHtmlIndexFile := Re <> cmCancel;
+  end;
 var I: integer;
     D: PFileDialog;
     FileName: string;
     Re: word;
     S: string;
     LS: PFPHTMLFileLinkScanner;
-    BS: PBufStream;
 begin
   case Event.What of
     evKeyDown :
@@ -193,30 +228,15 @@ begin
                     else
                       begin
                         FileName:=DirAndNameOf(FileName)+HTMLIndexExt;
-                        if ExistsFile(FileName) then
-                          if ConfirmBox(FormatStrStr(msg_filealreadyexistsoverwrite,FileName),nil,true)<>cmYes then
-                            Re:=cmCancel;
-                        if Re<>cmCancel then
+                        if not StoreHtmlIndexFile(FileName, LS, Re, True) then
                         begin
-                          PushStatus(FormatStrStr(msg_storinghtmlindexinfile,FileName));
-                          New(BS, Init(FileName, stCreate, 4096));
-                          if Assigned(BS)=false then
-                            begin
-                              ErrorBox(FormatStrStr(msg_cantcreatefile,FileName),nil);
-                              Re:=cmCancel;
-                            end
-                          else
-                            begin
-                              LS^.StoreDocuments(BS^);
-                              if BS^.Status<>stOK then
-                                begin
-                                  ErrorBox(FormatStrInt(msg_errorstoringindexdata,BS^.Status),nil);
-                                  Re:=cmCancel;
-                                end;
-                              Dispose(BS, Done);
-                            end;
-                          PopStatus;
-                        end;
+                          Re:=ConfirmBox(FormatStrStr('Could not create "%s", try creating it in local dir?', FileName),nil,true);
+                          FileName := GetCurDir + NameAndExtOf(FileName);
+                          if Re = cmYes then
+                          begin
+                            StoreHtmlIndexFile(FileName, LS, Re, False);
+                          end;
+                        end
                       end;
                     Dispose(LS, Done);
                     PopStatus;

ide/whtmlhlp.pas

@@ -1615,7 +1615,7 @@ begin
     OK:=Assigned(LS);
     if OK then
     begin
-      LS^.SetBaseDir(DirOf(IndexFileName));
+      {LS^.SetBaseDir(DirOf(IndexFileName)); already set by LoadDocuments to real base dire stored into htx file. This allows storing toc file in current dir in case doc installation dir is read only.}
       for I:=0 to LS^.GetDocumentCount-1 do
         begin
           TLI:=TopicLinks^.AddItem(LS^.GetDocumentURL(I));

packages/fcl-base/src/fptemplate.pp

@@ -78,6 +78,7 @@ Type
     Function ParseString(Src : String) : String;
     Function ParseStream(Src : TStream; Dest : TStream) : Integer; // Wrapper, Returns number of bytes written.
     Procedure ParseStrings(Src : TStrings; Dest : TStrings) ;      // Wrapper
+    Procedure ParseFiles(Const Src,Dest : String);
     Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;               // Called if not found in values  //used only when AllowTagParams = false
     Property OnReplaceTag : TReplaceTagEvent Read FOnReplaceTag Write FOnReplaceTag;       // Called if a tag found          //used only when AllowTagParams = true
     Property StartDelimiter : TParseDelimiter Index 1 Read GetDelimiter Write SetDelimiter;// Start char/string, default '}'
@@ -462,9 +463,9 @@ begin
   if FAllowTagParams then
   begin//template tags with parameters are allowed
     SLen:=Length(Src);
+    Result:='';
     If SLen=0 then
       exit;
-    Result:='';
     SP:=PChar(Src);
     P:=SP;
     While (P-SP<SLen) do
@@ -515,10 +516,10 @@ begin
     If FParseLevel>FMaxParseDepth then
       Raise ETemplateParser.CreateFmt(SErrParseDepthExceeded,[FMaxParseDepth]);
     SLen:=Length(Src); // Minimum
+    Result:='';
     If SLen=0 then
       exit;
 //    STLen:=Length(FStartDelimiter);
-    Result:='';
     SP:=PChar(Src);
     P:=SP;
     While (P-SP<SLen) do
@@ -592,6 +593,25 @@ begin
     Dest.Add(ParseString(Src[i]));
 end;
 
+procedure TTemplateParser.ParseFiles(const Src, Dest: String);
+
+Var
+  Fin,Fout : TFileStream;
+
+begin
+  Fin:=TFileStream.Create(Src,fmOpenRead or fmShareDenyWrite);
+  try
+    Fout:=TFileStream.Create(Dest,fmCreate);
+    try
+      ParseStream(Fin,Fout);
+    finally
+      Fout.Free;
+    end;
+  finally
+    Fin.Free;
+  end;
+end;
+
 { TFPCustomTemplate }
 
 procedure TFPCustomTemplate.GetParam(Sender: TObject; const ParamName: String; out AValue: String);

packages/paszlib/src/zipper.pp

@@ -1227,6 +1227,7 @@ Begin
     FreeAndNil(FInFile)
   else
     FinFile:=Nil;
+  DoEndOfFile;
 end;
 
 
@@ -1606,6 +1607,7 @@ Begin
   end
   else
     FreeAndNil(OutStream);
+  DoEndOfFile;
 end;
 
 

rtl/inc/objpas.inc

@@ -176,7 +176,11 @@
         tmpi2:=nil;
         if Assigned(S) and ((TObject(S).GetInterfaceWeak(IUnknown,tmpi2) and (IUnknown(tmpi2).QueryInterface(IID,tmpi)=S_OK)) or
             TObject(S).GetInterface(IID,tmpi)) then
-          pointer(fpc_class_cast_intf):=tmpi
+          begin
+            // decrease reference count
+            fpc_class_cast_intf:=nil;
+            pointer(fpc_class_cast_intf):=tmpi
+          end
         else
           fpc_class_cast_intf:=nil;
       end;
@@ -202,6 +206,8 @@
              tmpi:=nil;
              if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
                handleerror(219);
+             // decrease reference count
+             fpc_intf_as:=nil;
              pointer(fpc_intf_as):=tmpi;
           end
         else
@@ -235,6 +241,8 @@
              tmpi2:=nil;
              if not ((TObject(S).GetInterfaceWeak(IUnknown,tmpi2) and (IUnknown(tmpi2).QueryInterface(IID,tmpi)=S_OK)) or TObject(S).GetInterface(IID,tmpi)) then
                handleerror(219);
+             // decrease reference count
+             fpc_class_as_intf:=nil;
              pointer(fpc_class_as_intf):=tmpi;
           end
         else

rtl/objpas/sysutils/filutilh.inc

@@ -111,4 +111,4 @@ Function FileIsReadOnly(const FileName: String): Boolean;
 
 Function GetFileHandle(var f : File):THandle;
 Function GetFileHandle(var f : Text):THandle;
-
+function FileAge(const FileName: string; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;

rtl/objpas/sysutils/sysutils.inc

@@ -153,6 +153,25 @@
         temp.free;
       end;
 
+   function FileAge(const FileName: string; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
+   
+   Var
+     Info : TSearchRec;
+     A : Integer;
+      
+   begin
+     for A:=1 to Length(FileName) do
+       If (FileName[A] in ['?','*']) then
+         Exit(False);
+     A:=0;
+     if Not FollowLink then
+       A:=A or faSymLink;
+     Result:=FindFirst(FileName,A,Info)=0;
+     If Result then 
+       FileDateTime:=FileDatetoDateTime (Info.Time);
+     FindClose(Info);
+   end;
+
   { Interfaces support }
   {$i sysuintf.inc}
 
@@ -725,3 +744,4 @@ begin
   If Assigned(OnBeep) then
     OnBeep;
 end;
+

rtl/win/wininc/ascfun.inc

@@ -478,9 +478,9 @@ function CreateProcessAsUserA(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _par
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
 function CreateWaitableTimerA(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'CreateWaitableTimerA'; 
 function OpenWaitableTimerA(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'OpenWaitableTimerA'; 
-function FindFirstFileExA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExA';
+function FindFirstFileExA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external 'kernel32' name 'FindFirstFileExA';
 // winver>$0600
-function FindFirstFileTransactedA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedA';
+function FindFirstFileTransactedA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedA';
 
 {$endif read_interface}