' Set of Macros used for Help Authoring ' ===================================== ' Version ' ------------------------------------- ' ' #************************************************************** ' # ' # Licensed to the Apache Software Foundation (ASF) under one ' # or more contributor license agreements. See the NOTICE file ' # distributed with this work for additional information ' # regarding copyright ownership. The ASF licenses this file ' # to you under the Apache License, Version 2.0 (the ' # "License"); you may not use this file except in compliance ' # with the License. You may obtain a copy of the License at ' # ' # http://www.apache.org/licenses/LICENSE-2.0 ' # ' # Unless required by applicable law or agreed to in writing, ' # software distributed under the License is distributed on an ' # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY ' # KIND, either express or implied. See the License for the ' # specific language governing permissions and limitations ' # under the License. ' # ' #************************************************************** Global Const Version = "v3.20100805" Global Const strErr_NoHelpFile = "Not a Help File" '======================================================= ' Main '------------------------------------------------------- ' Ensure that necessary library functions are available '======================================================= Sub Main GlobalScope.BasicLibraries.loadLibrary("Tools") End Sub '======================================================= ' SetMetaDataOnSave '------------------------------------------------------- ' Sets the document meta data. It is called when ' the document is saved. It changes the data and ' then saves it again. '======================================================= Sub SetMetaDataOnSave(Path as String) document = StarDesktop.CurrentComponent sDocRoot = ReadConfig("HelpPrefix") If Path = "" Then Path = document.URL End If If not(IsSubDir(Path,sDocRoot)) Then ' doesn'tr work when resaving the file since it contains the OLD url (before resave) msgbox("The File"+chr(13)+Path+chr(13)+"is outside of your Document Root"+chr(13)+sDocRoot+chr(13)+chr(13)+"You may want to adjust your document root settings and re-save the file.",48,"Warning") Else Path = Right(Path,Len(Path)-Len(sDocRoot)) End If document.DocumentInfo.SetUserFieldName(0,"Indexer") document.DocumentInfo.SetUserFieldName(1,"ID") ' document.DocumentInfo.SetUserFieldName(2,"Comment") document.DocumentInfo.SetPropertyValue("Subject",Path) End Sub '======================================================= ' ValidateOnSave '------------------------------------------------------- ' Ensures that the document is validated when saved ' should be bound to the "Document Save" event but ' currently isn't '======================================================= Sub ValidateOnSave BasicLibraries.LoadLibrary("HelpAuthoring") document = StarDesktop.CurrentComponent If document.URL <> "" Then ' not initial save If IsHelpFile Then SetMetaDataOnSave("") ValidateXHP End If End If End Sub '======================================================= ' CreateFile '------------------------------------------------------- ' Creates a new help file based on the help template ' and calls the save dialog '======================================================= Sub CreateFile GlobalScope.BasicLibraries.loadLibrary("Tools") oPath = createUNOService("com.sun.star.util.PathSettings") arPaths = Split(oPath.Template,";") ' get the paths to the templates from the configuration sHelpTemplate = "" ' change stw extension to ott extension for template For i=0 to ubound(arPaths) ' see if the template path contains the help template If FileExists(arPaths(i)+"/Help/xmlhelptemplate.ott") Then sHelpTemplate = arPaths(i)+"/Help/xmlhelptemplate.ott" End If Next i If sHelpTemplate = "" Then msgbox "Cannot find the help template.",256 Else oDoc = StarDesktop.loadComponentFromURL(sHelpTemplate,"_blank",0,Array()) SaveAs(oDoc) End If End Sub '======================================================= ' SaveAs '------------------------------------------------------- ' Initially saves a new help file on creation. ' Is called from CreateFile '======================================================= Sub SaveAs(oDoc As Object) Dim ListAny(0) as Long Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue On Local Error Goto ERRHANDLE: sLastSaveDir = ReadConfig("LastSaveDir") sDocRoot = ReadConfig("HelpPrefix") ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") oFileDialog.Initialize(ListAny()) If sLastSaveDir <> "" AND IsSubDir(sLastSaveDir,sDocRoot) Then oFileDialog.setDisplayDirectory(sLastSaveDir) Else oFileDialog.setDisplayDirectory(sDocRoot) End If oMasterKey = GetRegistryKeyContent("org.openoffice.Office.TypeDetection/") oFilters() = oMasterKey.Filters oFileDialog.AppendFilter("Help", "*.xhp") oFileDialog.SetTitle("Save Help File As") iAccept = oFileDialog.Execute() If iAccept = 1 Then WriteConfig("LastSaveDir",oFileDialog.getDisplayDirectory+"/") sPath = oFileDialog.Files(0) oStoreProperties(0).Name = "FilterName" oStoreProperties(0).Value = "XHP_Help" SetMetaDataOnSave(sPath) oDoc.StoreAsUrl(sPath, oStoreProperties()) Else msgbox "You must save a help document before you can work on it."+chr(13)+"This document will be disposed.", 48 oDoc.dispose End If oFileDialog.Dispose() ERRHANDLE: If Err <> 0 Then msgbox "Error: "+chr(13)+ Error$+chr(13)+"Cannot save file."+chr(13),48,"Fatal Error" oDoc.dispose End If End Sub Sub CheckOnLoad ' oDoc = StarDesktop.CurrentComponent ' sDocRoot = ReadConfig("HelpPrefix") ' If sDocRoot="" Then ' msgbox("No document root set. Please set the root folder for your documents.") ' sDocRoot = SetDocumentRoot ' End If ' msgbox(HasUnoInterfaces(oDoc, "com.sun.star.lang.XServiceInfo")) ' sFName = oDoc.URL ' msgbox(sFName+chr(13)+sDocRoot) ' If not(IsSubDir(sFName,sDocRoot)) Then ' msgbox("The file is located outside of your Document Root"+chr(13)+sDocRoot+chr(13)+chr(13)+"Please adjust your document root settings to avoid trouble with links, transcludes and images!",48,"Warning!") ' End If End Sub Sub DisplayVersion msgbox "OpenOffice.org Help Authoring Framework"+chr(13)+"Version "+Version,256 End Sub ' Set of Macros used for Help Authoring ' ===================================== ' Version ' ------------------------------------- ' ' #************************************************************** ' # ' # Licensed to the Apache Software Foundation (ASF) under one ' # or more contributor license agreements. See the NOTICE file ' # distributed with this work for additional information ' # regarding copyright ownership. The ASF licenses this file ' # to you under the Apache License, Version 2.0 (the ' # "License"); you may not use this file except in compliance ' # with the License. You may obtain a copy of the License at ' # ' # http://www.apache.org/licenses/LICENSE-2.0 ' # ' # Unless required by applicable law or agreed to in writing, ' # software distributed under the License is distributed on an ' # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY ' # KIND, either express or implied. See the License for the ' # specific language governing permissions and limitations ' # under the License. ' # ' #************************************************************** Global Const Version = "v3.20100805" Global Const strErr_NoHelpFile = "Not a Help File" '======================================================= ' Main '------------------------------------------------------- ' Ensure that necessary library functions are available '======================================================= Sub Main GlobalScope.BasicLibraries.loadLibrary("Tools") End Sub '======================================================= ' SetMetaDataOnSave '------------------------------------------------------- ' Sets the document meta data. It is called when ' the document is saved. It changes the data and ' then saves it again. '======================================================= Sub SetMetaDataOnSave(Path as String) document = StarDesktop.CurrentComponent sDocRoot = ReadConfig("HelpPrefix") If Path = "" Then Path = document.URL End If If not(IsSubDir(Path,sDocRoot)) Then ' doesn'tr work when resaving the file since it contains the OLD url (before resave) msgbox("The File"+chr(13)+Path+chr(13)+"is outside of your Document Root"+chr(13)+sDocRoot+chr(13)+chr(13)+"You may want to adjust your document root settings and re-save the file.",48,"Warning") Else Path = Right(Path,Len(Path)-Len(sDocRoot)) End If document.DocumentInfo.SetUserFieldName(0,"Indexer") document.DocumentInfo.SetUserFieldName(1,"ID") ' document.DocumentInfo.SetUserFieldName(2,"Comment") document.DocumentInfo.SetPropertyValue("Subject",Path) End Sub '======================================================= ' ValidateOnSave '------------------------------------------------------- ' Ensures that the document is validated when saved ' should be bound to the "Document Save" event but ' currently isn't '======================================================= Sub ValidateOnSave BasicLibraries.LoadLibrary("HelpAuthoring") document = StarDesktop.CurrentComponent If document.URL <> "" Then ' not initial save If IsHelpFile Then SetMetaDataOnSave("") ValidateXHP End If End If End Sub '======================================================= ' CreateFile '------------------------------------------------------- ' Creates a new help file based on the help template ' and calls the save dialog '======================================================= Sub CreateFile GlobalScope.BasicLibraries.loadLibrary("Tools") oPath = createUNOService("com.sun.star.util.PathSettings") arPaths = Split(oPath.Template,";") ' get the paths to the templates from the configuration sHelpTemplate = "" ' change stw extension to ott extension for template For i=0 to ubound(arPaths) ' see if the template path contains the help template If FileExists(arPaths(i)+"/Help/xmlhelptemplate.ott") Then sHelpTemplate = arPaths(i)+"/Help/xmlhelptemplate.ott" End If Next i If sHelpTemplate = "" Then msgbox "Cannot find the help template.",256 Else oDoc = StarDesktop.loadComponentFromURL(sHelpTemplate,"_blank",0,Array()) SaveAs(oDoc) End If End Sub '======================================================= ' SaveAs '------------------------------------------------------- ' Initially saves a new help file on creation. ' Is called from CreateFile '======================================================= Sub SaveAs(oDoc As Object) Dim ListAny(0) as Long Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue On Local Error Goto ERRHANDLE: sLastSaveDir = ReadConfig("LastSaveDir") sDocRoot = ReadConfig("HelpPrefix") ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") oFileDialog.Initialize(ListAny()) If sLastSaveDir <> "" AND IsSubDir(sLastSaveDir,sDocRoot) Then oFileDialog.setDisplayDirectory(sLastSaveDir) Else oFileDialog.setDisplayDirectory(sDocRoot) End If oMasterKey = GetRegistryKeyContent("org.openoffice.Office.TypeDetection/") oFilters() = oMasterKey.Filters oFileDialog.AppendFilter("Help", "*.xhp") oFileDialog.SetTitle("Save Help File As") iAccept = oFileDialog.Execute() If iAccept = 1 Then WriteConfig("LastSaveDir",oFileDialog.getDisplayDirectory+"/") sPath = oFileDialog.Files(0) oStoreProperties(0).Name = "FilterName" oStoreProperties(0).Value = "XHP_Help" SetMetaDataOnSave(sPath) oDoc.StoreAsUrl(sPath, oStoreProperties()) Else msgbox "You must save a help document before you can work on it."+chr(13)+"This document will be disposed.", 48 oDoc.dispose End If oFileDialog.Dispose() ERRHANDLE: If Err <> 0 Then msgbox "Error: "+chr(13)+ Error$+chr(13)+"Cannot save file."+chr(13),48,"Fatal Error" oDoc.dispose End If End Sub Sub CheckOnLoad ' oDoc = StarDesktop.CurrentComponent ' sDocRoot = ReadConfig("HelpPrefix") ' If sDocRoot="" Then ' msgbox("No document root set. Please set the root folder for your documents.") ' sDocRoot = SetDocumentRoot ' End If ' msgbox(HasUnoInterfaces(oDoc, "com.sun.star.lang.XServiceInfo")) ' sFName = oDoc.URL ' msgbox(sFName+chr(13)+sDocRoot) ' If not(IsSubDir(sFName,sDocRoot)) Then ' msgbox("The file is located outside of your Document Root"+chr(13)+sDocRoot+chr(13)+chr(13)+"Please adjust your document root settings to avoid trouble with links, transcludes and images!",48,"Warning!") ' End If End Sub Sub DisplayVersion msgbox "OpenOffice.org Help Authoring Framework"+chr(13)+"Version "+Version,256 End Sub