Updated to use the pascal implementation of fdblib

bepascal/Jamfile

@@ -34,6 +34,7 @@ rule MakeDistribs
 	MkDir $(DISTRIB_DIR) ;
 	# copy libbepascal.so in lib
 	Bulk lib : libbepascal.so ;
+	Bulk lib : libstubgen.so ;
 	Depends all :  ;
 	# binary files like libbepascal.so are needed to build bin_bepascal.zip
 	Depends bin_bepascal.zip : libbepascal.so ;
@@ -48,6 +49,7 @@ rule MakeDistribs
 
 # Install libbepascal.so in LIBBEPASCAL_INSTALL_DIR (/boot/home/config/lib)
 InstallLib $(LIBBEPASCAL_INSTALL_DIR) : libbepascal.so ;
+InstallLib $(LIBBEPASCAL_INSTALL_DIR) : libstubgen.so ;
 
 # Make distribution files
 MakeDistribs ;

bepascal/Jamrules

@@ -43,7 +43,7 @@ rule fpc
 # call the FreePascal compiler
 actions fpc
 {
-	fpc -g -S2 $(2)
+	fpc -FU$(LOCATE_TARGET) -g -S2 $(2)
 }
 
 # Make a zip file named $(1) that include (recursively) all files in the directory list $(2), except the ones 

bepascal/source/Jamfile

@@ -21,3 +21,4 @@
 SubDir BEPASCAL_TOP source ;
 
 SubInclude BEPASCAL_TOP source bepascal ;
+SubInclude BEPASCAL_TOP source tools ;

bepascal/source/bepascal/cpp/Jamfile

@@ -60,7 +60,7 @@ SRCS = src/be/bepas_kernel/beobj.cpp
        src/be/device/SerialPort.cpp 
        src/be/interface/Alert.cpp 
        src/be/interface/Box.cpp 
-       src/be/interface/Button.cpp
+       src/be/interface/Button.cpp 
        src/be/interface/CheckBox.cpp 
        src/be/interface/Control.cpp 
        src/be/interface/Font.cpp 
@@ -89,7 +89,7 @@ SRCS = src/be/bepas_kernel/beobj.cpp
        src/be/support/DataIO.cpp 
        src/be/support/Flattenable.cpp 
        src/be/support/List.cpp 
-       src/be/support/String.cpp
+       src/be/support/String.cpp 
        src/hey/hey.cpp ;
 
 # Specify the resource files to use

bepascal/source/bepascal/cpp/src/be/app/Messenger.cpp

@@ -271,8 +271,6 @@ BMessenger_Team(BMessenger *Messenger)
 //{
 //   Messenger->InitData(mime_sig, team, perr);
 //}
-
-
 #if defined(__cplusplus)
 }
 #endif

bepascal/source/bepascal/pas/Jamfile

@@ -20,5 +20,9 @@
 
 SubDir BEPASCAL_TOP source bepascal pas ;
 
+#Objects src/be/app/appdefs.pp 
+#        src/be/app/application.pp 
+#        src/be/app/handler.pp ;
+
 
 

bepascal/source/bepascal/pas/src/be/app/appdefs.pp

@@ -205,6 +205,8 @@ var
 	B_CONTROL_INVOKED			: Cardinal;
 	B_CONTROL_MODIFIED			: Cardinal;
 
+function trans( S : Array of char): cardinal;
+
 implementation
 
 FUNCTION Power(X,Y:Word):LongInt;

bepascal/source/bepascal/pas/src/be/app/application.pp

@@ -21,7 +21,7 @@ unit Application;
 interface
 
 uses
-  beobj, looper, appdefs, supportdefs, message, os, fdblib,roster;
+  beobj, looper, appdefs, supportdefs, message, os, roster;
 
 type
   BApplication = class(BLooper)

bepascal/source/bepascal/pas/src/be/app/handler.pp

@@ -21,7 +21,7 @@ unit handler;
 interface
 
 uses
-  beobj, archivable, message, fdblib;
+  beobj, archivable, message;
  
 type
   BHandler = class(BArchivable)

bepascal/source/bepascal/pas/src/be/app/messenger.pp

@@ -28,8 +28,8 @@ type
   private
   public
     constructor Create; override;
-    constructor Create(mime_sig : PChar; aTeam : Team_id; perr : PStatus_t);
+    constructor Create(mime_sig : PChar; aTeam : Team_id; var err : Status_t);
-    constructor Create(handler : BHandler; looper : BLooper; perr : PStatus_t);
+    constructor Create(handler : BHandler; looper : BLooper; var err : Status_t);
     constructor Create(from : BMessenger);
     destructor Destroy; override;
     function IsTargetLocal : boolean;
@@ -59,9 +59,9 @@ type
   end;
 
 function BMessenger_Create(AObject : TBeObject) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create';
-function BMessenger_Create(AObject : TBeObject; mime_sig : PChar; team : Team_id; perr : PStatus_t) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_1';
+function BMessenger_Create_1(AObject : TBeObject; mime_sig : PChar; team : Team_id; var err : Status_t) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_1';
-function BMessenger_Create(AObject : TBeObject; handler : BHandler; looper : BLooper; perr : PStatus_t) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_2';
+function BMessenger_Create_2(AObject : TBeObject; handler : BHandler; looper : BLooper; var err : Status_t) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_2';
-function BMessenger_Create(AObject : TBeObject; from : BMessenger) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_3';
+function BMessenger_Create_3(AObject : TBeObject; from : BMessenger) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_3';
 procedure BMessenger_Free(AObject : TCPlusObject); cdecl; external BePascalLibName name 'BMessenger_Free';
 function BMessenger_IsTargetLocal(AObject : TCPlusObject) : boolean; cdecl; external BePascalLibName name 'BMessenger_IsTargetLocal';
 function BMessenger_Target(AObject : TCPlusObject; looper : TCplusObject) : BHandler; cdecl; external BePascalLibName name 'BMessenger_Target';
@@ -100,19 +100,19 @@ begin
   BMessenger_Create(Self);
 end;
 
-constructor BMessenger.Create(mime_sig : PChar; aTeam : Team_id; perr : PStatus_t);
+constructor BMessenger.Create(mime_sig : PChar; aTeam : Team_id; var err : Status_t);
 begin
-  CPlusObject := BMessenger_Create(Self, mime_sig, aTeam, perr);
+  CPlusObject := BMessenger_Create_1(Self, mime_sig, aTeam, err);
 end;
 
-constructor BMessenger.Create(handler : BHandler; looper : BLooper; perr : PStatus_t);
+constructor BMessenger.Create(handler : BHandler; looper : BLooper; var err : Status_t);
 begin
-  CPlusObject := BMessenger_Create(Self, handler, looper, perr);
+  CPlusObject := BMessenger_Create_2(Self, handler, looper, err);
 end;
 
 constructor BMessenger.Create(from : BMessenger);
 begin
-  CPlusObject := BMessenger_Create(Self, from);
+  CPlusObject := BMessenger_Create_3(Self, from);
 end;
 
 destructor BMessenger.Destroy;
@@ -147,12 +147,22 @@ end;
 
 function BMessenger.SendMessage(a_message : BMessage; reply_to : BHandler; timeout : Bigtime_t) : Status_t;
 begin
-  Result := BMessenger_SendMessage_1(CPlusObject, a_message.CPlusObject, reply_to.CPlusObject, timeout);
+  if reply_to = nil then
+    Result := BMessenger_SendMessage_1(CPlusObject, a_message.CPlusObject, nil, timeout)
+  else 
+    Result := BMessenger_SendMessage_1(CPlusObject, a_message.CPlusObject, reply_to.CPlusObject, timeout);
 end;
 
 function BMessenger.SendMessage(a_message : BMessage; reply_to : BMessenger; timeout : Bigtime_t) : Status_t;
 begin
-  Result := BMessenger_SendMessage_2(CPlusObject, a_message.CPlusObject, reply_to.CPlusObject, timeout);
+  if reply_to = nil then
+  begin
+    WriteLn('BMessenger.SendMessage');
+    Result := BMessenger_SendMessage_2(CPlusObject, a_message.CPlusObject, nil, timeout);
+    WriteLn('BMessenger.AfterSendMessage');    
+  end
+  else 
+    Result := BMessenger_SendMessage_2(CPlusObject, a_message.CPlusObject, reply_to.CPlusObject, timeout);
 end;
 
 function BMessenger.SendMessage(command : Cardinal; reply : BMessage) : Status_t;

bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp

@@ -22,9 +22,6 @@ interface
 
 {$M+}
 
-uses
-  fdblib;
-  
 // FreePascal use ld on BeOS (like on LINUX) to link to libraries.
 // ld use the environment variable BELIBRARIES to find libraries.
 
@@ -49,6 +46,12 @@ type
     property CPlusObject : TCPlusObject read FCPlusObject write FCPlusObject;
   end;
 
+type
+  TSendTextProc = procedure(aText : string);
+
+procedure SendText(aText : string);
+procedure SetSendTextProc(aProc : TSendTextProc);
+
 implementation
 
 uses
@@ -56,7 +59,21 @@ uses
 
 var
   PasObject_GetPasClassName_hook : Pointer; cvar; external;
-  
+  SendTextProc : TSendTextProc;
+
+procedure SendText(aText : string);
+begin
+  if Assigned(SendTextProc) then
+  begin
+    SendTextProc(aText);
+  end;
+end;
+
+procedure SetSendTextProc(aProc : TSendTextProc);
+begin
+  SendTextProc := aProc;
+end;
+ 
 function PasObject_GetPasClassName_hook_func(PasObject : TBeObject) : PChar;
 begin
   if PasObject <> nil then
@@ -120,7 +137,10 @@ end;
 
 initialization
   PasObject_GetPasClassName_hook := @PasObject_GetPasClassName_hook_func;
+  if not Assigned(SendTextProc) then
+    SendTextProc := nil;
   
 finalization
   PasObject_GetPasClassName_hook := nil;
+  
 end.

bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp

@@ -0,0 +1,107 @@
+{  BePascal - A pascal wrapper around the BeOS API
+    Copyright (C) 2002 Olivier Coursiere
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library 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.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+{
+This is an implementation of fdblib in pascal for BePascal.
+When this unit is used in a BePascal project, the SendText function
+in beobj.pp send a "dbug" message to a fdb client.
+When fdblib is not in the project, SendText in beobj just do nothing.
+}
+
+unit fdblib;
+
+interface 
+
+procedure force;
+
+implementation
+
+uses
+  appdefs, message, application, messenger, handler, os, supportdefs, beobj;
+  
+const
+  B_DEBUG : array[0..3] of Char = ('d', 'b', 'u', 'g');
+  
+procedure SendMessage(message : BMessage);
+var
+  Messenger : BMessenger;
+  signature : PChar;
+  err : Status_t;
+begin
+  signature := 'application/x-vnd.befpc-debugconsole';
+  if be_app <> nil then
+  begin
+    Messenger := BMessenger.Create(signature, - 1, err);
+    try
+      if Messenger.IsValid then
+      begin
+        // BHandler(nil) is needed to call the right SendMessage function
+        // Here, we call SendMessage with one parameter (message)
+        // and  2 default parameters.
+        messenger.SendMessage(message, BHandler(nil), B_INFINITE_TIMEOUT);
+      end;
+    finally
+      Messenger.Free;
+    end;
+  end;
+end;
+
+procedure InternalSendText(text : string);
+var
+  message : BMessage;
+  local : string;
+begin
+  if be_app <> nil then
+  begin
+    local := text + #0;
+    message := BMessage.Create(trans(B_DEBUG));
+    try
+      message.AddString(PChar('dbstring'), @local[1]);
+      SendMessage(message);
+    finally
+      message.Free;
+    end;  
+  end
+  else
+    WriteLn(text);
+end;
+
+{
+procedure SendText(text : string);
+var
+  local : string;
+begin
+  local := text + #0;
+  SendText(@local[1]);
+end;
+}
+
+
+procedure force;
+begin
+  writeln('force');
+end;
+
+initialization
+  SetSendTextProc(@InternalSendText);
+  SendText('----------------------');
+  SendText('App start');
+
+finalization
+  SendText('App end');
+
+end.

bepascal/source/bepascal/pas/src/be/interface/menu.pp

@@ -22,7 +22,7 @@ interface
 
 uses
   beobj, view, message, archivable, SupportDefs, rect, list,
-  handler, messenger, fdblib;
+  handler, messenger;
 
 type
   Menu_Info = record

bepascal/source/bepascal/pas/src/be/interface/view.pp

@@ -24,7 +24,7 @@ interface
 
 uses
   beobj, handler, rect, os, application, appdefs, message,
-  graphicdefs, fdblib;
+  graphicdefs;
   
 type
 //  TWindow = class(TBeObject);

bepascal/source/bepascal/pas/src/be/kernel/os.pp

@@ -36,7 +36,13 @@ const
 const
   B_OS_NAME_LENGTH = 32;
   B_PAGE_SIZE = 4096;
-  B_INFINITE_TIMEOUT = 9223372036854775807;
+//  B_INFINITE_TIMEOUT = 9223372036854775807; // $7FFFFFFFFFFFFFFF
+
+// workaround because fpc 1.0.* don't support int64 const -> will
+// be changed in fpc 1.1.
+// see initialization section
+var
+  B_INFINITE_TIMEOUT : int64;
   
 type
   Area_id = Longint;
@@ -89,4 +95,13 @@ type
 
 implementation
 
+uses
+  SysUtils;
+  
+initialization
+// workaround because fpc 1.0.* don't support int64 const -> will
+// be changed in fpc 1.1.
+//  B_INFINITE_TIMEOUT := 9223372036854775807;
+  B_INFINITE_TIMEOUT := int64($7FFFFFFF) shl 32 + int64($FFFFFFFF);
+
 end.