Replace obsolete/broken lcoregtklaz with new lcorelazarus

Rename lmessages to lcoremessages due to unit name conflict with Lazarus

git-svn-id: file:///svnroot/lcore/trunk@149 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/bsearchtree.pas b/bsearchtree.pas
index 9ec804c750edae6740653c11364ba1a17c04dd7e..249a6ff3c066e48b9f19b2777a3ae97f4be5c8b3 100644 (file)
--- a/bsearchtree.pas
+++ b/bsearchtree.pas
@@ -7,6 +7,9 @@
 \r
 unit bsearchtree;\r
 \r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 uses blinklist;\r

diff --git a/btime.pas b/btime.pas
index ff77de9e8a681a23ae3292c8a604981fe4a3ca93..8218e6415a97bf63f25a278f6c75ceb0ad95280c 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -9,7 +9,9 @@ works on windows/delphi, and on freepascal on unix.
 \r
 \r
 unit btime;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 {$ifdef mswindows}\r
@@ -105,9 +107,7 @@ var
 \r
 implementation\r
 \r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
+\r
 \r
 uses\r
   {$ifdef UNIX}\r

diff --git a/dnsasync.pas b/dnsasync.pas
index 68b5c1f3adf3573b1a710c1808441a950eea8dd5..f9fa50e974bac9b316ed0210621101d9ae180b22 100644 (file)
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -7,7 +7,9 @@
 //not seem to have any form of retry code.\r
 \r
 unit dnsasync;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 uses\r

diff --git a/lcoregtklaz.pas b/lcoregtklaz.pas
deleted file mode 100644 (file)
index 6473784..0000000
--- a/lcoregtklaz.pas
+++ /dev/null
@@ -1,142 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-      \r
-unit lcoregtklaz;\r
-{$mode delphi}\r
-interface\r
-       \r
-uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;\r
-//procedure lcoregtklazrun;\r
-const\r
-  G_IO_IN=1;\r
-  G_IO_OUT=4;\r
-  G_IO_PRI=2;\r
-  G_IO_ERR=8;\r
-\r
-  G_IO_HUP=16;\r
-  G_IO_NVAL=32;\r
-type\r
-  tlaztimerwrapperinterface=class(ttimerwrapperinterface)\r
-  public\r
-    function createwrappedtimer : tobject;override;\r
-//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;\r
-    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;\r
-  end;\r
-\r
-procedure lcoregtklazinit;\r
-implementation\r
-  uses\r
-    ExtCtrls;\r
-{$I unixstuff.inc}\r
-var\r
-  giochannels : array[0..absolutemaxs] of pgiochannel;\r
-\r
-function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;\r
-// return true if we want the callback to stay\r
-var\r
-  fd                    : integer ;\r
-  fdsrlocal , fdswlocal : fdset   ;\r
-  currentasio           : tlasio  ;\r
-begin\r
-  fd := g_io_channel_unix_get_fd(source);\r
-  fd_zero(fdsrlocal);\r
-  fd_set(fd,fdsrlocal);\r
-  fdswlocal := fdsrlocal;\r
-  select(fd+1,@fdsrlocal,@fdswlocal,nil,0);\r
-  if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin\r
-    currentasio := fdreverse[fd];\r
-    if assigned(currentasio) then begin\r
-      currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));\r
-    end else begin\r
-      rmasterclr(fd);\r
-      wmasterclr(fd);\r
-    end;\r
-  end;\r
-  case condition of\r
-    G_IO_IN : begin\r
-      result := rmasterisset(fd);\r
-    end;\r
-    G_IO_OUT : begin\r
-      result := wmasterisset(fd);\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure gtkrmasterset(fd : integer);\r
-begin\r
-  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
-  g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);\r
-end;\r
-\r
-procedure gtkrmasterclr(fd: integer);\r
-begin\r
-end;\r
-  \r
-procedure gtkwmasterset(fd : integer);\r
-begin\r
-  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
-  g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);\r
-end;\r
-\r
-procedure gtkwmasterclr(fd: integer);\r
-begin\r
-end;\r
-\r
-type\r
-  tsc = class\r
-    procedure dotasksandsink(sender:tobject;error:word);\r
-  end;\r
-var\r
-  taskloopback : tlloopback;\r
-  sc           : tsc;\r
-procedure tsc.dotasksandsink(sender:tobject;error:word);\r
-begin\r
-  with tlasio(sender) do begin\r
-    sinkdata(sender,error);\r
-    processtasks;\r
-  end;\r
-end;\r
-procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  taskloopback.sendstr(' ');\r
-  \r
-end;\r
-\r
-procedure lcoregtklazinit;\r
-begin\r
-  onrmasterset := gtkrmasterset;\r
-  onrmasterclr := gtkrmasterclr;\r
-  onwmasterset := gtkwmasterset;\r
-  onwmasterclr := gtkwmasterclr;\r
-  onaddtask := gtkaddtask;\r
-  taskloopback := tlloopback.create(nil);\r
-  taskloopback.ondataavailable := sc.dotasksandsink;\r
-  timerwrapperinterface := tlaztimerwrapperinterface.create(nil);\r
-end;\r
-\r
-function tlaztimerwrapperinterface.createwrappedtimer : tobject;\r
-begin\r
-  result := ttimer.create(nil);\r
-end;\r
-procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);\r
-begin\r
-  ttimer(wrappedtimer).ontimer := newvalue;\r
-end;\r
-procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);\r
-begin\r
-  ttimer(wrappedtimer).enabled := newvalue;\r
-end;\r
-\r
-\r
-procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);\r
-begin\r
-  ttimer(wrappedtimer).interval := newvalue;\r
-end;\r
-\r
-\r
-end.\r
-\r

diff --git a/lcorelazarus.pas b/lcorelazarus.pas
new file mode 100644 (file)
index 0000000..d347703
--- /dev/null
+++ b/lcorelazarus.pas
@@ -0,0 +1,166 @@
+{ Copyright (C) 2005-2017 Robin Green, Bas Steendijk, Peter Green\r
+  For conditions of distribution and use, see copyright notice in zlib_license.\r
+txt\r
+  which is included in the package\r
+  -----------------------------------------------------------------------------\r
+}\r
+\r
+unit lcorelazarus;\r
+{$mode delphi}\r
+interface\r
+\r
+uses\r
+  lcore,\r
+  Classes, SysUtils,Forms,fd_utils,LCLIntf,InterfaceBase,ExtCtrls;\r
+\r
+\r
+procedure lcoreinit;\r
+\r
+implementation\r
+const\r
+  absolutemaxs_select = (sizeof(fdset)*8)-1;\r
+\r
+var\r
+  fdreverse:array[0..absolutemaxs_select] of tlasio;\r
+  fdEventHandlers:array[0..absolutemaxs_select] of PEventHandler;\r
+  fdflags:array[0..absolutemaxs_select] of byte;\r
+  tasksoutstanding : boolean;\r
+type\r
+  tlazaruseventcore=class(teventcore)\r
+  public\r
+    procedure processmessages; override;\r
+    procedure messageloop; override;\r
+    procedure exitmessageloop;override;\r
+    procedure setfdreverse(fd : integer;reverseto : tlasio); override;\r
+    procedure rmasterset(fd : integer;islistensocket : boolean); override;\r
+    procedure rmasterclr(fd: integer); override;\r
+    procedure wmasterset(fd : integer); override;\r
+    procedure wmasterclr(fd: integer); override;\r
+    procedure WaitHandleEvent(AData: PtrInt; AFlags: dword);\r
+    procedure taskcb(Data: PtrInt);\r
+  end;\r
+\r
+  tlaztimerwrapperinterface=class(ttimerwrapperinterface)\r
+  public\r
+    function createwrappedtimer : tobject;override;\r
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;\r
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;\r
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;\r
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;\r
+  end;\r
+const\r
+  G_IO_IN  = 1;\r
+  G_IO_OUT = 4;\r
+\r
+procedure tlazaruseventcore.taskcb(Data: PtrInt);\r
+begin\r
+\r
+   tasksoutstanding := false;\r
+   processtasks;\r
+end;\r
+\r
+procedure tlazaruseventcore.WaitHandleEvent(AData: PtrInt; AFlags: dword);\r
+var lasio:tlasio;\r
+begin\r
+   lasio:=fdreverse[AData];\r
+   if lasio<>nil then lasio.handlefdtrigger((AFlags and G_IO_IN)<>0,(AFlags and G_IO_OUT)<>0);\r
+end;\r
+\r
+procedure tlazaruseventcore.processmessages;\r
+begin\r
+   Application.ProcessMessages;\r
+end;\r
+procedure tlazaruseventcore.messageloop;\r
+begin\r
+   Application.Run;\r
+end;\r
+procedure tlazaruseventcore.exitmessageloop;\r
+begin\r
+   Application.Terminate;\r
+end;\r
+procedure tlazaruseventcore.setfdreverse(fd : integer;reverseto : tlasio);\r
+begin\r
+  fdreverse[fd] := reverseto;\r
+\r
+end;\r
+procedure addfdflags(fd : integer;flags:byte);\r
+begin\r
+   fdflags[fd]:=fdflags[fd] or flags;\r
+   if fdEventHandlers[fd]=nil then  begin\r
+      fdEventHandlers[fd]:=AddEventHandler(fd,flags,tlazaruseventcore(eventcore).WaitHandleEvent,fd);\r
+   end else begin\r
+\r
+      SetEventHandlerFlags(fdEventHandlers[fd], fdflags[fd]);\r
+   end;\r
+end;\r
+\r
+procedure removefdflags(fd : integer;flags:byte);\r
+begin\r
+   if fdEventHandlers[fd]<>nil then  begin\r
+      fdflags[fd]:=fdflags[fd] and (not flags);\r
+      if fdflags[fd]=0 then begin\r
+         RemoveEventHandler(fdEventHandlers[fd]);\r
+         fdEventHandlers[fd]:=nil;\r
+      end else begin\r
+\r
+         SetEventHandlerFlags(fdEventHandlers[fd], fdflags[fd]);\r
+      end;\r
+   end;\r
+end;\r
+\r
+procedure tlazaruseventcore.rmasterset(fd : integer;islistensocket : boolean);\r
+begin\r
+   addfdflags(fd,G_IO_IN);\r
+end;\r
+procedure tlazaruseventcore.rmasterclr(fd: integer);\r
+begin\r
+   removefdflags(fd,G_IO_IN);\r
+end;\r
+procedure tlazaruseventcore.wmasterset(fd : integer);\r
+begin\r
+   addfdflags(fd,G_IO_OUT);\r
+\r
+end;\r
+procedure tlazaruseventcore.wmasterclr(fd: integer);\r
+begin\r
+   removefdflags(fd,G_IO_OUT);\r
+end;\r
+\r
+procedure lazaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
+begin\r
+  if not tasksoutstanding then  Application.QueueAsyncCall(tlazaruseventcore(eventcore).taskcb,0);\r
+  tasksoutstanding := true;\r
+end;\r
+\r
+function tlaztimerwrapperinterface.createwrappedtimer : tobject;\r
+begin\r
+  result := ttimer.create(nil);\r
+end;\r
+procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);\r
+begin\r
+  ttimer(wrappedtimer).ontimer := newvalue;\r
+end;\r
+procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);\r
+begin\r
+  ttimer(wrappedtimer).enabled := newvalue;\r
+end;\r
+\r
+\r
+procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);\r
+begin\r
+  ttimer(wrappedtimer).interval := newvalue;\r
+end;\r
+var\r
+  inited:boolean;\r
+procedure lcoreinit;\r
+begin\r
+  if (inited) then exit;\r
+  eventcore := tlazaruseventcore.create;\r
+  onaddtask := lazaddtask;\r
+\r
+  absolutemaxs := absolutemaxs_select;\r
+  inited := true;\r
+end;\r
+\r
+end.\r
+\r

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index d2750129f343906eee9231f4082c5a9c965f2e6f..8698a8cc47b305d59b9518d90be4110ebb6b155f 100644 (file)
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -36,7 +36,9 @@ notes:
 }\r
 \r
 unit lcorelocalips;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 uses binipstuff,pgtypes;\r
@@ -416,4 +418,4 @@ begin
 end;\r
 {$endif}\r
 \r
-end.\r
+end.\r
\ No newline at end of file

diff --git a/lmessages.pas b/lcoremessages.pas
similarity index 96%
rename from lmessages.pas
rename to lcoremessages.pas
index d5521e59d93460ec79eef3f1a785bd8d9b87fce7..8a2bd546a83354f230140460e0adf74590accaff 100644 (file)
--- a/lmessages.pas
+++ b/lcoremessages.pas
@@ -8,7 +8,7 @@
 //the main lcore thread\r
 //This unit is *nix only, on windows you should use the real thing\r
 \r
-unit lmessages;\r
+unit lcoremessages;\r
 //windows messages like system based on lcore tasks\r
 interface\r
 \r

diff --git a/lcorernd.pas b/lcorernd.pas
index b76ab4934ffe4c15365f12467442e3d186b2dccb..d2788523f244b521f2a0fc9a7e7ed14c535a2c19 100644 (file)
--- a/lcorernd.pas
+++ b/lcorernd.pas
@@ -4,7 +4,9 @@
   ----------------------------------------------------------------------------- }\r
 \r
 unit lcorernd;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 {$include lcoreconfig.inc}\r

diff --git a/lcoretest.dpr b/lcoretest.dpr
index bfba05491ace25c95a860074859a96babfd217c7..288c0b477b762f2e637361717e7aecd6c0daa532 100644 (file)
--- a/lcoretest.dpr
+++ b/lcoretest.dpr
@@ -17,7 +17,7 @@ uses
   {$ifndef mswindows}\r
     ,\r
     {$ifndef nomessages}\r
-      lmessages,\r
+      lcoremessages,\r
       unitwindowobject,\r
     {$endif}\r
     unitfork\r

diff --git a/lcorewsaasyncselect.pas b/lcorewsaasyncselect.pas
index d0291036f2ed35b4048c525ef5c41d60530947fa..6b4c01b4961eccd852c65d09cf600759adba19a2 100644 (file)
--- a/lcorewsaasyncselect.pas
+++ b/lcorewsaasyncselect.pas
@@ -166,6 +166,7 @@ end;
 procedure winaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
 begin\r
   if not tasksoutstanding then PostMessage(hwndlcore,wm_dotasks,0,0);\r
+  tasksoutstanding := true;\r
 end;\r
 type\r
   twcoretimer = wcore.tltimer;\r

diff --git a/unitfork.pas b/unitfork.pas
index 019695bfb796ea852173ef290476c5e926bab579..3bcb3b1c3a408abfe325d7b9d750ae54c033a952 100644 (file)
--- a/unitfork.pas
+++ b/unitfork.pas
@@ -3,7 +3,9 @@
     which is included in the package\r
       ----------------------------------------------------------------------------- }\r
 unit unitfork;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
 procedure dofork(const programname:string);\r

diff --git a/unitwindowobject.pas b/unitwindowobject.pas
index 414f975ee0d38dbb2663372b2485db63c59bfda4..ec5d955fa3b0a3b1315ed59c686b2efa951c1d96 100644 (file)
--- a/unitwindowobject.pas
+++ b/unitwindowobject.pas
@@ -12,9 +12,9 @@ uses
   {$ifdef mswindows}\r
     windows,messages,wmessages,\r
   {$else}\r
-    lmessages,\r
+    lcoremessages,\r
     {$macro on}\r
-    {$define windows := lmessages}\r
+    {$define windows := lcoremessages}\r
   {$endif}\r
   sysutils,\r
   pgtypes;\r

diff --git a/wmessages.pas b/wmessages.pas
index 205e79d07f2754048b14eb44db55cc98635758c1..526eba5ccc5e938c0e47efe2bca3fbb2b3056596 100644 (file)
--- a/wmessages.pas
+++ b/wmessages.pas
@@ -5,7 +5,7 @@
       \r
 unit wmessages;\r
 //this unit contains various functions and types to make it easier to write\r
-//code that works with both real windows messages and lmessages\r
+//code that works with both real windows messages and lcoremessages\r
 \r
 interface\r
 uses windows,messages,pgtypes;\r
@@ -15,7 +15,7 @@ type
 \r
 //according to MS you are supposed to use get/setwindowlongptr to get/set\r
 //pointers in extra window memory so your program can be built for win64, this\r
-//is also the only interface to window memory that lmessages offers but delphi\r
+//is also the only interface to window memory that lcoremessages offers but delphi\r
 //doesn't define it so alias it to getwindowlong here for win32.\r
 {$ifndef win64} //future proofing ;)\r
   function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r