Jean-Pierre Ledure
8a4ee0fb39
Complete a predefined context menu with new items placed at its bottom. A context menu is obtained by a right-click on several areas of a document. Each area has its own context menu. Each component model has its own set of context menus. A context menu is usually predefined at LibreOffice installation. Customization is done statically with the Tools + Customize dialog. The actual new service provides a mean to make temporary additions at the bottom of a context menu. Those changes are lost when the document is closed. The name of a context menu is the last component of the resource URL: "private:resource/popupmenu/the-name-here" Context menu items are either usual items or line separators. Checkboxes or radio buttons are not supported. Items run a command or a script when clicked. The service implements 2 methods: AddItem() adds an entry in the menu hierarchy Activate() shows or hides the added entries A context menu can be defined from both Basic and Python user scripts. An update of the documentation is required. Change-Id: Id77f1f2565d75e36c09b13972330d0f83b3f1db4 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/172355 Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
310 lines
14 KiB
XML
310 lines
14 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFWidgets library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_Register
|
|
''' ===========
|
|
''' The ScriptForge framework includes
|
|
''' the master ScriptForge library
|
|
''' a number of "associated" libraries SF*
|
|
''' any user/contributor extension wanting to fit into the framework
|
|
'''
|
|
''' The main methods in this module allow the current library to cling to ScriptForge
|
|
''' - RegisterScriptServices
|
|
''' Register the list of services implemented by the current library
|
|
''' - _NewMenu
|
|
''' Create a new menu service instance.
|
|
''' Called from SFDocuments services with doc.CreateMenu(...)
|
|
''' - _NewContextMenu
|
|
''' Create a new context menu service instance.
|
|
''' Called from SFDocuments services with doc.ContextMenus(...)
|
|
''' - _NewPopupMenu
|
|
''' Create a new popup menu service instance.
|
|
''' Called from CreateScriptService("PopupMenu, ...)
|
|
''' - _NewToolbar
|
|
''' Create a new toolbar service instance.
|
|
''' Called from SFDocuments services with doc.Toolbars(...)
|
|
''' - _NewToolbarButton
|
|
''' Create a new toolbarbutton service instance.
|
|
''' Called from a Toolbar service with toolbar.ToolbarButtons(...)
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
REM ================================================================= DEFINITIONS
|
|
|
|
REM ============================================================== PUBLIC METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub RegisterScriptServices() As Variant
|
|
''' Register into ScriptForge the list of the services implemented by the current library
|
|
''' Each library pertaining to the framework must implement its own version of this method
|
|
'''
|
|
''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
|
|
''' with 2 arguments:
|
|
''' ServiceName: the name of the service as a case-insensitive string
|
|
''' ServiceReference: the reference as an object
|
|
''' If the reference refers to a module, then return the module as an object:
|
|
''' GlobalScope.Library.Module
|
|
''' If the reference is a class instance, then return a string referring to the method
|
|
''' containing the New statement creating the instance
|
|
''' "libraryname.modulename.function"
|
|
|
|
With GlobalScope.ScriptForge.SF_Services
|
|
.RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service
|
|
.RegisterService("ContextMenu", "SFWidgets.SF_Register._NewContextMenu") ' id.
|
|
.RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id.
|
|
.RegisterService("Toolbar", "SFWidgets.SF_Register._NewToolbar") ' id.
|
|
.RegisterService("ToolbarButton", "SFWidgets.SF_Register._NewToolbarButton") ' id.
|
|
End With
|
|
|
|
End Sub ' SFWidgets.SF_Register.RegisterScriptServices
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _NewContextMenu(Optional ByVal pvArgs As Variant) As Object
|
|
''' Create a new instance of the SF_ContextMenu class
|
|
''' Args:
|
|
''' Component: the document's component requesting a context menu
|
|
''' ContextMenuName: a private:resource/popupmenu/... reference
|
|
''' SubmenuChar: Delimiter used in menu trees
|
|
''' Returns: the instance or Nothing
|
|
|
|
Dim oMenu As Object ' Return value
|
|
Dim Component As Object ' The document's component requesting a context menu
|
|
Dim ContextMenuName As String ' A "private:resource/popupmenu/..." reference
|
|
Dim SubmenuChar As String ' Delimiter in menu trees
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oMenu = Nothing
|
|
|
|
Check:
|
|
' Get arguments, their check has been done upstream
|
|
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
|
|
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
|
|
If UBound(pvArgs) >= 0 Then Set Component = pvArgs(0) Else Set Component = Nothing
|
|
If UBound(pvArgs) >= 1 Then ContextMenuName = pvArgs(1) Else ContextMenuName = ""
|
|
If UBound(pvArgs) >= 2 Then SubmenuChar = pvArgs(2) Else SubmenuChar = ">"
|
|
|
|
Try:
|
|
If Not IsNull(Component) Then
|
|
Set oMenu = New SF_ContextMenu
|
|
With oMenu
|
|
Set .[Me] = oMenu
|
|
._Initialize(Component, ContextMenuName, SubmenuChar)
|
|
End With
|
|
Else
|
|
Set oMenu = Nothing
|
|
End If
|
|
|
|
Finally:
|
|
Set _NewContextMenu = oMenu
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFWidgets.SF_Register._NewContextMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _NewMenu(Optional ByVal pvArgs As Variant) As Object
|
|
''' Create a new instance of the SF_Menu class
|
|
''' [called internally from SFDocuments.Document.CreateMenu() ONLY]
|
|
''' Args:
|
|
''' Component: the com.sun.star.lang.XComponent where to find the menubar to plug the new menu in
|
|
''' Header: the name/header of the menu
|
|
''' Before: the place where to put the new menu on the menubar (string or number >= 1)
|
|
''' When not found => last position
|
|
''' SubmenuChar: the delimiter used in menu trees. Default = ">"
|
|
''' Returns: the instance or Nothing
|
|
|
|
Dim oMenu As Object ' Return value
|
|
Dim oComponent As Object ' The document or formdocument's component - com.sun.star.lang.XComponent
|
|
Dim sHeader As String ' Menu header
|
|
Dim sBefore As String ' Position of menu as a string
|
|
Dim iBefore As Integer ' as a number
|
|
Dim sSubmenuChar As String ' Delimiter in menu trees
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oMenu = Nothing
|
|
|
|
Check:
|
|
' Types and number of arguments are not checked because internal call only
|
|
Set oComponent = pvArgs(0)
|
|
sHeader = pvArgs(1)
|
|
Select Case VarType(pvArgs(2))
|
|
Case V_STRING : sBefore = pvArgs(2)
|
|
iBefore = 0
|
|
Case Else : sBefore = ""
|
|
iBefore = pvArgs(2)
|
|
End Select
|
|
sSubmenuChar = pvArgs(3)
|
|
|
|
Try:
|
|
If Not IsNull(oComponent) Then
|
|
Set oMenu = New SF_Menu
|
|
With oMenu
|
|
Set .[Me] = oMenu
|
|
._Initialize(oComponent, sHeader, sBefore, iBefore, sSubmenuChar)
|
|
End With
|
|
End If
|
|
|
|
Finally:
|
|
Set _NewMenu = oMenu
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFWidgets.SF_Register._NewMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object
|
|
''' Create a new instance of the SF_PopupMenu class
|
|
''' Args:
|
|
''' Event: a mouse event
|
|
''' If the event has no source or is not a mouse event, the menu is displayed above the actual window
|
|
''' X, Y: forced coordinates
|
|
''' SubmenuChar: Delimiter used in menu trees
|
|
''' Returns: the instance or Nothing
|
|
|
|
Dim oMenu As Object ' Return value
|
|
Dim Event As Variant ' Mouse event
|
|
Dim X As Long ' Mouse click coordinates
|
|
Dim Y As Long
|
|
Dim SubmenuChar As String ' Delimiter in menu trees
|
|
Dim vUno As Variant ' UNO type split into an array
|
|
Dim sEventType As String ' Event type, must be "MouseEvent"
|
|
Dim oControl As Object ' The dialog or form control view which triggered the event
|
|
Dim oWindow As Object ' ui.Window type
|
|
Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
|
|
Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oMenu = Nothing
|
|
|
|
Check:
|
|
' Check and get arguments, their number may vary
|
|
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
|
|
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
|
|
If UBound(pvArgs) >= 0 Then Event = pvArgs(0) Else Event = Nothing
|
|
If IsEmpty(Event) Then Event = Nothing
|
|
If UBound(pvArgs) >= 1 Then X = pvArgs(1) Else X = 0
|
|
If UBound(pvArgs) >= 2 Then Y = pvArgs(2) Else Y = 0
|
|
If UBound(pvArgs) >= 3 Then SubmenuChar = pvArgs(3) Else SubmenuChar = ""
|
|
If Not ScriptForge.SF_Utils._Validate(Event, "Event", ScriptForge.V_OBJECT) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(X, "X", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Y, "Y", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
|
|
|
|
Try:
|
|
' Find and identify the control that triggered the popup menu
|
|
Set oControl = Nothing
|
|
If Not IsNull(Event) Then
|
|
' Determine the X, Y coordinates
|
|
vUno = Split(oSession.UnoObjectType(Event), ".")
|
|
sEventType = vUno(UBound(vUno))
|
|
If UCase(sEventType) = "MOUSEEVENT" Then
|
|
X = Event.X
|
|
Y = Event.Y
|
|
' Determine the window peer target
|
|
If oSession.HasUnoProperty(Event, "Source") Then Set oControl = Event.Source.Peer
|
|
End If
|
|
End If
|
|
' If not a mouse event, if no control, find what can be decent alternatives: (a menu header in) the actual window
|
|
If IsNull(oControl) Then
|
|
Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window
|
|
With oWindow
|
|
If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow()
|
|
End With
|
|
End If
|
|
|
|
If Not IsNull(oControl) Then
|
|
Set oMenu = New SF_PopupMenu
|
|
With oMenu
|
|
Set .[Me] = oMenu
|
|
._Initialize(oControl, X, Y, SubmenuChar)
|
|
End With
|
|
Else
|
|
Set oMenu = Nothing
|
|
End If
|
|
|
|
Finally:
|
|
Set _NewPopupMenu = oMenu
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFWidgets.SF_Register._NewPopupMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _NewToolbar(Optional ByVal pvArgs As Variant) As Object
|
|
''' Create a new instance of the SF_Toolbar class
|
|
''' The "Toolbar" service must not be invoked directly in a user script
|
|
''' Args:
|
|
''' ToolbarDesc: a proto-toolbar object type. See ScriptForge.SF_UI for a detailed description
|
|
''' Returns:
|
|
''' the instance or Nothing
|
|
|
|
Dim oToolbar As Object ' Return value
|
|
Dim oToolbarDesc As Object ' A proto-toolbar description
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oToolbar = Nothing
|
|
|
|
Check:
|
|
Set oToolbarDesc = pvArgs(0)
|
|
|
|
Try:
|
|
Set oToolbar = New SF_Toolbar
|
|
With oToolbar
|
|
Set .[Me] = oToolbar
|
|
._Initialize(oToolbarDesc)
|
|
End With
|
|
|
|
Finally:
|
|
Set _NewToolbar = oToolbar
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFWidgets.SF_Register._NewToolbar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _NewToolbarButton(Optional ByVal pvArgs As Variant) As Object
|
|
''' Create a new instance of the SF_ToolbarButton class
|
|
''' The "ToolbarButton" service must not be invoked directly in a user script
|
|
''' Args:
|
|
''' ToolbarButtonDesc: a proto-toolbarButton object type. See SFWidgets.SF_Toolbar for a detailed description
|
|
''' Returns:
|
|
''' the instance or Nothing
|
|
|
|
Dim oToolbarButton As Object ' Return value
|
|
Dim oToolbarButtonDesc As Object ' A proto-toolbarbutton description
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oToolbarButton = Nothing
|
|
|
|
Check:
|
|
Set oToolbarButtonDesc = pvArgs(0)
|
|
|
|
Try:
|
|
Set oToolbarButton = New SF_ToolbarButton
|
|
With oToolbarButton
|
|
Set .[Me] = oToolbarButton
|
|
._Initialize(oToolbarButtonDesc)
|
|
End With
|
|
|
|
Finally:
|
|
Set _NewToolbarButton = oToolbarButton
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFWidgets.SF_Register._NewToolbarButton
|
|
|
|
|
|
REM ============================================== END OF SFWIDGETS.SF_REGISTER
|
|
</script:module> |