From 75fbed472cd689c8cc0b89e13a97969d77a0ea7c Mon Sep 17 00:00:00 2001
From: Noel Power <noel.power@novell.com>
Date: Mon, 5 Mar 2012 14:54:04 +0000
Subject: vba implementation for Application.OnKey

---
 vbahelper/inc/vbahelper/vbaapplicationbase.hxx    |  1 +
 vbahelper/source/vbahelper/vbaapplicationbase.cxx | 49 +++++++++++++++++++++++
 2 files changed, 50 insertions(+)

(limited to 'vbahelper')

diff --git a/vbahelper/inc/vbahelper/vbaapplicationbase.hxx b/vbahelper/inc/vbahelper/vbaapplicationbase.hxx
index 7d21d3ed453b..a27afa5d5b01 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 293d6b0eaaf6..f1ec673e8270 100644
--- a/vbahelper/source/vbahelper/vbaapplicationbase.cxx
+++ b/vbahelper/source/vbahelper/vbaapplicationbase.cxx
@@ -42,7 +42,10 @@
 #include <com/sun/star/document/XDocumentPropertiesSupplier.hpp>
 #include <com/sun/star/document/XEmbeddedScripts.hpp>
 #include <com/sun/star/awt/XWindow2.hpp>
+#include <com/sun/star/ui/XUIConfigurationManagerSupplier.hpp>
+#include <com/sun/star/ui/XUIConfigurationManager.hpp>
 
+#include <svtools/acceleratorexecute.hxx>
 #include <boost/unordered_map.hpp>
 #include <filter/msfilter/msvbahelper.hxx>
 #include <tools/datetime.hxx>
@@ -277,6 +280,52 @@ 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();
+
+    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();
+
+        MacroResolvedInfo aMacroInfo = resolveVBAMacro( getSfxObjShell( xModel ), 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(xModel, 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( aKeyEvent );
+    else
+        xAcc->setKeyEvent( aKeyEvent, ooo::vba::makeMacroURL( MacroName ) );
+}
+
 uno::Any SAL_CALL
 VbaApplicationBase::CommandBars( const uno::Any& aIndex ) throw (uno::RuntimeException)
 {
-- 
cgit