REM  *****  BASIC  *****

Option Explicit

Global oDocView As Object
Global oContextMenuInterceptor As Object

Global oStore As Object
Global oPropSetRegistry As Object

Const MNU_PREFIX = "pmxMenu_"


'_______________________________________________________________________________
Sub registerContextMenuInterceptor
	
	InitMenuFactory

	oDocView = ThisComponent.CurrentController
	oContextMenuInterceptor = _
	CreateUnoListener("ThisDocument_", "com.sun.star.ui.XContextMenuInterceptor")
	
	oDocView.registerContextMenuInterceptor(oContextMenuInterceptor)
	
End Sub


'_______________________________________________________________________________
Sub releaseContextMenuInterceptor

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


'_______________________________________________________________________________
Function ThisDocument_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

	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


	'remove all menu entries:
	For I = oATContainer.Count - 1 To 0 Step -1
		oATContainer.removeByIndex(I)
	Next I
	
	'add some context menu entry
	oMenuItem = GetSimpleMenuItem("Entry1", "Paolo Mantovani Was Here", "")
	oATContainer.insertByIndex(0, oMenuItem)
	
	oMenuItem = GetMenuSeparator("Entry2")
	oATContainer.insertByIndex(1, oMenuItem)
	
	oMenuItem = GetSimpleMenuItem("Entry3", "Run the Snippet Creator", "macro:///SnippetCreator.Main.Main")
	oATContainer.insertByIndex(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.

	ThisDocument_notifyContextMenuExecute = _
		com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED

End Function


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

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

End Sub


'_______________________________________________________________________________
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

'_______________________________________________________________________________
' Sorry: menu icon and sub-menues not supported
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


'_______________________________________________________________________________
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