--- Merging r13962 into '.':

U    rtl/inc/objpash.inc
--- Merging r13963 into '.':
U    packages/fcl-image/src/fpreadjpeg.pas
U    packages/pasjpeg/src/jmemnobs.pas
--- Merging r13965 into '.':
U    utils/fpdoc/dwlinear.pp
--- Merging r13967 into '.':
U    packages/imagemagick/src/imagemagick.pas
U    packages/imagemagick/src/magick_wand.pas
U    packages/imagemagick/src/pixel.inc
U    packages/imagemagick/src/pixel_wand.inc
A    packages/imagemagick/src/cache.inc
A    packages/imagemagick/examples/wandpixelaccess.pas
U    packages/imagemagick/examples/image.png
U    packages/imagemagick/examples/wanddemo.lpr
--- Merging r13974 into '.':
U    rtl/objpas/rtlconst.inc
--- Merging r13975 into '.':
U    rtl/inc/dynlibs.pas
--- Merging r13979 into '.':
G    rtl/inc/dynlibs.pas
--- Merging r13986 into '.':
U    rtl/darwin/Makefile.fpc
U    rtl/darwin/Makefile
--- Merging r13970 into '.':
U    packages/fcl-db/src/base/dbconst.pas
--- Merging r13995 into '.':
G    rtl/inc/dynlibs.pas
--- Merging r14000 into '.':
U    packages/fcl-process/src/unix/process.inc
--- Merging r14002 into '.':
U    rtl/unix/cthreads.pp
--- Merging r14007 into '.':
A    utils/rmwait
A    utils/rmwait/Makefile.fpc
A    utils/rmwait/rmwait.pas
--- Merging r14011 into '.':
U    packages/paszlib/src/gzio.pas
--- Merging r14012 into '.':
G    packages/paszlib/src/gzio.pas

# revisions: 13962,13963,13965,13967,13974,13975,13979,13986,13970,13995,14000,14002,14007,14011,14012
------------------------------------------------------------------------
r13962 | florian | 2009-10-28 20:22:29 +0100 (Wed, 28 Oct 2009) | 2 lines
Changed paths:
   M /trunk/rtl/inc/objpash.inc

+ make TObject.Dispatch and DispatchStr virtual, patch by Paul Ishenin, resolves #14920

------------------------------------------------------------------------
------------------------------------------------------------------------
r13963 | michael | 2009-10-29 16:31:44 +0100 (Thu, 29 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/fpreadjpeg.pas
   M /trunk/packages/pasjpeg/src/jmemnobs.pas

* Applied patch from José Mejuto to fix reading of progressive JPEGs
------------------------------------------------------------------------
------------------------------------------------------------------------
r13965 | michael | 2009-10-29 16:48:14 +0100 (Thu, 29 Oct 2009) | 1 line
Changed paths:
   M /trunk/utils/fpdoc/dwlinear.pp

* Small patch from Graeme to fix ordering (bug ID 14917)
------------------------------------------------------------------------
------------------------------------------------------------------------
r13967 | sekelsenmat | 2009-10-29 18:16:38 +0100 (Thu, 29 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/imagemagick/examples/image.png
   M /trunk/packages/imagemagick/examples/wanddemo.lpr
   A /trunk/packages/imagemagick/examples/wandpixelaccess.pas
   A /trunk/packages/imagemagick/src/cache.inc
   M /trunk/packages/imagemagick/src/imagemagick.pas
   M /trunk/packages/imagemagick/src/magick_wand.pas
   M /trunk/packages/imagemagick/src/pixel.inc
   M /trunk/packages/imagemagick/src/pixel_wand.inc

imagemagick: Adds a pixel access demo and updates some parts to newer imagemagick
------------------------------------------------------------------------
------------------------------------------------------------------------
r13974 | ivost | 2009-10-30 14:10:31 +0100 (Fri, 30 Oct 2009) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/rtlconst.inc

* added 3 new resources strings to describe library errors

------------------------------------------------------------------------
------------------------------------------------------------------------
r13975 | ivost | 2009-10-30 14:16:13 +0100 (Fri, 30 Oct 2009) | 3 lines
Changed paths:
   M /trunk/rtl/inc/dynlibs.pas

* added some highlevel helper functions to load/unload dynamic libraries.
* initialize/release calls are refcounted. On loading, requested symbols are checked.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13979 | ivost | 2009-10-30 14:42:49 +0100 (Fri, 30 Oct 2009) | 2 lines
Changed paths:
   M /trunk/rtl/inc/dynlibs.pas

* symbols are cleared now after unloading the library (ClearLibrarySymbols)

------------------------------------------------------------------------
------------------------------------------------------------------------
r13986 | jonas | 2009-10-31 11:11:00 +0100 (Sat, 31 Oct 2009) | 3 lines
Changed paths:
   M /trunk/rtl/darwin/Makefile
   M /trunk/rtl/darwin/Makefile.fpc

  * fixed Darwin compilation after r13975 (dynlibs now depends on sysconst,
    rtlconsts and sysutils)

------------------------------------------------------------------------
------------------------------------------------------------------------
r13970 | joost | 2009-10-30 07:53:46 +0100 (Fri, 30 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/dbconst.pas

 * Forgot to commit file, fixed compilation
------------------------------------------------------------------------
------------------------------------------------------------------------
r13995 | ivost | 2009-11-01 12:28:17 +0100 (Sun, 01 Nov 2009) | 2 lines
Changed paths:
   M /trunk/rtl/inc/dynlibs.pas

* lib handler: default libraries can be changed now

------------------------------------------------------------------------
------------------------------------------------------------------------
r14000 | jonas | 2009-11-01 15:53:45 +0100 (Sun, 01 Nov 2009) | 3 lines
Changed paths:
   M /trunk/packages/fcl-process/src/unix/process.inc

  * use "open" rather than xterm for poNewConsole on Darwin (patch by
    Dmitry Boyarintsev, fixes mantis #14957)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14002 | jonas | 2009-11-01 16:41:29 +0100 (Sun, 01 Nov 2009) | 2 lines
Changed paths:
   M /trunk/rtl/unix/cthreads.pp

  * return errors from unimplemented functions instead of random values

------------------------------------------------------------------------
------------------------------------------------------------------------
r14007 | hajny | 2009-11-01 22:33:07 +0100 (Sun, 01 Nov 2009) | 1 line
Changed paths:
   A /trunk/utils/rmwait
   A /trunk/utils/rmwait/Makefile.fpc
   A /trunk/utils/rmwait/rmwait.pas

  + enhanced clone of GNU rm, helper for building GO32v2 releases under WinXP, but possibly useful in some other cases too
------------------------------------------------------------------------
------------------------------------------------------------------------
r14011 | marco | 2009-11-02 22:53:07 +0100 (Mon, 02 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/paszlib/src/gzio.pas

 * add "append" mode, fixes 14420

------------------------------------------------------------------------
------------------------------------------------------------------------
r14012 | marco | 2009-11-02 22:58:37 +0100 (Mon, 02 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/paszlib/src/gzio.pas

 * rearranged the append/rewrite slightly

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

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

.gitattributes

@@ -2828,8 +2828,10 @@ packages/imagemagick/examples/image.png -text svneol=unset#image/png
 packages/imagemagick/examples/screenshot.lpr svneol=native#text/plain
 packages/imagemagick/examples/wanddemo.dpr svneol=native#text/plain
 packages/imagemagick/examples/wanddemo.lpr svneol=native#text/plain
+packages/imagemagick/examples/wandpixelaccess.pas svneol=native#text/plain
 packages/imagemagick/fpmake.pp svneol=native#text/plain
 packages/imagemagick/src/buildim.pp svneol=native#text/plain
+packages/imagemagick/src/cache.inc svneol=native#text/plain
 packages/imagemagick/src/cache_view.inc svneol=native#text/plain
 packages/imagemagick/src/compare.inc svneol=native#text/plain
 packages/imagemagick/src/constitute.inc svneol=native#text/plain
@@ -10541,6 +10543,8 @@ utils/ppdep.pp svneol=native#text/plain
 utils/ptop.pp svneol=native#text/plain
 utils/ptopu.pp svneol=native#text/plain
 utils/rmcvsdir.pp svneol=native#text/plain
+utils/rmwait/Makefile.fpc svneol=native#text/plain
+utils/rmwait/rmwait.pas svneol=native#text/plain
 utils/rstconv.pp svneol=native#text/plain
 utils/sim_pasc/Answers svneol=native#text/plain
 utils/sim_pasc/ChangeLog svneol=native#text/plain

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

@@ -95,6 +95,7 @@ Resourcestring
   SMaxIndexes              = 'The maximum amount of indexes is reached';
   SMinIndexes              = 'The minimum amount of indexes is 1';
   STooManyFields           = 'More fields specified then really exist';
+  SNullParamNotAllowed     = 'The parameter ''%s'' does not allow null-values';
 // These are added for Delphi-compatilility, but not used by the fcl:
   SFieldIndexError         = 'Field index out of range';
   SIndexFieldMissing       = 'Cannot access index field ''%s''';

packages/fcl-image/src/fpreadjpeg.pas

@@ -15,7 +15,6 @@
   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
   ToDo:
-    - grayscale
     - palette
 }
 unit FPReadJPEG;
@@ -225,27 +224,21 @@ var
     x: Integer;
     y: Integer;
     c: word;
-  begin
-    InitReadingPixels;
-
-    Continue:=true;
-    Progress(psStarting, 0, False, Rect(0,0,0,0), '', Continue);
-    if not Continue then exit;
-
-    jpeg_start_decompress(@FInfo);
-
-    Img.SetSize(FInfo.output_width,FInfo.output_height);
-
-    // read one line per call
-    GetMem(SampArray,SizeOf(JSAMPROW));
-    GetMem(SampRow,FInfo.output_width*FInfo.output_components);
-    SampArray^[0]:=SampRow;
-    try
+    Status,Scan: integer;
+    ReturnValue,RestartLoop: Boolean;
+    procedure OutputScanLines();
+    var
+      x: integer;
+    begin
       Color.Alpha:=alphaOpaque;
       y:=0;
       while (FInfo.output_scanline < FInfo.output_height) do begin
+        // read one line per call
         LinesRead := jpeg_read_scanlines(@FInfo, SampArray, 1);
-        if LinesRead<1 then break;
+        if LinesRead<1 then begin
+          ReturnValue:=false;
+          break;
+        end;
         if (FInfo.jpeg_color_space = JCS_CMYK) then
         for x:=0 to FInfo.output_width-1 do begin
           Color.Red:=SampRow^[x*4+0];
@@ -274,12 +267,100 @@ var
         end;
         inc(y);
       end;
+    end;
+  begin
+    InitReadingPixels;
+
+    Continue:=true;
+    Progress(psStarting, 0, False, Rect(0,0,0,0), '', Continue);
+    if not Continue then exit;
+
+    jpeg_start_decompress(@FInfo);
+
+    Img.SetSize(FInfo.output_width,FInfo.output_height);
+
+    GetMem(SampArray,SizeOf(JSAMPROW));
+    GetMem(SampRow,FInfo.output_width*FInfo.output_components);
+    SampArray^[0]:=SampRow;
+    try
+      case FProgressiveEncoding of
+        false:
+          begin
+            ReturnValue:=true;
+            OutputScanLines();
+            if FInfo.buffered_image then jpeg_finish_output(@FInfo);
+          end;
+        true:
+          begin
+            while true do begin
+              (* The RestartLoop variable drops a placeholder for suspension
+                 mode, or partial jpeg decode, return and continue. In case
+                 of support this suspension, the RestartLoop:=True should be
+                 changed by an Exit and in the routine enter detects that it
+                 is being called from a suspended state to not
+                 reinitialize some buffer *)
+              RestartLoop:=false;
+              repeat
+                status := jpeg_consume_input(@FInfo);
+              until (status=JPEG_SUSPENDED) or (status=JPEG_REACHED_EOI);
+              ReturnValue:=true;
+              if FInfo.output_scanline = 0 then begin
+                Scan := FInfo.input_scan_number;
+                (* if we haven't displayed anything yet (output_scan_number==0)
+                  and we have enough data for a complete scan, force output
+                  of the last full scan *)
+                if (FInfo.output_scan_number = 0) and (Scan > 1) and
+                  (status <> JPEG_REACHED_EOI) then Dec(Scan);
+
+                if not jpeg_start_output(@FInfo, Scan) then begin
+                  RestartLoop:=true; (* I/O suspension *)
+                end;
+              end;
+
+              if not RestartLoop then begin
+                if (FInfo.output_scanline = $ffffff) then
+                  FInfo.output_scanline := 0;
+
+                OutputScanLines();
+
+                if ReturnValue=false then begin
+                  if (FInfo.output_scanline = 0) then begin
+                     (* didn't manage to read any lines - flag so we don't call
+                        jpeg_start_output() multiple times for the same scan *)
+                     FInfo.output_scanline := $ffffff;
+                  end;
+                  RestartLoop:=true; (* I/O suspension *)
+                end;
+
+                if not RestartLoop then begin
+                  if (FInfo.output_scanline = FInfo.output_height) then begin
+                    if not jpeg_finish_output(@FInfo) then begin
+                      RestartLoop:=true; (* I/O suspension *)
+                    end;
+
+                    if not RestartLoop then begin
+                      if (jpeg_input_complete(@FInfo) and
+                         (FInfo.input_scan_number = FInfo.output_scan_number)) then
+                        break;
+
+                      FInfo.output_scanline := 0;
+                    end;
+                  end;
+                end;
+              end;
+              if RestartLoop then begin
+                (* Suspension mode, but as not supported by this implementation
+                   it will simple break the loop to avoid endless looping. *)
+                break;
+              end;
+            end;
+          end;
+      end;
     finally
       FreeMem(SampRow);
       FreeMem(SampArray);
     end;
 
-    if FInfo.buffered_image then jpeg_finish_output(@FInfo);
     jpeg_finish_decompress(@FInfo);
 
     Progress(psEnding, 100, false, Rect(0,0,0,0), '', Continue);

packages/fcl-process/src/unix/process.inc

@@ -160,6 +160,9 @@ begin
     CommandToList(Cmd,S);
     if poNewConsole in P.Options then
       begin
+      {$ifdef darwin}
+      S.Insert(0,'open');
+      {$else}
       S.Insert(0,'-e');
       If (P.ApplicationName<>'') then
         begin
@@ -172,6 +175,7 @@ begin
         S.Insert(0,'-geometry');
         end;
       S.Insert(0,'xterm');
+      {$endif}
       end;
     if (P.ApplicationName<>'') then
       begin

packages/imagemagick/examples/wanddemo.lpr

@@ -28,6 +28,7 @@ end;
 var
   status: MagickBooleanType;
   wand: PMagickWand;
+
 begin
   { Read an image. }
 

packages/imagemagick/examples/wandpixelaccess.pas

@@ -0,0 +1,84 @@
+{
+  Demonstration program for the ImageMagick Library
+
+  Usage: Just execute the program. It will change all black pixels
+  in the image.png image on it's directory to be transparent
+  and then it will save it as image2.png
+  The idea is to demonstrate pixel access using MagickWand.
+}
+program wandpixelaccess;
+
+{$mode objfpc}{$H+}
+
+uses SysUtils, magick_wand, ImageMagick, ctypes;
+
+procedure ThrowWandException(wand: PMagickWand);
+var
+  description: PChar;
+  severity: ExceptionType;
+begin
+  description := MagickGetException(wand, @severity);
+  WriteLn(Format('An error ocurred. Description: %s', [description]));
+  description := MagickRelinquishMemory(description);
+  Abort;
+end;
+
+var
+  status: MagickBooleanType;
+  wand: PMagickWand = nil;
+  pixel: MagickPixelPacket;
+  iterator: PPixelIterator;
+  pixels: PPPixelWand = nil;
+  x, y: Integer;
+  width: culong;
+begin
+  { Read an image. }
+
+  MagickWandGenesis;
+
+  wand := NewMagickWand();
+
+  try
+    status := MagickReadImage(wand, 'image.png');
+    if (status = MagickFalse) then ThrowWandException(wand);
+
+    iterator := NewPixelIterator(wand);
+    if (iterator = nil) then ThrowWandException(wand);
+
+    for y := 0 to MagickGetImageHeight(wand) - 1 do
+    begin
+//      WriteLn(' Line ', y, ' from ', MagickGetImageHeight(wand) - 1);
+      pixels := PixelGetNextIteratorRow(iterator, width);
+      if (pixels = nil) then Break;
+
+      for x := 0 to width - 1 do
+      begin
+//        WriteLn(Format(' x %d y %d r %f g %f b %f o %f',
+//         [x, y, pixel.red, pixel.green, pixel.blue, pixel.opacity]));
+        PixelGetMagickColor(pixels[x], @pixel);
+        if (pixel.red = 0.0) and
+           (pixel.green = 0.0) and
+           (pixel.blue = 0.0) then
+        begin
+          pixel.opacity := QuantumRange;
+          pixel.matte := QuantumRange; // matte=alpha
+        end;
+        PixelSetMagickColor(pixels[x], @pixel);
+      end;
+      PixelSyncIterator(iterator);
+    end;
+
+//    if y < MagickGetImageHeight(wand) then ThrowWandException(wand);
+    iterator := DestroyPixelIterator(iterator);
+
+    { Write the image }
+
+    status := MagickWriteImage(wand, 'image2.png');
+    if (status = MagickFalse) then ThrowWandException(wand);
+  finally
+    { Clean-up }
+    if wand <> nil then wand := DestroyMagickWand(wand);
+    MagickWandTerminus;
+  end;
+end.
+

packages/imagemagick/src/cache.inc

@@ -0,0 +1,66 @@
+{
+  Copyright 1999-2009 ImageMagick Studio LLC, a non-profit organization
+  dedicated to making software imaging solutions freely available.
+  
+  You may not use this file except in compliance with the License.
+  obtain a copy of the License at
+  
+    http://www.imagemagick.org/script/license.php
+  
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.
+
+  MagickCore cache methods.
+}
+{
+  Based on ImageMagick 6.5.7
+}
+
+//#include "magick/blob.h"
+
+{extern MagickExport const IndexPacket
+  *GetVirtualIndexQueue(const Image *);
+
+extern MagickExport const PixelPacket
+  *GetVirtualPixels(const Image *,const long,const long,const unsigned long,
+    const unsigned long,ExceptionInfo *),
+  *GetVirtualPixelQueue(const Image *);
+
+extern MagickExport IndexPacket
+  *GetAuthenticIndexQueue(const Image *);
+
+extern MagickExport MagickBooleanType
+  GetOneVirtualMagickPixel(const Image *,const long,const long,
+    MagickPixelPacket *,ExceptionInfo *),
+  GetOneVirtualPixel(const Image *,const long,const long,PixelPacket *,
+    ExceptionInfo *),
+  GetOneVirtualMethodPixel(const Image *,const VirtualPixelMethod,const long,
+    const long,PixelPacket *,ExceptionInfo *),
+  GetOneAuthenticPixel(Image *,const long,const long,PixelPacket *,
+    ExceptionInfo *),
+  InstantiateCacheComponent(void),
+  PersistPixelCache(Image *,const char *,const MagickBooleanType,
+    MagickOffsetType *,ExceptionInfo *),
+  SyncAuthenticPixels(Image *,ExceptionInfo *);
+
+extern MagickExport MagickSizeType
+  GetImageExtent(const Image *);}
+
+//extern MagickExport PixelPacket
+function GetAuthenticPixels(_image: PImage; const x, y: clong;
+  const columns, rows: culong; exception: PExceptionInfo
+  ): PPixelPacket; cdecl; external MagickExport;
+//  *GetAuthenticPixelQueue(const Image *),
+//  *QueueAuthenticPixels(Image *,const long,const long,const unsigned long,
+//    const unsigned long,ExceptionInfo *);
+
+{extern MagickExport VirtualPixelMethod
+  GetPixelCacheVirtualMethod(const Image *),
+  SetPixelCacheVirtualMethod(const Image *,const VirtualPixelMethod);
+
+extern MagickExport void
+  DestroyCacheFaclity(void);}
+

packages/imagemagick/src/imagemagick.pas

@@ -14,7 +14,8 @@
   limitations under the License.
 
   ImageMagick Application Programming Interface declarations.
-  
+}
+{
   Converted from c by: Felipe Monteiro de Carvalho Dez/2005
 
 	Bug-fixed by Ángel Eduardo García Hernández
@@ -34,10 +35,18 @@ uses SysUtils, ctypes;
 
 {$PACKENUM 4}
 
+// Fix to compile in older FPC versions
+{$ifdef VER2_2}
+type
+  Pcsize_t = ^size_t;
+{$endif}
+
 const
 {$ifdef Win32}
+  MagickExport = 'CORE_RL_magick_.dll';
   WandExport = 'CORE_RL_wand_.dll';
 {$else}
+  MagickExport = 'libMagickCore';
   WandExport = 'libWand';
 {$endif}
 
@@ -50,7 +59,7 @@ const
 {#$include annotate.inc}
 {#$include attribute.inc}
 {#$include blob.inc}
-{#$include cache.inc}
+{$include cache.inc}
 {$include cache_view.inc}
 {#include "magick/coder.h"
 #include "magick/client.h"

packages/imagemagick/src/magick_wand.pas

@@ -14,7 +14,10 @@
   limitations under the License.
 
   ImageMagick MagickWand API.
-  
+}
+{
+  Based on ImageMagick 6.2
+
   Converted from c by: Felipe Monteiro de Carvalho Dez/2005
 
 	Bug-fixed by Ángel Eduardo García Hernández

packages/imagemagick/src/pixel.inc

@@ -54,6 +54,8 @@ type
 
 type
   MagickPixelPacket = record
+    storage_class: ClassType; // Added after 6.2
+
     colorspace: ColorspaceType;
 
     matte: MagickBooleanType;

packages/imagemagick/src/pixel_wand.inc

@@ -82,7 +82,7 @@ function PixelGetYellowQuantum(const wand: PPixelWand): Quantum; cdecl; external
 function PixelGetColorCount(const wand: PPixelWand): culong; cdecl; external WandExport;
 
 procedure ClearPixelWand(wand: PPixelWand); cdecl; external WandExport;
-procedure PixelGetMagickColor(const wand: PPixelWand; packet: PMagickPixelPacket); cdecl; external WandExport;
+//  PixelGetHSL(const PixelWand *,double *,double *,double *), // Added after 6.2
 procedure PixelGetQuantumColor(const wand: PPixelWand; color: PPixelPacket); cdecl; external WandExport;
 procedure PixelSetAlpha(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetAlphaQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
@@ -90,14 +90,18 @@ procedure PixelSetBlack(wand: PPixelWand; const opacity: Double); cdecl; externa
 procedure PixelSetBlackQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
 procedure PixelSetBlue(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetBlueQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
+//  PixelSetColorFromWand(PixelWand *,const PixelWand *), // Added after 6.2
 procedure PixelSetColorCount(wand: PPixelWand; const count: culong); cdecl; external WandExport;
 procedure PixelSetCyan(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetCyanQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
+//  PixelSetFuzz(PixelWand *,const double), // Added after 6.2
 procedure PixelSetGreen(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetGreenQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
+//  PixelSetHSL(PixelWand *,const double,const double,const double), // Added after 6.2
 procedure PixelSetIndex(wand: PPixelWand; const index: IndexPacket); cdecl; external WandExport;
 procedure PixelSetMagenta(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetMagentaQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
+procedure PixelSetMagickColor(wand: PPixelWand; const color: PMagickPixelPacket); cdecl; external WandExport; // Added after 6.2
 procedure PixelSetOpacity(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetOpacityQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
 procedure PixelSetQuantumColor(wand: PPixelWand; const color: PPixelPacket); cdecl; external WandExport;
@@ -106,4 +110,6 @@ procedure PixelSetRedQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; e
 procedure PixelSetYellow(wand: PPixelWand; const opacity: Double); cdecl; external WandExport;
 procedure PixelSetYellowQuantum(wand: PPixelWand; const opacity: Quantum); cdecl; external WandExport;
 
+// Considered a private method in newer versions (after 6.2)
+procedure PixelGetMagickColor(const wand: PPixelWand; packet: PMagickPixelPacket); cdecl; external WandExport;
 

packages/pasjpeg/src/jmemnobs.pas

@@ -27,7 +27,7 @@ uses
   NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
   size_t and will be a multiple of sizeof(align_type). }
 
-{$IFDEF WINDOWS}
+{$IFDEF CPU16}
 const
   MAX_ALLOC_CHUNK = long(32752);
 {$ELSE}

packages/paszlib/src/gzio.pas

@@ -133,7 +133,9 @@ var
 {$IFNDEF NO_DEFLATE}
   gzheader : array [0..9] of byte;
 {$ENDIF}
-
+  doseek,
+  exists,
+  writing : boolean;
 begin
 
   if (path='') or (mode='') then begin
@@ -169,6 +171,7 @@ begin
     case mode[i] of
       'r'      : s^.mode := 'r';
       'w'      : s^.mode := 'w';
+      'a'      : s^.mode := 'a';
       '0'..'9' : level := Ord(mode[i])-Ord('0');
       'f'      : strategy := Z_FILTERED;
       'h'      : strategy := Z_HUFFMAN_ONLY;
@@ -180,7 +183,9 @@ begin
     exit;
   end;
 
-  if (s^.mode='w') then begin
+  writing:=( s^.mode='a') or (s^.mode='w');
+
+  if writing then begin
 {$IFDEF NO_DEFLATE}
     err := Z_STREAM_ERROR;
 {$ELSE}
@@ -217,25 +222,33 @@ begin
   {$IFOPT I+} {$I-} {$define IOcheck} {$ENDIF}
   Assign (s^.gzfile, path);
   {$ifdef unix}
-  if (fpstat(path,info)<0) and (s^.mode='w') then
-    ReWrite (s^.gzfile,1)  
-  else
-    Reset (s^.gzfile,1);
+    exists:=not (fpstat(path,info)<0);
   {$else}
-  GetFAttr(s^.gzfile, Attr);
-  if (DosError <> 0) and (s^.mode='w') then
-    ReWrite (s^.gzfile,1)
-  else
-    Reset (s^.gzfile,1);
+    GetFAttr(s^.gzfile, Attr);
+    exists:=(DosError= 0)
   {$endif}
+  
+  doseek:=false;
+  if ((s^.mode='a') and not exists) or (s^.mode='w') then
+    ReWrite (s^.gzfile,1)  
+  else
+    begin
+      Reset (s^.gzfile,1);  
+      if s^.mode='a' then
+        doseek:=true;      // seek AFTER I/O check.
+    end;
+    
   {$IFDEF IOCheck} {$I+} {$ENDIF}
   if (IOResult <> 0) then begin
     destroy(s);
     gzopen := gzFile(nil);
     exit;
   end;
-
-  if (s^.mode = 'w') then begin { Write a very simple .gz header }
+  // append binary file.
+  if doseek then
+     seek(s^.gzfile,filesize(s^.gzfile));
+  s^.mode:='w';   // difference append<->write doesn't matter anymore
+  if writing then begin { Write a very simple .gz header }
 {$IFNDEF NO_DEFLATE}
     gzheader [0] := gz_magic [0];
     gzheader [1] := gz_magic [1];

rtl/darwin/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/08/02]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/08/14]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -2467,7 +2467,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
 		 unxconst.inc $(UNIXINC)/timezone.inc \
 		 unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
-dynlibs$(PPUEXT) : dl$(PPUEXT) objpas$(PPUEXT)
+dynlibs$(PPUEXT) : dl$(PPUEXT) objpas$(PPUEXT) rtlconsts$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT)
 ctypes$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
 dos$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
 	       unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/darwin/Makefile.fpc

@@ -154,7 +154,7 @@ unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(P
 
 unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
 
-dynlibs$(PPUEXT) : dl$(PPUEXT) objpas$(PPUEXT)
+dynlibs$(PPUEXT) : dl$(PPUEXT) objpas$(PPUEXT) rtlconsts$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT)
 
 ctypes$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
 

rtl/inc/dynlibs.pas

@@ -20,6 +20,9 @@ unit dynlibs;
 
 interface
 
+uses
+  SysUtils, RtlConsts, SysConst;
+
 { ---------------------------------------------------------------------
   Read OS-dependent interface declarations.
   ---------------------------------------------------------------------}
@@ -38,13 +41,77 @@ Function LoadLibrary(Name : AnsiString) : TLibHandle;
 Function GetProcedureAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
 Function UnloadLibrary(Lib : TLibHandle) : Boolean;
 
+
 // Kylix/Delphi compability
 
+Type
+  HModule = TLibHandle;
+
 Function FreeLibrary(Lib : TLibHandle) : Boolean;
 Function GetProcAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
 
-Type
-  HModule = TLibHandle; 
+
+// Dynamic Library Manager
+
+{ Note: If you look for some code that uses this library handler, take a look at
+    sqlite3.inc of sqlite package (simple) or
+    mysql.inc of mysql package (advanced)
+}
+
+type
+  PLibHandler = ^TLibHandler;
+
+  TLibEventLoading = function(User: Pointer; Handler: PLibHandler): Boolean;
+  TLibEventUnloading = procedure(Handler: PLibHandler);
+
+  PPLibSymbol = ^PLibSymbol;
+  PLibSymbol = ^TLibSymbol;
+  TLibSymbol = record
+    pvar: PPointer;  { pointer to Symbol variable }
+    name: String;    { name of the Symbol }
+    weak: Boolean;   { weak }
+  end;
+
+  TLibHandler = record
+    InterfaceName: String;                { abstract name of the library }
+    Defaults     : array of String;       { list of default library filenames }
+    Filename     : String;                { handle of the current loaded library }
+    Handle       : TLibHandle;            { filename of the current loaded library }
+    Loading      : TLibEventLoading;      { loading event, called after the unit is loaded }
+    Unloading    : TLibEventUnloading;    { unloading event, called before the unit is unloaded }
+    SymCount     : Integer;               { number of symbols }
+    Symbols      : PLibSymbol;            { symbol address- and namelist }
+    ErrorMsg     : String;                { last error message }
+    RefCount     : Integer;               { reference counter }
+  end;
+
+
+{ handler definition }
+function LibraryHandler(const InterfaceName: String; const DefaultLibraries: array of String;
+  const Symbols: PLibSymbol; const SymCount: Integer; const AfterLoading: TLibEventLoading = nil;
+  const BeforeUnloading: TLibEventUnloading = nil): TLibHandler;
+
+{ initialization/finalization }
+function TryInitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
+  const User: Pointer = nil; const NoSymbolErrors: Boolean = False): Integer;
+function TryInitializeLibrary(var Handler: TLibHandler; const LibraryName: String = '';
+  const User: Pointer = nil; const NoSymbolErrors: Boolean = False): Integer;
+function InitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
+  const User: Pointer = nil; const NoSymbolErrors: Boolean = False): Integer;
+function InitializeLibrary(var Handler: TLibHandler; const LibraryName: String = '';
+  const User: Pointer = nil; const NoSymbolErrors: Boolean = False): Integer;
+function ReleaseLibrary(var Handler: TLibHandler): Integer;
+
+{ errors }
+procedure AppendLibraryError(var Handler: TLibHandler; const Msg: String);
+function GetLastLibraryError(var Handler: TLibHandler): String;
+procedure RaiseLibraryException(var Handler: TLibHandler);
+
+{ symbol load/clear }
+function LoadLibrarySymbols(const Lib: TLibHandle; const Symbols: PLibSymbol; const Count: Integer;
+  const ErrorSym: PPLibSymbol = nil): Boolean;
+procedure ClearLibrarySymbols(const Symbols: PLibSymbol; const Count: Integer);
+
 
 // these are for easier crossplatform construction of dll names in dynloading libs.
 Const
@@ -57,11 +124,11 @@ Const
      {$ifdef OS2}
        SharedSuffix = 'dll';
      {$else}
-       SharedSuffix = 'so';  
+       SharedSuffix = 'so';
      {$endif}
    {$endif}
- {$endif}      
-      
+ {$endif}
+
 Implementation
 
 { ---------------------------------------------------------------------
@@ -88,7 +155,6 @@ Function SafeLoadLibrary(Name : AnsiString) : TLibHandle;
  var w : word;
 {$endif}
 
-
 Begin
 {$ifdef i386}
   w:=get8087cw;
@@ -100,4 +166,210 @@ Begin
 {$endif}
 End;
 
+function LibraryHandler(const InterfaceName: String; const DefaultLibraries: array of String;
+  const Symbols: PLibSymbol; const SymCount: Integer; const AfterLoading: TLibEventLoading;
+  const BeforeUnloading: TLibEventUnloading): TLibHandler;
+var
+  I: Integer;
+begin
+  Result.InterfaceName := InterfaceName;
+  Result.Filename      := '';
+  Result.Handle        := NilHandle;
+  Result.Loading       := AfterLoading;
+  Result.Unloading     := BeforeUnloading;
+  Result.SymCount      := SymCount;
+  Result.Symbols       := Symbols;
+  Result.ErrorMsg      := '';
+  Result.RefCount      := 0;
+
+  SetLength(Result.Defaults, Length(DefaultLibraries));
+  for I := 0 to High(DefaultLibraries) do
+    Result.Defaults[I] := DefaultLibraries[I];
+end;
+
+function TryInitializeLibraryInternal(var Handler: TLibHandler; const LibraryName: String;
+  const User: Pointer; const NoSymbolErrors: Boolean): Integer;
+var
+  ErrSym: PLibSymbol;
+begin
+  if (Handler.Filename <> '') and (Handler.Filename <> LibraryName) then
+  begin
+    AppendLibraryError(Handler, Format(SLibraryAlreadyLoaded, [Handler.InterfaceName, Handler.Filename]));
+    Result := -1;
+    Exit;
+  end;
+
+  Result := InterlockedIncrement(Handler.RefCount);
+  if Result = 1 then
+  begin
+    Handler.Handle := LoadLibrary(LibraryName);
+    if Handler.Handle = NilHandle then
+    begin
+      AppendLibraryError(Handler, Format(SLibraryNotLoaded, [Handler.InterfaceName, LibraryName]));
+      Handler.RefCount := 0;
+      Result := -1;
+      Exit;
+    end;
+
+    Handler.Filename := LibraryName;
+
+    if not LoadLibrarySymbols(Handler.Handle, Handler.Symbols, Handler.SymCount, @ErrSym) and not NoSymbolErrors then
+    begin
+      AppendLibraryError(Handler, Format(SLibraryUnknownSym, [ErrSym^.name, Handler.InterfaceName, LibraryName]));
+      UnloadLibrary(Handler.Handle);
+      Handler.Handle := NilHandle;
+      Handler.Filename := '';
+      Handler.RefCount := 0;
+      Result := -1;
+      Exit;
+    end;
+
+    if Assigned(Handler.Loading) and not Handler.Loading(User, @Handler) then
+    begin
+      UnloadLibrary(Handler.Handle);
+      Handler.Handle := NilHandle;
+      Handler.Filename := '';
+      Handler.RefCount := 0;
+      Result := -1;
+      Exit;
+    end;
+  end;
+end;
+
+function TryInitializeLibrary(var Handler: TLibHandler; const LibraryName: String;
+  const User: Pointer; const NoSymbolErrors: Boolean): Integer;
+begin
+  if LibraryName <> '' then
+  begin
+    Handler.ErrorMsg := '';
+    Result := TryInitializeLibraryInternal(Handler, LibraryName, User, NoSymbolErrors);
+  end else
+    Result := TryInitializeLibrary(Handler, Handler.Defaults, User, NoSymbolErrors);
+end;
+
+function TryInitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
+  const User: Pointer; const NoSymbolErrors: Boolean): Integer;
+var
+  I: Integer;
+begin
+  Handler.ErrorMsg := '';
+
+  if Length(LibraryNames) <= 0 then
+  begin
+    if Length(Handler.Defaults) > 0 then
+    begin
+      Result := TryInitializeLibrary(Handler, Handler.Defaults, User, NoSymbolErrors);
+      Exit;
+    end;
+
+    AppendLibraryError(Handler, SVarInvalid);
+    Result := -1;
+    Exit;
+  end;
+
+  for I := 0 to High(LibraryNames) do
+  begin
+    Result := TryInitializeLibraryInternal(Handler, LibraryNames[I], User, NoSymbolErrors);
+    if Result > 0 then
+    begin
+      Handler.ErrorMsg := '';
+      Exit;
+    end;
+  end;
+end;
+
+function InitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
+  const User: Pointer; const NoSymbolErrors: Boolean): Integer;
+begin
+  Result := TryInitializeLibrary(Handler, LibraryNames, User, NoSymbolErrors);
+  if Result < 0 then
+    RaiseLibraryException(Handler);
+end;
+
+function InitializeLibrary(var Handler: TLibHandler; const LibraryName: String;
+  const User: Pointer; const NoSymbolErrors: Boolean): Integer;
+begin
+  Result := TryInitializeLibrary(Handler, LibraryName, User, NoSymbolErrors);
+  if Result < 0 then
+    RaiseLibraryException(Handler);
+end;
+
+function ReleaseLibrary(var Handler: TLibHandler): Integer;
+begin
+  Handler.ErrorMsg := '';
+
+  Result := InterlockedDecrement(Handler.RefCount);
+  if Result = 0 then
+  begin
+    if Assigned(Handler.Unloading) then
+      Handler.Unloading(@Handler);
+    ClearLibrarySymbols(Handler.Symbols, Handler.SymCount);
+    UnloadLibrary(Handler.Handle);
+    Handler.Handle := NilHandle;
+    Handler.Filename := '';
+  end else
+    if Result < 0 then
+      Handler.RefCount := 0;
+end;
+
+procedure AppendLibraryError(var Handler: TLibHandler; const Msg: String);
+begin
+  if Handler.ErrorMsg <> '' then
+    Handler.ErrorMsg := Handler.ErrorMsg + LineEnding + Msg
+  else
+    Handler.ErrorMsg := Msg;
+end;
+
+function GetLastLibraryError(var Handler: TLibHandler): String;
+begin
+  Result := Handler.ErrorMsg;
+  Handler.ErrorMsg := '';
+end;
+
+procedure RaiseLibraryException(var Handler: TLibHandler);
+var
+  Msg: String;
+begin
+  Msg := GetLastLibraryError(Handler);
+  if Msg <> '' then
+    raise EInOutError.Create(Msg)
+  else
+    raise EInOutError.Create(SUnknown);
+end;
+
+function LoadLibrarySymbols(const Lib: TLibHandle; const Symbols: PLibSymbol; const Count: Integer;
+  const ErrorSym: PPLibSymbol): Boolean;
+var
+  P,L: PLibSymbol;
+begin
+  P := Symbols;
+  L := @Symbols[Count];
+  while P < L do
+  begin
+    P^.pvar^ := GetProcedureAddress(Lib, P^.name);
+    if not Assigned(P^.pvar^) and not P^.weak then
+    begin
+      if Assigned(ErrorSym) then
+        ErrorSym^ := P;
+      Result := False;
+      Exit;
+    end;
+    Inc(P);
+  end;
+  Result := True;
+end;
+
+procedure ClearLibrarySymbols(const Symbols: PLibSymbol; const Count: Integer);
+var
+  P,L: PLibSymbol;
+begin
+  P := Symbols;
+  L := @Symbols[Count];
+  while P < L do
+  begin
+    P^.pvar^ := nil;
+    Inc(P);
+  end;
+end;
+
 end.

rtl/inc/objpash.inc

@@ -54,6 +54,8 @@
        vmtAfterConstruction    = vmtMethodStart+sizeof(pointer)*5;
        vmtBeforeDestruction    = vmtMethodStart+sizeof(pointer)*6;
        vmtDefaultHandlerStr    = vmtMethodStart+sizeof(pointer)*7;
+       vmtDispatch             = vmtMethodStart+sizeof(pointer)*8;
+       vmtDispatchStr          = vmtMethodStart+sizeof(pointer)*9;
 
        { IInterface }
        S_OK          = 0;
@@ -113,6 +115,8 @@
          vAfterConstruction: Pointer;
          vBeforeDestruction: Pointer;
          vDefaultHandlerStr: Pointer;
+         vDispatch: Pointer;
+         vDispatchStr: Pointer;
        end;
 
        PGuid = ^TGuid;
@@ -192,9 +196,6 @@
           class function InstanceSize : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
           class function InheritsFrom(aclass : tclass) : boolean;
           class function StringMessageTable : pstringmessagetable;
-          { message handling routines }
-          procedure Dispatch(var message);
-          procedure DispatchStr(var message);
 
           class function MethodAddress(const name : shortstring) : pointer;
           class function MethodName(address : pointer) : shortstring;
@@ -207,6 +208,10 @@
           { new for gtk, default handler for text based messages }
           procedure DefaultHandlerStr(var message);virtual;
 
+          { message handling routines }
+          procedure Dispatch(var message);virtual;
+          procedure DispatchStr(var message);virtual;
+
           { interface functions }
           function GetInterface(const iid : tguid; out obj) : boolean;
           function GetInterface(const iidstr : shortstring;out obj) : boolean;

rtl/objpas/rtlconst.inc

@@ -50,7 +50,10 @@ ResourceString
   SCannotShowModal              = 'A visible Window can not be made modal';
   SCantChangeWhileActive        = 'Changing value on an active socket is not allowed';
   SCantWriteResourceStreamError = 'Can not write to read-only ResourceStream';
-  SCardDLLNotLoaded             = 'CARDS library could not be loaded';
+  SCardDLLNotLoaded             = 'CARDS library could not be loaded' deprecated; { use SLibraryNotLoaded }
+  SLibraryAlreadyLoaded         = 'Interface %s already initialized from library "%s"';
+  SLibraryNotLoaded             = 'Can not initialize interface %s from library "%s"';
+  SLibraryUnknownSym            = 'Can not resolve symbol "%s" of interface %s from library "%s"';
   SChangeIconSize               = 'Can not change icon size';
   SCharExpected                 = '"%s" expected';
   SCheckSynchronizeError        = 'CheckSynchronize called from non-main thread "$%x"';
@@ -93,7 +96,7 @@ ResourceString
   SDefaultFilter                = 'All files (*.*)|*.*';
   SDelimiterQuoteCharError      = 'Delimiter and QuoteChar properties cannot have the same value';
   SDeviceOnPort                 = '%s on %s';
-  SDimsDoNotMatch  = 'Image size mismatch';
+  SDimsDoNotMatch               = 'Image size mismatch';
   SDirNameCap                   = 'Directory &name:';
   SDirsCap                      = '&Directories:';
   SDrivesCap                    = '&Drives:';

rtl/unix/cthreads.pp

@@ -328,12 +328,14 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
        http://java.sun.com/j2se/1.4.2/docs/guide/misc/threadPrimitiveDeprecation.html
     }
 //      result := pthread_kill(threadHandle,SIGSTOP);
+      result:=dword(-1);
     end;
 
 
   function  CResumeThread  (threadHandle : TThreadID) : dword;
     begin
 //      result := pthread_kill(threadHandle,SIGCONT);
+      result:=dword(-1);
     end;
 
 
@@ -367,12 +369,14 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
     function  CThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
     begin
       {$Warning ThreadSetPriority needs to be implemented}
+      result:=false;
     end;
 
 
   function  CThreadGetPriority (threadHandle : TThreadID): Integer;
     begin
       {$Warning ThreadGetPriority needs to be implemented}
+      result:=0;
     end;
 
 

utils/fpdoc/dwlinear.pp

@@ -30,10 +30,10 @@ Type
     procedure SortElementList(List : TList);
     procedure StartListing(Frames: Boolean);
     Function  ShowMember(M : TPasElement) : boolean;
-    procedure StartChapter(ChapterName : String; ChapterLabel : String);
-    procedure StartSection(SectionName : String; SectionLabel : String);
-    procedure StartSubSection(SubSectionName : String; SubSectionLabel : String);
-    procedure StartSubSubSection(SubSubSectionName : String; SubSubSectionLabel : String);
+    procedure StartChapter(ChapterName : String; ChapterLabel : String); virtual;
+    procedure StartSection(SectionName : String; SectionLabel : String); virtual;
+    procedure StartSubSection(SubSectionName : String; SubSectionLabel : String); virtual;
+    procedure StartSubSubSection(SubSubSectionName : String; SubSubSectionLabel : String); virtual;
     Function  GetDescrString(AContext: TPasElement; DescrNode: TDOMElement) : String;
     function  ConstValue(ConstDecl: TPasConst): String; virtual;
     procedure ProcessSection(ASection: TPasSection); virtual;
@@ -442,7 +442,6 @@ procedure TLinearWriter.WriteDoc;
 
 var
   i : Integer;
-  DocNode : TDocNode;
   L : TstringList;
 
 begin
@@ -467,9 +466,7 @@ begin
         WriteCommentLine;
         StartChapter(Format(SDocUnitTitle, [Module.Name]));
         WriteLabel(Module);
-        DocNode:=Engine.FindDocNode(Module);
-        If Assigned(DocNode) then
-          ProcessTopics(DocNode,1);
+        // extra Topics now get processed in ProcessSection()
         ProcessSection(Module.InterfaceSection);
         end;
     Finally
@@ -482,7 +479,8 @@ begin
 end;
 
 procedure TLinearWriter.ProcessSection(ASection: TPasSection);
-
+var
+  DocNode: TDocNode;
 begin
   With ASection do
     begin
@@ -496,6 +494,12 @@ begin
     SortElementList(Variables);
     end;
   WriteUnitOverView(ASection);
+
+  // Now process unit (extra) Topics
+  DocNode:=Engine.FindDocNode(Module);
+  If Assigned(DocNode) then
+    ProcessTopics(DocNode,1);
+
   WriteVarsConstsTypes(ASection);
   WriteFunctionsAndProcedures(ASection);
   WriteClasses(ASection);

utils/rmwait/Makefile.fpc

@@ -0,0 +1,15 @@
+#
+#   Makefile.fpc for Free Pascal Utils
+#
+
+[target]
+programs=rmwait
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+rmwait$(EXEEXT): rmwait.pp

utils/rmwait/rmwait.pas

@@ -0,0 +1,559 @@
+{
+    rmwait - remove (delete) file(s) with optional retries
+    Copyright (C) 2009 by Tomas Hajny, member of the Free Pascal team
+
+    This tool tries to mimic behaviour of GNU rm, but it provides
+    the additional feature of retries and it also fixes some issues
+    appearing at least with the Win32 port of version 3.13.
+
+    See the file COPYING, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+program rmwait;
+{$D
+Remove (delete) file(s) with optional retries.
+}
+
+{ $DEFINE DONOTHING}
+
+uses
+{$IFDEF GO32V2}
+  Go32,
+{$ENDIF GO32V2}
+{$IFDEF OS2}
+  DosCalls,
+{$ENDIF OS2}
+{$IFDEF WINDOWS}
+  Windows,
+{$ENDIF WINDOWS}
+{$IFDEF UNIX}
+  BaseUnix,
+{$ENDIF UNIX}
+  Dos;
+
+const
+  OptDirectories: boolean = false;
+  OptForce: boolean = false;
+  OptInteractive: boolean = false;
+  OptRecursive: boolean = false;
+  OptVerbose: boolean = false;
+  OptRetries: longint = 1;
+  OptWait: longint = 5;
+  OptsStop: boolean = false;
+
+
+var
+  OldExit: pointer;
+  Deleted: cardinal;
+
+procedure VerbLine (S: string); inline;
+begin
+  if OptVerbose then
+    WriteLn (S);
+end;
+
+
+procedure ForceErrorLn (S: string); inline;
+begin
+  WriteLn (ParamStr (0), ': ', S);
+end;
+
+
+procedure ErrorLn (S: string); inline;
+begin
+{  if not (OptForce) then}
+   ForceErrorLn (S);
+end;
+
+
+procedure GenericErrorLn (S: string; N: longint); inline;
+begin
+  if not (OptForce) then
+   WriteLn (ParamStr (0), ': ', S, ' (', N, ')');
+end;
+
+
+procedure ClearIO; inline;
+begin
+  if IOResult <> 0 then ;
+end;
+
+
+procedure Wait (Seconds: Cardinal);
+{$IFDEF GO32v2}
+var
+  R: Registers;
+  T0, T1, T2: int64;
+  DayOver: boolean;
+begin
+(* Sleep is supposed to give up time slice - DOS Idle Interrupt chosen
+   because it should be supported in all DOS versions. *)
+  R.AH := $2C;
+  RealIntr($21, R);
+  T0 := R.CH * 3600 + R.CL * 60 + R.DH;
+  T2 := T0 + Seconds;
+  DayOver := T2 > (24 * 3600);
+  repeat
+    Intr ($28, R);
+(*    R.AH := $2C; - should be preserved. *)
+    RealIntr($21, R);
+    T1 := R.CH * 3600 + R.CL * 60 + R.DH;
+    if DayOver and (T1 < T0) then
+     Inc (T1, 24 * 3600);
+  until T1 >= T2;
+end;
+{$ELSE GO32v2}
+ {$IFDEF OS2}
+begin
+  DosSleep (Seconds * 1000);
+end;
+ {$ELSE OS2}
+  {$IFDEF UNIX}
+begin
+  fpSleep (Seconds * 1000);
+end;
+  {$ELSE UNIX}
+   {$IFDEF WINDOWS}
+begin
+  Sleep (Seconds * 1000);
+end;
+   {$ELSE WINDOWS}
+var
+  T0, T1, T2: int64;
+begin
+{$WARNING No sleeping is performed with this platform!}
+  T0 := GetMSCount;
+  T2 := T0 + Seconds * 1000;
+  repeat
+    T1 := GetMSCount;
+(* GetMSCount returning lower value than in the first check indicates overflow
+   and is treated as end of the waiting period due to undefined range. *)
+  until (T1 >= T2) or (T1 < T0);
+end;
+   {$ENDIF WINDOWS}
+  {$ENDIF UNIX}
+ {$ENDIF OS2}
+{$ENDIF GO32v2}
+
+
+procedure ClearAttribs (var F: file); inline;
+var
+  W: word;
+begin
+{$I-}
+  GetFAttr (F, W);
+  if W and (ReadOnly or SysFile) <> 0 then
+    SetFAttr (F, W and not ReadOnly and not SysFile);
+  ClearIO;
+{$I+}
+end;
+
+
+function StrF (U: cardinal): string; inline;
+begin
+  Str (U, StrF);
+end;
+
+
+function CheckOK (Msg: string; FN: PathStr): boolean;
+var
+  Resp: string;
+begin
+  Write (ParamStr (0), ': ', Msg, '''', FN, '''? ');
+  ReadLn (Resp);
+  CheckOK := (Length (Resp) > 0) and (UpCase (Resp [1]) = 'Y');
+end;
+
+
+procedure DelFile (FN: PathStr); inline;
+var
+  F: file;
+  R, Tries: longint;
+begin
+  VerbLine ('removing ''' + FN + '''');
+  Inc (Deleted);
+  if not (OptInteractive) or CheckOK ('remove ', FN) then
+    begin
+      Assign (F, FN);
+      if OptForce then
+        ClearAttribs (F);
+      Tries := 1;
+      repeat
+{$I-}
+{$IFDEF DONOTHING}
+        WriteLn ('Debug: ', FN);
+{$ELSE DONOTHING}
+        Erase (F);
+{$ENDIF DONOTHING}
+        R := IOResult;
+{$I+}
+        Inc (Tries);
+        if (R = 5) and (Tries <= OptRetries) then
+          Wait (OptWait);
+      until (R <> 5) or (Tries > OptRetries);
+      case R of
+        0: ;
+        2: ErrorLn (FN + ': No such file or directory');
+        5: ErrorLn (FN + ': Permission denied');
+      else
+       GenericErrorLn (FN + ': Cannot be removed', R);
+      end;
+    end;
+end;
+
+
+procedure DelDir (FN: PathStr); inline;
+var
+  F: file;
+  R, Tries: longint;
+begin
+  VerbLine ('removing ''' + FN + '''');
+  Inc (Deleted);
+  if not (OptInteractive) or CheckOK ('remove directory ', FN) then
+    begin
+      if OptForce then
+        begin
+          Assign (F, FN);
+          ClearAttribs (F);
+        end;
+      Tries := 1;
+      repeat
+{$I-}
+{$IFDEF DONOTHING}
+        WriteLn ('Debug: Directory ', FN);
+{$ELSE DONOTHING}
+        RmDir (FN);
+{$ENDIF DONOTHING}
+        R := IOResult;
+{$I+}
+        Inc (Tries);
+        if (R = 5) and (Tries <= OptRetries) then
+         begin
+          VerbLine ('Removal attempt failed, waiting ' + StrF (OptWait) + ' seconds before trying again...');
+          Wait (OptWait);
+         end;
+      until (R <> 5) or (Tries > OptRetries);
+      case R of
+        0: ;
+        5: ErrorLn (FN + ': Permission denied');
+      else
+       GenericErrorLn (FN + ': Cannot be removed', R);
+      end;
+    end;
+end;
+
+
+procedure Syntax;
+begin
+  WriteLn;
+  WriteLn ('RMWait - remove (delete) file(s) with optional retries');
+  WriteLn;
+  WriteLn ('Syntax:');
+  WriteLn (ParamStr (0) + ' [<options>...] [<file specifications>...]');
+  WriteLn;
+  WriteLn ('<file specifications> may contain wildcards ''*'' and ''?''.');
+  WriteLn;
+  WriteLn ('Options:');
+  WriteLn (' -d, --directory                 remove directory. even if non-empty');
+  WriteLn (' -f, --force                     ignore non-existent files, never prompt');
+  WriteLn (' -i, --interactive               prompt before any removal');
+  WriteLn (' -r, -R, --recursive             remove the contents of directories recursively');
+  WriteLn (' -v, --verbose                   explain what is being done');
+  WriteLn (' --version                       output version information and exit');
+  WriteLn (' -h, -?, --help                  display this help and exit');
+  WriteLn (' -t[<N>[,<T>]], --try[<N>[,<T>]] in case of errors, retry deleting N times');
+  WriteLn ('                                 (default 3 times) waiting T seconds between');
+  WriteLn ('                                 individual attempts (default 5 seconds)');
+  WriteLn (' --                              stop processing of options');
+  WriteLn;
+  WriteLn ('To remove a file whose name starts with a ''-'', for example ''-file'',');
+  WriteLn ('use one of these commands:');
+  WriteLn (' rm -- -file');
+  WriteLn (' rm ./-file');
+  WriteLn;
+  Halt;
+end;
+
+
+procedure ParError (S: string); inline;
+begin
+  ForceErrorLn (S);
+  WriteLn;
+  Syntax;
+end;
+
+
+procedure ProcessFSpec (FN: PathStr);
+var
+  SR: SearchRec;
+  D, BaseDir: DirStr;
+  N, BaseName: NameStr;
+  E: ExtStr;
+  RemFNDir: boolean;
+begin
+  RemFNDir := false;
+{$IF NOT DEFINED (OS2) and NOT DEFINED (WINDOWS) and NOT DEFINED (DPMI) and NOT DEFINED (UNIX) and NOT DEFINED (MACOS) and NOT DEFINED (AMIGA) and NOT DEFINED (NETWARE)}
+ {$WARNING Proper behaviour for this target platform has not been checked!}
+{$ENDIF}
+{$IF NOT DEFINED (MACOS) and NOT DEFINED (AMIGA)}
+(* Special case - root directory needs to be treated in a special way. *)
+ {$IFDEF UNIX}
+ if (Length (FN) = 1)
+ {$ELSE UNIX}
+  {$IF DEFINED (OS2) or DEFINED (WINDOWS) or DEFINED (DPMI)}
+ if (((Length (FN) = 3) and (FN [2] = DriveSeparator))
+        or ((Length (FN) = 2) and (FN [1] = DirectorySeparator)))
+(* Root of UNC path - nonsense, but changing it to root of current drive would be dangerous. *)
+  {$ELSE}
+   {$IFDEF NETWARE}
+ if (Length (FN) = Pos (DirectorySeparator, FN))
+   {$ENDIF NETWARE}
+  {$ENDIF}
+      and (FN [Length (FN)] = DirectorySeparator) then
+ {$ENDIF UNIX}
+  if OptRecursive then
+    begin
+      BaseDir := FN;
+      BaseName := AllFilesMask;
+    end
+  else
+    begin
+      ErrorLn (FN + ': is a directory');
+      Exit;
+    end
+ else
+{$ENDIF}
+  begin
+(* Check if the specification directly corresponds to a directory *)
+  if FN [Length (FN)] = DirectorySeparator then
+    Delete (FN, Length (FN), 1);
+  FSplit (FN, D, N, E);
+  FindFirst (FN, (AnyFile or Directory) and not VolumeID, SR);
+  if (DosError = 0) and (SR.Attr and Directory = Directory) and
+                                                ((SR.Name = N + E) or
+(* Checking equal names is not sufficient with case preserving file systems. *)
+                              (Pos ('?', FN) = 0) and (Pos ('*', FN) = 0)) then
+    if OptRecursive then
+     begin
+      BaseDir := FN;
+      if BaseDir [Length (BaseDir)] <> DirectorySeparator then
+       BaseDir := BaseDir + DirectorySeparator;
+      BaseName := AllFilesMask;
+      RemFNDir := true;
+     end
+    else
+     if OptDirectories then
+      RemFNDir := true
+     else
+      begin
+       ErrorLn (FN + ': is a directory');
+       Exit;
+      end
+  else
+    begin
+      BaseDir := D;
+      BaseName := N + E;
+    end;
+  FindClose (SR);
+ end;
+  FindFirst (BaseDir + BaseName, AnyFile and not Directory and not VolumeID, SR);
+  while DosError = 0 do
+    begin
+      DelFile (BaseDir + SR.Name);
+      FindNext (SR);
+    end;
+  FindClose (SR);
+
+  if OptRecursive then
+    begin
+      FindFirst (BaseDir + BaseName, (AnyFile or Directory) and not VolumeID, SR);
+      while DosError = 0 do
+        begin
+          if (SR.Attr and Directory > 0) and
+           ((Length (SR.Name) <> 1) or (SR.Name [1] <> '.')) and
+           ((Length (SR.Name) <> 2) or (SR.Name [1] <> '.') or (SR.Name [2] <> '.')) and
+           (not (OptInteractive) or CheckOK ('descend directory ', BaseDir + SR.Name)) then
+            ProcessFSpec (BaseDir + SR.Name);
+          FindNext (SR);
+        end;
+      FindClose (SR);
+    end;
+  if RemFNDir then
+    DelDir (FN);
+end;
+
+
+procedure NewExit; far;
+begin
+  ExitProc := OldExit;
+  if (ErrorAddr <> nil) or (ExitCode <> 0) then
+    begin
+      ErrorAddr := nil;
+      case ExitCode of
+        202: WriteLn ('Directory tree too deep!!');
+        4: WriteLn ('Increase the FILES directive in CONFIG.SYS!!');
+        5, 101, 150..152, 154, 156..158, 160..162: WriteLn ('I/O error (',
+                                                              ExitCode, ')!!');
+      else
+        WriteLn ('Internal error (', ExitCode, ')!!');
+      end;
+      WriteLn;
+    end;
+end;
+
+
+procedure AllowSlash (var S: string); inline;
+var
+  I: byte;
+begin
+  if DirectorySeparator <> '/' then
+    for I := 1 to Length (S) do
+      begin
+        if S [I] = '/' then
+         S [I] := DirectorySeparator;
+      end;
+end;
+
+
+procedure ProcessOpts (S: string);
+var
+  I: longint;
+
+  procedure ParseOptTries; inline;
+  var
+    SN: string;
+    J, N, Err: longint;
+  begin
+    J := Succ (I);
+    while (J <= Length (S)) and (S [J] in ['0'..'9']) do
+     Inc (J);
+    if J = Succ (I) then
+     OptRetries := 3
+    else
+     begin
+      SN := Copy (S, Succ (I), J - I - 1);
+      Val (SN, N, Err);
+      if Err <> 0 then
+       ParError ('invalid value for retry attempts ''' + SN + '''');
+      OptRetries := N;
+      I := Pred (J);
+      if (J < Length (S)) and (S [J] = ',') then
+       begin
+        Inc (J);
+        Inc (I);
+        while (J <= Length (S)) and (S [J] in ['0'..'9']) do
+         Inc (J);
+        if J > Succ (I) then
+         begin
+          SN := Copy (S, Succ (I), J - I - 1);
+          Val (SN, N, Err);
+          if Err <> 0 then
+           ParError ('invalid value for retry wait time ''' + SN + '''');
+          OptWait := N;
+          I := Pred (J);
+         end;
+       end;
+     end;
+  end;
+
+begin
+  if S [2] = '-' then
+   if Length (S) = 2 then
+    OptsStop := true
+   else
+    begin
+      Delete (S, 1, 2);
+      for I := 1 to Length (S) do
+       S [I] := Upcase (S [I]);
+      if S = 'HELP' then Syntax;
+      if S = 'DIRECTORY' then
+       OptDirectories := true
+      else if S = 'FORCE' then
+       OptForce := true
+      else if S = 'INTERACTIVE' then
+       OptInteractive := true
+      else if S = 'RECURSIVE' then
+       OptRecursive := true
+      else if S = 'VERBOSE' then
+       OptVerbose := true
+      else if S = 'VERSION' then
+       begin
+        WriteLn ('rmwait - version 20091101');
+        Halt;
+       end
+      else if Copy (S, 1, 3) = 'TRY' then
+       begin
+        I := 3;
+        ParseOptTries;
+        if I <> Length (S) then
+         ParError ('unrecognized option ''' + S + '''');
+       end
+      else
+       ParError ('unrecognized option ''' + S + '''');
+    end
+  else
+   begin
+    I := 2;
+    repeat
+      case Upcase (S [I]) of
+       'H', '?': Syntax;
+       'D': OptDirectories := true;
+       'F': OptForce := true;
+       'I': OptInteractive := true;
+       'R': OptRecursive := true;
+       'V': OptVerbose := true;
+       'T': ParseOptTries;
+      else
+       ParError ('invalid option -- ' + S [I])
+      end;
+      Inc (I);
+    until (I > Length (S));
+   end;
+end;
+
+var
+  J, K: longint;
+  Par: string;
+
+begin
+{$IFDEF OS2}
+  DosCalls.DosError (0);
+{$ENDIF}
+
+  OldExit := ExitProc;
+  ExitProc := @NewExit;
+
+  J := ParamCount;
+  if J = 0 then
+    Syntax
+  else
+   begin
+    K := 1;
+    Par := ParamStr (K);
+
+    while (K <= J) and (Par [1] = '-') and (Length (Par) > 1) and not OptsStop do
+      begin
+        ProcessOpts (Par);
+        Inc (K);
+        Par := ParamStr (K);
+      end;
+
+    if K > J then
+     Syntax
+    else
+     repeat
+       AllowSlash (Par);
+       Deleted := 0;
+       ProcessFSpec (FExpand (Par));
+       if Deleted = 0 then
+        ErrorLn (ParamStr (K) + ': No such file or directory');
+       Inc (K);
+       Par := ParamStr (K);
+     until K > J;
+   end;
+end.