' Set of Macros used for Help Authoring ' ===================================== ' Version ' ------------------------------------- ' ' *********************************************************************** ' * ' * The Contents of this file are made available subject to the terms of ' * either of the following licenses ' * ' * - GNU Lesser General Public License Version 2.1 ' * - Sun Industry Standards Source License Version 1.1 ' * ' * Sun Microsystems Inc., October, 2000 ' * ' * GNU Lesser General Public License Version 2.1 ' * ============================================= ' * Copyright 2000 by Sun Microsystems, Inc. ' * 901 San Antonio Road, Palo Alto, CA 94303, USA ' * ' * This library is free software; you can redistribute it and/or ' * modify it under the terms of the GNU Lesser General Public ' * License version 2.1, as published by the Free Software Foundation. ' * ' * This library is distributed in the hope that it will be useful, ' * but WITHOUT ANY WARRANTY; without even the implied warranty of ' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' * Lesser General Public License for more details. ' * ' * You should have received a copy of the GNU Lesser General Public ' * License along with this library; if not, write to the Free Software ' * Foundation, Inc., 59 Temple Place, Suite 330, Boston, ' * MA 02111-1307 USA ' * ' * ' * Sun Industry Standards Source License Version 1.1 ' * ================================================= ' * The contents of this file are subject to the Sun Industry Standards ' * Source License Version 1.1 (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.openoffice.org/license.html. ' * ' * Software provided under this License is provided on an "AS IS" basis, ' * WITHOUT WARRUNTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, ' * WITHOUT LIMITATION, WARRUNTIES THAT THE SOFTWARE IS FREE OF DEFECTS, ' * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. ' * See the License for the specific provisions governing your rights and ' * obligations concerning the Software. ' * ' * The Initial Developer of the Original Code is: Sun Microsystems, Inc.. ' * ' * Copyright: 2000 by Sun Microsystems, Inc. ' * ' * All Rights Reserved. ' * ' * Contributor(s): _______________________________________ ' * ' * ' ************************************************************************ 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+chr(13)+chr(13)+"(c) 2010 Oracle, Licensed under LGPL",256 End Sub