diff options
author | Jens-Heiner Rechtien <hr@openoffice.org> | 2000-09-18 15:18:56 +0000 |
---|---|---|
committer | Jens-Heiner Rechtien <hr@openoffice.org> | 2000-09-18 15:18:56 +0000 |
commit | c25ec0608a167bcf1d891043f02273761c351701 (patch) | |
tree | 32c3e19f0b663e37ad1910e8fddeac200ad3856d /basic/source/classes/sb.cxx |
initial import
Diffstat (limited to 'basic/source/classes/sb.cxx')
-rw-r--r-- | basic/source/classes/sb.cxx | 1028 |
1 files changed, 1028 insertions, 0 deletions
diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx new file mode 100644 index 000000000000..6b3cd5c011ba --- /dev/null +++ b/basic/source/classes/sb.cxx @@ -0,0 +1,1028 @@ +/************************************************************************* + * + * $RCSfile: sb.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:10 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * 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 + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include <stdio.h> // sprintf() + +#pragma hdrstop +#include "sb.hxx" +#ifdef VCL +#include <vcl/rcid.h> +#include <vcl/config.hxx> +#endif + +#ifndef _STREAM_HXX //autogen +#include <tools/stream.hxx> +#endif +#ifndef __RSC //autogen +#include <tools/errinf.hxx> +#endif +#ifndef _SBXCLASS_HXX //autogen +#include <svtools/sbx.hxx> +#endif +#ifndef _LIST_HXX //autogen +#include <tools/list.hxx> +#endif +#ifndef _SHL_HXX //autogen +#include <tools/shl.hxx> +#endif +#ifndef _TOOLS_RC_HXX //autogen +#include <tools/rc.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#include "sbunoobj.hxx" +#include "sbjsmeth.hxx" +#include "sbjsmod.hxx" +#include "sbintern.hxx" +#include "disas.hxx" +#include "runtime.hxx" +#include "sbuno.hxx" +#include "stdobj.hxx" +#include "filefmt.hxx" +#include "sb.hrc" +#include <basrid.hxx> + +#pragma SW_SEGMENT_CLASS( SBASIC, SBASIC_CODE ) + +SV_IMPL_VARARR(SbTextPortions,SbTextPortion) + +TYPEINIT1(StarBASIC,SbxObject) + +#define RTLNAME "@SBRTL" + + +//======================================================================== +// Array zur Umrechnung SFX <-> VB-Fehlercodes anlegen + +struct SFX_VB_ErrorItem +{ + USHORT nErrorVB; + SbError nErrorSFX; +}; + +const SFX_VB_ErrorItem __FAR_DATA SFX_VB_ErrorTab[] = +{ + { 2, SbERR_SYNTAX }, + { 3, SbERR_NO_GOSUB }, + { 4, SbERR_REDO_FROM_START }, + { 5, SbERR_BAD_ARGUMENT }, + { 6, SbERR_MATH_OVERFLOW }, + { 7, SbERR_NO_MEMORY }, + { 8, SbERR_ALREADY_DIM }, + { 9, SbERR_OUT_OF_RANGE }, + { 10, SbERR_DUPLICATE_DEF }, + { 11, SbERR_ZERODIV }, + { 12, SbERR_VAR_UNDEFINED }, + { 13, SbERR_CONVERSION }, + { 14, SbERR_BAD_PARAMETER }, + { 18, SbERR_USER_ABORT }, + { 20, SbERR_BAD_RESUME }, + { 28, SbERR_STACK_OVERFLOW }, + { 35, SbERR_PROC_UNDEFINED }, + { 48, SbERR_BAD_DLL_LOAD }, + { 49, SbERR_BAD_DLL_CALL }, + { 51, SbERR_INTERNAL_ERROR }, + { 52, SbERR_BAD_CHANNEL }, + { 53, SbERR_FILE_NOT_FOUND }, + { 54, SbERR_BAD_FILE_MODE }, + { 55, SbERR_FILE_ALREADY_OPEN }, + { 57, SbERR_IO_ERROR }, + { 58, SbERR_FILE_EXISTS }, + { 59, SbERR_BAD_RECORD_LENGTH }, + { 61, SbERR_DISK_FULL }, + { 62, SbERR_READ_PAST_EOF }, + { 63, SbERR_BAD_RECORD_NUMBER }, + { 67, SbERR_TOO_MANY_FILES }, + { 68, SbERR_NO_DEVICE }, + { 70, SbERR_ACCESS_DENIED }, + { 71, SbERR_NOT_READY }, + { 73, SbERR_NOT_IMPLEMENTED }, + { 74, SbERR_DIFFERENT_DRIVE }, + { 75, SbERR_ACCESS_ERROR }, + { 76, SbERR_PATH_NOT_FOUND }, + { 91, SbERR_NO_OBJECT }, + { 93, SbERR_BAD_PATTERN }, + { 94, SBERR_IS_NULL }, + { 250, SbERR_DDE_ERROR }, + { 280, SbERR_DDE_WAITINGACK }, + { 281, SbERR_DDE_OUTOFCHANNELS }, + { 282, SbERR_DDE_NO_RESPONSE }, + { 283, SbERR_DDE_MULT_RESPONSES }, + { 284, SbERR_DDE_CHANNEL_LOCKED }, + { 285, SbERR_DDE_NOTPROCESSED }, + { 286, SbERR_DDE_TIMEOUT }, + { 287, SbERR_DDE_USER_INTERRUPT }, + { 288, SbERR_DDE_BUSY }, + { 289, SbERR_DDE_NO_DATA }, + { 290, SbERR_DDE_WRONG_DATA_FORMAT }, + { 291, SbERR_DDE_PARTNER_QUIT }, + { 292, SbERR_DDE_CONV_CLOSED }, + { 293, SbERR_DDE_NO_CHANNEL }, + { 294, SbERR_DDE_INVALID_LINK }, + { 295, SbERR_DDE_QUEUE_OVERFLOW }, + { 296, SbERR_DDE_LINK_ALREADY_EST }, + { 297, SbERR_DDE_LINK_INV_TOPIC }, + { 298, SbERR_DDE_DLL_NOT_FOUND }, + { 323, SbERR_CANNOT_LOAD }, + { 341, SbERR_BAD_INDEX }, + { 366, SbERR_NO_ACTIVE_OBJECT }, + { 380, SbERR_BAD_PROP_VALUE }, + { 382, SbERR_PROP_READONLY }, + { 394, SbERR_PROP_WRITEONLY }, + { 420, SbERR_INVALID_OBJECT }, + { 423, SbERR_NO_METHOD }, + { 424, SbERR_NEEDS_OBJECT }, + { 425, SbERR_INVALID_USAGE_OBJECT }, + { 430, SbERR_NO_OLE }, + { 438, SbERR_BAD_METHOD }, + { 440, SbERR_OLE_ERROR }, + { 445, SbERR_BAD_ACTION }, + { 446, SbERR_NO_NAMED_ARGS }, + { 447, SbERR_BAD_LOCALE }, + { 448, SbERR_NAMED_NOT_FOUND }, + { 449, SbERR_NOT_OPTIONAL }, + { 450, SbERR_WRONG_ARGS }, + { 451, SbERR_NOT_A_COLL }, + { 452, SbERR_BAD_ORDINAL }, + { 453, SbERR_DLLPROC_NOT_FOUND }, + { 460, SbERR_BAD_CLIPBD_FORMAT }, + { 951, SbERR_UNEXPECTED }, + { 952, SbERR_EXPECTED }, + { 953, SbERR_SYMBOL_EXPECTED }, + { 954, SbERR_VAR_EXPECTED }, + { 955, SbERR_LABEL_EXPECTED }, + { 956, SbERR_LVALUE_EXPECTED }, + { 957, SbERR_VAR_DEFINED }, + { 958, SbERR_PROC_DEFINED }, + { 959, SbERR_LABEL_DEFINED }, + { 960, SbERR_UNDEF_VAR }, + { 961, SbERR_UNDEF_ARRAY }, + { 962, SbERR_UNDEF_PROC }, + { 963, SbERR_UNDEF_LABEL }, + { 964, SbERR_UNDEF_TYPE }, + { 965, SbERR_BAD_EXIT }, + { 966, SbERR_BAD_BLOCK }, + { 967, SbERR_BAD_BRACKETS }, + { 968, SbERR_BAD_DECLARATION }, + { 969, SbERR_BAD_PARAMETERS }, + { 970, SbERR_BAD_CHAR_IN_NUMBER }, + { 971, SbERR_MUST_HAVE_DIMS }, + { 972, SbERR_NO_IF }, + { 973, SbERR_NOT_IN_SUBR }, + { 974, SbERR_NOT_IN_MAIN }, + { 975, SbERR_WRONG_DIMS }, + { 976, SbERR_BAD_OPTION }, + { 977, SbERR_CONSTANT_REDECLARED }, + { 978, SbERR_PROG_TOO_LARGE }, + { 979, SbERR_NO_STRINGS_ARRAYS }, + { 1000, SbERR_PROPERTY_NOT_FOUND }, + { 1001, SbERR_METHOD_NOT_FOUND }, + { 1002, SbERR_ARG_MISSING }, + { 1003, SbERR_BAD_NUMBER_OF_ARGS }, + { 1004, SbERR_METHOD_FAILED }, + { 1005, SbERR_SETPROP_FAILED }, + { 1006, SbERR_GETPROP_FAILED }, + { 0xFFFF, 0xFFFFFFFFL } // End-Marke +}; + +//////////////////////////////////////////////////////////////////////////// + +// Die StarBASIC-Factory hat einen Hack. Wenn ein SbModule eingerichtet wird, +// wird der Pointer gespeichert und an nachfolgende SbProperties/SbMethods +// uebergeben. Dadurch wird die Modul-Relationship wiederhergestellt. Das +// klappt aber nur, wenn ein Modul geladen wird. Fuer getrennt geladene +// Properties kann es Probleme geben! + +SbxBase* SbiFactory::Create( UINT16 nSbxId, UINT32 nCreator ) +{ + if( nCreator == SBXCR_SBX ) + { + String aEmpty; + switch( nSbxId ) + { + case SBXID_BASIC: + return new StarBASIC( NULL ); + case SBXID_BASICMOD: + return new SbModule( aEmpty ); + case SBXID_BASICPROP: + return new SbProperty( aEmpty, SbxVARIANT, NULL ); + case SBXID_BASICMETHOD: + return new SbMethod( aEmpty, SbxVARIANT, NULL ); + case SBXID_JSCRIPTMOD: + return new SbJScriptModule( aEmpty ); + case SBXID_JSCRIPTMETH: + return new SbJScriptMethod( aEmpty, SbxVARIANT, NULL ); + } + } + return NULL; +} + +SbxObject* SbiFactory::CreateObject( const String& rClass ) +{ + if( rClass.EqualsIgnoreCaseAscii( "StarBASIC" ) ) + return new StarBASIC( NULL ); + else + if( rClass.EqualsIgnoreCaseAscii( "StarBASICModule" ) ) + { + String aEmpty; + return new SbModule( aEmpty ); + } + else + return NULL; +} + +//////////////////////////////////////////////////////////////////////////// + +StarBASIC::StarBASIC( StarBASIC* p ) + : SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("StarBASIC") ) ) +{ + SetParent( p ); + pLibInfo = NULL; + bNoRtl = bBreak = FALSE; + pModules = new SbxArray; + +#ifdef DBG_UTIL + Config LangConfig( String( RTL_CONSTASCII_USTRINGPARAM("d:\\LANGUAGE.INI") ) ); + LangConfig.SetGroup( "main" ); + ByteString aStr = LangConfig.ReadKey( "language","basic" ); + if( aStr == "vbscript" ) + SetGlobalLanguageMode( SB_LANG_VBSCRIPT ); + else + if( aStr == "javascript" ) + SetGlobalLanguageMode( SB_LANG_JAVASCRIPT ); +#endif + + if( !GetSbData()->nInst++ ) + { + pSBFAC = new SbiFactory; + AddFactory( pSBFAC ); + pUNOFAC = new SbUnoFactory; + AddFactory( pUNOFAC ); + } + pRtl = new SbiStdObject( String( RTL_CONSTASCII_USTRINGPARAM(RTLNAME) ), this ); + // Suche ueber StarBASIC ist immer global + SetFlag( SBX_GBLSEARCH ); +} + +// #51727 SetModified ueberladen, damit der Modified- +// Zustand nicht an den Parent weitergegeben wird. +void StarBASIC::SetModified( BOOL b ) +{ + SbxBase::SetModified( b ); +} + +//*** + +StarBASIC::~StarBASIC() +{ + if( !--GetSbData()->nInst ) + { + RemoveFactory( pSBFAC ); + pSBFAC = NULL; + RemoveFactory( pUNOFAC ); + pUNOFAC = NULL; + +#ifdef DBG_UTIL + // SbiData braucht am Programm-Ende nicht abgeraeumt werden, + // aber wir wollen keine MLK's beim Purify + // Wo sollte es sonst geschehen??? + SbiGlobals** pp = (SbiGlobals**) ::GetAppData( SHL_SBC ); + SbiGlobals* p = *pp; + if( p ) + { + delete p; + *pp = 0; + } +#endif + } +} + +// operator new() wird hier versenkt, damit jeder eine Instanz +// anlegen kann, ohne neu zu bilden. + +void* StarBASIC::operator new( size_t n ) +{ + if( n < sizeof( StarBASIC ) ) + { +// DBG_ASSERT( FALSE, "Warnung: inkompatibler BASIC-Stand!" ); + n = sizeof( StarBASIC ); + } + return ::operator new( n ); +} + +void StarBASIC::operator delete( void* p ) +{ + ::operator delete( p ); +} + +/************************************************************************** +* +* Erzeugen/Verwalten von Modulen +* +**************************************************************************/ + +SbModule* StarBASIC::MakeModule( const String& rName, const String& rSrc ) +{ + SbModule* p = new SbModule( rName ); + p->SetSource( rSrc ); + p->SetParent( this ); + pModules->Insert( p, pModules->Count() ); + SetModified( TRUE ); + return p; +} + +void StarBASIC::Insert( SbxVariable* pVar ) +{ + if( pVar->IsA( TYPE(SbModule) ) ) + { + pModules->Insert( pVar, pModules->Count() ); + pVar->SetParent( this ); + StartListening( pVar->GetBroadcaster(), TRUE ); + } + else + { + BOOL bWasModified = IsModified(); + SbxObject::Insert( pVar ); + if( !bWasModified && pVar->IsSet( SBX_DONTSTORE ) ) + SetModified( FALSE ); + } +} + +void StarBASIC::Remove( SbxVariable* pVar ) +{ + if( pVar->IsA( TYPE(SbModule) ) ) + { + pModules->Remove( pVar ); + pVar->SetParent( 0 ); + EndListening( pVar->GetBroadcaster() ); + } + else + SbxObject::Remove( pVar ); +} + +BOOL StarBASIC::Compile( SbModule* pMod ) +{ + return pMod ? pMod->Compile() : FALSE; +} + +BOOL StarBASIC::Disassemble( SbModule* pMod, String& rText ) +{ + rText.Erase(); + if( pMod ) + pMod->Disassemble( rText ); + return BOOL( rText.Len() != 0 ); +} + +void StarBASIC::Clear() +{ + while( pModules->Count() ) + pModules->Remove( pModules->Count() - 1 ); +} + +SbModule* StarBASIC::FindModule( const String& rName ) +{ + for( USHORT i = 0; i < pModules->Count(); i++ ) + { + SbModule* p = (SbModule*) pModules->Get( i ); + if( p->GetName().EqualsIgnoreCaseAscii( rName ) ) + return p; + } + return NULL; +} + +// Init-Code aller Module ausfuehren (auch in inserteten Bibliotheken) +void StarBASIC::InitAllModules( void ) +{ + // Eigene Module initialisieren + for ( USHORT nMod = 0; nMod < pModules->Count(); nMod++ ) + { + SbModule* pModule = (SbModule*)pModules->Get( nMod ); + if( !pModule->IsCompiled() ) + pModule->Compile(); + pModule->RunInit(); + } + // Alle Objekte ueberpruefen, ob es sich um ein Basic handelt + // Wenn ja, auch dort initialisieren + for ( USHORT nObj = 0; nObj < pObjs->Count(); nObj++ ) + { + SbxVariable* pVar = pObjs->Get( nObj ); + StarBASIC* pBasic = PTR_CAST(StarBASIC,pVar); + if( pBasic ) + pBasic->InitAllModules(); + } +} + +// #43011 Fuer das TestTool, um globale Variablen loeschen zu koennen +void StarBASIC::ClearGlobalVars( void ) +{ + SbxArrayRef xProps( GetProperties() ); + USHORT nPropCount = xProps->Count(); + for ( USHORT nProp = 0 ; nProp < nPropCount ; ++nProp ) + { + SbxBase* pVar = xProps->Get( nProp ); + pVar->Clear(); + } + SetModified( TRUE ); +} + + +// Diese Implementation sucht erst innerhalb der Runtime-Library, dann +// nach einem Element innerhalb eines Moduls. Dieses Element kann eine +// Public-Variable oder ein Entrypoint sein. Wenn nicht gefunden, wird, +// falls nach einer Methode gesucht wird und ein Modul mit dem angege- +// benen Namen gefunden wurde, der Entrypoint "Main" gesucht. Wenn das +// auch nicht klappt, laeuft die traditionelle Suche ueber Objekte an. + +SbxVariable* StarBASIC::Find( const String& rName, SbxClassType t ) +{ + SbxVariable* pRes = NULL; + SbModule* pNamed = NULL; + // "Extended" search in Runtime Lib + // aber nur, wenn SbiRuntime nicht das Flag gesetzt hat + if( !bNoRtl ) + { + if( t == SbxCLASS_DONTCARE || t == SbxCLASS_OBJECT ) + { + if( rName.EqualsIgnoreCaseAscii( RTLNAME ) ) + pRes = pRtl; + } + if( !pRes ) + pRes = ((SbiStdObject*) (SbxObject*) pRtl)->Find( rName, t ); + if( pRes ) + pRes->SetFlag( SBX_EXTFOUND ); + } + // Module durchsuchen + if( !pRes ) + for( USHORT i = 0; i < pModules->Count(); i++ ) + { + SbModule* p = (SbModule*) pModules->Get( i ); + if( p->IsVisible() ) + { + // Modul merken fuer Main()-Aufruf + // oder stimmt etwa der Name ueberein?!? + if( p->GetName().EqualsIgnoreCaseAscii( rName ) ) + { + if( t == SbxCLASS_OBJECT || t == SbxCLASS_DONTCARE ) + { + pRes = p; break; + } + pNamed = p; + } + // Sonst testen, ob das Element vorhanden ist + // GBLSEARCH-Flag rausnehmen (wg. Rekursion) + USHORT nGblFlag = p->GetFlags() & SBX_GBLSEARCH; + p->ResetFlag( SBX_GBLSEARCH ); + pRes = p->Find( rName, t ); + p->SetFlag( nGblFlag ); + if( pRes ) + break; + } + } + if( !pRes && pNamed && ( t == SbxCLASS_METHOD || t == SbxCLASS_DONTCARE ) ) + pRes = pNamed->Find( String( RTL_CONSTASCII_USTRINGPARAM("Main") ), SbxCLASS_METHOD ); + if( !pRes ) + pRes = SbxObject::Find( rName, t ); + return pRes; +} + +BOOL StarBASIC::Call( const String& rName, SbxArray* pParam ) +{ + BOOL bRes = SbxObject::Call( rName, pParam ); + if( !bRes ) + { + SbxError eErr = SbxBase::GetError(); + SbxBase::ResetError(); + if( eErr != SbxERR_OK ) + RTError( (SbError)eErr, 0, 0, 0 ); + } + return bRes; +} + +// Find-Funktion ueber Name (z.B. Abfrage aus BASIC-IDE) +SbxBase* StarBASIC::FindSBXInCurrentScope( const String& rName ) +{ + if( !pINST ) + return NULL; + if( !pINST->pRun ) + return NULL; + return pINST->pRun->FindElementExtern( rName ); +} + +// Alte Schnittstelle vorerst erhalten +SbxVariable* StarBASIC::FindVarInCurrentScopy +( const String& rName, USHORT& rStatus ) +{ + rStatus = 1; // Annahme: Nichts gefunden + SbxVariable* pVar = NULL; + SbxBase* pSbx = FindSBXInCurrentScope( rName ); + if( pSbx ) + { + if( !pSbx->ISA(SbxMethod) && !pSbx->ISA(SbxObject) ) + pVar = PTR_CAST(SbxVariable,pSbx); + } + if( pVar ) + rStatus = 0; // doch gefunden + return pVar; +} + +void StarBASIC::Stop() +{ + SbiInstance* p = pINST; + while( p ) + { + p->Stop(); + p = p->pNext; + } +} + +BOOL StarBASIC::IsRunning() +{ + return BOOL( pINST != NULL ); +} + +/************************************************************************** +* +* Objekt-Factories etc. +* +**************************************************************************/ + +// Aktivierung eines Objekts. Aktive Objekte muessen nicht mehr +// von BASIC aus ueber den Namen angesprochen werden. Ist +// NULL angegeben, wird alles aktiviert. + +void StarBASIC::ActivateObject( const String* pName, BOOL bActivate ) +{ + if( pName ) + { + SbxObject* p = (SbxObject*) SbxObject::Find( *pName, SbxCLASS_OBJECT ); + if( p ) + if( bActivate ) + p->SetFlag( SBX_EXTSEARCH ); + else + p->ResetFlag( SBX_EXTSEARCH ); + } + else + { + for( USHORT i = 0; i < GetObjects()->Count(); i++ ) + { + SbxObject* p = (SbxObject*) GetObjects()->Get( i ); + if( bActivate ) + p->SetFlag( SBX_EXTSEARCH ); + else + p->ResetFlag( SBX_EXTSEARCH ); + } + } +} + +/************************************************************************** +* +* Debugging und Fehlerbehandlung +* +**************************************************************************/ + +SbMethod* StarBASIC::GetActiveMethod( USHORT nLevel ) +{ + if( pINST ) + return pINST->GetCaller( nLevel ); + else + return NULL; +} + +SbModule* StarBASIC::GetActiveModule() +{ + if( pINST && !IsCompilerError() ) + return pINST->GetActiveModule(); + else + return pCMOD; +} + +USHORT StarBASIC::BreakPoint( USHORT l, USHORT c1, USHORT c2 ) +{ + SetErrorData( 0, l, c1, c2 ); + bBreak = TRUE; + if( GetSbData()->aBreakHdl.IsSet() ) + return (USHORT) GetSbData()->aBreakHdl.Call( this ); + else + return BreakHdl(); +} + +USHORT StarBASIC::StepPoint( USHORT l, USHORT c1, USHORT c2 ) +{ + SetErrorData( 0, l, c1, c2 ); + bBreak = FALSE; + if( GetSbData()->aBreakHdl.IsSet() ) + return (USHORT) GetSbData()->aBreakHdl.Call( this ); + else + return BreakHdl(); +} + +USHORT __EXPORT StarBASIC::BreakHdl() +{ + return (USHORT) ( aBreakHdl.IsSet() + ? aBreakHdl.Call( this ) : SbDEBUG_CONTINUE ); +} + +// Abfragen fuer den Error-Handler und den Break-Handler: +USHORT StarBASIC::GetLine() { return GetSbData()->nLine; } +USHORT StarBASIC::GetCol1() { return GetSbData()->nCol1; } +USHORT StarBASIC::GetCol2() { return GetSbData()->nCol2; } + +// Spezifisch fuer den Error-Handler: +SbError StarBASIC::GetErrorCode() { return GetSbData()->nCode; } +const String& StarBASIC::GetErrorText() { return GetSbData()->aErrMsg; } +BOOL StarBASIC::IsCompilerError() { return GetSbData()->bCompiler; } +void StarBASIC::SetGlobalLanguageMode( SbLanguageMode eLanguageMode ) +{ + GetSbData()->eLanguageMode = eLanguageMode; +} +SbLanguageMode StarBASIC::GetGlobalLanguageMode() +{ + return GetSbData()->eLanguageMode; +} +// Lokale Einstellung +SbLanguageMode StarBASIC::GetLanguageMode() +{ + // Globale Einstellung nehmen? + if( eLanguageMode == SB_LANG_GLOBAL ) + return GetSbData()->eLanguageMode; + else + return eLanguageMode; +} + +// AB: 29.3.96 +// Das Mapping zwischen alten und neuen Fehlercodes erfolgt, indem die Tabelle +// SFX_VB_ErrorTab[] durchsucht wird. Dies ist zwar nicht besonders performant, +// verbraucht aber viel weniger Speicher als entsprechende switch-Bloecke. +// Die Umrechnung von Fehlercodes muss nicht schnell sein, daher auch keine +// binaere Suche bei VB-Error -> SFX-Error. + +// Neue Fehler-Codes auf alte, Sbx-Kompatible zurueckmappen +USHORT StarBASIC::GetVBErrorCode( SbError nError ) +{ + USHORT nRet = 0; + + // Suchschleife + const SFX_VB_ErrorItem* pErrItem; + USHORT nIndex = 0; + do + { + pErrItem = SFX_VB_ErrorTab + nIndex; + if( pErrItem->nErrorSFX == nError ) + { + nRet = pErrItem->nErrorVB; + break; + } + nIndex++; + } + while( pErrItem->nErrorVB != 0xFFFF ); // bis End-Marke + return nRet; +} + +SbError StarBASIC::GetSfxFromVBError( USHORT nError ) +{ + SbError nRet = 0L; + + // Suchschleife + const SFX_VB_ErrorItem* pErrItem; + USHORT nIndex = 0; + do + { + pErrItem = SFX_VB_ErrorTab + nIndex; + if( pErrItem->nErrorVB == nError ) + { + nRet = pErrItem->nErrorSFX; + break; + } + else if( pErrItem->nErrorVB > nError ) + break; // kann nicht mehr gefunden werden + + nIndex++; + } + while( pErrItem->nErrorVB != 0xFFFF ); // bis End-Marke + return nRet; +} + +// Error- / Break-Daten setzen +void StarBASIC::SetErrorData +( SbError nCode, USHORT nLine, USHORT nCol1, USHORT nCol2 ) +{ + SbiGlobals& aGlobals = *GetSbData(); + aGlobals.nCode = nCode; + aGlobals.nLine = nLine; + aGlobals.nCol1 = nCol1; + aGlobals.nCol2 = nCol2; +} + +//---------------------------------------------------------------- +// Hilfsklasse zum Zugriff auf String SubResourcen einer Resource. +// Quelle: sfx2\source\doc\docfile.cxx (TLX) +struct BasicStringList_Impl : private Resource +{ + ResId aResId; + + BasicStringList_Impl( ResId& rErrIdP, USHORT nId) + : Resource( rErrIdP ),aResId(nId){} + ~BasicStringList_Impl() { FreeResource(); } + + String GetString(){ return String( aResId ); } + BOOL IsErrorTextAvailable( void ) + { return IsAvailableRes(aResId.SetRT(RSC_STRING)); } +}; +//---------------------------------------------------------------- + +// #60175 Flag, das bei Basic-Fehlern das Anziehen der SFX-Resourcen verhindert +static BOOL bStaticSuppressSfxResource = FALSE; + +void StarBASIC::StaticSuppressSfxResource( BOOL bSuppress ) +{ + bStaticSuppressSfxResource = bSuppress; +} + +void StarBASIC::MakeErrorText( SbError nId, const String& aMsg ) +{ + if( bStaticSuppressSfxResource ) + { + GetSbData()->aErrMsg = String( RTL_CONSTASCII_USTRINGPARAM("No resource: Error message not available") ); + return; + } + + USHORT nOldID = GetVBErrorCode( nId ); + + // Hilfsklasse instanzieren + BasicResId aId( RID_BASIC_START ); + BasicStringList_Impl aMyStringList( aId, USHORT(nId & ERRCODE_RES_MASK) ); + + if( aMyStringList.IsErrorTextAvailable() ) + { + // Merge Message mit Zusatztext + String aMsg1 = aMyStringList.GetString(); + // Argument-Platzhalter durch %s ersetzen + String aSrgStr( RTL_CONSTASCII_USTRINGPARAM("$(ARG1)") ); + USHORT nResult = aMsg1.Search( aSrgStr ); + + if( nResult != STRING_NOTFOUND ) + { + aMsg1.Erase( nResult, aSrgStr.Len() ); + aMsg1.Insert( aMsg, nResult ); + } + GetSbData()->aErrMsg = aMsg1; + } + else + { + String aStdMsg( RTL_CONSTASCII_USTRINGPARAM("Fehler ") ); + aStdMsg += String::CreateFromInt32( nOldID); + aStdMsg += String( RTL_CONSTASCII_USTRINGPARAM(": Kein Fehlertext verfuegbar!") ); + GetSbData()->aErrMsg = aStdMsg; + } +} + +BOOL StarBASIC::CError + ( SbError code, const String& rMsg, USHORT l, USHORT c1, USHORT c2 ) +{ + // Compiler-Fehler waehrend der Laufzeit -> Programm anhalten + if( IsRunning() ) + Stop(); + + // #45741# Falls der Wait-Cursor gesetzt ist, jetzt zuruecksetzen + if( GetSbData()->bCompWait ) + { + Application::LeaveWait(); + GetSbData()->bCompWait = FALSE; + } + + // Flag setzen, damit GlobalRunInit den Fehler mitbekommt + GetSbData()->bGlobalInitErr = TRUE; + + // Fehlertext basteln + MakeErrorText( code, rMsg ); + + // Umsetzung des Codes fuer String-Transport in SFX-Error + if( rMsg.Len() ) + code = (ULONG)*new StringErrorInfo( code, String(rMsg) ); + + SetErrorData( code, l, c1, c2 ); + GetSbData()->bCompiler = TRUE; + BOOL bRet; + if( GetSbData()->aErrHdl.IsSet() ) + bRet = (BOOL) GetSbData()->aErrHdl.Call( this ); + else + bRet = ErrorHdl(); + GetSbData()->bCompiler = FALSE; // nur TRUE fuer Error-Handler + return bRet; +} + +BOOL StarBASIC::RTError + ( SbError code, USHORT l, USHORT c1, USHORT c2 ) +{ + return RTError( code, String(), l, c1, c2 ); +} + +BOOL StarBASIC::RTError( SbError code, const String& rMsg, USHORT l, USHORT c1, USHORT c2 ) +{ + SbError c = code; + if( (c & ERRCODE_CLASS_MASK) == ERRCODE_CLASS_COMPILER ) + c = 0; + MakeErrorText( c, rMsg ); + + // Umsetzung des Codes fuer String-Transport in SFX-Error + if( rMsg.Len() ) + code = (ULONG)*new StringErrorInfo( code, String(rMsg) ); + + SetErrorData( code, l, c1, c2 ); + if( GetSbData()->aErrHdl.IsSet() ) + return (BOOL) GetSbData()->aErrHdl.Call( this ); + else + return ErrorHdl(); +} + +void StarBASIC::Error( SbError n ) +{ + Error( n, String() ); +} + +void StarBASIC::Error( SbError n, const String& rMsg ) +{ + if( pINST ) + pINST->Error( n, rMsg ); +} + +void StarBASIC::FatalError( SbError n ) +{ + if( pINST ) + pINST->FatalError( n ); +} + +SbError StarBASIC::GetErr() +{ + if( pINST ) + return pINST->GetErr(); + else + return 0; +} + +// #66536 Zusatz-Message fuer RTL-Funktion Error zugreifbar machen +String StarBASIC::GetErrorMsg() +{ + if( pINST ) + return pINST->GetErrorMsg(); + else + return String(); +} + +USHORT StarBASIC::GetErl() +{ + if( pINST ) + return pINST->GetErl(); + else + return 0; +} + +BOOL __EXPORT StarBASIC::ErrorHdl() +{ + return (BOOL) ( aErrorHdl.IsSet() + ? aErrorHdl.Call( this ) : FALSE ); +} + +Link StarBASIC::GetGlobalErrorHdl() +{ + return GetSbData()->aErrHdl; +} + +void StarBASIC::SetGlobalErrorHdl( const Link& rLink ) +{ + GetSbData()->aErrHdl = rLink; +} + + +Link StarBASIC::GetGlobalBreakHdl() +{ + return GetSbData()->aBreakHdl; +} + +void StarBASIC::SetGlobalBreakHdl( const Link& rLink ) +{ + GetSbData()->aBreakHdl = rLink; +} + +/************************************************************************** +* +* Laden und Speichern +* +**************************************************************************/ + +BOOL StarBASIC::LoadData( SvStream& r, USHORT nVer ) +{ + if( !SbxObject::LoadData( r, nVer ) ) + return FALSE; + UINT16 nMod; + pModules->Clear(); + r >> nMod; + for( USHORT i = 0; i < nMod; i++ ) + { + SbModule* pMod = (SbModule*) SbxBase::Load( r ); + if( !pMod ) + return FALSE; + else if( pMod->ISA(SbJScriptModule) ) + { + // Ref zuweisen, damit pMod deleted wird + SbModuleRef xRef = pMod; + } + else + { + pMod->SetParent( this ); + pModules->Put( pMod, i ); + } + } + // HACK fuer SFX-Mist! + SbxVariable* p = Find( String( RTL_CONSTASCII_USTRINGPARAM("FALSE") ), SbxCLASS_PROPERTY ); + if( p ) + Remove( p ); + p = Find( String( RTL_CONSTASCII_USTRINGPARAM("TRUE") ), SbxCLASS_PROPERTY ); + if( p ) + Remove( p ); + // Ende des Hacks! + // Suche ueber StarBASIC ist immer global + DBG_ASSERT( IsSet( SBX_GBLSEARCH ), "Basic ohne GBLSEARCH geladen" ); + SetFlag( SBX_GBLSEARCH ); + return TRUE; +} + +BOOL StarBASIC::StoreData( SvStream& r ) const +{ + if( !SbxObject::StoreData( r ) ) + return FALSE; + r << (UINT16) pModules->Count(); + for( USHORT i = 0; i < pModules->Count(); i++ ) + { + SbModule* p = (SbModule*) pModules->Get( i ); + if( !p->Store( r ) ) + return FALSE; + } + return TRUE; +} + +BOOL StarBASIC::LoadOldModules( SvStream& r ) +{ + return FALSE; +} + + |