Re: [REVIEW 3-5] misc vba api implementations

On 11/05/12 11:16, Noel Power wrote:
> would be very handy to have these in 3.5, these are a bunch of 
> *mostly* vba api implementations ( some cases partial ) and as such 
> should pose little/no risk to the core code. Please cherry pick
>
> Noel
>
> details...
[...]
> 0006-vba-implementation-for-Application.OnKey.patch ( backport ( and 
> squash ) of master 75fbed472cd689c8cc0b89e13a97969d77a0ea7c & master 
> 14620c3b33cf0315a9b746a0a2418b78d6154821 - impacts a few things, the 
> api part should be safe, there is additionally some tweaking of 
> vbamodule import to try and import the keybinding if it exists, should 
> be ok
I attach a new version here ( I got caught with using the new OUString( 
char& ) ctor as patch was grabbed from master )
From a1d3cb47d2fd49ac06a49725f5ceac1376a1138d Mon Sep 17 00:00:00 2001
From: Noel Power <noel.power@novell.com>
Date: Mon, 5 Mar 2012 14:54:04 +0000
Subject: [PATCH 6/7] vba implementation for Application.OnKey

support import of key shortcut for macro ( Excel only )
---
 filter/inc/filter/msfilter/msvbahelper.hxx        |    6 +-
 filter/source/msfilter/msvbahelper.cxx            |  176 +++++++++++++++++++++
 oovbaapi/ooo/vba/XApplicationBase.idl             |    2 +-
 oox/source/ole/vbamodule.cxx                      |   36 ++++-
 vbahelper/inc/vbahelper/vbaapplicationbase.hxx    |    1 +
 vbahelper/source/vbahelper/vbaapplicationbase.cxx |   23 +++
 6 files changed, 240 insertions(+), 4 deletions(-)

diff --git a/filter/inc/filter/msfilter/msvbahelper.hxx b/filter/inc/filter/msfilter/msvbahelper.hxx
index affc8b2..e7e6533 100644
--- a/filter/inc/filter/msfilter/msvbahelper.hxx
+++ b/filter/inc/filter/msfilter/msvbahelper.hxx
@@ -33,8 +33,9 @@
 #include <com/sun/star/lang/XInitialization.hpp>
 #include <com/sun/star/lang/XServiceInfo.hpp>
 #include <com/sun/star/script/vba/XVBAMacroResolver.hpp>
+#include <com/sun/star/awt/KeyEvent.hpp>
+#include <com/sun/star/frame/XModel.hpp>
 #include "filter/msfilter/msfilterdllapi.h"
-
 namespace ooo {
 namespace vba {
 
@@ -55,7 +56,8 @@ MSFILTER_DLLPUBLIC ::rtl::OUString getDefaultProjectName( SfxObjectShell* pShell
 MSFILTER_DLLPUBLIC ::rtl::OUString resolveVBAMacro( SfxObjectShell* pShell, const ::rtl::OUString& 
rLibName, const ::rtl::OUString& rModuleName, const ::rtl::OUString& rMacroName );
 MSFILTER_DLLPUBLIC MacroResolvedInfo resolveVBAMacro( SfxObjectShell* pShell, const 
::rtl::OUString& rMacroName, bool bSearchGlobalTemplates = false );
 MSFILTER_DLLPUBLIC sal_Bool executeMacro( SfxObjectShell* pShell, const String& sMacroName, 
com::sun::star::uno::Sequence< com::sun::star::uno::Any >& aArgs, com::sun::star::uno::Any& aRet, 
const com::sun::star::uno::Any& aCaller );
-
+MSFILTER_DLLPUBLIC ::com::sun::star::awt::KeyEvent parseKeyEvent( const ::rtl::OUString& sKey ) 
throw (::com::sun::star::uno::RuntimeException);
+MSFILTER_DLLPUBLIC void applyShortCutKeyBinding ( const ::com::sun::star::uno::Reference< 
com::sun::star::frame::XModel >& rxDoc, const ::com::sun::star::awt::KeyEvent& rKeyEvent, const 
::rtl::OUString& sMacro ) throw (::com::sun::star::uno::RuntimeException);
 // ============================================================================
 
 typedef ::cppu::WeakImplHelper3<
diff --git a/filter/source/msfilter/msvbahelper.cxx b/filter/source/msfilter/msvbahelper.cxx
index ca0288f..962d211 100644
--- a/filter/source/msfilter/msvbahelper.cxx
+++ b/filter/source/msfilter/msvbahelper.cxx
@@ -42,6 +42,12 @@
 #include <osl/file.hxx>
 #include <unotools/pathoptions.hxx>
 
+#include <com/sun/star/awt/KeyModifier.hpp>
+#include <svtools/acceleratorexecute.hxx>
+#include <com/sun/star/ui/XUIConfigurationManagerSupplier.hpp>
+#include <com/sun/star/ui/XUIConfigurationManager.hpp>
+#include <map>
+
 using namespace ::com::sun::star;
 
 namespace ooo {
@@ -581,6 +587,176 @@ void SAL_CALL VBAMacroResolver::initialize( const uno::Sequence< uno::Any >& 
rAr
     throw uno::RuntimeException();
 }
 
+bool getModifier( char c, sal_uInt16& mod )
+{
+    static const char modifiers[] = "+^%";
+    static const sal_uInt16 KEY_MODS[] = {KEY_SHIFT, KEY_MOD1, KEY_MOD2};
+
+    for ( unsigned int i=0; i<SAL_N_ELEMENTS(modifiers); ++i )
+    {
+        if ( c == modifiers[i] )
+        {
+            mod = mod | KEY_MODS[ i ];
+            return true;
+        }
+    }
+    return false;
+}
+
+typedef std::map< rtl::OUString, sal_uInt16 > MSKeyCodeMap;
+
+sal_uInt16 parseChar( char c ) throw ( uno::RuntimeException )
+{
+    sal_uInt16 nVclKey = 0;
+    // do we care about locale here for isupper etc. ? probably not
+    if ( isalpha( c ) )
+    {
+        nVclKey |= ( toupper( c ) - 'A' ) + KEY_A;
+        if ( isupper( c ) )
+            nVclKey |= KEY_SHIFT;
+    }
+    else if ( isdigit( c ) )
+        nVclKey |= ( c  - '0' ) + KEY_0;
+    else if ( c == '~' ) // special case
+        nVclKey = KEY_RETURN;
+    else if ( c == ' ' ) // special case
+        nVclKey = KEY_SPACE;
+    else // I guess we have a problem ( but not sure if locale specific keys might come into play 
here )
+        throw uno::RuntimeException();
+    return nVclKey;
+}
+
+struct KeyCodeEntry
+{
+   const char* sName;
+   sal_uInt16 nCode;
+};
+
+KeyCodeEntry aMSKeyCodesData[] = {
+    { "BACKSPACE", KEY_BACKSPACE },
+    { "BS", KEY_BACKSPACE },
+    { "DELETE", KEY_DELETE },
+    { "DEL", KEY_DELETE },
+    { "DOWN", KEY_DOWN },
+    { "UP", KEY_UP },
+    { "LEFT", KEY_LEFT },
+    { "RIGHT", KEY_RIGHT },
+    { "END", KEY_END },
+    { "ESCAPE", KEY_ESCAPE },
+    { "ESC", KEY_ESCAPE },
+    { "HELP", KEY_HELP },
+    { "HOME", KEY_HOME },
+    { "PGDN", KEY_PAGEDOWN },
+    { "PGUP", KEY_PAGEUP },
+    { "INSERT", KEY_INSERT },
+    { "SCROLLLOCK", KEY_SCROLLLOCK },
+    { "NUMLOCK", KEY_NUMLOCK },
+    { "TAB", KEY_TAB },
+    { "F1", KEY_F1 },
+    { "F2", KEY_F2 },
+    { "F3", KEY_F3 },
+    { "F4", KEY_F4 },
+    { "F5", KEY_F5 },
+    { "F6", KEY_F6 },
+    { "F7", KEY_F7 },
+    { "F8", KEY_F8 },
+    { "F9", KEY_F1 },
+    { "F10", KEY_F10 },
+    { "F11", KEY_F11 },
+    { "F12", KEY_F12 },
+    { "F13", KEY_F13 },
+    { "F14", KEY_F14 },
+    { "F15", KEY_F15 },
+};
+
+awt::KeyEvent parseKeyEvent( const ::rtl::OUString& Key ) throw ( uno::RuntimeException )
+{
+    static MSKeyCodeMap msKeyCodes;
+    if ( msKeyCodes.empty() )
+    {
+        for ( unsigned int i = 0; i < SAL_N_ELEMENTS( aMSKeyCodesData ); ++i )
+        {
+            msKeyCodes[ rtl::OUString::createFromAscii( aMSKeyCodesData[ i ].sName ) ] = 
aMSKeyCodesData[ i ].nCode;
+        }
+    }
+    rtl::OUString sKeyCode;
+    sal_uInt16 nVclKey = 0;
+
+    // parse the modifier if any
+    for ( int i=0; i<Key.getLength(); ++i )
+    {
+        if ( ! getModifier( Key[ i ], nVclKey ) )
+        {
+            sKeyCode = Key.copy( i );
+            break;
+        }
+    }
+
+    // check if keycode is surrounded by '{}', if so scoop out the contents
+    // else it should be just one char of ( 'a-z,A-Z,0-9' )
+    if ( sKeyCode.getLength() == 1 ) // ( a single char )
+    {
+        char c = (char)( sKeyCode[ 0 ] );
+        nVclKey |= parseChar( c );
+    }
+    else // key should be enclosed in '{}'
+    {
+        if ( sKeyCode.getLength() < 3 ||  !( sKeyCode[0] == '{' && sKeyCode[sKeyCode.getLength() - 
1 ] == '}' ) )
+            throw uno::RuntimeException();
+
+        sKeyCode = sKeyCode.copy(1, sKeyCode.getLength() - 2 );
+
+        if ( sKeyCode.getLength() == 1 )
+            nVclKey |= parseChar( (char)( sKeyCode[ 0 ] ) );
+        else
+        {
+            MSKeyCodeMap::iterator it = msKeyCodes.find( sKeyCode );
+            if ( it == msKeyCodes.end() ) // unknown or unsupported
+                throw uno::RuntimeException();
+            nVclKey |= it->second;
+        }
+    }
+
+    awt::KeyEvent aKeyEvent = svt::AcceleratorExecute::st_VCLKey2AWTKey( KeyCode( nVclKey ) );
+    return aKeyEvent;
+}
+
+void applyShortCutKeyBinding ( const uno::Reference< frame::XModel >& rxModel, const 
awt::KeyEvent& rKeyEvent, const ::rtl::OUString& rMacroName ) throw (uno::RuntimeException)
+{
+    rtl::OUString MacroName( rMacroName );
+    if ( !MacroName.isEmpty() )
+    {
+        ::rtl::OUString sSeparator(RTL_CONSTASCII_USTRINGPARAM("/"));
+        ::rtl::OUString sMacroSeparator(RTL_CONSTASCII_USTRINGPARAM("!"));
+        ::rtl::OUString aMacroName = MacroName.trim();
+        if (0 == aMacroName.indexOf('!'))
+            MacroName = aMacroName.copy(1).trim();
+        SfxObjectShell* pShell = NULL;
+        if ( rxModel.is() )
+        {
+            uno::Reference< lang::XUnoTunnel >  xObjShellTunnel( rxModel, uno::UNO_QUERY_THROW );
+            pShell = reinterpret_cast<SfxObjectShell*>( 
xObjShellTunnel->getSomething(SfxObjectShell::getUnoTunnelId()));
+            if ( !pShell )
+                throw uno::RuntimeException();
+        }
+        MacroResolvedInfo aMacroInfo = resolveVBAMacro( pShell, aMacroName );
+        if( !aMacroInfo.mbFound )
+            throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("The procedure 
doesn't exist") ), uno::Reference< uno::XInterface >() );
+       MacroName = aMacroInfo.msResolvedMacro;
+    }
+    uno::Reference< ui::XUIConfigurationManagerSupplier > xCfgSupplier(rxModel, 
uno::UNO_QUERY_THROW);
+    uno::Reference< ui::XUIConfigurationManager > xCfgMgr = 
xCfgSupplier->getUIConfigurationManager();
+
+    uno::Reference< ui::XAcceleratorConfiguration > xAcc( xCfgMgr->getShortCutManager(), 
uno::UNO_QUERY_THROW );
+    if ( MacroName.isEmpty() )
+        // I believe this should really restore the [application] default. Since
+        // afaik we don't actually setup application default bindings on import
+        // we don't even know what the 'default' would be for this key
+        xAcc->removeKeyEvent( rKeyEvent );
+    else
+        xAcc->setKeyEvent( rKeyEvent, ooo::vba::makeMacroURL( MacroName ) );
+
+}
 // ============================================================================
 
 } // namespace vba
diff --git a/oovbaapi/ooo/vba/XApplicationBase.idl b/oovbaapi/ooo/vba/XApplicationBase.idl
index d46eb24..93f39ae 100644
--- a/oovbaapi/ooo/vba/XApplicationBase.idl
+++ b/oovbaapi/ooo/vba/XApplicationBase.idl
@@ -47,7 +47,7 @@ interface XApplicationBase
     [attribute, readonly] any VBE;
 
     void Quit();
-
+    void OnKey( [in] string Key, [in] any Procedure );
     any CommandBars( [in] any Index );
     any Run([in] string MacroName, [in] /*Optional*/ any varg1, [in] /*Optional*/ any varg2, [in] 
/*Optional*/ any varg3, [in] /*Optional*/ any varg4, [in] /*Optional*/ any varg5, [in] /*Optional*/ 
any varg6, [in] /*Optional*/ any varg7, [in] /*Optional*/ any varg8, [in] /*Optional*/ any varg9, 
[in] /*Optional*/ any varg10, [in] /*Optional*/ any varg11, [in] /*Optional*/ any varg12, [in] 
/*Optional*/ any varg13, [in] /*Optional*/ any varg14, [in] /*Optional*/ any varg15, [in] 
/*Optional*/ any varg16, [in] /*Optional*/ any varg17, [in] /*Optional*/ any varg18, [in] 
/*Optional*/ any varg19, [in] /*Optional*/ any varg20, [in] /*Optional*/ any varg21, [in] 
/*Optional*/ any varg22, [in] /*Optional*/ any varg23, [in] /*Optional*/ any varg24, [in] 
/*Optional*/ any varg25, [in] /*Optional*/ any varg26, [in] /*Optional*/ any varg27, [in] 
/*Optional*/ any varg28, [in] /*Optional*/ any varg29, [in] /*Optional*/ any varg30);
     void OnTime( [in] any EarliestTime, [in] string Procedure, [in] any LatestTime, [in] any 
Schedule );
diff --git a/oox/source/ole/vbamodule.cxx b/oox/source/ole/vbamodule.cxx
index cbd9744..5672f59 100644
--- a/oox/source/ole/vbamodule.cxx
+++ b/oox/source/ole/vbamodule.cxx
@@ -33,7 +33,9 @@
 #include <com/sun/star/script/ModuleInfo.hpp>
 #include <com/sun/star/script/ModuleType.hpp>
 #include <com/sun/star/script/vba/XVBAModuleInfo.hpp>
+#include <com/sun/star/awt/KeyEvent.hpp>
 #include <cppuhelper/implbase1.hxx>
+#include <filter/msfilter/msvbahelper.hxx>
 #include "oox/helper/binaryinputstream.hxx"
 #include "oox/helper/storagebase.hxx"
 #include "oox/helper/textinputstream.hxx"
@@ -54,6 +56,7 @@ using namespace ::com::sun::star::uno;
 
 using ::rtl::OUString;
 using ::rtl::OUStringBuffer;
+using ::com::sun::star::awt::KeyEvent;
 // ============================================================================
 typedef ::cppu::WeakImplHelper1< XIndexContainer > OleIdToNameContainer_BASE;
 typedef boost::unordered_map< sal_Int32, rtl::OUString >  ObjIdToName;
@@ -237,7 +240,38 @@ OUString VbaModule::readSourceCode( StorageBase& rVbaStrg, const Reference< 
XNam
                 if( aCodeLine.matchAsciiL( RTL_CONSTASCII_STRINGPARAM( "Attribute " ) ) )
                 {
                     // attribute
-                    extractOleOverrideFromAttr( aCodeLine, rxOleNameOverrides );
+                    int index = aCodeLine.indexOf( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( 
".VB_ProcData.VB_Invoke_Func = " ) ) );
+                    if ( index != -1 )
+                    {
+                        // format is
+                        //    'Attribute Procedure.VB_ProcData.VB_Invoke_Func = "*\n14"'
+                        //    where 'Procedure' is the procedure name and '*' is the shortcut key
+                        // note: his is only relevant for Excel, seems that
+                        // word doesn't store the shortcut in the module
+                        // attributes
+                        int nSpaceIndex = aCodeLine.indexOf(' ');
+                        rtl::OUString sProc = aCodeLine.copy( nSpaceIndex + 1, index - nSpaceIndex 
- 1);
+                        // for Excel short cut key seems limited to cntrl+'a-z, A-Z'
+                        rtl::OUString sKey = aCodeLine.copy( aCodeLine.lastIndexOf( rtl::OUString( 
RTL_CONSTASCII_USTRINGPARAM( "= ") ) )+ 3, 1 );
+                        // only alpha key valid for key shortcut, however the api will accept 
other keys
+                        if ( !isalpha( (char)sKey[ 0 ] ) )
+                        {
+                            // cntrl modifier is explicit ( but could be cntrl+shift ), 
parseKeyEvent
+                            // will handle and uppercase letter appropriately
+                            rtl::OUString sApiKey( RTL_CONSTASCII_USTRINGPARAM( "^" ) );
+                            sApiKey += sKey;
+                            try
+                            {
+                                KeyEvent aKeyEvent = ooo::vba::parseKeyEvent( sApiKey );
+                                ooo::vba::applyShortCutKeyBinding( mxDocModel, aKeyEvent, sProc );
+                            }
+                            catch( Exception& )
+                            {
+                            }
+                        }
+                    }
+                    else
+                        extractOleOverrideFromAttr( aCodeLine, rxOleNameOverrides );
                 }
                 else
                 {
diff --git a/vbahelper/inc/vbahelper/vbaapplicationbase.hxx 
b/vbahelper/inc/vbahelper/vbaapplicationbase.hxx
index 7d21d3e..a27afa5 100644
--- a/vbahelper/inc/vbahelper/vbaapplicationbase.hxx
+++ b/vbahelper/inc/vbahelper/vbaapplicationbase.hxx
@@ -58,6 +58,7 @@ public:
     virtual void SAL_CALL setInteractive( ::sal_Bool bInteractive ) throw 
(css::uno::RuntimeException);
     virtual ::sal_Bool SAL_CALL getVisible() throw (css::uno::RuntimeException);
     virtual void SAL_CALL setVisible( ::sal_Bool bVisible ) throw (css::uno::RuntimeException);
+    virtual void SAL_CALL OnKey( const ::rtl::OUString& Key, const ::com::sun::star::uno::Any& 
Procedure ) throw (::com::sun::star::uno::RuntimeException);
     virtual css::uno::Any SAL_CALL CommandBars( const css::uno::Any& aIndex ) throw 
(css::uno::RuntimeException);
     virtual ::rtl::OUString SAL_CALL getVersion() throw (css::uno::RuntimeException);
     virtual css::uno::Any SAL_CALL getVBE() throw (css::uno::RuntimeException);
diff --git a/vbahelper/source/vbahelper/vbaapplicationbase.cxx 
b/vbahelper/source/vbahelper/vbaapplicationbase.cxx
index 162ea28..039494c 100644
--- a/vbahelper/source/vbahelper/vbaapplicationbase.cxx
+++ b/vbahelper/source/vbahelper/vbaapplicationbase.cxx
@@ -277,6 +277,29 @@ void SAL_CALL VbaApplicationBase::setVisible( sal_Bool bVisible ) throw 
(uno::Ru
     m_pImpl->mbVisible = bVisible;  // dummy implementation
 }
 
+
+void SAL_CALL
+VbaApplicationBase::OnKey( const ::rtl::OUString& Key, const uno::Any& Procedure ) throw 
(uno::RuntimeException)
+{
+    // parse the Key & modifiers
+    awt::KeyEvent aKeyEvent = parseKeyEvent( Key );
+    rtl::OUString MacroName;
+    Procedure >>= MacroName;
+    uno::Reference< frame::XModel > xModel;
+    SbMethod* pMeth = StarBASIC::GetActiveMethod();
+    if ( pMeth )
+    {
+        SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
+        if ( pMod )
+            xModel = StarBASIC::GetModelFromBasic( pMod );
+    }
+
+    if ( !xModel.is() )
+        xModel = getCurrentDocument();
+
+    applyShortCutKeyBinding( xModel, aKeyEvent, MacroName );
+}
+
 uno::Any SAL_CALL
 VbaApplicationBase::CommandBars( const uno::Any& aIndex ) throw (uno::RuntimeException)
 {
-- 
1.7.3.4