1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_Main" script:language="StarBasic">' Set of Macros used for Help Authoring 4' ===================================== 5' Version 6' ------------------------------------- 7' 8 9' *********************************************************************** 10' * 11' * The Contents of this file are made available subject to the terms of 12' * either of the following licenses 13' * 14' * - GNU Lesser General Public License Version 2.1 15' * - Sun Industry Standards Source License Version 1.1 16' * 17' * Sun Microsystems Inc., October, 2000 18' * 19' * GNU Lesser General Public License Version 2.1 20' * ============================================= 21' * Copyright 2000 by Sun Microsystems, Inc. 22' * 901 San Antonio Road, Palo Alto, CA 94303, USA 23' * 24' * This library is free software; you can redistribute it and/or 25' * modify it under the terms of the GNU Lesser General Public 26' * License version 2.1, as published by the Free Software Foundation. 27' * 28' * This library is distributed in the hope that it will be useful, 29' * but WITHOUT ANY WARRANTY; without even the implied warranty of 30' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 31' * Lesser General Public License for more details. 32' * 33' * You should have received a copy of the GNU Lesser General Public 34' * License along with this library; if not, write to the Free Software 35' * Foundation, Inc., 59 Temple Place, Suite 330, Boston, 36' * MA 02111-1307 USA 37' * 38' * 39' * Sun Industry Standards Source License Version 1.1 40' * ================================================= 41' * The contents of this file are subject to the Sun Industry Standards 42' * Source License Version 1.1 (the "License"); You may not use this file 43' * except in compliance with the License. You may obtain a copy of the 44' * License at http://www.openoffice.org/license.html. 45' * 46' * Software provided under this License is provided on an "AS IS" basis, 47' * WITHOUT WARRUNTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, 48' * WITHOUT LIMITATION, WARRUNTIES THAT THE SOFTWARE IS FREE OF DEFECTS, 49' * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. 50' * See the License for the specific provisions governing your rights and 51' * obligations concerning the Software. 52' * 53' * The Initial Developer of the Original Code is: Sun Microsystems, Inc.. 54' * 55' * Copyright: 2000 by Sun Microsystems, Inc. 56' * 57' * All Rights Reserved. 58' * 59' * Contributor(s): _______________________________________ 60' * 61' * 62' ************************************************************************ 63 64Global Const Version = "v3.20100805" 65 66Global Const strErr_NoHelpFile = "Not a Help File" 67 68'======================================================= 69' Main 70'------------------------------------------------------- 71' Ensure that necessary library functions are available 72'======================================================= 73Sub Main 74 GlobalScope.BasicLibraries.loadLibrary("Tools") 75End Sub 76 77'======================================================= 78' SetMetaDataOnSave 79'------------------------------------------------------- 80' Sets the document meta data. It is called when 81' the document is saved. It changes the data and 82' then saves it again. 83'======================================================= 84Sub SetMetaDataOnSave(Path as String) 85 86 document = StarDesktop.CurrentComponent 87 sDocRoot = ReadConfig("HelpPrefix") 88 89 If Path = "" Then 90 Path = document.URL 91 End If 92 93 If not(IsSubDir(Path,sDocRoot)) Then ' doesn'tr work when resaving the file since it contains the OLD url (before resave) 94 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") 95 Else 96 Path = Right(Path,Len(Path)-Len(sDocRoot)) 97 End If 98 99 document.DocumentInfo.SetUserFieldName(0,"Indexer") 100 document.DocumentInfo.SetUserFieldName(1,"ID") 101' document.DocumentInfo.SetUserFieldName(2,"Comment") 102 document.DocumentInfo.SetPropertyValue("Subject",Path) 103 104 105End Sub 106 107'======================================================= 108' ValidateOnSave 109'------------------------------------------------------- 110' Ensures that the document is validated when saved 111' should be bound to the "Document Save" event but 112' currently isn't 113'======================================================= 114Sub ValidateOnSave 115 BasicLibraries.LoadLibrary("HelpAuthoring") 116 document = StarDesktop.CurrentComponent 117 If document.URL <> "" Then ' not initial save 118 If IsHelpFile Then 119 SetMetaDataOnSave("") 120 ValidateXHP 121 End If 122 End If 123End Sub 124 125 126'======================================================= 127' CreateFile 128'------------------------------------------------------- 129' Creates a new help file based on the help template 130' and calls the save dialog 131'======================================================= 132Sub CreateFile 133 GlobalScope.BasicLibraries.loadLibrary("Tools") 134 oPath = createUNOService("com.sun.star.util.PathSettings") 135 arPaths = Split(oPath.Template,";") ' get the paths to the templates from the configuration 136 sHelpTemplate = "" 137 138 ' change stw extension to ott extension for template 139 140 For i=0 to ubound(arPaths) ' see if the template path contains the help template 141 If FileExists(arPaths(i)+"/Help/xmlhelptemplate.ott") Then 142 sHelpTemplate = arPaths(i)+"/Help/xmlhelptemplate.ott" 143 End If 144 Next i 145 146 If sHelpTemplate = "" Then 147 msgbox "Cannot find the help template.",256 148 Else 149 oDoc = StarDesktop.loadComponentFromURL(sHelpTemplate,"_blank",0,Array()) 150 SaveAs(oDoc) 151 End If 152 153End Sub 154 155'======================================================= 156' SaveAs 157'------------------------------------------------------- 158' Initially saves a new help file on creation. 159' Is called from CreateFile 160'======================================================= 161Sub SaveAs(oDoc As Object) 162Dim ListAny(0) as Long 163Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue 164 On Local Error Goto ERRHANDLE: 165 166 sLastSaveDir = ReadConfig("LastSaveDir") 167 sDocRoot = ReadConfig("HelpPrefix") 168 169 ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD 170 oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") 171 oFileDialog.Initialize(ListAny()) 172 173 If sLastSaveDir <> "" AND IsSubDir(sLastSaveDir,sDocRoot) Then 174 oFileDialog.setDisplayDirectory(sLastSaveDir) 175 Else 176 oFileDialog.setDisplayDirectory(sDocRoot) 177 End If 178 179 oMasterKey = GetRegistryKeyContent("org.openoffice.Office.TypeDetection/") 180 oFilters() = oMasterKey.Filters 181 oFileDialog.AppendFilter("Help", "*.xhp") 182 183 oFileDialog.SetTitle("Save Help File As") 184 iAccept = oFileDialog.Execute() 185 If iAccept = 1 Then 186 WriteConfig("LastSaveDir",oFileDialog.getDisplayDirectory+"/") 187 sPath = oFileDialog.Files(0) 188 oStoreProperties(0).Name = "FilterName" 189 oStoreProperties(0).Value = "XHP_Help" 190 SetMetaDataOnSave(sPath) 191 oDoc.StoreAsUrl(sPath, oStoreProperties()) 192 Else 193 msgbox "You must save a help document before you can work on it."+chr(13)+"This document will be disposed.", 48 194 oDoc.dispose 195 End If 196 oFileDialog.Dispose() 197 198 ERRHANDLE: 199 If Err <> 0 Then 200 msgbox "Error: "+chr(13)+ Error$+chr(13)+"Cannot save file."+chr(13),48,"Fatal Error" 201 oDoc.dispose 202 End If 203End Sub 204 205Sub CheckOnLoad 206' oDoc = StarDesktop.CurrentComponent 207' sDocRoot = ReadConfig("HelpPrefix") 208' If sDocRoot="" Then 209' msgbox("No document root set. Please set the root folder for your documents.") 210' sDocRoot = SetDocumentRoot 211' End If 212' msgbox(HasUnoInterfaces(oDoc, "com.sun.star.lang.XServiceInfo")) 213' sFName = oDoc.URL 214' msgbox(sFName+chr(13)+sDocRoot) 215' If not(IsSubDir(sFName,sDocRoot)) Then 216' 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!") 217' End If 218End Sub 219 220Sub DisplayVersion 221 msgbox "OpenOffice.org Help Authoring Framework"+chr(13)+"Version "+Version+chr(13)+chr(13)+"(c) 2010 Oracle, Licensed under LGPL",256 222End Sub 223</script:module>