From a5d36f286e2c1ec7e60c60465304cb3829639734 Mon Sep 17 00:00:00 2001 From: ocoursiere Date: Mon, 28 Jul 2003 23:22:07 +0000 Subject: [PATCH] Updated to use the pascal implementation of fdblib --- bepascal/Jamfile | 2 + bepascal/Jamrules | 2 +- bepascal/source/Jamfile | 1 + bepascal/source/bepascal/cpp/Jamfile | 4 +- .../bepascal/cpp/src/be/app/Messenger.cpp | 2 - bepascal/source/bepascal/pas/Jamfile | 4 + .../source/bepascal/pas/src/be/app/appdefs.pp | 2 + .../bepascal/pas/src/be/app/application.pp | 2 +- .../source/bepascal/pas/src/be/app/handler.pp | 2 +- .../bepascal/pas/src/be/app/messenger.pp | 34 ++++-- .../bepascal/pas/src/be/bepas_kernel/beobj.pp | 28 ++++- .../pas/src/be/bepas_kernel/fdblib.pp | 107 ++++++++++++++++++ .../bepascal/pas/src/be/interface/menu.pp | 2 +- .../bepascal/pas/src/be/interface/view.pp | 2 +- .../source/bepascal/pas/src/be/kernel/os.pp | 17 ++- 15 files changed, 185 insertions(+), 26 deletions(-) create mode 100644 bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp diff --git a/bepascal/Jamfile b/bepascal/Jamfile index e658f6c..ee628eb 100644 --- a/bepascal/Jamfile +++ b/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 ; diff --git a/bepascal/Jamrules b/bepascal/Jamrules index dd4b727..6030a1e 100644 --- a/bepascal/Jamrules +++ b/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 diff --git a/bepascal/source/Jamfile b/bepascal/source/Jamfile index c02f192..f9b7da6 100644 --- a/bepascal/source/Jamfile +++ b/bepascal/source/Jamfile @@ -21,3 +21,4 @@ SubDir BEPASCAL_TOP source ; SubInclude BEPASCAL_TOP source bepascal ; +SubInclude BEPASCAL_TOP source tools ; diff --git a/bepascal/source/bepascal/cpp/Jamfile b/bepascal/source/bepascal/cpp/Jamfile index 467cca6..3449d27 100644 --- a/bepascal/source/bepascal/cpp/Jamfile +++ b/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 diff --git a/bepascal/source/bepascal/cpp/src/be/app/Messenger.cpp b/bepascal/source/bepascal/cpp/src/be/app/Messenger.cpp index 06fe52b..3bf91de 100644 --- a/bepascal/source/bepascal/cpp/src/be/app/Messenger.cpp +++ b/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 diff --git a/bepascal/source/bepascal/pas/Jamfile b/bepascal/source/bepascal/pas/Jamfile index de8f177..829b774 100644 --- a/bepascal/source/bepascal/pas/Jamfile +++ b/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 ; + diff --git a/bepascal/source/bepascal/pas/src/be/app/appdefs.pp b/bepascal/source/bepascal/pas/src/be/app/appdefs.pp index 4ed57d1..cd189a8 100644 --- a/bepascal/source/bepascal/pas/src/be/app/appdefs.pp +++ b/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; diff --git a/bepascal/source/bepascal/pas/src/be/app/application.pp b/bepascal/source/bepascal/pas/src/be/app/application.pp index 7d28ea4..92c0bd1 100644 --- a/bepascal/source/bepascal/pas/src/be/app/application.pp +++ b/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) diff --git a/bepascal/source/bepascal/pas/src/be/app/handler.pp b/bepascal/source/bepascal/pas/src/be/app/handler.pp index 78c21a7..e42b3e0 100644 --- a/bepascal/source/bepascal/pas/src/be/app/handler.pp +++ b/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) diff --git a/bepascal/source/bepascal/pas/src/be/app/messenger.pp b/bepascal/source/bepascal/pas/src/be/app/messenger.pp index 87ae9bf..bb68504 100644 --- a/bepascal/source/bepascal/pas/src/be/app/messenger.pp +++ b/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(handler : BHandler; looper : BLooper; perr : PStatus_t); + constructor Create(mime_sig : PChar; aTeam : Team_id; var err : Status_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(AObject : TBeObject; handler : BHandler; looper : BLooper; perr : PStatus_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_1(AObject : TBeObject; mime_sig : PChar; team : Team_id; var err : Status_t) : TCplusObject; cdecl; external BePascalLibName name 'BMessenger_Create_1'; +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_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; diff --git a/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp b/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp index 92e1141..6768484 100644 --- a/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp +++ b/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. diff --git a/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp b/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp new file mode 100644 index 0000000..adbbde1 --- /dev/null +++ b/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. diff --git a/bepascal/source/bepascal/pas/src/be/interface/menu.pp b/bepascal/source/bepascal/pas/src/be/interface/menu.pp index 4e5b7d4..d72f919 100644 --- a/bepascal/source/bepascal/pas/src/be/interface/menu.pp +++ b/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 diff --git a/bepascal/source/bepascal/pas/src/be/interface/view.pp b/bepascal/source/bepascal/pas/src/be/interface/view.pp index 7a33d47..ab28507 100644 --- a/bepascal/source/bepascal/pas/src/be/interface/view.pp +++ b/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); diff --git a/bepascal/source/bepascal/pas/src/be/kernel/os.pp b/bepascal/source/bepascal/pas/src/be/kernel/os.pp index f0f87aa..aaf806a 100644 --- a/bepascal/source/bepascal/pas/src/be/kernel/os.pp +++ b/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.