diff --git a/wizards/Package_sfwidgets.mk b/wizards/Package_sfwidgets.mk index 75fc0bd1f18f..062ee557c4f6 100644 --- a/wizards/Package_sfwidgets.mk +++ b/wizards/Package_sfwidgets.mk @@ -22,6 +22,7 @@ $(eval $(call gb_Package_Package,wizards_basicsrvsfwidgets,$(SRCDIR)/wizards/sou $(eval $(call gb_Package_add_files,wizards_basicsrvsfwidgets,$(LIBO_SHARE_FOLDER)/basic/SFWidgets,\ SF_Menu.xba \ SF_MenuListener.xba \ + SF_ContextMenu.xba \ SF_PopupMenu.xba \ SF_Register.xba \ SF_Toolbar.xba \ diff --git a/wizards/source/scriptforge/SF_PythonHelper.xba b/wizards/source/scriptforge/SF_PythonHelper.xba index b0bf9e93ceef..6cc8fc42daca 100644 --- a/wizards/source/scriptforge/SF_PythonHelper.xba +++ b/wizards/source/scriptforge/SF_PythonHelper.xba @@ -784,12 +784,14 @@ Try: If Script = "SetTableData" Then vReturn = vBasicObject.SetTableData(vArgs(0), vArgs(1), vArgs(2)) Case "SFDocuments.Document" Select Case Script + Case "ContextMenus" : vReturn = vBasicObject.ContextMenus(vArgs(0), vArgs(1)) Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0)) Case "Styles" : vReturn = vBasicObject.Styles(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5)) Case "Toolbars" : vReturn = vBasicObject.Toolbars(vArgs(0)) End Select Case "SFDocuments.Base" Select Case Script + Case "ContextMenus" : vReturn = vBasicObject.ContextMenus(vArgs(0), vArgs(1)) Case "FormDocuments" : vReturn = vBasicObject.FormDocuments() Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0), vArgs(1)) Case "Toolbars" : vReturn = vBasicObject.Toolbars(vArgs(0)) @@ -797,6 +799,7 @@ Try: Case "SFDocuments.Calc" Select Case Script Case "Charts" : vReturn = vBasicObject.Charts(vArgs(0), vArgs(1)) + Case "ContextMenus" : vReturn = vBasicObject.ContextMenus(vArgs(0), vArgs(1)) Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0), vArgs(1)) Case "GetFormula" : vReturn = vBasicObject.GetFormula(vArgs(0)) Case "GetValue" : vReturn = vBasicObject.GetValue(vArgs(0)) @@ -815,11 +818,13 @@ Try: If Script = "Controls" Then vReturn = vBasicObject.Controls(vArgs(0)) Case "SFDocuments.FormDocument" Select Case Script + Case "ContextMenus" : vReturn = vBasicObject.ContextMenus(vArgs(0), vArgs(1)) Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0)) Case "Toolbars" : vReturn = vBasicObject.Toolbars(vArgs(0)) End Select Case "SFDocuments.Writer" Select Case Script + Case "ContextMenus" : vReturn = vBasicObject.ContextMenus(vArgs(0), vArgs(1)) Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0)) Case "Styles" : vReturn = vBasicObject.Styles(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5)) Case "Toolbars" : vReturn = vBasicObject.Toolbars(vArgs(0)) diff --git a/wizards/source/scriptforge/SF_Services.xba b/wizards/source/scriptforge/SF_Services.xba index f525d7a447f2..4e6a1130a874 100644 --- a/wizards/source/scriptforge/SF_Services.xba +++ b/wizards/source/scriptforge/SF_Services.xba @@ -134,7 +134,7 @@ Try: sLibrary = "SFDialogs" Case "database", "datasheet" : sLibrary = "SFDatabases" Case "unittest" : sLibrary = "SFUnitTests" - Case "menu", "popupmenu", "toolbar", "toolbarbutton" + Case "contextmenu", "menu", "popupmenu", "toolbar", "toolbarbutton" sLibrary = "SFWidgets" Case Else End Select diff --git a/wizards/source/scriptforge/SF_UI.xba b/wizards/source/scriptforge/SF_UI.xba index 3bde6c22e4ac..47e785edb3d6 100644 --- a/wizards/source/scriptforge/SF_UI.xba +++ b/wizards/source/scriptforge/SF_UI.xba @@ -1255,6 +1255,53 @@ Public Sub _CloseProgressBar(Optional ByRef poEvent As Object) End Sub ' ScriptForge.SF_UI._CloseProgressBar +REM ----------------------------------------------------------------------------- +Function _GetConfigurationManager(ByRef poComponent) As String +''' Derives the argument to be passed to a configuration manager +''' (managing the user interface elements like menus, toolbars, ...) +''' from the nature of the component +''' Args: +''' poComponent: any component in desktop, typically a document but not only + +Dim sConfigurationManager As String ' Return value +Dim oWindow As Object ' Window type + +Check: +' On Local Error GoTo Catch + If IsNull(poComponent) Then GoTo Catch + +Try: + Set oWindow = _IdentifyWindow(poComponent) + + ' Derive the name of the UI configuration manager from the component type + With oWindow + Select Case .WindowName + Case BASICIDE : sConfigurationManager = "com.sun.star.script.BasicIDE" + Case WELCOMESCREEN : sConfigurationManager = "com.sun.star.frame.StartModule" + Case Else + Select Case .DocumentType + Case BASEDOCUMENT : sConfigurationManager = "com.sun.star.sdb.OfficeDatabaseDocument" + Case CALCDOCUMENT : sConfigurationManager = "com.sun.star.sheet.SpreadsheetDocument" + Case DRAWDOCUMENT : sConfigurationManager = "com.sun.star.drawing.DrawingDocument" + Case FORMDOCUMENT : sConfigurationManager = "com.sun.star.sdb.FormDesign" + Case IMPRESSDOCUMENT : sConfigurationManager = "com.sun.star.presentation.PresentationDocument" + Case MATHDOCUMENT : sConfigurationManager = "com.sun.star.formula.FormulaProperties" + Case WRITERDOCUMENT : sConfigurationManager = "com.sun.star.text.TextDocument" + Case TABLEDATA, QUERYDATA, SQLDATA + sConfigurationManager = "com.sun.star.sdb.DataSourceBrowser" + Case Else : sConfigurationManager = "" + End Select + End Select + End With + +Finally: + _GetConfigurationManager = sConfigurationManager + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_UI._GetConfigurationManager + REM ----------------------------------------------------------------------------- Public Function _IdentifyWindow(ByRef poComponent As Object) As Object ''' Return a Window object (definition on top of module) based on component given as argument @@ -1362,7 +1409,6 @@ Public Function _ListToolbars(ByRef poComponent As Object) As Object ''' poComponent: any component in desktop, typically a document but not only Dim oToolbarsDict As Object ' Return value -Dim oWindow As Object ' Window type Dim oConfigMgr As Object ' com.sun.star.ui.ModuleUIConfigurationManagerSupplier Dim sConfigurationManager As String ' Derived from the component's type Dim oUIConfigMgr As Object ' com.sun.star.comp.framework.ModuleUIConfigurationManager @@ -1382,30 +1428,12 @@ Check: Try: Set oToolbarsDict = CreateScriptService("Dictionary") - Set oWindow = _IdentifyWindow(poComponent) ' 1. Collect all builtin and custom toolbars stored in the LibreOffice configuration files ' Derive the name of the UI configuration manager from the component type - With oWindow - Select Case .WindowName - Case BASICIDE : sConfigurationManager = "com.sun.star.script.BasicIDE" - Case WELCOMESCREEN : sConfigurationManager = "com.sun.star.frame.StartModule" - Case Else - Select Case .DocumentType - Case BASEDOCUMENT : sConfigurationManager = "com.sun.star.sdb.OfficeDatabaseDocument" - Case CALCDOCUMENT : sConfigurationManager = "com.sun.star.sheet.SpreadsheetDocument" - Case DRAWDOCUMENT : sConfigurationManager = "com.sun.star.drawing.DrawingDocument" - Case FORMDOCUMENT : sConfigurationManager = "com.sun.star.sdb.FormDesign" - Case IMPRESSDOCUMENT : sConfigurationManager = "com.sun.star.presentation.PresentationDocument" - Case MATHDOCUMENT : sConfigurationManager = "com.sun.star.formula.FormulaProperties" - Case WRITERDOCUMENT : sConfigurationManager = "com.sun.star.text.TextDocument" - Case TABLEDATA, QUERYDATA, SQLDATA - sConfigurationManager = "com.sun.star.sdb.DataSourceBrowser" - Case Else : sConfigurationManager = "" - End Select - End Select - End With + sConfigurationManager = _GetConfigurationManager(poComponent) + Set oConfigMgr = SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier") Set oUIConfigMgr = oConfigMgr.getUIConfigurationManager(sConfigurationManager) vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR) diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index aab41c00c4fe..6b5431f75429 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -2293,6 +2293,9 @@ class SFDocuments: def CloseDocument(self, saveask = True): return self.ExecMethod(self.vbMethod, 'CloseDocument', saveask) + def ContextMenus(self, contextmenuname = '', submenuchar = '>'): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'ContextMenus', contextmenuname, submenuchar) + def CreateMenu(self, menuheader, before = '', submenuchar = '>'): return self.ExecMethod(self.vbMethod, 'CreateMenu', menuheader, before, submenuchar) @@ -2894,6 +2897,32 @@ class SFWidgets: return self.ExecMethod(self.vbMethod, 'AddRadioButton', menuitem, name, status, icon, tooltip, command, script) + # ######################################################################### + # SF_ContextMenu CLASS + # ######################################################################### + class SF_ContextMenu(SFServices): + """ + A context menu is obtained by a right-click on several areas of a document. + 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 service provides a mean to make temporary additions at + the bottom of a context menu. Those changes are lost when the document is closed. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFWidgets.ContextMenu' + servicesynonyms = ('contextmenu', 'sfwidgets.contextmenu') + serviceproperties = dict(ShortcutCharacter = False, SubmenuCharacter = False) + + def Activate(self, enable = True): + return self.ExecMethod(self.vbMethod, 'Activate', enable) + + def AddItem(self, menuitem, command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddItem', menuitem, command, script) + + # ######################################################################### # SF_PopupMenu CLASS # ######################################################################### @@ -3082,6 +3111,7 @@ FORMDOCUMENT = SFDocuments.SF_FormDocument WRITER = SFDocuments.SF_Writer # SFWidgets MENU = SFWidgets.SF_Menu +CONTEXTMENU = SFWidgets.SF_ContextMenu POPUPMENU = SFWidgets.SF_PopupMenu TOOLBAR = SFWidgets.SF_Toolbar TOOLBARBUTTON = SFWidgets.SF_ToolbarButton diff --git a/wizards/source/scriptforge/python/scriptforge.pyi b/wizards/source/scriptforge/python/scriptforge.pyi index 4bfabb381414..e4f596661416 100644 --- a/wizards/source/scriptforge/python/scriptforge.pyi +++ b/wizards/source/scriptforge/python/scriptforge.pyi @@ -86,6 +86,7 @@ FORMDOCUMENT = SFDocuments.SF_FormDocument WRITER = SFDocuments.SF_Writer # SFWidgets MENU = SFWidgets.SF_Menu +CONTEXTMENU = SFWidgets.SF_ContextMenu POPUPMENU = SFWidgets.SF_PopupMenu TOOLBAR = SFWidgets.SF_Toolbar TOOLBARBUTTON = SFWidgets.SF_ToolbarButton @@ -95,7 +96,7 @@ SERVICE = Union[ARRAY, BASIC, DICTIONARY, EXCEPTION, FILESYSTEM, L10N, PLATFORM, DATABASE, DATASET, DATASHEET, DIALOG, DIALOGCONTROL, DOCUMENT, BASE, CALC, CALCREFERENCE, CHART, FORM, FORMCONTROL, FORMDOCUMENT, WRITER, - MENU, POPUPMENU, TOOLBAR, TOOLBARBUTTON] + MENU, CONTEXTMENU, POPUPMENU, TOOLBAR, TOOLBARBUTTON] # UNO UNO = TypeVar('UNO') # Other @@ -4486,12 +4487,28 @@ class SFDocuments: """ ... + def ContextMenus(self, contextmenuname: str = ..., submenuchar: str = ... + ) -> Union[CONTEXTMENU, Tuple[str, ...]]: + """ + Returns either a list of the available ContextMenu names in the actual document + or a ``SFWidgets.SF_ContextMenu`` object instance. + Args + ``contextmenuname``: the usual name of one of the available context menus. + + ``submenuchar``: the delimiter used to create menu trees when calling + the ``AddItem()`` method from the ``ContextMenu`` service. The default value is ">". + Returns + The list of available context menu names as a tuple of strings when ``contextmenuname`` + is absent, a ``ContextMenu`` class instance otherwise. + """ + ... + def CreateMenu(self, menuheader: str, before: Union[str, int] = ..., submenuchar: str = ... ) -> MENU: """ Creates a new menu entry in the menubar of a given document window. - The menu created is only available during the current LibreOffice session and is not saved neither + The created menu is only available during the current LibreOffice session and is not saved neither in the document nor in the global application settings. Hence, closing the document window will make the menu disappear. It will only reappear when the macro that creates the menu is executed again. @@ -6864,7 +6881,97 @@ class SFWidgets: ... # ######################################################################### - # SF_Menu CLASS + # SF_ContextMenu CLASS + # ######################################################################### + class SF_ContextMenu(SFServices): + """ + Complete a predefined context menu with new items. + + A context menu is obtained by a right-click on several areas of a document. + Each area determines its own context menu. + (Consider right-clicking on a cell or on a sheet tab in a Calc document). + 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 service provides a mean to make temporary additions at + the bottom of a context menu in an active document. 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. + """ + + ShortcutCharacter: str + """ Character used to define the access key of a menu item. The default character is "~" (tilde). """ + SubmenuCharacter: str + """ Character or string that defines how menu items are nested. The default character is ">". + + Example + ``oMenu.AddItem("Item A")`` + + ``oMenu.AddItem("Item B>Item B.1")`` + + ``oMenu.AddItem("Item B>Item B.2")`` + + ``oMenu.AddItem("---")`` + + ``oMenu.AddItem("Item C>Item C.1>Item C.1.1")`` + + ``oMenu.AddItem("Item C>Item C.1>Item C.1.2")`` + + ``oMenu.AddItem("Item C>Item C.2>Item C.2.1")`` + + ``oMenu.AddItem("Item C>Item C.2>Item C.2.2")`` + + ``oMenu.AddItem("Item C>Item C.2>---")`` + + ``oMenu.AddItem("Item C>Item C.2>Item C.2.3")`` + + ``oMenu.AddItem("Item C>Item C.2>Item C.2.4")`` + """ + + def Activate(self, enable: bool = ...) -> None: + """ + Make the added items of the context menu available for execution, or, at the opposite, + disable them, depending on the argument. + Args + ``enable``: when ``True`` (default), the new items of the context menu are made visible. + When ``False``, they are suppressed. + Returns + None + """ + ... + + def AddItem(self, + menuitem: str, + command: str = ..., + script: str = ..., + ) -> None: + """ + Inserts a labeled entry or a line separator in the menu. + Args + ``menuitem``: defines the text to be displayed in the menu. + This argument also defines the hierarchy of the item inside the menu by using the submenu + character. If the last component is equal to "---", a line separator is inserted + and all other arguments are ignored. + + ``command``: a menu command like ".uno:About". The validity of the command is not checked. + + ``script``: a Basic or Python script (determined by its URI notation) to be run when + the item is clicked. + Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification + No argument will be passed to the called script. + Note + Arguments ``Command`` and ``Script`` are mutually exclusive. + Returns + None + """ + ... + + # ######################################################################### + # SF_PopupMenu CLASS # ######################################################################### class SF_PopupMenu(SFServices): """ @@ -6948,11 +7055,12 @@ class SFWidgets: tooltip: str = ..., ) -> int: """ - Inserts a label entry in the menu. + Inserts a labeled entry or a line separator in the menu. Args ``menuitem``: defines the text to be displayed in the menu. This argument also defines the hierarchy of the item inside the menu by using the submenu - character. + character. If the last component is equal to "---", a line separator is inserted + and all other arguments are ignored. ``name``: the string value used to identify the menu item. By default, the last component of the menu hierarchy is used. diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba index b6497b9b4f12..c977cb6a29b7 100644 --- a/wizards/source/sfdocuments/SF_Base.xba +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -912,6 +912,13 @@ Public Function Activate() As Boolean Activate = [_Super].Activate() End Function ' SFDocuments.SF_Base.Activate +REM ----------------------------------------------------------------------------- +Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Variant + ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar) +End Function ' SFDocuments.SF_Base.ContextMenus + REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index 1d2a04056065..aa3e125731db 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -3728,6 +3728,13 @@ Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean CloseDocument = [_Super].CloseDocument(SaveAsk) End Function ' SFDocuments.SF_Calc.CloseDocument +REM ----------------------------------------------------------------------------- +Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Variant + ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar) +End Function ' SFDocuments.SF_Calc.ContextMenus + REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba index 43e143f30a59..230be6248a10 100644 --- a/wizards/source/sfdocuments/SF_Document.xba +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -86,6 +86,9 @@ Private _CustomProperties As Object ' Dictionary of custom properties ' Cache for static toolbar descriptions Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document +' List of standard context menus +Private _ContextMenus As Variant ' Array of ResourceURL strings + ' Style descriptor Type StyleDescriptor Family As Object @@ -123,6 +126,7 @@ Private Sub Class_Initialize() Set _DocumentProperties = Nothing Set _CustomProperties = Nothing Set _Toolbars = Nothing + _ContextMenus = Array() _StyleFamilies = Array() End Sub ' SFDocuments.SF_Document Constructor @@ -530,6 +534,57 @@ Catch: GoTo Finally End Function ' SFDocuments.SF_Document.CloseDocument +REM ----------------------------------------------------------------------------- +Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Variant +''' Returns either a list of the available ContextMenu names in the actual document +''' or a SFWidgets.ContextMenu object instance. +''' Args: +''' ContextMenuName: the usual name of one of the available ContextMenus +''' SubmenuChar: Delimiter used in menu trees +''' Returns: +''' A zero-based array of ContextMenu names when there is no argument, +''' or a new ContextMenu object instance from the SFWidgets library. + +Const cstThisSub = "SFDocuments.Document.ContextMenus" +Const cstSubArgs = "[ContextMenuName=""""], [SubmenuChar="">""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(ContextMenuName) Or IsEmpty(ContextMenuName) Then ContextMenuName = "" + If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ">" + If UBound(_ContextMenus) < 0 Then _ContextMenus = _ListContextMenus() + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If VarType(ContextMenuName) = V_STRING Then + If Len(ContextMenuName) > 0 Then + If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING, _ContextMenus) Then GoTo Finally + End If + Else + If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING) Then GoTo Finally ' Manage here the VarType error + End If + If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally + End If + +Try: + If Len(ContextMenuName) = 0 Then + ContextMenus = _ContextMenus + Else + ContextMenus = CreateScriptService("SFWidgets.ContextMenu" _ + , _Component _ + , "private:resource/popupmenu/" & LCase(ContextMenuName) _ + , SubmenuChar) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.ContextMenus + REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ @@ -855,6 +910,7 @@ Public Function Methods() As Variant Methods = Array( _ "Activate" _ , "CloseDocument" _ + , "ContextMenus" _ , "CreateMenu" _ , "Echo" _ , "DeleteStyles" _ @@ -2000,6 +2056,43 @@ CatchReadonly: GoTo Finally End Function ' SFDocuments.SF_Document._IsStillAlive +REM ----------------------------------------------------------------------------- +Private Function _ListContextMenus() As Variant +''' Returns an array of the usual names of the context menus available in the current document + +Dim vMenus As Variant ' Return value +Dim vMenusObj As Variant ' Array of arrays of property values +Dim oSupplier As Object ' /singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier +Dim sComponentType As String ' Argument to determine the system config manager, ex. "com.sun.star.text.TextDocument" +Dim oUIConf As Object ' com.sun.star.ui.XUIConfigurationManager +Dim i As Long + + On Local Error GoTo Catch + vMenus = Array() + +Try: + Set oSupplier = ScriptForge.SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier") + sComponentType = ScriptForge.SF_UI._GetConfigurationManager(_Component) + Set oUIConf = oSupplier.getUIConfigurationManager(sComponentType) + + ' Discard menubar, statusbar, ... + vMenusObj = oUIConf.getUIElementsInfo(com.sun.star.ui.UIElementType.POPUPMENU) + + ' Extract and sort the names + ReDim vMenus(0 To UBound(vMenusObj)) + For i = 0 To UBound(vMenusObj) + vMenus(i) = Mid(vMenusObj(i)(0).Value, Len("private:resource/popupmenu/") + 1) + Next i + vMenus = ScriptForge.SF_Array.Unique(vMenus, CaseSensitive := True) + +Finally: + _ListContextMenus = vMenus + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' SFDocuments.SF_Document._ListContextMenus + REM ----------------------------------------------------------------------------- Private Sub _LoadDocumentProperties() ''' Create dictionary with document properties as entries/ Custom properties are excluded diff --git a/wizards/source/sfdocuments/SF_FormDocument.xba b/wizards/source/sfdocuments/SF_FormDocument.xba index 42f853f174f4..f187bb85441b 100644 --- a/wizards/source/sfdocuments/SF_FormDocument.xba +++ b/wizards/source/sfdocuments/SF_FormDocument.xba @@ -501,6 +501,13 @@ Public Function Activate() As Boolean Activate = [_Super].Activate() End Function ' SFDocuments.SF_FormDocument.Activate +REM ----------------------------------------------------------------------------- +Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Variant + ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar) +End Function ' SFDocuments.SF_FormDocument.ContextMenus + REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ diff --git a/wizards/source/sfdocuments/SF_Writer.xba b/wizards/source/sfdocuments/SF_Writer.xba index d71df30135cc..a7fce5fe9840 100644 --- a/wizards/source/sfdocuments/SF_Writer.xba +++ b/wizards/source/sfdocuments/SF_Writer.xba @@ -654,6 +654,13 @@ Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean CloseDocument = [_Super].CloseDocument(SaveAsk) End Function ' SFDocuments.SF_Writer.CloseDocument +REM ----------------------------------------------------------------------------- +Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Variant + ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar) +End Function ' SFDocuments.SF_Writer.ContextMenus + REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ @@ -1166,4 +1173,4 @@ Private Function _Repr() As String End Function ' SFDocuments.SF_Writer._Repr REM ============================================ END OF SFDOCUMENTS.SF_WRITER - + \ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_ContextMenu.xba b/wizards/source/sfwidgets/SF_ContextMenu.xba new file mode 100644 index 000000000000..e246c5aeb5d6 --- /dev/null +++ b/wizards/source/sfwidgets/SF_ContextMenu.xba @@ -0,0 +1,574 @@ + + +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 ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_ContextMenu +''' ============== +''' Complete a predefined context menu with new items. +''' +''' A context menu is obtained by a right-click on several areas of a document. +''' Each area determines its own context menu. +''' (Consider right-clicking on a cell or on a sheet tab in a Calc document). +''' 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 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 +''' - line separators +''' Checkboxes or radio buttons are not supported. +''' +''' A context menu is setup in next sequence: +''' 1. Define each menu item, submenu or line separator with AddItem(...) +''' 2. Activate() the menu to make it visible and active +''' 3. If meaningful, it can be temporarily deactivate with Activate(False) +''' 4. Items can be optionally added, and the menu might be made active again +''' 5. Dispose() cleans the memory resources +''' +''' Definitions: +''' SubmenuCharacter: the character or the character string that identifies how menus are cascading +''' Default = ">" +''' Can be set when invoking the ContextMenu service +''' ShortcutCharacter: the underline access key character +''' Default = "~" +''' +''' Service invocation: +''' From a document, calc, writer, formdocument or datasheet service: +''' Dim MenusList As Variant, oCtxMenu As Object +''' MenusList = doc.ContextMenus() +''' ' Returns a list of available context menus as strings +''' Set oCtxMenu = doc.ContextMenus(ContextMenuName, SubmenuChar = ">>") +''' ' Returns a context menu service instance +''' +''' Menus and submenus +''' To create a context menu with submenus, use the character defined in the +''' SubmenuCharacter property while creating the menu entry to define where it will be +''' placed. For instance, consider the following menu/submenu hierarchy. +''' Item A +''' Item B > Item B.1 +''' Item B.2 +''' ------ (line separator) +''' Item C > Item C.1 > Item C.1.1 +''' Item C.1.2 +''' Item C > ------ (line separator) +''' Item C > Item C.2 > Item C.2.1 +''' Item C.2.2 +''' Next code will create the menu/submenu hierarchy +''' With myMenu +''' .AddItem("Item A", Command := ...) +''' .AddItem("Item B>Item B.1", Script := ...) +''' .AddItem("Item B>Item B.2", ...) +''' .AddItem("---") +''' .AddItem("Item C>Item C.1>Item C.1.1", ...) +''' .AddItem("Item C>Item C.1>Item C.1.2", ...) +''' .AddItem("Item C>---") +''' .AddItem("Item C>Item C.2>Item C.2.1", ...) +''' .AddItem("Item C>Item C.2>Item C.2.2", ...) +''' End With +''' +''' Example: Add 2 items to the general context menu of a Writer document +''' Sub SetContextMenu(oWriter As Object) +''' Dim oMenu As Object +''' Set oMenu = oWriter.ContextMenus("text") +''' With oMenu +''' .AddItem("About", Command := ".uno:About") +''' .AddItem("Run", Script := "vnd.sun.star.script:Standard.Module1.MyFunction?language=Basic&location=document") +''' ' MyFunction is a Sub without argument +''' .Activate() +''' .Dispose() +''' End With +''' End Sub +''' +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_contextmenu.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private ObjectType As String ' Must be ContextMenu +Private ServiceName As String + + +' Menu descriptors +Private Component As Object ' com.sun.star.lang.XComponent +Private ResourceURL As String ' private:resource/popupmenu/... +Private ConfigManager As Object ' com.sun.star.ui.XUIConfigurationManager +Private MenuTree As Variant ' Dictionary nodename - com.sun.star.ui.ItemDescriptor pair +Private SubmenuChar As String ' Delimiter in menu trees +Private MenuContainer As Object ' com.sun.star.container.XIndexAccess + +REM ============================================================ MODULE CONSTANTS + +Private Const _UnderlineAccessKeyChar = "~" +Private Const _DefaultSubmenuChar = ">" +Private Const _SeparatorChar = "---" +Private Const cstUnoPrefix = ".uno:" + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + ObjectType = "ContextMenu" + ServiceName = "SFWidgets.ContextMenu" + Set Component = Nothing + Set ConfigManager = Nothing + ResourceURL = "" + Set MenuTree = Nothing + SubmenuChar = _DefaultSubmenuChar + Set MenuContainer = Nothing +End Sub ' SFWidgets.SF_ContextMenu Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFWidgets.SF_ContextMenu Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If Not IsNull(MenuTree) Then Set MenuTree = MenuTree.Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFWidgets.SF_ContextMenu Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ShortcutCharacter() As Variant +''' The ShortcutCharacter property specifies character preceding the underline access key + ShortcutCharacter = _PropertyGet("ShortcutCharacter") +End Property ' SFWidgets.SF_ContextMenu.ShortcutCharacter (get) + +REM ----------------------------------------------------------------------------- +Property Get SubmenuCharacter() As Variant +''' The SubmenuCharacter property specifies the character string indicating +''' a sub-menu in a popup menu item + SubmenuCharacter = _PropertyGet("SubmenuCharacter") +End Property ' SFWidgets.SF_ContextMenu.SubmenuCharacter (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Sub Activate(Optional ByVal Enable As Variant) As Variant +''' Make the added items of the context menu available for execution, +''' or, at the opposite, disable them, depending on the argument. +''' Args: +''' Enable: When True (default), the new items of the context menu are made visible. +''' When False, they are suppressed. +''' Returns: +''' None +''' Examples: +''' Sub SetContextMenu(oWriter As Object) ' oWriter is a SFDocuments.SF_Writer service instance +''' Dim oMenu As Object +''' Set oMenu = oWriter.ContextMenus("text") +''' With oMenu +''' .AddItem("About", Command := ".uno:About") +''' .AddItem("Run", Script := "vnd.sun.star.script:Standard.Module1.MyFunction?language=Basic&location=document") +''' ' MyFunction is a Sub without argument +''' .Activate() +''' .Dispose() ' Do not dispose() if you plan later on to Activate(Enable := False) the context menu +''' End With +''' End Sub + +Dim bSettings As Boolean ' When True, the menu is already stored + +Const cstThisSub = "SFWidgets.ContextMenu.Activate" +Const cstSubArgs = "[Enable=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Enable) Or IsEmpty(Enable) Then Enable = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(Enable, "Enable", ScriptForge.V_BOOLEAN) Then GoTo Catch + End If + If IsNull(ConfigManager) Or IsNull(MenuContainer) Then GoTo Finally + +Try: + With ConfigManager + bSettings = .hasSettings(ResourceURL) + If Enable And bSettings Then + .replaceSettings(ResourceURL, MenuContainer) + ElseIf Enable And Not bSettings Then + .insertSettings(ResourceURL, MenuContainer) + ElseIf Not Enable And bSettings Then + .removeSettings(ResourceURL) + Else + ' Nothing to deactivate + End If + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFWidgets.SF_ContextMenu.Activate + +REM ----------------------------------------------------------------------------- +Public Sub AddItem(Optional ByVal MenuItem As Variant _ + , Optional ByVal Command As Variant _ + , Optional ByVal Script As Variant _ + ) As Integer +''' Insert in the context menu a new entry +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to "---", a line separator is inserted and all other arguments are ignored +''' Command: A menu command like ".uno:About". The validity of the command is not checked. +''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' No argument will be passed to the called script. +''' Arguments Command and Script are mutually exclusive. +''' Returns: +''' None +''' Examples: +''' myMenu.AddItem("Menu top>Item 1", Command := "About") +''' myMenu.AddItem("Menu top>Item 2", Script := "vnd.sun.star.script:myLib.Module1.ThisSub?language=Basic&location=document") + +Dim sCommand As String ' Alias of either Command or Script +Dim vSplit As Variant ' Split menu item +Dim sMenu As String ' Submenu where to attach the new item, as a string +Dim oMenu As Object ' Submenu where to attach the new item, as an object +Dim sName As String ' The text displayed in the menu box +Dim vEntry As Variant ' com.sun.star.ui.ItemDescriptor + +Const cstThisSub = "SFWidgets.ContextMenu.AddItem" +Const cstSubArgs = "MenuItem, [Command=""""], [Script=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Command) Or IsEmpty(Command) Then Command = "" + If IsMissing(Script) Or IsEmpty(Script) Then Script = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch + End If + + If Len(Command) > 0 Then + If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command + Else + sCommand = Script + End If + +Try: + ' Run through the upper menu tree + vSplit = _SplitMenuItem(MenuItem) + + ' Create and determine the menu to which to attach the new item + sMenu = vSplit(0) + Set oMenu = _GetContextMenu(sMenu) ' Run through the upper menu tree and retain the last branch + + ' Insert the new item + sName = vSplit(1) + With ScriptForge.SF_Utils + vEntry = Array( ._MakePropertyValue("Type", Iif(sName = _SeparatorChar, _ + com.sun.star.ui.ItemType.SEPARATOR_LINE, _ + com.sun.star.ui.ItemType.DEFAULT)) _ + , ._MakePropertyValue("Label", Iif(sName = _SeparatorChar, "", sName)) _ + , ._MakePropertyValue("CommandURL", sCommand) _ + , ._MakePropertyValue("HelpURL", "") _ + , ._MakePropertyValue("Style", _ + Iif(Len(Script) > 0, 0, com.sun.star.ui.ItemStyle.ICON)) _ + , ._MakePropertyValue("ItemDescriptorContainer", Null) _ + ) + oMenu.insertByIndex(oMenu.Count, vEntry) + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFWidgets.SF_ContextMenu.AddItem + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' see the exceptions of the individual properties +''' Examples: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFWidgets.ContextMenu.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_ContextMenu.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "AddItem" _ + , "Execute" _ + ) + +End Function ' SFWidgets.SF_ContextMenu.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array + + Properties = Array( _ + "ShortcutCharacter" _ + , "SubmenuCharacter" _ + ) + +End Function ' SFWidgets.SF_ContextMenu.Properties + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFWidgets.ContextMenu.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + SetProperty = _PropertySet(PropertyName, Value) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_ContextMenu.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _GetContextMenu(ByVal psSubmenu As String) As Object +''' Get the context menu node corresponding with the string in argument +''' A context menu entry is represented by a set of property values +''' grouped as a ItemDescriptor entry in above array. +''' The menu node is stored in a com.cun.star.ItemDescriptor service +''' If the menu entry exists, it is found in the MenuTree dictionary +''' If it does not exist, it is created recursively. +''' Args: +''' psSubmenu: a string like "A>B" +''' Returns +''' A com.sun.star.container.XIndexAccess object +''' Example +''' If psSubmenu = "A>B>C>D", and the initial menu container is empty, +''' - "A", "A>B", "A>B>C", "A>B>C>D" should be created +''' - the popup menu corresponding with "A>B>C>D" should be returned + +Dim oContext As Object ' Return value +Dim vSplit As Variant ' An array as returned by Split() +Dim sMenu As String ' The left part of psSubmenu +Dim vMenu As Variant ' Array of property values => com.sun.star.ui.ItemDescriptor +Dim oLastMenu As Object ' com.sun.star.ui.ItemDescriptor.ItemDescriptorContainer +Dim oNewMenu As Object ' com.sun.star.ui.ItemDescriptor.ItemDescriptorContainer +Dim i As Long + + Set oContext = Nothing + +Try: + With ScriptForge.SF_Utils + If Len(psSubmenu) = 0 Then ' Menu starts at the root + Set oContext = MenuContainer + ElseIf MenuTree.Exists(psSubmenu) Then ' Shortcut: if the submenu exists, get it directly + Set oContext = ._GetPropertyValue(MenuTree.Item(psSubmenu), "ItemDescriptorContainer") + Else ' Build the tree + vSplit = Split(psSubmenu, SubmenuChar) + ' Search the successive submenus in the MenuTree dictionary, If not found, create a new entry + Set oLastMenu = MenuContainer + For i = 0 To UBound(vSplit) + sMenu = Join(ScriptForge.SF_Array.Slice(vSplit, 0, i), SubmenuChar) + If MenuTree.Exists(sMenu) Then + Set oNewMenu = ._GetPropertyValue(MenuTree.Item(sMenu), "ItemDescriptorContainer") + Else + ' Insert the new menu tree item at the bottom of the tree branch + Set oNewMenu = MenuContainer.createInstanceWithContext(GetDefaultContext()) + vMenu = Array( ._MakePropertyValue("Type", com.sun.star.ui.ItemType.DEFAULT) _ + , ._MakePropertyValue("Label", vSplit(i)) _ + , ._MakePropertyValue("CommandURL", "") _ + , ._MakePropertyValue("HelpURL", "") _ + , ._MakePropertyValue("Style", 0) _ + , ._MakePropertyValue("ItemDescriptorContainer", oNewMenu) _ + ) + oLastMenu.insertByIndex(oLastMenu.Count, vMenu) + MenuTree.Add(sMenu, vMenu) + End If + Set oLastMenu = oNewMenu + Next i + Set oContext = oLastMenu + End If + End With + +Finally: + Set _GetContextMenu = oContext + Exit Function +End Function ' SFWidgets.SF_ContextMenu._GetContextMenu + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize(ByRef poComponent As Object _ + , ByVal psContextMenuName As String _ + , ByVal psSubmenuChar As String _ + ) +''' Complete the object creation process: +''' - Initialize the dictionary +''' - initialize the root popup menu +''' - store the arguments for later use +''' Args: +''' Component: the document's component requesting a context menu +''' ContextMenuName: a private:resource/popupmenu/... reference +''' SubmenuChar: Delimiter used in menu trees + +Dim oSupplier As Object ' /singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier +Dim sComponentType As String ' Argument to determine the system config manager, ex. "com.sun.star.text.TextDocument" +Dim MainConfigManager As Object ' com.sun.star.ui.XUIConfigurationManager + +Try: + ' Initialize the dictionary + Set MenuTree = ScriptForge.SF_Services.CreateScriptService("Dictionary") + + ' Identify the container of the menu tree + ' The container is taken either from the system configuration manager of from the local (= in document) one + ' It is saved in the local version when the menu is Executed() + Set oSupplier = ScriptForge.SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier") + sComponentType = ScriptForge.SF_UI._GetConfigurationManager(poComponent) + Set MainConfigManager = oSupplier.getUIConfigurationManager(sComponentType) + Set ConfigManager = poComponent.getUIConfigurationManager(sComponentType) + ' Copy from system config manager if not found in local (= in document) one + If ConfigManager.hasSettings(psContextMenuName) Then + Set MenuContainer = ConfigManager.getSettings(psContextMenuName, true) + Else + Set MenuContainer = MainConfigManager.getSettings(psContextMenuName, true) + End If + + ' Store the private instance properties + Set Component = poComponent + ResourceURL = psContextMenuName + If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar + +Finally: + Exit Sub +End Sub ' SFWidgets.SF_ContextMenu._Initialize + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim vGet As Variant ' Return value +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SFWidgets.ContextMenu.get" & psProperty + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + _PropertyGet = Null + + Select Case UCase(psProperty) + Case UCase("ShortcutCharacter") + _PropertyGet = _UnderlineAccessKeyChar + Case UCase("SubmenuCharacter") + _PropertyGet = SubmenuChar + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_ContextMenu._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_ContextMenu instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[ContextMenu]: Name, Menu entries + _Repr = "[ContextMenu]: " & ResourceURL & ", " & SF_String.Represent(MenuTree.Keys()) + +End Function ' SFWidgets.SF_ContextMenu._Repr + +REM ----------------------------------------------------------------------------- +Private Function _SplitMenuItem(ByVal psMenuItem As String ) As Variant +''' Split a menu item given as a string and delimited by the submenu character +''' Args: +''' psMenuItem: a string like "A>B>C" +''' Returns: +''' An array: [0] = "A>B" +''' [1] = "C" + +Dim vReturn(0 To 1) As String ' Return value +Dim vMenus() As Variant ' Array of menus + +Try: + vMenus = Split(psMenuItem, SubmenuChar) + vReturn(1) = vMenus(UBound(vMenus)) + vReturn(0) = Left(psMenuItem, Len(psMenuItem) - Iif(UBound(vMenus) > 0, Len(SubmenuChar), 0) - Len(vReturn(1))) + +Finally: + _SplitMenuItem = vReturn +End Function ' SFWidgets.SF_ContextMenu._SplitMenuItem + +REM ============================================ END OF SFWIDGETS.SF_CONTEXTMENU + \ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba index 85d505904df5..13ccd3c5eec5 100644 --- a/wizards/source/sfwidgets/SF_Menu.xba +++ b/wizards/source/sfwidgets/SF_Menu.xba @@ -13,7 +13,7 @@ Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Menu -''' ============ +''' ======= ''' Display a menu in the menubar of a document or a form document. ''' After use, the menu will not be saved neither in the application settings, nor in the document. ''' @@ -69,8 +69,9 @@ Option Explicit ''' Set oDoc = ui.GetDocument(ThisComponent) ''' Set myMenu = oDoc.CreateMenu("My own menu") ''' +''' ''' Detailed user documentation: -''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/SF_Menu.html?DbPAR=BASIC +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_menu.html?DbPAR=BASIC ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' diff --git a/wizards/source/sfwidgets/SF_PopupMenu.xba b/wizards/source/sfwidgets/SF_PopupMenu.xba index 3d5ba65a80f8..50b28cab9fa1 100644 --- a/wizards/source/sfwidgets/SF_PopupMenu.xba +++ b/wizards/source/sfwidgets/SF_PopupMenu.xba @@ -378,8 +378,8 @@ Public Function Execute(Optional ByVal ReturnId As Variant) As Variant ''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent) ''' With myMenu ''' .AddCheckBox("View>Toolbars>Dialog") -''' .AddCheckBox("View>Toolbars>Find", STatus := True) -''' .AddCheckBox("View>Status Bar", STatus := True) +''' .AddCheckBox("View>Toolbars>Find", Status := True) +''' .AddCheckBox("View>Status Bar", Status := True) ''' .AddItem("View>Full Screen", Name := "FULLSCREEN") ''' vChoice = .Execute(False) ' When 1st checkbox is clicked, return "Dialog" ''' ' When last item is clicked, return "FULLSCREEN" @@ -531,7 +531,7 @@ Public Function _AddItem(ByVal MenuItem As String _ ''' Example: "cmd/sc_cut.png" ''' Tooltip: The help text to be displayed as a tooltip ''' Command: only for menubar menus -''' Either a uo command like ".uno:About" +''' Either a UNO command like ".uno:About" ''' or a script to be run: script URI ::: string argument to be passed to the script ''' Returns: ''' The numeric identification of the newly inserted item @@ -655,7 +655,7 @@ Private Function _GetPopupMenu(ByVal psSubmenu As String) As Object ''' - the popup menu corresponding with "A>B>C>D" should be returned Dim oPopup As Object ' Return value -Dim vSplit As Variant ' An array as returned by _SplitMenuItem() +Dim vSplit As Variant ' An array as returned by Split() Dim sMenu As String ' The left part of psSubmenu Dim oMenu As Object ' com.sun.star.awt.XpopupMenu Dim oLastMenu As Object ' com.sun.star.awt.XpopupMenu diff --git a/wizards/source/sfwidgets/SF_Register.xba b/wizards/source/sfwidgets/SF_Register.xba index d2c424513168..468d2f76b415 100644 --- a/wizards/source/sfwidgets/SF_Register.xba +++ b/wizards/source/sfwidgets/SF_Register.xba @@ -22,10 +22,19 @@ Option Explicit ''' Register the list of services implemented by the current library ''' - _NewMenu ''' Create a new menu service instance. -''' Called from SFDocuments services with CreateMenu() +''' 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() +''' 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 @@ -51,15 +60,59 @@ Public Sub RegisterScriptServices() As Variant 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. + .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 diff --git a/wizards/source/sfwidgets/SF_Toolbar.xba b/wizards/source/sfwidgets/SF_Toolbar.xba index c457a62f1cad..1cfbc9301753 100644 --- a/wizards/source/sfwidgets/SF_Toolbar.xba +++ b/wizards/source/sfwidgets/SF_Toolbar.xba @@ -48,6 +48,12 @@ Option Explicit ''' Dim oCalc As Object, oToolbar As Object ''' Set oCalc = CreateScriptService("Calc", "myFile.ods") ''' Set oToolbar = oCalc.Toolbars("findbar") +''' +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/toolbar.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS diff --git a/wizards/source/sfwidgets/SF_ToolbarButton.xba b/wizards/source/sfwidgets/SF_ToolbarButton.xba index 58c594f06612..a5c3ccd03064 100644 --- a/wizards/source/sfwidgets/SF_ToolbarButton.xba +++ b/wizards/source/sfwidgets/SF_ToolbarButton.xba @@ -34,6 +34,12 @@ Option Explicit ''' Set oCalc = CreateScriptService("Calc", "myFile.ods") ''' Set oToolbar = oCalc.Toolbars("findbar") ''' Set oToolbarButton = oToolbar.ToolbarButtons("Find Next") +''' +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/toolbarcontrol.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS diff --git a/wizards/source/sfwidgets/script.xlb b/wizards/source/sfwidgets/script.xlb index 06975e6fc55f..8fb6343d86d4 100644 --- a/wizards/source/sfwidgets/script.xlb +++ b/wizards/source/sfwidgets/script.xlb @@ -8,4 +8,5 @@ + \ No newline at end of file