diff options
Diffstat (limited to 'scripting/workben/bindings/ScriptBinding.xba')
-rw-r--r-- | scripting/workben/bindings/ScriptBinding.xba | 2093 |
1 files changed, 2093 insertions, 0 deletions
diff --git a/scripting/workben/bindings/ScriptBinding.xba b/scripting/workben/bindings/ScriptBinding.xba new file mode 100644 index 000000000000..7f689d34f797 --- /dev/null +++ b/scripting/workben/bindings/ScriptBinding.xba @@ -0,0 +1,2093 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ScriptBinding" script:language="StarBasic">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 allready 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 dependant 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 +</script:module> |