Add items to context menu programatically

English
, ,
#1

I have a whole lot of macros in a shared Basic library which is accessed from multiple machines and OSes so when I make changes to the code it available to all the others. In the library is a sub, which gets executed at application start, to create a custom menu. I now want to add custom entries to the Writer’s Context Menu for text. I can do it manually from Tools > Customize but I would like to have it created programmatically so I can have it appear across all my machines/OSes on app startup.

Does anyone have Basic macro example to add an entry to the Context Menu for text elements? I’ve googled plenty but I haven’t found anything yet. I even tried macro recording the actions but it didn’t work either.

Thanks.

#2
#3

Found working example for Calc here. Apache OpenOffice Community Forum - Custom Cell Background - (View topic) Tested on LO v7.x OK. I am now trying to adapt it and I can get a new blank entry in spelling error Context Menu but can’t link it to my library macro…

#4

Looks like LO was all confused and a restart got it working. I’ll post working example tomorrow, its very late here atm.

#5

Here is the code I modified from Apache OpenOffice Community Forum - Custom Cell Background - (View topic) to use in my library. The difference in adding the items using this macro versus Tools > Customize is that,

  • If a macro is mapped to keyboard shortcut, the shortcut don’t show on the popup menu.
  • The change is for active document only.
  • The change is not permanent. Needs to be reloaded when you next open the document again. This can be automated using Document Open event in Tools > Customize
  • According to the original author, you can’t add a real separator using his code :frowning: Best case is a blank item.
  • This macro adds items to the context menu of both text selection and spelling errors. Where as @sokol92’s solution and manually doing via Tools menu only adds it for text selection.

Here is the code,


' Context Menu globals...
Global oDocView As Object
Global oContextMenuInterceptor As Object
Global oStore As Object
Global oPropSetRegistry As Object
Const MNU_PREFIX = "MyContextMenu_" 

'_______________________________________________________________________________
'
Sub registerContextMenuInterceptor
	
	InitMenuFactory

	oDocView = ThisComponent.CurrentController
	oContextMenuInterceptor = CreateUnoListener("oTextDoc_", "com.sun.star.ui.XContextMenuInterceptor")
	
	oDocView.registerContextMenuInterceptor(oContextMenuInterceptor)
	
End Sub	'/registerContextMenuInterceptor


'_______________________________________________________________________________
'
Sub releaseContextMenuInterceptor

	On Error Resume Next
	oDocView.releaseContextMenuInterceptor(oContextMenuInterceptor)
	
	TerminateMenuFactory
	
End Sub	'/releaseContextMenuInterceptor
	

'_______________________________________________________________________________
'
Function oTextDoc_notifyContextMenuExecute(ContextMenuExecuteEvent As Object) As Variant
	Dim oSrcWin As Object
	Dim oExePoint As Object
	Dim oATContainer As Object
	Dim oSelection As Object

	Dim oMenuItem As Object
	Dim I As Integer
	Dim NextEntry As Integer
	Dim t As String

	With ContextMenuExecuteEvent
	
		'contains the window where the context
		'menu has been requested 
		oSrcWin = .SourceWindow
		
		'contains the position the context menu
		'will be executed at (css.awt.Point)
		oExePoint = .ExecutePosition
		
		'enables the access to the menu content. 
		'The implementing object has to support the
		'service ActionTriggerContainer
		oATContainer = .ActionTriggerContainer 
		
		'provides the current selection
		'inside the source window
		oSelection = .Selection 				
	End With
	NextEntry = oATContainer.Count
	
	Const macroPrefix = "macro:///MyLibrary.Module1"
	
	oMenuItem = GetSimpleMenuItem("NewEntry1", "Google Text", _
								macroPrefix & ".googleSelection")	
	oATContainer.insertByIndex(NextEntry, oMenuItem)
	
	oMenuItem = GetSimpleMenuItem("NewEntry2", "Google As Quoted Text", _
								macroPrefix & ".googleSelectionQuoted")
	oATContainer.insertByIndex(NextEntry + 1, oMenuItem)
	
	oMenuItem = GetSimpleMenuItem("NewEntry3", "Google Translate", _
								macroPrefix & ".googleTranslate")
	oATContainer.insertByIndex(NextEntry + 2, oMenuItem)
	
	' POSSIBLE RESULTS FOR THIS FUNCTION
' This function must result one of the following values:

' com.sun.star.ui.ContextMenuInterceptorAction.IGNORED
'	the XContextMenuInterceptor has ignored the call. 
'	The next registered XContextMenuInterceptor should be notified.

' com.sun.star.ui.ContextMenuInterceptorAction.CANCELLED
'	the context menu must not be executed. 
'	The next registered XContextMenuInterceptor should not be notified.

' com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
'	the menu has been modified and should be executed
'	without notifying the next registered XContextMenuInterceptor.

' com.sun.star.ui.ContextMenuInterceptorAction.CONTINUE_MODIFIED
'	the menu has been modified and the next registered
'	XContextMenuInterceptor should be notified.

	oTextDoc_notifyContextMenuExecute = com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
	
End Function	'/oTextDoc_notifyContextMenuExecute


'_______________________________________________________________________________
'
'	MENU FACTORY ROUTINES
'_______________________________________________________________________________
'
Sub InitMenuFactory()

	oStore = CreateUnoService("com.sun.star.ucb.Store")
	oPropSetRegistry = oStore.createPropertySetRegistry("")

End Sub	'/InitMenuFactory


'_______________________________________________________________________________
'
Sub TerminateMenuFactory()
	Dim mNames()
	Dim sName As String
	Dim i As Integer

	mNames() = oPropSetRegistry.getElementNames
	
	For i = LBound(mNames()) To UBound(mNames())
		sName = mNames(i)
		
		If Left(sName, Len(MNU_PREFIX)) = MNU_PREFIX Then
			oPropSetRegistry.removePropertySet(sName) 
		End If
	Next i
	
	oPropSetRegistry.dispose
	oStore.dispose
	
End Sub	'/TerminateMenuFactory


'
' Sorry: menu icon and sub-menues not supported (maybe later)
'_______________________________________________________________________________
'
Function GetSimpleMenuItem( sName As String, sText As String, sCommandUrl As String, Optional sHelpUrl As String ) As Object

	Dim oPropSet As Object
	Dim sInternalName As String

	sInternalName = MNU_PREFIX & sName
	If oPropSetRegistry.hasByName(sInternalName) Then
		oPropSetRegistry.removePropertySet(sInternalName)
	End If
		
	oPropSet = oPropSetRegistry.openPropertySet(sInternalName, True)
	
	oPropSet.addProperty("Text", 0, sText)
	oPropSet.addProperty("CommandURL", 0, sCommandUrl)
	
	If Not IsMissing(sHelpUrl) Then
		oPropSet.addProperty("HelpURL", 0, sHelpUrl)
	End If
		
	GetSimpleMenuItem = oPropSet
	
End Function	'/GetSimpleMenuItem


'_______________________________________________________________________________
'
Function GetMenuSeparator( sName As String ) As Object

	Dim oPropSet As Object
	Dim sInternalName As String
	Dim iSeparatorType As Integer

	sInternalName = MNU_PREFIX & sName
	If oPropSetRegistry.hasByName(sInternalName) Then
		oPropSetRegistry.removePropertySet(sInternalName)
	End If
	
	oPropSet = oPropSetRegistry.openPropertySet(sInternalName, True)
	
	'constant group com.sun.star.ui.ActionTriggerSeparatorType not supported?
	'unfortunately, the only separator-type working is the "SPACE"
	'regardless for the iSeparatorType passed...
	iSeparatorType = 1
	oPropSet.addProperty("SeparatorType", 0, iSeparatorType)

	GetMenuSeparator = oPropSet
	
End Function	'/GetMenuSeparator
#6

Here is another, shorter way. Context menu changes can be either permanent or temporary.

Place the following text in the ContextMenu module of the Standard library (from MyMacro…). Run the AddMenuContextItem macro. Please note the additional menu item “My item” in the text context menu.

Option Explicit

Sub AddMenuContextItem
  Dim oSupplier as Object, oUIConf As Object, oSettings As Object, settingsURL As String
  Dim oItems(1) As New com.sun.star.beans.PropertyValue 
  
  oSupplier=GetDefaultContext.getValueByName("/singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier")
  
  oUIConf=oSupplier.getUIConfigurationManager("com.sun.star.text.TextDocument")
  
  settingsURL="private:resource/popupmenu/text"
  oSettings=oUIConf.getSettings(settingsURL, true)
  
  oItems(0).Name = "CommandURL": oItems(0).Value = "vnd.sun.star.script:Standard.ContextMenu.MyFunction?language=Basic&location=application"
  oItems(1).Name = "Label"     : oItems(1).Value = "My Item"
  
  oSettings.insertByIndex oSettings.count, oItems
  oUIConf.replaceSettings(settingsURL, oSettings)
   
  ' Uncomment the following line to make the changes permanent 
  ' oUIConf.store
 
End Sub

Sub MyFunction()
  MsgBox "MyFunction called" 
End Sub
#7

Much better, thank you. How do I add a separator just so the menu looks neater?

#8

Just tested your code and noticed two things. 1) your code will not show the new item until I make a selection. So when I right click over a misspelled word, it doesn’t appear. Where as the code I posted does. 2) I like how your code shows the keyboard mapping of my macro which is great.

#9

Add where a separator is needed:

  Dim oItems2(0) As New com.sun.star.beans.PropertyValue
  oItems2(0).Name = "Type": oItems2(0).Value = 1
  oSettings.insertByIndex oSettings.count, oItems2
#10

That’s right. Spell check has its own menu items.

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.