<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!--*********************************************************** * * 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. * ***********************************************************--> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validate" script:language="StarBasic"> '############################################ ' VALIDATION ROUTINES '############################################ Dim sSwitchType As String Dim sCellSwitchType As String Dim sCaseType As String Dim sCellCaseType As String Dim sDefaultType As String Dim sCellDefaultType As String Dim bDefaultSet As Boolean Dim bCellDefaultSet As Boolean Dim bCaseSet As Boolean Dim bCellCaseSet As Boolean Dim aTagsOpen(0) As String Dim aCellTagsOpen(0) As String Dim bWarn As Boolean Dim bWarnEmptyPara As Boolean Dim bWarnParaNoID As Boolean Sub ValidateXHP Validate End Sub Sub Validate If not IsHelpFile Then msgbox(strErr_NoHelpFile) Exit Sub End If oDoc = StarDesktop.CurrentComponent sSwitchType = "" sCaseType = "" sDefaultType = "" bWarn = TRUE bWarnEmptyPara = TRUE bWarnParaNoID = TRUE CheckMetaData(oDoc) CheckHeading(oDoc) Enum = oDoc.Text.createEnumeration Do While Enum.hasMoreElements TextElement = Enum.nextElement If TextElement.supportsService("com.sun.star.text.Paragraph") Then ' we are a paragraph CheckSwitches(TextElement) CheckParaID(TextElement) CheckParaFormat(TextElement) CheckTags(TextElement) CheckInlineTags(TextElement) ElseIf TextElement.supportsService("com.sun.star.text.TextTable") Then If sSwitchType <> "" AND (sCaseType = "" AND sDefaultType = "") Then '<------ Terminate("Switch must be closed or case/default must be opened before a table starts.",tmpCellElement) End If CheckCell(TextElement) End If Loop If sCaseType <> "" Then Terminate("Previous case ("+sCaseType+") not closed!",TextElement) End If If sDefaultType <> "" Then Terminate("Previous default not closed!",TextElement) End If If sSwitchType <> "" Then Terminate("Previous switch ("+sSwitchType+") not closed!",TextElement) End If If ubound(aTagsOpen()) > 0 Then Terminate("Element "+aTagsOpen(ubound(aTagsOpen()))+" not closed",TextElement) End If msgbox("Validation finished.") End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECKCELL ' checks a table cell contents '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckCell(TE As Object) On Local Error Goto ERRHANDLE: CellName = "A1" Cell = TE.getCellByName(CellName) tmpCellEnum = Cell.createEnumeration tmpCellElement = tmpCellEnum.nextElement Rows = TE.getRows Cols = TE.getColumns ReDim aCellTagsOpen(0) For RowIndex = 1 to Rows.getCount() For ColIndex = 1 to Cols.getCount() CellName = Chr(64 + ColIndex) & RowIndex Cell = TE.getCellByName(CellName) CellEnum = Cell.createEnumeration Do While CellEnum.hasMoreElements CellElement = CellEnum.nextElement ' <-- MODIFY, check closed switches within cells If CellElement.supportsService("com.sun.star.text.Paragraph") Then CheckSwitchesInCell(CellElement) CheckParaID(CellElement) CheckParaFormat(CellElement) CheckTagsInCell(CellElement) CheckInlineTags(CellElement) EndIf Loop If sCellCaseType <> "" Then Terminate("Previous case ("+sCellCaseType+") not closed!",CellElement) End If If sCellSwitchType <> "" Then Terminate("Previous switch ("+sCellSwitchType+") not closed!",CellElement) End If If ubound(aCellTagsOpen()) > 0 Then Terminate("Element "+aCellTagsOpen(ubound(aCellTagsOpen()))+" not closed",CellElement) End If Next Next ERRHANDLE: If Err <> 0 Then msgbox "Error: "+chr(13)+ Error$,48,"D'oh!" End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK PARA ID ' checks a paragraph for an ID '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckParaID(TE As Object) If Left(TE.ParaStyleName,4) = "hlp_" AND Not(Left(TE.ParaStyleName,8) = "hlp_aux_") Then sText = TE.GetString If sText = "" Then If bWarnEmptyPara Then Warn("Empty Paragraph","Empty paragraphs should be avoided. Do not use empty paragraphs for formatting purpose.",TE) bWarnEmptyPara = FALSE End If Else TP = TE.createEnumeration Ct = 0 posID = 0 While TP.hasmoreElements Ct = Ct+1 TPE = TP.nextElement If TPE.TextPortionType="TextField" Then If TPE.TextField.TextFieldMaster.Name="ID" Then posID = Ct End If End If ' Lets cheat and allow empty strings before the ID -- otherwise we'll get ' a validation error if a paragraph starts at the top of a page after ' a page break (for whatever reason) If TPE.String = "" Then Ct = Ct-1 End If Wend If posID = 0 Then If bWarnParaNoID Then Warn("Paragraph has no id.","IDs will be assigned on save. You can also assign an ID using the Assign Paragraph ID menu item",TPE) bWarnParaNoID = FALSE InsertNewParaData Else oCur = TE.getText.createTextCursorByRange(TE) thiscomponent.getcurrentcontroller.select(oCur) InsertNewParaData End If ElseIf posID > 1 Then Terminate("Paragraph ID not at the start of the paragraph. The paragraph ID must be the first element of a paragraph. Move the ID to the beginning of the paragraph",TPE) End If End If End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK PARA FORMAT '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckParaFormat(TE As Object) sText = TE.GetString If Left(TE.ParaStyleName,4) <> "hlp_" AND sText <> "" Then ' just disregard empty paras in wrong formats Warn("Invalid paragraph format. Contents will be lost.",_ "Use only the paragraph styles starting with ""hlp_""."+_ " Paragraphs in other formats will be lost on export",TE) End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK SWITCHES '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckSwitches(TE As Object) If TE.ParaStyleName="hlp_aux_switch" Then ' we are a switch or case or default sText = TE.GetString ' get the switch contents If Left(sText,8) = "<SWITCH " Then ' an opening switch tag If sSwitchType = "" Then ' no other switch is open sSwitchType = Right(sText,Len(sText)-16) sSwitchType = Left(sSwitchType,InStr(sSwitchType,"""")-1) If (sSwitchType <> "sys" AND sSwitchType <> "appl" AND sSwitchType <> "distrib") Then Terminate("Unknown switch type """+sSwitchType+"""",TE) End If Else Terminate("Previous switch ("+sSwitchType+") not closed!",TE) End If End If ' OPENING SWITCH If Left(sText,8) = "</SWITCH" Then ' a closing switch tag If sSwitchType = "" Then ' there was no switch open Terminate("No switch open!",TE) Else If not(bCaseSet OR bDefaultSet) Then Terminate("Empty switch",TE) End If If sCaseType <> "" Then ' there is still a case open Terminate("Previous case ("+sCaseType+") not closed!",TE) End If sSwitchType = "" bDefaultSet = FALSE bCaseSet = FALSE End If End If ' CLOSING SWITCH If Left(sText,6) = "<CASE " Then ' an opening case tag If bDefaultSet Then Terminate("No case after default allowed.",TE) End If If sCaseType = "" Then sCaseType = Right(sText,Len(sText)-14) sCaseType = Left(sCaseType,InStr(sCaseType,"""")-1) bCaseSet = TRUE If sSwitchType = "" Then Terminate("Case without switch",TE) End If Else Terminate("Previous case ("+sCaseType+") not closed!",TE) End If End If ' OPENING CASE If Left(sText,6) = "</CASE" Then ' a closing case tag If sCaseType = "" Then Terminate("No case open!",TE) Else sCaseType = "" End If End If ' CLOSING CASE If Left(sText,8) = "<DEFAULT" Then ' an opening default tag If sCaseType = "" Then If (sDefaultType <> "" OR bDefaultSet) Then Terminate("Multiple default not allowed.",TE) Else sDefaultType = "DEFAULT" If sSwitchType = "" Then Terminate("Default without switch",TE) End If End If sDefaultType = "DEFAULT" bDefaultSet = TRUE Else Terminate("Previous case ("+sCaseType+") not closed!",TE) End If End If ' OPENING CASE If Left(sText,9) = "</DEFAULT" Then ' a closing default tag If sDefaultType <> "DEFAULT" Then Terminate("No default open!",TE) Else sDefaultType = "" End If End If ' CLOSING CASE Else ' We are not hlp_aux_switch If (sSwitchType <> "" AND sCaseType = "" AND sDefaultType = "") Then Terminate("Nothing allowed between switch and case or default or /case or /default and /switch", TE) End If End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK SWITCHES IN A CELL '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckSwitchesInCell(CE As Object) If CE.ParaStyleName="hlp_aux_switch" Then ' we are a switch or case or default sText = CE.GetString ' get the switch contents If Left(sText,8) = "<SWITCH " Then ' an opening switch tag If sCellSwitchType = "" Then ' no other switch is open sCellSwitchType = Right(sText,Len(sText)-16) sCellSwitchType = Left(sCellSwitchType,InStr(sCellSwitchType,"""")-1) If (sCellSwitchType <> "sys" AND sCellSwitchType <> "appl" AND sCellSwitchType <> "distrib") Then Terminate("Unknown switch type """+sCellSwitchType+"""",CE) End If Else Terminate("Previous switch ("+sCellSwitchType+") not closed!",CE) End If End If ' OPENING SWITCH If Left(sText,8) = "</SWITCH" Then ' a closing switch tag If sCellSwitchType = "" Then ' there was no switch open Terminate("No switch open!",CE) Else If not(bCellCaseSet OR bCellDefaultSet) Then Terminate("Empty switch",CE) End If If sCellCaseType <> "" Then ' there is still a case open Terminate("Previous case ("+sCellCaseType+") not closed!",CE) End If sCellSwitchType = "" bCellDefaultSet = FALSE bCellCaseSet = FALSE End If End If ' CLOSING SWITCH If Left(sText,6) = "<CASE " Then ' an opening case tag If bCellDefaultSet Then Terminate("No case after default allowed.",CE) End If If sCellCaseType = "" Then sCellCaseType = Right(sText,Len(sText)-14) sCellCaseType = Left(sCellCaseType,InStr(sCellCaseType,"""")-1) bCellCaseSet = TRUE If sCellSwitchType = "" Then Terminate("Case without switch",CE) End If Else Terminate("Previous case ("+sCellCaseType+") not closed!",CE) End If End If ' OPENING CASE If Left(sText,6) = "</CASE" Then ' a closing case tag If sCellCaseType = "" Then Terminate("No case open!",CE) Else sCellCaseType = "" End If End If ' CLOSING CASE If Left(sText,8) = "<DEFAULT" Then ' an opening default tag If sCellCaseType = "" Then If (sCellDefaultType <> "" OR bCellDefaultSet) Then Terminate("Multiple default not allowed.",CE) Else sCellDefaultType = "DEFAULT" If sCellSwitchType = "" Then Terminate("Default without switch",CE) End If End If sCellDefaultType = "DEFAULT" bCellDefaultSet = TRUE Else Terminate("Previous case ("+sCellCaseType+") not closed!",CE) End If End If ' OPENING CASE If Left(sText,9) = "</DEFAULT" Then ' a closing default tag If sCellDefaultType <> "DEFAULT" Then Terminate("No default open!",CE) Else sCellDefaultType = "" End If End If ' CLOSING CASE Else ' We are not hlp_aux_switch If (sCellSwitchType <> "" AND sCellCaseType = "" AND sCellDefaultType = "") Then Terminate("Nothing allowed between switch and case or default or /case or /default and /switch", CE) End If End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' TERMINATE VALIDATION WITH AN ERROR MESSAGE '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Terminate(sStr As String, TE As Object) oCur = TE.getText.createTextCursorByRange(TE) thiscomponent.getcurrentcontroller.select(oCur) msgbox sStr,48,"D'oh!" Stop End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' SHOW A WARNING '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Warn(sWarn As String, sSolv As String, Optional TE As Object) If bWarn Then BasicLibraries.LoadLibrary("HelpAuthoring") oDialog = LoadDialog("HelpAuthoring", "dlgWarn") oTxtWarn = oDialog.GetControl("txtWarning") oTxtWarn.Text = sWarn oTxtSolv = oDialog.GetControl("txtSolution") oTxtSolv.Text = sSolv If not(IsMissing(TE)) Then oCur = TE.getText.createTextCursorByRange(TE) thiscomponent.getcurrentcontroller.select(oCur) End If If oDialog.Execute() = 1 Then oCbWarn = oDialog.GetControl("cbWarn") If oCbWarn.State = 1 Then bWarn = FALSE End If Exit Sub Else Stop End If End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK DOCUMENT META DATA '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckMetaData(oDoc As Object) sTopicID = oDoc.DocumentInfo.GetUserFieldValue(1) If sTopicID <> AlphaNum(sTopicID) OR sTopicID="" Then sTopicID = "topic_"+CreateID ' create a topic id End If oDoc.DocumentInfo.SetUserFieldValue(1,sTopicID) sCreated = oDoc.DocumentInfo.GetUserFieldValue(2) sEdited = oDoc.DocumentInfo.GetUserFieldValue(3) sTitle = oDoc.DocumentInfo.Title If sTitle="" OR sTitle="<Set Topic Title>" Then Enum = document.Text.createEnumeration Do While Enum.hasMoreElements TextElement = Enum.nextElement If TextElement.supportsService("com.sun.star.text.Paragraph") Then If Left(TextElement.ParaStyleName,8)="hlp_head" Then Enum2 = TextElement.createEnumeration While Enum2.hasMoreElements TextPortion = Enum2.nextElement If Not(TextPortion.TextPortionType="TextField") Then strg = strg + TextPortion.String End If Wend document.DocumentInfo.Title = strg Exit Do End If End If Loop End If sIndex = oDoc.DocumentInfo.GetUserFieldValue(0) End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK IF HEADING EXISTS '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckHeading(oDoc As Object) End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK FOR CORRECT INLINE TAGS '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckInlineTags(TE As Object) If Left(TE.ParaStyleName,4)="hlp_" AND (Left(TE.ParaStyleName,8)<>"hlp_aux_" OR TE.ParaStyleName="hlp_aux_bookmark") Then Dim aTokens(0) As Object Dim aInlineTagsOpen(0) As String TP = TE.createEnumeration While TP.hasmoreElements sDim = ubound(aTokens())+1 ReDim Preserve aTokens(sDim) As Object aTokens(sDim) = TP.nextElement Wend For i=1 to ubound(aTokens()) Token = aTokens(i) If Token.supportsService("com.sun.star.text.TextField") Then sTag = Token.TextField.TextFieldMaster.Name If Right(sTag,1)="_" Then ' a tag starts sTagName = Left(sTag,Len(sTag)-1) ' check for forbidden tags in paragraphs sTagFormat = TagFormatIsCorrect(sTagName, TE.ParaStyleName) If sTagFormat <> "" Then Terminate(sTagName+" element has wrong paragraph style ("+TE.ParaStyleName+")."+chr(13)+"Must be "+sTagFormat,Token) End If sDim = ubound(aInlineTagsOpen())+1 Redim Preserve aInlineTagsOpen(sDim) as String aInlineTagsOpen(sDim)=sTagName ElseIf Left(sTag,1)="_" Then ' a tag ends, all other cases are empty tags sTagName = Right(sTag,Len(sTag)-1) ' check for forbidden tags in paragraphs sTagFormat = TagFormatIsCorrect(sTagName, TE.ParaStyleName) If sTagFormat <> "" Then Terminate(sTagName+" element has wrong paragraph style ("+TE.ParaStyleName+")."+chr(13)+"Must be "+sTagFormat,Token) End If If ubound(aInlineTagsOpen()) > 0 Then If aInlineTagsOpen(ubound(aInlineTagsOpen())) <> sTagName Then Terminate("Inline Element "+aInlineTagsOpen(ubound(aInlineTagsOpen()))+" not closed",Token) End If sDim = ubound(aInlineTagsOpen())-1 Else Terminate("No opening tag for "+sTagName,Token) End If Redim Preserve aInlineTagsOpen(sDim) as String Else ' empty tag sTagName = sTag sTagFormat = TagFormatIsCorrect(sTagName, TE.ParaStyleName) If sTagFormat <> "" Then Terminate(sTagName+" element has wrong paragraph style ("+TE.ParaStyleName+")."+chr(13)+"Must be "+sTagFormat,Token) End If EndIf ElseIf (i > 1) AND (Trim(Token.String) <> "") Then If aInlineTagsOpen(ubound(aInlineTagsOpen())) = "SWITCHINLINE" Then Terminate("No text allowed here.",Token) End If End If Next If ubound(aInlineTagsOpen()) > 0 Then Terminate("Inline Element "+aInlineTagsOpen(ubound(aInlineTagsOpen()))+" not closed",Token) End If End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK FOR CORRECT TAGS '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckTags(TE As Object) If (Left(TE.ParaStyleName,8) = "hlp_aux_" AND TE.ParaStyleName <> "hlp_aux_bookmark") Then TP = TE.createEnumeration While TP.hasmoreElements TPE = TP.nextElement If TPE.supportsService("com.sun.star.text.TextField") Then sTag = TPE.TextField.TextFieldMaster.Name If Right(sTag,1)="_" Then ' a tag starts sTagName = Left(sTag,Len(sTag)-1) sDim = ubound(aTagsOpen())+1 Redim Preserve aTagsOpen(sDim) as String aTagsOpen(sDim)=sTagName ElseIf Left(sTag,1)="_" Then ' a tag ends, all other cases are empty tags sTagName = Right(sTag,Len(sTag)-1) If ubound(aTagsOpen()) > 0 Then If aTagsOpen(ubound(aTagsOpen())) <> sTagName Then Terminate("No close tag for "+aTagsOpen(ubound(aTagsOpen())),TPE) Else sDim = ubound(aTagsOpen())-1 End If Else Terminate("No opening tag for "+sTagName,TPE) End If Redim Preserve aTagsOpen(sDim) as String Else ' empty tags EndIf End If Wend End If End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' CHECK FOR CORRECT TAGS IN A TABLE CELL '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckTagsInCell(CE As Object) If (Left(CE.ParaStyleName,8) = "hlp_aux_" AND CE.ParaStyleName <> "hlp_aux_bookmark") Then CP = CE.createEnumeration While CP.hasmoreElements CPE = CP.nextElement If CPE.supportsService("com.sun.star.text.TextField") Then sTag = CPE.TextField.TextFieldMaster.Name If Right(sTag,1)="_" Then ' a tag starts sTagName = Left(sTag,Len(sTag)-1) sDim = ubound(aCellTagsOpen())+1 Redim Preserve aCellTagsOpen(sDim) as String aCellTagsOpen(sDim)=sTagName ElseIf Left(sTag,1)="_" Then ' a tag ends, all other cases are empty tags sTagName = Right(sTag,Len(sTag)-1) If ubound(aCellTagsOpen()) > 0 Then If aCellTagsOpen(ubound(aCellTagsOpen())) <> sTagName Then Terminate("No close tag for "+aCellTagsOpen(ubound(aCellTagsOpen())),CPE) Else sDim = ubound(aCellTagsOpen())-1 End If Else Terminate("No opening tag for "+sTagName,CPE) End If Redim Preserve aCellTagsOpen(sDim) as String EndIf End If Wend End If End Sub </script:module>