REM ***** BASIC ***** REM ----- Global Variables ----- 'bindingDialog can refer to either KeyBinding or MenuBinding dialog private languages() as String private extensions() as Object private locations() as String private filesysScripts() as String private filesysCount as integer private bindingDialog as object private helpDialog as object 'Couldn't get redim to work, so scriptDisplayList is and array of arrays 'where the one and only array in scriptDisplayList is an array 'of com.sun.star.beans.PropertyValue, where Name = [logicalName][FunctionName] 'and value is ScriptStorage object private scriptDisplayList(0) private testArray() as String 'Array to store lines from the xml file private xmlFile() as string 'Name of the xml file [writer/calc][menubar/keybindings].xml private xmlFileName as string 'Number of lines in the xml file private numberOfLines as integer 'Parallel arrays to store all top-level menu names and line positions private menuItems() as string private menuItemLinePosition() as integer 'Counter for the number of top-level menus private menuCount as integer 'Parallel arrays to store all sub-menu names and line positions for a particular top-level menu private subMenuItems() as string private subMenuItemLinePosition() as integer 'Counter for the number of sub-menus private subMenuCount as integer 'Parallel arrays to store all script names and line positions private scriptNames() as string private scriptLinePosition() as integer 'Counter for the number of scripts private scriptCount as integer 'Array to store all combinations of key bindings private allKeyBindings() as string 'Array of Arrays 'KeyBindArrayOfArrays(0) contains array of "SHIFT + CONTROL + F Keys" data 'Similarly 'KeyBindArrayOfArrays(1) contains SHIFT + CONTROL + digits 'KeyBindArrayOfArrays(2) contains SHIFT + CONTROL + letters 'KeyBindArrayOfArrays(3) contains CONTROL + F keys 'KeyBindArrayOfArrays(4) contains CONTROL + digits 'KeyBindArrayOfArrays(5) contains CONTROL + letters 'KeyBindArrayOfArrays(6) contains SHIFT + F keys private KeyBindArrayOfArrays(6) 'Each PropertyValue represents a key, Name member contains the script (if a binding exists) ' the Value contains and integer ' 0 means no script bound ' 1 script is bound to an office function ' >1 line number of entry in xmlfile array private keyAllocationMap(6,25) as new com.sun.star.beans.PropertyValue 'array to store key group descriptions private AllKeyGroupsArray(6) as String 'Array of props to store all event bindings for the Applications private allEventTypesApp( 14 ) as new com.sun.star.beans.PropertyValue 'Array of props to store all event bindings for the Document private allEventTypesDoc( 14 ) as new com.sun.star.beans.PropertyValue 'Array of props to store all event types (Name) and textual description (Value) private allEventTypes( 14 ) as new com.sun.star.beans.PropertyValue private dialogName as String REM ------ Storage Refresh Function ------ sub RefreshUserScripts() ' TDB - change Menu bindings to allow user to refresh all, user, share or document script RefreshAppScripts( "USER" ) end sub sub RefreshAllScripts() RefreshAppScripts( "USER" ) RefreshAppScripts( "SHARE" ) RefreshDocumentScripts end sub sub RefreshAppScripts( appName as String ) On Error Goto ErrorHandler smgr = getProcessServiceManager() context = smgr.getPropertyValue( "DefaultContext" ) scriptstoragemgr = context.getValueByName( "/singletons/drafts.com.sun.star.script.framework.storage.theScriptStorageManager" ) scriptstoragemgr.refreshScriptStorage( appName ) Exit sub ErrorHandler: reset MsgBox ("Error: Unable to refresh Java (scripts)" + chr$(10) + chr$(10)+ "Detail: " & error$ + chr$(10) + chr$(10)+ "Action: Please restart Office",0,"Error" ) end sub sub RefreshDocumentScripts() On Error Goto ErrorHandler smgr = getProcessServiceManager() context = smgr.getPropertyValue( "DefaultContext" ) scriptstoragemgr = context.getValueByName( "/singletons/drafts.com.sun.star.script.framework.storage.theScriptStorageManager" ) oDocURL = ThisComponent.GetCurrentController.getModel.getURL On Error Goto ErrorHandlerDoc scriptstoragemgr.refreshScriptStorage( oDocURL ) Exit sub ErrorHandlerDoc: reset ' Ignore document script errors as it will happen when refreshing an unsaved doc Exit sub ErrorHandler: reset MsgBox ("Error: Unable to refresh Java (scripts)" + chr$(10) + chr$(10)+ "Detail: " & error$ + chr$(10) + chr$(10)+ "Action: Please restart Office",0,"Error" ) end sub REM ----- Launch Functions ----- Sub createAndPopulateKeyArrays() 'Create SHIFT + CONTROL + F keys array 'Dim keyGroupProp as new com.sun.star.beans.PropertyValue Dim SCFKey( 11 ) for FKey = 1 to 12 SCFKey( FKey - 1 ) = "SHIFT + CONTROL + F" + FKey next FKey KeyBindArrayOfArrays(0) = SCFKey() 'Create SHIFT + CONTROL + digits Dim SCDKey( 9 ) for Digit = 0 to 9 SCDKey( Digit ) = "SHIFT + CONTROL + " + Digit next Digit KeyBindArrayOfArrays(1) = SCDKey() 'Create SHIFT + CONTROL + letters Dim SCLKey( 25 ) for Alpha = 65 to 90 SCLKey( Alpha - 65 ) = "SHIFT + CONTROL + " + chr$( Alpha ) next Alpha KeyBindArrayOfArrays(2) = SCLKey() 'Create CONTROL + F keys Dim CFKey( 11 ) for FKey = 1 to 12 CFKey( Fkey - 1 ) = "CONTROL + F" + FKey next FKey KeyBindArrayOfArrays(3) = CFKey() 'Create CONTROL + digits Dim CDKey( 9 ) for Digit = 0 to 9 CDKey( Digit ) = "CONTROL + " + Digit next Digit KeyBindArrayOfArrays(4) = CDKey() 'Create CONTROL + letters Dim CLKey( 25 ) for Alpha = 65 to 90 CLKey( Alpha - 65 ) = "CONTROL + " + chr$( Alpha ) next Alpha KeyBindArrayOfArrays(5) = CLKey() 'Create SHIFT + F Keys Dim SFKey( 11 ) for FKey = 1 to 12 SFKey( Fkey - 1 ) = "SHIFT + F" + FKey next FKey KeyBindArrayOfArrays(6) = SFKey() End Sub Sub updateMapWithDisabledKeys() 'disable CONTROL + F1 & keyAllocationMap( 3, 0 ).Value = 1 keyAllocationMap( 3, 0 ).Name = "" 'disable CONTROL + F4 & keyAllocationMap( 3, 3 ).Value = 1 keyAllocationMap( 3, 3 ).Name = "" 'disable CONTROL + F6 keyAllocationMap( 3, 5 ).Value = 1 keyAllocationMap( 3, 5 ).Name = "" 'disable SHIFT + F1 & keyAllocationMap( 6, 0 ).Value = 1 keyAllocationMap( 6, 0 ).Name = "" 'disable SHIFT + F2 & keyAllocationMap( 6, 1 ).Value = 1 keyAllocationMap( 6, 1 ).Name = "" 'disable SHIFT + F6 & keyAllocationMap( 6, 5 ).Value = 1 keyAllocationMap( 6, 5 ).Name = "" End Sub Sub initialiseFileExtensions() ReDim extensions(ubound(languages())+1) as Object oConfigProvider = CreateUnoService( "com.sun.star.configuration.ConfigurationProvider" ) Dim configArgs(1) as new com.sun.star.beans.PropertyValue configargs(0).Name = "nodepath" configArgs(0).Value = "org.openoffice.Office.Scripting/ScriptRuntimes" configargs(1).Name = "lazywrite" configArgs(1).Value = false oConfigAccess = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", configArgs()) for index = 0 to ubound(languages()) if(languages(index) <> "Java") then xPropSet = oConfigAccess.getByName(languages(index)) extns() = xPropSet.getPropertyValue("SupportedFileExtensions") extensions(index) = extns() endif next index end sub Sub ExecuteEditDebug() locations = Array ( "User", "Share", "Document", "Filesystem" ) languages = Array ( "BeanShell", "JavaScript" ) dialogName = "EditDebug" initialiseFileExtensions() bindingDialog = LoadDialog( "ScriptBindingLibrary", "EditDebug" ) PopulateLanguageCombo() PopulateLocationCombo() PopulateScriptList( languages(0), locations(0) ) bindingDialog.execute() End Sub Sub ExecuteKeyBinding() dialogName = "Key" createAndPopulateKeyArrays() updateMapWithDisabledKeys() xmlFileName = GetDocumentType( "Key" ) if not (ReadXMLToArray( "Key" )) then Exit Sub endif bindingDialog = LoadDialog( "ScriptBindingLibrary", "KeyBinding" ) PopulateKeyBindingList(0) initialiseNavigationComboArrays() PopulateLanguageCombo() PopulateLocationCombo() PopulateScriptList( languages(0), locations(0) ) PopulateTopLevelKeyBindingList() bindingDialog.execute() end Sub Sub initialiseNavigationComboArrays() locations = Array ( "User", "Share", "Document", "Filesystem" ) ReDim languages(0) as String ReDim extensions(0) as Object languages(0) = "Java" REM extensions(0) = "" ' Setup languages array for all supported languages oServiceManager = GetProcessServiceManager() svrArray = oServiceManager.getAvailableServiceNames langCount = 1 for index = 0 to ubound(svrArray) iPos = inStr(svrArray(index), "ScriptProviderFor") if (iPos > 0) then lang = Mid(svrArray(index), iPos + Len("ScriptProviderFor") if not (lang = "Java") then 'Add to language vector ReDim Preserve languages(langCount) as String languages(langCount) = lang langCount = langCount + 1 endif endif next index initialiseFileExtensions() End Sub Sub ExecuteEventBinding dialogName = "Event" createAllEventTypes() createAllEventBindings() 'Populate application event bindings array (from config xml file) if not (ReadXMLToArray( "Event" )) then Exit Sub endif 'Populate document event bindings array (using Office API calls) ReadEventsFromDoc() bindingDialog = LoadDialog( "ScriptBindingLibrary", "EventsBinding" ) initialiseNavigationComboArrays() PopulateLanguageCombo() PopulateLocationCombo() PopulateScriptList( languages(0), locations(0) ) populateEventList( 0 ) EventListListener() bindingDialog.execute() End Sub Sub ExecuteMenuBinding() dialogName = "Menu" xmlFileName = GetDocumentType( "Menu" ) if not (ReadXMLToArray( "Menu" )) then Exit Sub endif bindingDialog = LoadDialog( "ScriptBindingLibrary", "MenuBinding" ) initialiseNavigationComboArrays() PopulateLanguageCombo() PopulateLocationCombo() PopulateScriptList( languages(0), locations(0) ) PopulateMenuCombo() PopulateSubMenuList( 1 ) subMenuList = bindingDialog.getControl("SubMenuList") subMenuList.selectItemPos( 0, true ) bindingDialog.execute() end Sub REM ----- Initialising functions ----- function LoadDialog( libName as string, dialogName as string ) as object dim library as object dim libDialog as object dim runtimeDialog as object libContainer = DialogLibraries libContainer.LoadLibrary( libName ) library = libContainer.getByName( libname ) libDialog = library.getByName( dialogName ) runtimeDialog = CreateUnoDialog( libDialog ) LoadDialog() = runtimeDialog end function function GetDocumentType( bindingType as string ) as string document = StarDesktop.ActiveFrame.Controller.Model Dim errornumber As Integer errornumber = 111 Error errornumber if document.SupportsService("com.sun.star.sheet.SpreadsheetDocument") then if bindingType = "Key" then GetDocumentType() = "calckeybinding.xml" else if bindingType = "Menu" then GetDocumentType() = "calcmenubar.xml" end if end if elseif document.SupportsService("com.sun.star.text.TextDocument") then if bindingType = "Key" then GetDocumentType() = "writerkeybinding.xml" else if bindingType = "Menu" then GetDocumentType() = "writermenubar.xml" end if end if elseif document.SupportsService("com.sun.star.presentation.PresentationDocument") then if bindingType = "Key" then GetDocumentType() = "impresskeybinding.xml" else if bindingType = "Menu" then GetDocumentType() = "impressmenubar.xml" end if end if elseif document.SupportsService("com.sun.star.presentation.PresentationDocument") then if bindingType = "Key" then GetDocumentType() = "impresskeybinding.xml" else if bindingType = "Menu" then GetDocumentType() = "impressmenubar.xml" end if end if elseif document.SupportsService("com.sun.star.drawing.DrawingDocument") then if bindingType = "Key" then GetDocumentType() = "drawkeybinding.xml" else if bindingType = "Menu" then GetDocumentType() = "drawmenubar.xml" end if end if else MsgBox ("Error: Couldn't determine configuration file type" + chr$(10) + chr$(10) + "Action: Please reinstall Scripting Framework",0,"Error" ) end if end function function lastIndexOf( targetStr as String, substr as String ) as Integer copyStr = targetStr while instr(copyStr, substr) > 0 pos = instr(copyStr, substr) tpos = tpos + pos copyStr = mid(copyStr, pos+1, len(copyStr)-pos ) wend lastIndexOf() = tpos end function function getScriptURI( selectedScript as String ) as String combo = bindingDialog.getControl( "LocationCombo" ) location = combo.text if ( location = "User" ) then location = "user" elseif ( location = "Share" ) then location = "share" elseif ( location = "Filesystem" ) then location = "filesystem" else location = "document" end if if ( location = "filesystem" ) then REM need to build URI here - dcf combo = bindingDialog.getControl( "LanguageCombo" ) language = combo.text url = selectedscript pos = lastIndexOf( url, "/" ) locationPath = mid( url, 1, pos) url = mid( url, pos+1, len( url ) - pos ) functionName = url pos = lastIndexOf( url, "." ) logicalName = mid( url, 1, pos - 1 ) getScriptURI() = "script://" + logicalName + "?language=" _ + language + "&amp;function=" + functionName _ + "&amp;location=filesystem:" + locationPath else Dim scriptInfo as Object scripts() = scriptDisplayList(0) for n = LBOUND( scripts() ) to UBOUND( scripts() ) if ( scripts( n ).Name = selectedScript ) then scriptInfo = scripts( n ).Value exit for end if next n getScriptURI() = "script://" + scriptInfo.getLogicalName + "?language=" _ + scriptInfo.getLanguage() + "&amp;function=" + _ scriptInfo.getFunctionName() + "&amp;location=" + location end if end function function GetOfficePath() as string REM Error check and prompt user to manually input Office Path settings = CreateUnoService( "com.sun.star.frame.Settings" ) path = settings.getByName( "PathSettings" ) unformattedOfficePath = path.getPropertyValue( "UserPath" ) dim officePath as string const removeFromEnd = "/user" const removeFromEndWindows = "\user" REM If Solaris or Linux if not ( instr( unformattedOfficePath, removeFromEnd ) = 0 ) then endPosition = instr( unformattedOfficePath, removeFromEnd ) officePath = mid( unformattedOfficePath, 1, endPosition ) REM If Windows else if not ( instr( unformattedOfficePath, removeFromEndWindows ) = 0 ) then endPosition = instr( unformattedOfficePath, removeFromEndWindows ) officePath = mid( unformattedOfficePath, 1, endPosition ) while instr( officePath, "\" ) > 0 backSlash = instr( officePath, "\" ) startPath = mid( officePath, 1, backSlash - 1 ) endPath = mid( officePath, backslash + 1, len( officePath ) - backSlash ) officePath = startPath + "/" + endPath wend else MsgBox ("Error: Office path not found" + chr$(10) + chr$(10) + "Action: Please reinstall Scripting Framework",0,"Error" ) REM Prompt user end if end if GetOfficePath() = officePath end function REM ----- File I/O functions ----- function ReadXMLToArray( bindingType as string ) as boolean On Error Goto ErrorHandler if ( bindingType = "Event" ) then xmlfilename = "eventbindings.xml" endif simplefileaccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" ) filestream = simplefileaccess.openFileRead( "file://" + GetOfficePath() + "user/config/soffice.cfg/" + xmlFileName ) textin = CreateUnoService( "com.sun.star.io.TextInputStream" ) textin.setInputStream( filestream ) redim xmlFile( 400 ) as String redim menuItems( 30 ) as String redim menuItemLinePosition( 30 ) as Integer redim scriptNames( 120 ) as string redim scriptLinePosition( 120) as integer lineCount = 1 menuCount = 1 scriptCount = 1 do while not textin.isEOF() xmlline = textin.readLine() xmlFile( lineCount ) = xmlline const menuItemWhiteSpace = 2 const menuXMLTag = "<menu:menu" if bindingType = "Menu" then evaluateForMenu( xmlline, lineCount ) elseif bindingType = "Key" then processKeyXMLLine( lineCount, xmlline ) elseif bindingType = "Event" then evaluateForEvent( xmlline, lineCount ) else MsgBox ("Error: Couldn't determine file type" + chr$(10) + chr$(10) + "Action: Please reinstall Scripting Framework",0,"Error" ) end if lineCount = lineCount + 1 loop 'Set global variable numberOfLines (lineCount is one too many at end of the loop) numberOfLines = lineCount - 1 'Set global variable menuCount (it is one too many at end of the loop) menuCount = menuCount - 1 filestream.closeInput() ReadXMLToArray( ) = true Exit function ErrorHandler: reset MsgBox ("Error: Unable to read Star Office configuration file - " + xmlFileName + chr$(10) + chr$(10) + "Action: Please reinstall Scripting Framework",0,"Error" ) ReadXMLToArray( ) = false end function sub evaluateForMenu( xmlline as string, lineCount as integer ) const menuItemWhiteSpace = 2 const menuXMLTag = "<menu:menu" 'If the xml line is a top-level menu if instr( xmlline, menuXMLTag ) = menuItemWhiteSpace then menuLabel = ExtractLabelFromXMLLine( xmlline ) menuItems( menuCount ) = menuLabel menuItemLinePosition( menuCount ) = lineCount menuCount = menuCount + 1 end if end sub sub evaluateForEvent( xmlline as string, lineCount as integer ) dim eventName as String 'if the xml line identifies a script or SB macro dim scriptName as string dim lineNumber as integer if instr( xmlline, "event:language=" + chr$(34) + "Script" ) > 0 then eventName = ExtractEventNameFromXMLLine( xmlline ) scriptName = ExtractEventScriptFromXMLLine( xmlline ) lineNumber = lineCount elseif instr( xmlline, "event:language=" + chr$(34) + "StarBasic" ) > 0 then eventName = ExtractEventNameFromXMLLine( xmlline ) scriptName = "Allocated to Office function" lineNumber = 1 end if 'Need to sequence to find the corresponding index for the event type for n = 0 to ubound( allEventTypesApp() ) if ( eventName = allEventTypes( n ).Name ) then allEventTypesApp( n ).Name = scriptName allEventTypesApp( n ).Value = lineNumber end if next n end sub function isOKscriptProps( props() as Object, eventName as string ) as Boolean On Error Goto ErrorHandler props = ThisComponent.getEvents().getByName( eventName ) test = ubound( props() ) isOKscriptProps() = true exit function ErrorHandler: isOKscriptProps() = false end function sub ReadEventsFromDoc() On Error Goto ErrorHandler eventSupplier = ThisComponent for n = 0 to ubound( allEventTypes() ) Dim scriptProps() as Object if (isOKscriptProps( scriptProps(), allEventTypes( n ).Name) ) then if ( ubound( scriptProps ) > 0 ) then if ( scriptProps(0).Value = "Script" ) then 'Script binding allEventTypesDoc(n).Name = scriptProps(1).Value allEventTypesDoc(n).value = 2 elseif( scriptProps(0).Value = "StarBasic" ) then 'StarBasic macro allEventTypesDoc(n).Name = "Allocated to Office function" allEventTypesDoc(n).value = 1 end if end if end if next n exit sub ' eventProps is undefined if there are no event bindings in the doc ErrorHandler: reset end sub sub WriteEventsToDoc() On Error Goto ErrorHandler eventSupplier = ThisComponent for n = 0 to ubound( allEventTypes() ) scriptName = allEventTypesDoc( n ).Name eventName = allEventTypes( n ).Name if( allEventTypesDoc( n ).Value > 1 ) then 'script 'add to doc AddEventToDocViaAPI( scriptName, eventName ) elseif( allEventTypesDoc( n ).Value = 0 ) then 'blank (this will "remove" already blank entries) 'remove from doc RemoveEventFromDocViaAPI( eventName ) endif 'Otherwise it is a StarBasic binding - leave alone next n 'Mark document as modified ( should happen automatically as a result of calling the API ) ThisComponent.CurrentController.getModel().setModified( True ) exit sub ErrorHandler: reset msgbox( "Error calling UNO API for writing event bindings to the document" ) end sub sub RemoveEventFromDocViaAPI( event as string ) dim document as object dim dispatcher as object dim parser as object dim url as new com.sun.star.util.URL document = ThisComponent.CurrentController.Frame parser = createUnoService("com.sun.star.util.URLTransformer") dim args(0) as new com.sun.star.beans.PropertyValue args(0).Name = "" args(0).Value = event url.Complete = "script://_$ScriptFrmwrkHelper.removeEvent?" _ + "language=Java&function=ScriptFrmwrkHelper.removeEvent" _ + "&location=share" parser.parseStrict(url) disp = document.queryDispatch(url,"",0) disp.dispatch(url,args()) end sub sub AddEventToDocViaAPI( scriptName as string, eventName as string ) dim properties( 1 ) as new com.sun.star.beans.PropertyValue properties( 0 ).Name = "EventType" properties( 0 ).Value = "Script" properties( 1 ).Name = "Script" properties( 1 ).Value = scriptName eventSupplier = ThisComponent nameReplace = eventSupplier.getEvents() nameReplace.replaceByName( eventName, properties() ) end sub ' returns 0 for Fkey ' 1 for digit ' 2 for letter function getKeyTypeOffset( key as String ) as integer length = Len( key ) if ( length > 1 ) then getKeyTypeOffset() = 0 elseif ( key >= "0" AND key <= "9" ) then getKeyTypeOffset() = 1 else getKeyTypeOffset() = 2 end if end function function getKeyGroupIndex( key as String, offset as Integer ) as Integer ' Keys we are interested in are A - Z, F2 - F12, 0 - 9 anything else should ' ensure -1 is returned cutKey = mid( key,2 ) if ( cutKey <> "" ) then acode = asc ( mid( cutKey,1,1) ) if ( acode > 57 ) then getKeyGroupIndex() = -1 exit function end if end if select case offset case 0: num = cint( cutKey ) getKeyGroupIndex() = num - 1 exit function case 1: num = asc( key ) - 48 getKeyGroupIndex() = num exit function case 2: num = asc( key ) - 65 getKeyGroupIndex() = num exit function end select getKeyGroupIndex() = -1 end function Sub processKeyXMLLine( lineCount as Integer, xmlline as String ) if instr( xmlline, "<accel:item" ) > 0 then shift = false control = false if instr( xmlline, "accel:shift="+chr$(34)+"true"+chr$(34) ) > 0 then shift = true end if if instr( xmlFile( lineCount ), "accel:mod1="+chr$(34)+"true"+chr$(34) ) > 0 then control = true end if offsetIntoArrayOfArrays = -1 'default unknown if ( control AND shift ) then offsetIntoArrayOfArrays = 0 elseif ( control ) then offsetIntoArrayOfArrays = 3 elseif ( shift ) then offsetIntoArrayOfArrays = 6 endif ' Calculate which of the 7 key group arrays we need to point to key = ExtractKeyCodeFromXMLLine( xmlline ) keyTypeOffset = getKeyTypeOffset( key ) offsetIntoArrayOfArrays = offsetIntoArrayOfArrays + keyTypeOffset ' Calculate from the key the offset into key group array we need to point to KeyGroupIndex = getKeyGroupIndex( key, keyTypeOffset ) if ( offsetIntoArrayOfArrays = -1 ) then 'Unknown key group, no processing necessary Exit Sub end if if ( KeyGroupIndex > -1 ) then ' Determine if a script framework binding is present or not if instr( xmlline, "script://" ) > 0 then ' its one of ours so update its details scriptName = ExtractScriptIdFromXMLLine( xmlline ) keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Value = lineCount keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Name = scriptName else keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Value = 1 keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Name = "" end if end if end if End Sub Sub WriteXMLFromArray() On Error Goto ErrorHandler cfgFile = GetOfficePath() + "user/config/soffice.cfg/" + xmlFileName updateCfgFile( cfgFile ) 'if ( false ) then' config stuff not in build yet if ( true ) then updateConfig( xmlFileName ) else msgbox ("Office must be restarted before your changes will take effect."+ chr$(10)+"Also close the Office QuickStarter (Windows and Linux)", 48, "Assign Script (Java) To Menu" ) endif Exit Sub ErrorHandler: reset MsgBox ("Error: Unable to write to Star Office configuration file" + chr$(10) + "/" + GetOfficePath() + "user/config/soffice.cfg/" +xmlFileName + chr$(10) + chr$(10) + "Action: Please make sure you have write access to this file",0,"Error" ) end Sub Sub UpdateCfgFile ( fileName as String ) dim ScriptProvider as Object dim Script as Object dim args(1) dim displayDialogFlag as boolean displayDialogFlag = false args(0) = ThisComponent args(1) = displayDialogFlag ScriptProvider = createUnoService("drafts.com.sun.star.script.framework.provider.MasterScriptProvider") ScriptProvider.initialize( args() ) Script = ScriptProvider.getScript("script://_$ScriptFrmwrkHelper.updateCfgFile?" _ + "language=Java&function=ScriptFrmwrkHelper.updateCfgFile&location=share") Dim inArgs(2) Dim outArgs() Dim outIndex() dim localNumLines as integer inArgs(0) = xmlFile() inArgs(1) = fileName inArgs(2) = numberOfLines Script.invoke( inArgs(), outIndex(), outArgs() ) End Sub sub UpdateConfig( a$ ) dim document as object dim dispatcher as object dim parser as object dim disp as object dim url as new com.sun.star.util.URL document = ThisComponent.CurrentController.Frame parser = createUnoService("com.sun.star.util.URLTransformer") dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "StreamName" args1(0).Value = a$ url.Complete = ".uno:UpdateConfiguration" parser.parseStrict(url) disp = document.queryDispatch(url,"",0) disp.dispatch(url,args1()) End Sub sub AddNewEventBinding( scriptName as string, eventPosition as integer, isApp as boolean ) event = allEventTypes( eventPosition ).Name 'dim scriptProp as new com.sun.star.beans.PropertyValue if isApp then 'scriptProp.Name = scriptName 'scriptProp.Value = numberOfLines allEventTypesApp( eventPosition ).Name = scriptName allEventTypesApp( eventPosition ).Value = numberOfLines newline = " <event:event event:name=" + chr$(34) + event + chr$(34) newline = newline + " event:language=" + chr$(34) + "Script" + chr$(34) + " xlink:href=" + chr$(34) newline = newline + scriptName + chr$(34) + " xlink:type=" + chr$(34) + "simple" + chr$(34) + "/>" xmlFile( numberOfLines ) = newline xmlFile( numberOfLines + 1 ) = "</event:events>" numberOfLines = numberOfLines + 1 else 'scriptProp.Name = scriptName 'scriptProp.Value = 2 allEventTypesDoc( eventPosition ).Name = scriptName allEventTypesDoc( eventPosition ).Value = 2 end if end sub REM ----- Array update functions ----- sub AddNewMenuBinding( newScript as string, newMenuLabel as string, newLinePosition as integer ) dim newXmlFile( 400 ) as string dim newLineInserted as boolean dim lineCounter as integer lineCounter = 1 do while lineCounter <= numberOfLines if not newLineInserted then REM If the line number is the position at which to insert the new line if lineCounter = newLinePosition then if( instr( xmlFile( lineCounter ), "<menu:menupopup>" ) > 0 ) then indent = GetMenuWhiteSpace( xmlFile( newLinePosition + 1 ) ) newXmlFile( lineCounter ) = xmlFile( lineCounter ) newXmlFile( lineCounter + 1 ) = ( indent + "<menu:menuitem menu:id="+chr$(34) + newScript + chr$(34)+" menu:helpid="+chr$(34)+"1929"+chr$(34)+" menu:label="+chr$(34)+ newMenuLabel + chr$(34)+"/>" ) else indent = GetMenuWhiteSpace( xmlFile( newLinePosition - 1 ) ) newXmlFile( lineCounter ) = ( indent + "<menu:menuitem menu:id="+chr$(34) + newScript + chr$(34)+" menu:helpid="+chr$(34)+"1929"+chr$(34)+" menu:label="+chr$(34)+ newMenuLabel + chr$(34)+"/>" ) newXmlFile( lineCounter + 1 ) = xmlFile( lineCounter ) end if REM added -1 for debug --> ' indent = GetMenuWhiteSpace( xmlFile( newLinePosition ) ) ' newXmlFile( lineCounter ) = ( indent + "<menu:menuitem menu:id="+chr$(34)+"script://" + newScript + chr$(34)+" menu:helpid="+chr$(34)+"1929"+chr$(34)+" menu:label="+chr$(34)+ newMenuLabel + chr$(34)+"/>" ) ' newXmlFile( lineCounter + 1 ) = xmlFile( lineCounter ) newLineInserted = true else newXmlFile( lineCounter ) = xmlFile( lineCounter ) end if else REM if the new line has been inserted the read from one position behind newXmlFile( lineCounter + 1 ) = xmlFile( lineCounter ) end if lineCounter = lineCounter + 1 loop numberOfLines = numberOfLines + 1 REM read the new file into the global array for n = 1 to numberOfLines xmlFile( n ) = newXmlFile( n ) next n end sub sub AddNewKeyBinding( scriptName as string, shift as boolean, control as boolean, key as string ) dim keyCombo as string newLine = " <accel:item accel:code="+chr$(34)+"KEY_" + key +chr$(34) if shift then keyCombo = "SHIFT + " newLine = newLine + " accel:shift="+chr$(34)+"true"+chr$(34) end if if control then keyCombo = keyCombo + "CONTROL + " newLine = newLine + " accel:mod1="+chr$(34)+"true"+chr$(34) end if keyCombo = keyCombo + key newLine = newLine + " xlink:href="+chr$(34)+ scriptName +chr$(34) +"/>" if ( control AND shift ) then offsetIntoArrayOfArrays = 0 elseif ( control ) then offsetIntoArrayOfArrays = 3 elseif ( shift ) then offsetIntoArrayOfArrays = 6 endif keyTypeOffset = getKeyTypeOffset( key ) offsetIntoArrayOfArrays = offsetIntoArrayOfArrays + keyTypeOffset ' Calculate from the key the offset into key group array we need to point to KeyGroupIndex = getKeyGroupIndex( key, keyTypeOffset ) ' if key is already allocated to a script then just reallocate if ( keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Value > 1 ) then keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Name = scriptName 'replace line in xml file xmlFile( keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Value ) = newLine else ' this is a new binding, create a new line in xml file for n = 1 to numberOfLines if n = numberOfLines then xmlFile( n ) = newLine xmlFile( n + 1 ) = "</accel:acceleratorlist>" exit for else xmlFile( n ) = xmlFile( n ) end if next n keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Value = n keyAllocationMap( offsetIntoArrayOfArrays, KeyGroupIndex ).Name = scriptName numberOfLines = numberOfLines + 1 endif end sub Sub RemoveBinding( lineToRemove as Integer ) xmlFile( lineToRemove ) = "" end Sub REM Adds or removes the starting xml line positions for each top-level menu after the menu with the added script sub UpdateTopLevelMenus( topLevelMenuPosition as integer, addLine as boolean ) for n = topLevelMenuPosition to 8 if addLine then menuItemLinePosition( n ) = menuItemLinePosition( n ) + 1 end if next n end sub REM Remove scriptNames and scriptLinePosition entries sub RemoveScriptNameAndPosition( keyComboPosition ) dim updatedScriptNames( 120 ) as string dim updatedScriptLinePosition( 120 ) as integer dim removedScript as boolean removedScript = false for n = 1 to scriptCount if not removedScript then if not( n = keyComboPosition ) then updatedScriptNames( n ) = scriptNames( n ) else removedScript = true end if else updatedScriptNames( n - 1 ) = scriptNames( n ) end if next n scriptCount = scriptCount - 1 for n = 1 to scriptCount scriptNames( n ) = updatedScriptNames( n ) next n end sub REM ----- Populating Dialog Controls ----- Sub PopulateLanguageCombo() langCombo = bindingDialog.getControl( "LanguageCombo" ) langCombo.removeItems( 0, langCombo.getItemCount() ) for n = LBOUND( languages() ) to UBOUND ( languages() ) langCombo.addItem( languages( n ), n ) next n langCombo.setDropDownLineCount( n ) langCombo.text = langCombo.getItem( 0 ) End Sub Sub PopulateLocationCombo() dim ScriptProvider as Object dim args(1) dim displayDialogFlag as boolean displayDialogFlag = false args(0) = ThisComponent args(1) = displayDialogFlag ScriptProvider = createUnoService("drafts.com.sun.star.script.framework.provider.MasterScriptProvider") ScriptProvider.initialize( args() ) locCombo = bindingDialog.getControl( "LocationCombo" ) locCombo.removeItems( 0, locCombo.getItemCount() ) for n = LBOUND( locations() ) to UBOUND ( locations() ) locCombo.addItem( locations( n ), n ) next n locCombo.setDropDownLineCount( n ) locCombo.text = locCombo.getItem( 0 ) End Sub sub PopulateScriptList( lang as String, loc as String ) Dim detailedView as boolean detailedView = bindingDialog.Model.detail.state scriptList = bindingDialog.getControl( "ScriptList" ) scriptList.removeItems( 0, scriptList.getItemCount() ) smgr = getProcessServiceManager() context = smgr.getPropertyValue( "DefaultContext" ) scriptstoragemgr = context.getValueByName( "/singletons/drafts.com.sun.star.script.framework.storage.theScriptStorageManager" ) scriptLocationURI = "USER" if ( loc = "Share" ) then scriptLocationURI = "SHARE" elseif ( loc = "Document" )then document = StarDesktop.ActiveFrame.Controller.Model scriptLocationURI = document.getURL() elseif ( loc = "Filesystem" ) then REM populate the list from the filesysScripts list if(lang = "Java" ) then exit sub endif length = UBOUND( filesysScripts() ) if(length = -1) then exit sub endif for langIndex = lbound(languages()) to ubound(languages()) if ( lang = languages(langIndex)) then extns = extensions(langIndex) exit for endif next langIndex dim locnDisplayList( length ) as new com.sun.star.beans.PropertyValue for index = lbound(filesysScripts()) to ubound(filesysScripts()) scriptextn = filesysScripts( index ) pos = lastIndexOf( scriptextn, "." ) scriptextn = mid( scriptextn, pos + 1, len( scriptextn ) - pos ) for extnsIndex = lbound(extns()) to ubound(extns()) extn = extns(extnsIndex) if ( scriptextn = extn ) then if ( detailedView ) then locnDisplayList( index ).Name = filesysScripts( index ) locnDisplayList( index ).Value = filesysScripts( index ) else REM replace name with simplified view locnDisplayList( index ).Name = filesysScripts( index ) locnDisplayList( index ).Value = filesysScripts( index ) end if scriptList.addItem( locnDisplayList( index ).Name, index ) exit for end if next extnsIndex next index ScriptDisplayList(0) = locnDisplayList() scriptList.selectItemPos( 0, true ) REM !!!!At this point we exit the sub!!!! exit sub endif scriptStorageID = scriptstoragemgr.getScriptStorageID( scriptLocationURI ) dim resultList() as Object if ( scriptStorageID > -1 ) then storage = scriptstoragemgr.getScriptStorage( scriptStorageID ) implementations() = storage.getAllImplementations() length = UBOUND( implementations() ) reservedScriptTag = "_$" if ( length > -1 ) then dim tempDisplayList( length ) as new com.sun.star.beans.PropertyValue for n = LBOUND( implementations() ) to UBOUND( implementations() ) logicalName = implementations( n ).getLogicalName() firstTwoChars = LEFT( logicalName, 2 ) 'Only display scripts whose logicalnames don't begin with "_$" if ( firstTwoChars <> reservedScriptTag ) then if ( lang = implementations( n ).getLanguage() ) then if ( detailedView ) then tempDisplayList( n ).Name = logicalName _ + " [" + implementations( n ).getFunctionName() + "]" tempDisplayList( n ).Value = implementations( n ) else tempDisplayList( n ).Name = logicalName tempDisplayList( n ).Value = implementations( n ) endif scriptList.addItem( tempDisplayList( n ).Name, n ) endif endif next n resultList = tempDisplayList() endif ScriptDisplayList(0) = resultList() endif scriptList.selectItemPos( 0, true ) end sub sub PopulateMenuCombo() menuComboBox = bindingDialog.getControl( "MenuCombo" ) menuComboBox.removeItems( 0, menuComboBox.getItemCount() ) for n = 1 to menuCount menuComboBox.addItem( menuItems( n ), n - 1 ) next n menuComboBox.setDropDownLineCount( 8 ) menuComboBox.text = menuComboBox.getItem( 0 ) end sub sub PopulateSubMenuList( menuItemPosition as integer ) redim subMenuItems( 100 ) as string redim subMenuItemLinePosition( 100 ) as integer dim lineNumber as integer const menuItemWhiteSpace = 4 const menuXMLTag = "<menu:menu" subMenuCount = 1 REM xmlStartLine and xmlEndLine refer to the first and last lines ' menuItemPosition of a top-level menu ( 1=File to 8=Help ) add one line xmlStartLine = menuItemLinePosition( menuItemPosition ) + 1 REM If last menu item is chosen if menuItemPosition = menuCount then xmlEndLine = numberOfLines else REM Other wise get the line before the next top-level menu begins xmlEndLine = menuItemLinePosition( menuItemPosition + 1 ) - 1 end if for lineNumber = xmlStartLine to xmlEndLine REM Insert all sub-menus and sub-popupmenus if not( instr( xmlFile( lineNumber ), menuXMLTag ) = 0 ) and instr( xmlFile( lineNumber ), "menupopup") = 0 then subMenuIndent = GetMenuWhiteSpace( xmlFile( lineNumber ) ) if subMenuIndent = " " then subMenuIndent = "" else subMenuIndent = subMenuIndent + subMenuIndent end if if not( instr( xmlFile( lineNumber ), "menuseparator" ) = 0 ) then subMenuItems( subMenuCount ) = subMenuIndent + "----------------" else subMenuName = ExtractLabelFromXMLLine( xmlFile( lineNumber ) ) REM Add script Name if there is one bound to menu item if instr( xmlFile( lineNumber ), "script://" ) > 0 then script = ExtractScriptIdFromXMLLine( xmlFile( lineNumber ) ) subMenuItems( subMenuCount ) = ( subMenuIndent + subMenuName + " [" + script + "]" ) else subMenuItems( subMenuCount ) = subMenuIndent + subMenuName end if end if subMenuItemLinePosition( subMenuCount ) = lineNumber subMenuCount = subMenuCount + 1 end if next lineNumber subMenuList = bindingDialog.getControl( "SubMenuList" ) currentPosition = subMenuList.getSelectedItemPos() subMenuList.removeItems( 0, subMenuList.getItemCount() ) 'If there are no sub-menus i.e. a dynamically generated menu like Format 'if subMenuCount = 1 then if menuItems( menuItemPosition ) = "Format" then subMenuList.addItem( "Unable to Assign Scripts to this menu", 0 ) else for n = 1 to subMenuCount - 1 subMenuList.addItem( subMenuItems( n ), n - 1 ) next n end if subMenuList.selectItemPos( currentPosition, true ) SubMenuListListener() MenuLabelBoxListener() end sub sub PopulateTopLevelKeyBindingList() allKeyGroupsArray(0) = "SHIFT + CONTROL + F keys" allKeyGroupsArray(1) = "SHIFT + CONTROL + digits" ' CURRENTLY DISABLED allKeyGroupsArray(2) = "SHIFT + CONTROL + letters" allKeyGroupsArray(3) = "CONTROL + F keys" allKeyGroupsArray(4) = "CONTROL + digits" allKeyGroupsArray(5) = "CONTROL + letters" allKeyGroupsArray(6) = "SHIFT + F keys" keyCombo = bindingDialog.getControl( "KeyCombo" ) keyCombo.removeItems( 0, keyCombo.getItemCount() ) pos = 0 for n = LBOUND( allKeyGroupsArray() ) to UBOUND( allKeyGroupsArray() ) ' SHIFT + CONTROL + digits group is disabled at the moment, so skip ' it if ( n <> 1 ) then keyCombo.addItem( allKeyGroupsArray( n ), pos ) pos = pos +1 endif next n keyCombo.text = keyCombo.getItem( 0 ) end sub sub PopulateKeyBindingList( keyGroupIndex as Integer ) keyList = bindingDialog.getControl( "KeyList" ) selectedPos = keyList.getSelectedItemPos() keyList.removeItems( 0, keyList.getItemCount() ) ShortCutKeyArray() = KeyBindArrayOfArrays( keyGroupIndex ) Dim keyProp as new com.sun.star.beans.PropertyValue for n = lbound( ShortCutKeyArray() ) to ubound( ShortCutKeyArray() ) keyName = ShortCutKeyArray( n ) if ( keyAllocationMap( keyGroupIndex, n ).Value = 1 ) then keyName = keyName + " [Allocated to Office function]" elseif ( keyAllocationMap( keyGroupIndex, n ).Value > 1 ) then keyName = keyName + " " + keyAllocationMap( keyGroupIndex, n ).Name endif keyList.addItem( keyName, n ) next n if ( selectedPos <> -1 )then keyList.selectItemPos( selectedPos, true ) else keyList.selectItemPos( 0, true ) end if KeyListListener() end sub sub populateEventList( focusPosition as integer ) allApps = bindingDialog.getControl( "AllAppsOption" ) eventList = bindingDialog.getControl( "EventList" ) eventList.removeItems( 0, eventList.getItemCount() ) dim isApp as boolean if allApps.state = true then ' Application event isApp = true else isApp = false end if ' use allEventTypes() to fill list box ' for each element compare with allEventTypesApp dim scriptName as string dim lineNumber as integer for n = 0 to ubound( allEventTypes() ) ' If the line number is 1 then SB macro ' more than 1 it is the line number of the script if isApp and n > 12 then exit for endif if isApp then lineNumber = allEventTypesApp( n ).Value scriptName = allEventTypesApp( n ).Name else lineNumber = allEventTypesDoc( n ).Value scriptName = allEventTypesDoc( n ).Name end if stringToAdd = "" if ( lineNumber >= 1 ) then stringToAdd = " [" + scriptName + "]" end if eventList.addItem( allEventTypes( n ).Value + " " + stringToAdd, n ) next n eventList.selectItemPos( focusPosition, true ) end sub sub CreateAllKeyBindings() reDim allKeyBindings( 105 ) as string keyBindingPosition = 1 for FKey = 2 to 12 allKeyBindings( keyBindingPosition ) = "SHIFT + CONTROL + F" + FKey keyBindingPosition = keyBindingPosition + 1 next FKey for Digit = 0 to 9 allKeyBindings( keyBindingPosition ) = "SHIFT + CONTROL + " + Digit keyBindingPosition = keyBindingPosition + 1 next Digit for Alpha = 65 to 90 allKeyBindings( keyBindingPosition ) = "SHIFT + CONTROL + " + chr$( Alpha ) keyBindingPosition = keyBindingPosition + 1 next Alpha for FKey = 2 to 12 allKeyBindings( keyBindingPosition ) = "CONTROL + F" + FKey keyBindingPosition = keyBindingPosition + 1 next FKey for Digit = 0 to 9 allKeyBindings( keyBindingPosition ) = "CONTROL + " + Digit keyBindingPosition = keyBindingPosition + 1 next Digit for Alpha = 65 to 90 allKeyBindings( keyBindingPosition ) = "CONTROL + " + chr$( Alpha ) keyBindingPosition = keyBindingPosition + 1 next Alpha for FKey = 2 to 12 allKeyBindings( keyBindingPosition ) = "SHIFT + F" + FKey keyBindingPosition = keyBindingPosition + 1 next FKey end sub sub createAllEventTypes() allEventTypes( 0 ).Name = "OnStartApp" allEventTypes( 0 ).Value = "Start Application" allEventTypes( 1 ).Name = "OnCloseApp" allEventTypes( 1 ).Value = "Close Application" allEventTypes( 2 ).Name = "OnNew" allEventTypes( 2 ).Value = "Create Document" allEventTypes( 3 ).Name = "OnLoad" allEventTypes( 3 ).Value = "Open Document" allEventTypes( 4 ).Name = "OnSaveAs" allEventTypes( 4 ).Value = "Save Document As" allEventTypes( 5 ).Name = "OnSaveAsDone" allEventTypes( 5 ).Value = "Document has been saved as" allEventTypes( 6 ).Name = "OnSave" allEventTypes( 6 ).Value = "Save Document" allEventTypes( 7 ).Name = "OnSaveDone" allEventTypes( 7 ).Value = "Document has been saved" allEventTypes( 8 ).Name = "OnPrepareUnload" allEventTypes( 8 ).Value = "Close Document" allEventTypes( 9 ).Name = "OnUnload" allEventTypes( 9 ).Value = "Close Document" allEventTypes( 10 ).Name = "OnFocus" allEventTypes( 10 ).Value = "Activate document" allEventTypes( 11 ).Name = "OnUnfocus" allEventTypes( 11 ).Value = "DeActivate document" allEventTypes( 12 ).Name = "OnPrint" allEventTypes( 12 ).Value = "Print Document" REM The following are document-only events allEventTypes( 13 ).Name = "OnMailMerge" allEventTypes( 13 ).Value = "Print form letters" allEventTypes( 14 ).Name = "OnPageCountChange" allEventTypes( 14 ).Value = "Changing the page count" end sub sub createAllEventBindings() 'dim props as new com.sun.star.beans.PropertyValue 'props.Name = "" 'Name = script name 'props.Value = 0 'Value = 0 for empty, 1 for macro, linenumber for script ' Creates all types of event bindings for both Application and Document ' Initially both arrays have no bindings allocated to the events ' The value for Doc is only Script/macro name (no need for line number) for n = 0 to ubound( allEventTypes() ) allEventTypesApp( n ).Name = "" allEventTypesApp( n ).Value = 0 allEventTypesDoc( n ).Name = "" allEventTypesDoc( n ).Value = 0 next n end sub REM ----- Text Handling Functions ----- function ExtractLabelFromXMLLine( XMLLine as string ) as string labelStart = instr( XMLLine, "label="+chr$(34)) + 7 labelEnd = instr( XMLLine, chr$(34)+">" ) if labelEnd = 0 then labelEnd = instr( XMLLine, chr$(34)+"/>" ) end if labelLength = labelEnd - labelStart menuLabelUnformatted = mid( XMLLine, labelStart, labelLength ) tildePosition = instr( menuLabelUnformatted, "~" ) select case tildePosition case 0 menuLabel = menuLabelUnformatted case 1 menuLabel = right( menuLabelUnformatted, labelLength - 1 ) case else menuLabelLeft = left( menuLabelUnformatted, tildePosition - 1 ) menuLabelRight = right( menuLabelUnformatted, labelLength - tildePosition ) menuLabel = menuLabelLeft + menuLabelRight end select ExtractLabelFromXMLLine() = menuLabel end function function ExtractScriptIdFromXMLLine( XMLLine as string ) as string idStart = instr( XMLLine, "script://") + 9 if instr( XMLLine, chr$(34)+" menu:helpid=" ) = 0 then idEnd = instr( XMLLIne, "?location=" ) else idEnd = instr( XMLLine, ""+chr$(34)+" menu:helpid=" ) end if idLength = idEnd - idStart scriptId = mid( XMLLine, idStart, idLength ) ExtractScriptIdFromXMLLine() = scriptId end function function ExtractEventScriptFromXMLLine( xmlline as string ) if instr( xmlline, "script://" ) > 0 then idStart = instr( xmlline, "script://") + 9 idEnd = instr( xmlline, chr$(34)+" xlink:type=" ) idLength = idEnd - idStart scriptId = mid( xmlline, idStart, idLength ) end if ExtractEventScriptFromXMLLine() = scriptId end function function ExtractEventNameFromXMLLine( xmlline as string ) idStart = instr( xmlline, "event:name=" + chr$(34) ) + 12 idEnd = instr( xmlline, chr$(34)+" event:language" ) idLength = idEnd - idStart event = mid( xmlline, idStart, idLength ) ExtractEventNameFromXMLLine() = event end function function ExtractKeyCodeFromXMLLine( XMLLine as string ) as string keyStart = instr( XMLLine, "code="+chr$(34)+"KEY_") + 10 keyCode = mid( XMLLine, keyStart, ( len( XMLLine ) - keyStart ) ) keyEnd = instr( keyCode, chr$(34) ) keyCode = mid( keyCode, 1, keyEnd - 1 ) ExtractKeyCodeFromXMLLine() = keyCode end function function GetMenuWhiteSpace( MenuXMLLine as string ) as string whiteSpace = "" numberOfSpaces = instr( MenuXMLLine, "<" ) - 1 for i = 1 to numberOfSpaces whiteSpace = whiteSpace + " " next i GetMenuWhiteSpace() = whiteSpace end function function IsAllocatedMenuItem( script as string ) as boolean foundMenuItem = false Allocated = false count = 0 do count = count + 1 if strcomp( script, subMenuItems( count ) ) = 0 then foundMenuItem = true end if loop while not( foundMenuItem ) and count < subMenuCount linePosition = subMenuItemLinePosition( count ) if not( instr( xmlFile( linePosition ), "script://" ) = 0 ) then Allocated = true end if isAllocatedMenuItem() = Allocated end Function function HasShiftKey( keyCombo ) as boolean if instr( keyCombo, "SHIFT" ) = 0 then hasShift = false else hasShift = true end if HasShiftKey = hasShift end function function HasControlKey( keyCombo ) as boolean if instr( keyCombo, "CONTROL" ) = 0 then hasControl = false else hasControl = true end if HasControlKey = hasControl end function function ExtractKeyFromCombo( keyString as string ) as string while not( instr( keyString, "+" ) = 0 ) removeTo = instr( keyString, "+ " ) + 2 keyString = mid( keyString, removeTo, ( len( keyString ) - removeTo ) + 1 ) wend ExtractKeyFromCombo() = keyString end function REM ------ Event Handling Functions (Listeners) ------ sub KeyListListener() keyShortCutList = bindingDialog.getControl( "KeyList" ) selectedShortCut = keyShortCutList.getSelectedItem() combo = bindingDialog.getControl( "KeyCombo" ) menuScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = menuScriptList.getSelectedItem() keyGroup = combo.text dim keyGroupIndex as Integer dim selectedKeyIndex as Integer for n = lbound ( allKeyGroupsArray() ) to ubound ( allKeyGroupsArray() ) if ( allKeyGroupsArray( n ) = keyGroup )then keyGroupIndex = n exit for end if next n selectedKeyIndex = keyShortCutList.getSelectedItemPos() if keyAllocationMap( keyGroupIndex, selectedKeyIndex ).Value > 1 then bindingDialog.Model.Delete.enabled = true bindingDialog.Model.AddOn.enabled = true if selectedScript <> "" then bindingDialog.Model.NewButton.enabled = true endif else if keyAllocationMap( keyGroupIndex, selectedKeyIndex ).Value = 1 then bindingDialog.Model.Delete.enabled = false bindingDialog.Model.AddOn.enabled = false bindingDialog.Model.NewButton.enabled = false else bindingDialog.Model.Delete.enabled = false bindingDialog.Model.AddOn.enabled = false if selectedScript <> "" then bindingDialog.Model.NewButton.enabled = true end if end if end if end sub sub SubMenuListListener() scriptList = bindingDialog.getControl( "ScriptList" ) subMenuList = bindingDialog.getControl( "SubMenuList" ) selectedMenuItem = subMenuList.getSelectedItem() if IsAllocatedMenuItem( selectedMenuItem ) then bindingDialog.Model.Delete.enabled = true bindingDialog.Model.AddOn.enabled = true else bindingDialog.Model.Delete.enabled = false bindingDialog.Model.AddOn.enabled = false end if end sub REM a keypress listener that in turn fires the MenuCL on a return key even only sub fireMenuComboListernerOnRet( eventobj as object ) if (eventobj.KeyCode = 1280 ) then MenuComboListener() endif end sub 'Populates the SubMenuList with the appropriate menu items from the Top-level menu selected from the combo box sub MenuComboListener() combo = bindingDialog.getControl( "MenuCombo" ) newToplevelMenu = combo.text counter = 0 do counter = counter + 1 loop while not( newToplevelMenu = menuItems( counter ) ) PopulateSubMenuList( counter ) end sub REM a keypress listener that in turn fires the LLCL on a return key even only sub fireLangLocComboListernerOnRet( eventobj as object ) if (eventobj.KeyCode = 1280 ) then LangLocComboListener() endif end sub sub LangLocComboListener() combo = bindingDialog.getControl( "LanguageCombo" ) language = combo.text combo = bindingDialog.getControl( "LocationCombo" ) location = combo.text PopulateScriptList( language,location ) 'Enable/disable Assign button scriptList = bindingDialog.getControl( "ScriptList" ) if not (dialogName = "EditDebug") then if scriptList.getSelectedItem() = "" then bindingDialog.Model.NewButton.enabled = false end if end if if ( location = "Filesystem" ) and ( language <> "Java" ) then bindingDialog.Model.Browse.enabled = true if not (dialogName = "EditDebug") then bindingDialog.Model.fsonly.enabled = true end if else bindingDialog.Model.Browse.enabled = false if not (dialogName = "EditDebug") then bindingDialog.Model.fsonly.enabled = false end if endif ' extra dialog dependent processing if dialogName = "Menu" then ' will set New button to false if no text in LableBox MenuLabelBoxListener() elseif dialogName = "Key" then ' will set Assigne button to false if appropriate KeyListListener() elseif dialogName = "Event" then EventListListener() end if end sub REM a keypress listener that in turn fires the KeyCL on a return key even only sub fireKeyComboListernerOnRet( eventobj as object ) if (eventobj.KeyCode = 1280 ) then KeyComboListener() endif end sub 'Populates the KeyList with the appropriate key combos from the Top-level key group selected from the combo box sub KeyComboListener() combo = bindingDialog.getControl( "KeyCombo" ) keyGroup = combo.text for n = lbound ( allKeyGroupsArray() ) to ubound ( allKeyGroupsArray() ) if ( allKeyGroupsArray( n ) = keyGroup )then keyGroupIndex = n exit for end if next n PopulateKeyBindingList( keyGroupIndex ) end sub sub MenuLabelBoxListener() menuScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = menuScriptList.getSelectedItem() 'if the SubMenuList is from a dynamically created menu (e.g. Format) 'or if the Menu Label text box is empty subMenuList = bindingDialog.getControl( "SubMenuList" ) firstItem = subMenuList.getItem( 0 ) if bindingDialog.Model.MenuLabelBox.text = "" OR firstItem = "Unable to Assign Scripts to this menu" OR selectedScript = "" then bindingDialog.Model.NewButton.enabled = false else bindingDialog.Model.NewButton.enabled = true end if end sub sub AppDocEventListener() populateEventList( 0 ) EventListListener() end sub sub EventListListener() on error goto ErrorHandler eventList = bindingDialog.getControl( "EventList" ) eventPos = eventList.getSelectedItemPos() allApps = bindingDialog.getControl( "AllAppsOption" ) menuScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = menuScriptList.getSelectedItem() dim binding as integer if allApps.state = true then binding = allEventTypesApp( eventPos ).Value else binding = allEventTypesDoc( eventPos ).Value endif if ( binding > 1 ) then bindingDialog.Model.Delete.enabled = true else bindingDialog.Model.Delete.enabled = false end if if ( binding = 1 ) then ' staroffice binding, can't assign bindingDialog.Model.NewButton.enabled = false elseif ( selectedScript <> "" ) then bindingDialog.Model.NewButton.enabled = true end if exit sub ErrorHandler: reset bindingDialog.Model.Delete.enabled = false end sub REM ------ Event Handling Functions (Buttons) ------ function getFilePicker() as Object REM file dialog oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" ) combo = bindingDialog.getControl( "LanguageCombo" ) language = combo.text currentFilter = "" for langIndex = 0 to ubound(languages()) if( languages(langIndex) <> "Java" ) then filterName = languages(langIndex) + " (" filterVal="" extns = extensions(langIndex) for extnIndex = lbound(extns()) to ubound(extns()) filterName = filterName + "*." + extns(extnIndex) + "," filterVal = filterVal + "*." + extns(extnIndex) + "," next extnIndex filterName = left(filterName, len(filterName) -1) + ")" filterVal = left(filterVal, len(filterVal) -1) if(instr(filterName,language) = 1 ) then currentFilter = filterName end if oFilePicker.AppendFilter(filterName, filterVal) end if next langIndex if(len(currentFilter) > 0 ) then oFilePicker.SetCurrentFilter( currentFilter ) end if If sFileURL = "" Then oSettings = CreateUnoService( "com.sun.star.frame.Settings" ) oPathSettings = oSettings.getByName( "PathSettings" ) sFileURL = oPathSettings.getPropertyValue( "Work" ) End If REM set display directory oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" ) If oSimpleFileAccess.exists( sFileURL ) And oSimpleFileAccess.isFolder( sFileURL ) Then oFilePicker.setDisplayDirectory( sFileURL ) End If getFilePicker() = oFilePicker end function Sub DoBrowseAndEdit() Dim oFilePicker As Object, oSimpleFileAccess As Object Dim oSettings As Object, oPathSettings As Object Dim sFileURL As String Dim sFiles As Variant oFilePicker = getFilePicker() REM execute file dialog If oFilePicker.execute() Then sFiles = oFilePicker.getFiles() sFileURL = sFiles(0) oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" ) If oSimpleFileAccess.exists( sFileURL ) Then for langIndex = 0 to ubound(languages()) If (instr(oFilePicker.GetCurrentFilter, languages(langIndex)) = 1 ) then RunDebugger(languages(langIndex), sFileURL, "") End If next langIndex End If bindingDialog.endExecute() End If End Sub Sub RunDebugger(lang as String, uri as String, filename as String) dim document as object dim dispatcher as object dim parser as object dim url as new com.sun.star.util.URL document = ThisComponent.CurrentController.Frame parser = createUnoService("com.sun.star.util.URLTransformer") dim args(2) as new com.sun.star.beans.PropertyValue args(0).Name = "language" args(0).Value = lang args(1).Name = "uri" args(1).Value = uri args(2).Name = "filename" args(2).Value = filename url.Complete = "script://_$DebugRunner.Debug?" _ + "language=Java&function=DebugRunner.go" _ + "&location=share" parser.parseStrict(url) disp = document.queryDispatch(url,"",0) disp.dispatch(url, args()) End Sub sub DoEdit() Dim scriptInfo as Object menuScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = menuScriptList.getSelectedItem() if not (selectedScript = "") then scripts() = scriptDisplayList(0) for n = LBOUND( scripts() ) to UBOUND( scripts() ) if ( scripts( n ).Name = selectedScript ) then scriptInfo = scripts( n ).Value exit for end if next n RunDebugger(scriptInfo.getLanguage, scriptInfo.getParcelURI, scriptInfo.getFunctionName) bindingDialog.endExecute() end if end sub sub MenuOKButton() WriteXMLFromArray() bindingDialog.endExecute() end sub sub MenuCancelButton() bindingDialog.endExecute() end sub sub MenuHelpButton() helpDialog = LoadDialog( "ScriptBindingLibrary", "HelpBinding" ) helpDialog.execute() end sub sub MenuDeleteButton() subMenuList = bindingDialog.getControl( "SubMenuList" ) linePos = subMenuItemLinePosition( subMenuList.getSelectedItemPos() + 1 ) RemoveBinding( linePos ) REM Update the top-level menu's line positions combo = bindingDialog.getControl( "MenuCombo" ) newToplevelMenu = combo.text counter = 0 do counter = counter + 1 loop while not( newToplevelMenu = menuItems( counter ) ) UpdateTopLevelMenus( counter + 1, false ) MenuComboListener() subMenuList.selectItemPos( subMenuList.getSelectedItemPos(), true ) end sub sub MenuNewButton() menuScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = menuScriptList.getSelectedItem() scriptURI = getScriptURI( selectedScript ) newMenuLabel = bindingDialog.Model.MenuLabelBox.text subMenuList = bindingDialog.getControl( "SubMenuList" ) REM Update the top-level menu's line positions combo = bindingDialog.getControl( "MenuCombo" ) newToplevelMenu = combo.text counter = 0 do counter = counter + 1 loop while not( newToplevelMenu = menuItems( counter ) ) UpdateTopLevelMenus( counter + 1, true ) REM New line position is one ahead of the selected sub menu item linePos = subMenuItemLinePosition( subMenuList.getSelectedItemPos() + 1 ) + 1 AddNewMenuBinding( scriptURI, newMenuLabel, linePos ) MenuComboListener() subMenuList.selectItemPos( subMenuList.getSelectedItemPos() + 1, true ) SubMenuListListener() end sub sub BrowseButton() Dim oFilePicker As Object, oSimpleFileAccess As Object Dim oSettings As Object, oPathSettings As Object Dim sFileURL As String Dim sFiles As Variant oFilePicker = getFilePicker() REM execute file dialog If oFilePicker.execute() Then sFiles = oFilePicker.getFiles() sFileURL = sFiles(0) oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" ) If oSimpleFileAccess.exists( sFileURL ) Then REM add sFileURL to the list ReDim preserve filesysScripts(filesysCount) as String filesysScripts( filesysCount ) = sFileURL filesysCount=filesysCount+1 ' if user changed filter in file picker then populate ' language with language associated with that in file picker sFilter = oFilePicker.getCurrentFilter() langCombo = bindingDialog.getControl( "LanguageCombo" ) dim items() as String items() = langCombo.getItems() for index = lbound(items()) to ubound(items()) iPos = inStr(sFilter," ") Dim theLanguage as String if( iPos > 0 ) then theLanguage = Left( sFilter, iPos - 1) if ( theLanguage = items( index ) ) then langCombo.text = items( index ) exit for end if end if next index End If End If LangLocComboListener() End Sub sub KeyOKButton() WriteXMLFromArray() bindingDialog.endExecute() end sub sub KeyCancelButton() bindingDialog.endExecute() end sub sub KeyHelpButton() helpDialog = LoadDialog( "ScriptBindingLibrary", "HelpBinding" ) helpDialog.execute() end sub sub KeyNewButton() combo = bindingDialog.getControl( "KeyCombo" ) keyGroup = combo.text for n = lbound ( allKeyGroupsArray() ) to ubound ( allKeyGroupsArray() ) if ( allKeyGroupsArray( n ) = keyGroup )then keyGroupIndex = n exit for end if next n menuScriptList = bindingDialog.getControl( "ScriptList" ) script = menuScriptList.getSelectedItem() scriptURI = getScriptURI( script ) keyList = bindingDialog.getControl( "KeyList" ) keyIndex = keyList.getSelectedItemPos() ShortCutKeyArray() = KeyBindArrayOfArrays( keyGroupIndex ) keyText = ShortCutKeyArray( keyIndex ) AddNewKeyBinding( scriptURI, HasShiftKey( keyText ), HasControlKey( keyText ), ExtractKeyFromCombo( keyText ) ) KeyComboListener() end sub sub KeyDeleteButton() keyShortCutList = bindingDialog.getControl( "KeyList" ) selectedShortCut = keyShortCutList.getSelectedItem() combo = bindingDialog.getControl( "KeyCombo" ) keyGroup = combo.text dim keyGroupIndex as Integer dim selectedKeyIndex as Integer for n = lbound ( allKeyGroupsArray() ) to ubound ( allKeyGroupsArray() ) if ( allKeyGroupsArray( n ) = keyGroup )then keyGroupIndex = n exit for end if next n selectedKeyIndex = keyShortCutList.getSelectedItemPos() linePosition = keyAllocationMap( keyGroupIndex, selectedKeyIndex ).Value keyAllocationMap( keyGroupIndex, selectedKeyIndex ).Value = 0 keyAllocationMap( keyGroupIndex, selectedKeyIndex ).Name = "" RemoveBinding( linePosition ) KeyComboListener() end sub sub EventNewButton() eventScriptList = bindingDialog.getControl( "ScriptList" ) selectedScript = eventScriptList.getSelectedItem() scriptURI = getScriptURI( selectedScript ) eventList = bindingDialog.getControl( "EventList" ) eventPosition = eventList.getSelectedItemPos() allApps = bindingDialog.getControl( "AllAppsOption" ) dim isApp as boolean if allApps.state = true then 'Application isApp = true else 'Document isApp = false end if AddNewEventBinding( scriptURI, eventPosition, isApp ) populateEventList( eventPosition ) EventListListener() end sub sub EventDeleteButton() eventList = bindingDialog.getControl( "EventList" ) REM Check that combo is a script eventPosition = eventList.getSelectedItemPos() allApps = bindingDialog.getControl( "AllAppsOption" ) if allApps.state = true then 'Application linePosition = allEventTypesApp( eventPosition ).Value 'dim eventProp as new com.sun.star.beans.PropertyValue 'eventProp.Name = "" 'eventProp.Value = 0 allEventTypesApp( eventPosition ).Name = "" allEventTypesApp( eventPosition ).Value = 0 RemoveBinding( linePosition ) else 'Document 'DeleteEvent( allEventTypes( eventPosition ) ) allEventTypesDoc( eventPosition ).Name = "" allEventTypesDoc( eventPosition ).Value = 0 end if PopulateEventList( eventPosition ) EventListListener() end sub sub EventOKButton WriteEventsToDoc() WriteXMLFromArray() bindingDialog.endExecute() end sub sub HelpOKButton() helpDialog.endExecute() end sub