it-inspiration ls.doc doc. centre
C1256FD7005BC975
iti\lsdoc.nsf
85BD16000E55B4C5C1257064002640CC
16e2
21-08-2005 08:57:49
19-10-2005 14:18:22
CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration
12
19-10-2005 14:18:22
19-10-2005 14:18:22
21-08-2005 09:17:40
CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration
false
false
false
false
false
false
1 Then
'there is an alias
items(count) = Strleft(de.GetItemValue("$TITLE")(0), "|")
Else
'no alias
items(count) = de.GetItemValue("$TITLE")(0)
End If
count = count + 1
End Forall
End If
'store in item on document
Call doc.ReplaceItemValue("tmpViewNames", items)
End If
'get agents if flag has been toggled
If doc.IncludeAgents(0) = "1" Then
'get item
Redim items(0)
count = 0
'get agents
Dim i As Integer
v = dbdesign.AgentDocuments
If Not Isempty(v) Then
Forall de In v
'make sure this is a LotusScript agent ($AssistType = 65413)
If Cstr(de.GetItemValue("$AssistType")(0)) <> "" Then
If Clng(de.GetItemValue("$AssistType")(0)) = LOTUSSCRIPT_AGENT Then
Redim Preserve items(count)
items(count) = de.GetItemValue("$TITLE")(0)
count = count + 1
End If
End If
End Forall
End If
'store in item on document
Call doc.ReplaceItemValue("tmpAgentNames", items)
End If
'get script libs. if flag has been toggled
If doc.IncludeScriptLibraries(0) = "1" Then
'get item
Redim items(0)
count = 0
'get script libs
v = dbdesign.ScriptLibraryDocuments
If Not Isempty(v) Then
Forall de In v
'see if the document is a LotusScript script library
If Not de.HasItem("$FILE") And Not de.HasItem("$JavaScriptLibrary") Then
Redim Preserve items(count)
items(count) = de.GetItemValue("$TITLE")(0)
count = count + 1
End If
End Forall
End If
'store in item on document
Call doc.ReplaceItemValue("tmpScriptLibraryNames", items)
End If
'get web services if flag has been toggled
If doc.IncludeWebservices(0) = "1" Then
'get item
Redim items(0)
count = 0
'get script libs
v = dbdesign.WebServiceDocuments
If Not Isempty(v) Then
Forall de In v
'see if the document is a LotusScript web service
If de.GetItemValue("$AssistType")(0) = LOTUSSCRIPT_WEBSERVICE Then
Redim Preserve items(count)
items(count) = de.GetItemValue("$TITLE")(0)
count = count + 1
End If
End Forall
End If
'store in item on document
Call doc.ReplaceItemValue("tmpWebserviceNames", items)
End If
'get pages if flag has been toggled
If doc.IncludePages(0) = "1" Then
'get item
Redim items(0)
count = 0
'get script libs
v = dbdesign.PageDocuments
If Not Isempty(v) Then
Forall de In v
Redim Preserve items(count)
items(count) = de.GetItemValue("$TITLE")(0)
count = count + 1
End Forall
End If
'store in item on document
Call doc.ReplaceItemValue("tmpPageNames", items)
End If
End Sub]]>
false
false
false
false
false
false
1 Then
'the class has a parent class
Me.pParentClazzName = Mid$(source_line, index_as + 4)
End If
'get the class name
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
'public class
If index_as > 1 Then
Me.pName = Mid$(source_line, 14, index_as-14)
Else
Me.pName = Mid$(source_line, 14)
End If
Case Is = PRIVATE_MODIFIER
'private class
If index_as > 1 Then
Me.pName = Mid$(source_line, 15, index_as-15)
Else
Me.pName = Mid$(source_line, 15)
End If
Case Else
'friendly class
If index_as > 1 Then
Me.pName = Mid$(source_line, 7, index_as-7)
Else
Me.pName = Mid$(source_line, 7)
End If
End Select
End Sub
'/**
' * Adds a method to the class.
' *
' * @param The method to add (may not be Nothing)
' */
Public Sub AddMethod(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a method
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTMETHOD" Then
Error 9999, "Unable to add method to class since it is Nothing or not a method"
Else
Call Me.pMethods.AddElement(se)
End If
End Sub
'/**
' * Returns the methods (if any) added to this class.
' *
' * @return Vector of methods (never Nothing).
' */
Public Function GetMethods() As Vector
Set GetMethods = Me.pMethods
End Function
'/**
' * Adds a function to the class.
' *
' * @param The function to add (may not be Nothing)
' */
Public Sub AddFunction(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a function
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTFUNCTION" Then
Error 9999, "Unable to add method to class since it is Nothing or not a function"
Else
Call Me.pFunctions.AddElement(se)
End If
End Sub
'/**
' * Returns the functions (if any) added to this class.
' *
' * @return Vector of functions (never Nothing).
' */
Public Function GetFunctions() As Vector
Set GetFunctions = Me.pFunctions
End Function
'/**
' * Adds a property to the class.
' *
' * @param The property to add (may not be Nothing)
' */
Public Sub AddProperty(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a property
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTPROPERTY" Then
Error 9999, "Unable to add method to class since it is Nothing or not a property"
Else
Call Me.pProperties.AddElement(se)
End If
End Sub
'/**
' * Returns the properties (if any) added to this class.
' *
' * @return Vector of properties (never Nothing).
' */
Public Function GetProperties() As Vector
Set GetProperties = Me.pProperties
End Function
Public Sub AddSubclass(clazz As LotusScriptClass)
Call Me.pSubclasses.AddElement(clazz)
End Sub
Public Function GetSubClasses() As Vector
Set GetSubClasses = Me.pSubclasses
End Function
'/**
' * Returns the parent class name if any.
' */
Public Property Get ParentClazzName As String
ParentClazzName = Me.pParentClazzName
End Property
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate that this is a class
buf = "[CLASS] ("
'add modifier
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
buf = buf + "PUBLIC) "
Case Is = PRIVATE_MODIFIER
buf = buf + "PRIVATE) "
Case Else
buf = buf + "FRIENDLY) "
End Select
'add the class name
If Me.pParentClazzName <> "" Then
buf = buf + Me.pName + " extends " + Me.pParentClazzName
Else
buf = buf + Me.pName
End If
'return
ToString = buf
End Function
End Class
Public Class LotusScriptMethod As ScriptElement
'declarations
Private pArguments As Vector
'/**
' * @see ScriptElement#New
' */
Public Sub New(source_line As String), ScriptElement(source_line)
'declarations
Dim index_sub As Integer
Dim index_paren As Integer
Dim index_paren_stop As Integer
Dim arguments As String
'initialize vector for arguments
Set Me.pArguments = New Vector()
'find parentesis
index_paren = Instr(1, source_line, "(")
'get the name of the method
If Me.pModifier = FRIENDLY_MODIFIER Then
'get name for friendly method
If index_paren = 0 Then
'no parentesis so no arguments
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
Me.pName = Mid$(source_line, 5)
Elseif Typename(Me) = "LOTUSSCRIPTFUNCTION" Then
Me.pName = Mid$(source_line, 10)
Else
Me.pName = Mid$(source_line, 14)
End If
Else
'get name from start of line to (
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
Me.pName = Mid$(source_line, 5, index_paren - 5)
Elseif Typename(Me) = "LOTUSSCRIPTFUNCTION" Then
Me.pName = Mid$(source_line, 10, index_paren - 10)
Else
Me.pName = Mid$(source_line, 14, index_paren - 14)
End If
End If
Else
'find the method in private or public method
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
index_sub = Instr(1, source_line, " Sub ")
Elseif Typename(Me) = "LOTUSSCRIPTFUNCTION" Then
index_sub = Instr(1, source_line, " Function ")
Else
index_sub = Instr(1, source_line, " Property ")
End If
'get name
If index_paren = 0 Then
'no parentesis so no arguments
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
Me.pName = Mid$(source_line, index_sub + 5)
Elseif Typename(Me) = "LOTUSSCRIPTFUNCTION" Then
Me.pName = Mid$(source_line, index_sub + 10)
Else
Me.pName = Mid$(source_line, index_sub + 14)
End If
Else
'get name from start of line to (
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
Me.pName = Mid$(source_line, index_sub + 5, index_paren - index_sub - 5)
Elseif Typename(Me) = "LOTUSSCRIPTFUNCTION" Then
Me.pName = Mid$(source_line, index_sub + 10, index_paren - index_sub - 10)
Else
Me.pName = Mid$(source_line, index_sub + 14, index_paren - index_sub - 14)
End If
End If
End If
'trim the name to avoid trailing space
Me.pName = Fulltrim(Me.pName)
'if there is a parentesis there might be arguments
If index_paren > 0 Then
'there might be arguments (user may have spaces in between
'the parentesis' so we need to test). We need to use the
'StrLeftBack method to extract a substring to work on first
'since the arguments may have parentesis'.
arguments = Strright(Strleftback(source_line, ")"), "(")
If Len(Trim(arguments)) = 0 Then
'no arguments
Exit Sub
End If
'if the name is "New" (a constructor) then the method may call the
'parent class constructor so we need to handle this explicitly
If Left(Me.pName, 3) = "New" Then
'this is a constructor - look for the first unmatched
'right parentesis (")")
Dim start_paren As Boolean
Dim i As Integer
For i=1 To Len(arguments)
Select Case Mid$(arguments, i, 1)
Case Is = "("
'starting paren
start_paren = True
Case Is = ")"
If start_paren Then
'this closing started paren
start_paren = False
Else
'this is the unmatched paren
arguments = Mid$(arguments, 1, i-1)
Exit For
End If
End Select
Next
End If
'split the arguments into tokens
Dim arg_array As Variant
arg_array = Split(arguments, ",")
Forall str_arg In arg_array
'create argument object
Dim arg As New Argument(str_arg)
'add to arguments
Call Me.pArguments.AddElement(arg)
End Forall
End If
'user may have a return type (for functions) without any parentesis'
index_paren = Instr(1, Me.pName, " ")
If index_paren > 0 Then
Me.pName = Strleft(Me.pName, " ")
End If
'make sure the constructor / destructor if propercases
If Lcase(Me.pName) = "new" Then
Me.pName = "New"
Elseif Lcase(Me.pName) = "delete" Then
Me.pName = "Delete"
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is (method/function)
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
buf = "[SUB] ("
Else
buf = "[FUNCTION] ("
End If
'add modifier
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
buf = buf + "PUBLIC) "
Case Is = PRIVATE_MODIFIER
buf = buf + "PRIVATE) "
Case Else
buf = buf + "FRIENDLY) "
End Select
'add the method name
buf = buf + Me.pName
'are there any arguments
If Me.pArguments.Size() > 0 Then
'start arguments
buf = buf + "("
'get enumerator
Dim enum As Enumeration
Dim arg As Argument
Dim arg_string As String
Set enum = Me.pArguments.Elements
While enum.HasMoreElements
Set arg = enum.NextElement
If arg_string = "" Then
arg_string = arg.ArgumentName + " As " + arg.ArgumentDatatype
Else
arg_string = arg_string + ", " + arg.ArgumentName + " As " + arg.ArgumentDatatype
End If
Wend
'stop arguments
buf = buf + arg_string + ")"
End If
'return
ToString = buf
End Function
'/**
' * Returns a Vector of arguments if any.
' */
Public Function GetArguments() As Vector
Set GetArguments = Me.pArguments
End Function
End Class
Public Class LotusScriptFunction As LotusScriptMethod
'declarations
Private pReturnValue As String
'/**
' * @see ScriptElement#New
' */
Public Sub New(source_line As String), LotusScriptMethod(source_line)
'declarations
Dim index As Integer
'look for an ending parentesis
index = Instr(1, source_line, ")")
'was there a parentesis
If index = 0 Then
'no parentesis
index = Instr(1, source_line, " As ")
If index = 0 Then
'return type is Variant
Me.pReturnValue = "Variant"
Exit Sub
Else
'user has something like "MyFunction As MyDataType" - get datatype
Me.pReturnValue = Strrightback(source_line, " As ")
Exit Sub
End If
End If
'is parentesis the last character on the line
If Right(source_line, 1) = ")" Then
'no return value specified
Me.pReturnValue = "Variant"
Else
'get return value
Me.pReturnValue = Strrightback(source_line, " As ")
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'call super
buf = LotusScriptMethod..ToString()
'add return value
buf = buf + " returns " + Me.pReturnValue
'return
ToString = buf
End Function
'/**
' * Returns the return datatype.
' */
Public Property Get ReturnValue As String
ReturnValue = Me.pReturnValue
End Property
End Class
Public Class LotusScriptProperty As LotusScriptFunction
'declarations
Private pTypeWrite As Boolean 'True indicates setter and False indicate getter
'/**
' * @see ScriptElement#New
' */
Public Sub New(source_line As String), LotusScriptFunction(source_line)
'get type
If Instr(1, source_line, " Set ") Then
Me.pTypeWrite = True
Else
Me.pTypeWrite = False
'if there is no return value set to Variant
If Me.pReturnValue = "" Then
Me.pReturnValue = "Variant"
End If
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is
buf = "[PROPERTY] ("
'add modifier
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
buf = buf + "PUBLIC "
Case Is = PRIVATE_MODIFIER
buf = buf + "PRIVATE "
Case Else
buf = buf + "FRIENDLY "
End Select
'add type
If Me.pTypeWrite Then
'this is a setter
buf = buf + " SETTER) "
Else
'this is a getter
buf = buf + " GETTER) "
End If
'add the method name
buf = buf + Me.pName
'add datatype
buf = buf + " As " + Me.pReturnValue
'return
ToString = buf
End Function
'/**
' * Returns the datatype of the property as a String.
' */
Public Property Get PropertyDatatype As String
PropertyDatatype = Me.pReturnValue
End Property
'/**
' * Returns a flag indicating if the property is read (get) or
' * write (set). True is a setter.
' */
Public Property Get PropertyWrite As Boolean
PropertyWrite = Me.pTypeWrite
End Property
End Class
Public Class LotusScriptConst As ScriptElement
'declarations
Private pDatatype As String
Private pReturnValue As String
'/**
' * @see ScriptElement#New
' */
Public Sub New(source_line As String), ScriptElement(source_line)
'declarations
Dim index_const As Integer
Dim index_equal As Integer
Dim index_space As Integer
Dim index_comment As Integer
Dim const_type As String
'if the modifier is friendly we toggle it to private
'since no modifier for a const means private
If Me.pModifier = FRIENDLY_MODIFIER Then
Me.pModifier = PRIVATE_MODIFIER
End If
'find const keyword and equal sign
index_const = Instr(1, source_line, "Const ")
index_equal = Instr(1, source_line, "=")
'get the name of the constant
Me.pName = Mid$(source_line, index_const + 6, index_equal - index_const - 6)
'replace spaces and tabs
Dim replace_chars(1) As String
replace_chars(0) = " "
replace_chars(1) = Chr(9)
Me.pName = Replace(Me.pName, replace_chars, "")
'the name might end in a space
If Right(Me.pName, 1) = " " Then
'remove it
Me.pName = Mid(Me.pName, 1, Len(Me.pName)-1)
End If
'is there a datatype of the constant
const_type = Right(Me.pName, 1)
Select Case const_type
Case Is = "%"
Me.pDatatype = "Integer"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Is = "&"
Me.pDatatype = "Long"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Is = "!"
Me.pDatatype = "Single"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Is = "#"
Me.pDatatype = "Double"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Is = "@"
Me.pDatatype = "Currency"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Is = "$"
Me.pDatatype = "String"
'remove identifier
Me.pName = Mid$(Me.pName, 1, Len(Me.pName)-1)
Case Else
'default to variant
Me.pDatatype = "Variant"
End Select
'get the return value of the constant
index_space = Instr(index_equal + 2, source_line, " ")
index_comment = Instr(index_equal + 2, source_line, "'")
If index_space >=1 And index_space < index_comment Then
'there is a space at the end - probably a comment
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_space - index_equal - 1)
Elseif index_comment >=1 Then
'there is a comment ping at the end
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_comment - index_equal - 2)
Else
'no space
Me.pReturnValue = Mid$(source_line, index_equal + 1)
End If
'remove any leading space there might be
If Left(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 2)
End If
'remove any trailing space there might be
If Right(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 1, Len(Me.pReturnValue) - 1)
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is
buf = "[CONST] ("
'add modifier
If Me.pModifier = PUBLIC_MODIFIER Then
buf = buf + "PUBLIC) "
Else
buf = buf + "PRIVATE) "
End If
'add the const name
buf = buf + Me.pName
'add datatype
buf = buf + " As " + Me.pDatatype
'add return value
buf = buf + " = " + Me.pReturnValue
'return
ToString = buf
End Function
'/**
' * Returns the datatype of the constant.
' */
Public Property Get ConstDatatype As String
ConstDatatype = Me.pDatatype
End Property
'/**
' * Returns the return value of the constant.
' */
Public Property Get ConstReturnValue As String
ConstReturnValue = Me.pReturnValue
End Property
End Class
Public Class LotusScriptType As ScriptElement
'declarations
Private pMembers As Vector
'/**
' * Constructor.
' */
Public Sub New(source_line As String), ScriptElement(source_line)
'initialize vector to member variables
Set Me.pMembers = New Vector()
'if the modifier is friendly we toggle it to private
'since no modifier for a type means private
If Me.pModifier = FRIENDLY_MODIFIER Then
Me.pModifier = PRIVATE_MODIFIER
End If
'get the name of the type
Me.pName = Strrightback(source_line, " ")
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is
buf = "[TYPE] ("
'add modifier
If Me.pModifier = PUBLIC_MODIFIER Then
buf = buf + "PUBLIC) "
Else
buf = buf + "PRIVATE) "
End If
'add the type name
buf = buf + Me.pName
'return
ToString = buf
End Function
'/**
' * Adds an argument (member to the type).
' *
' * @param member The member to add
' */
Public Sub AddMember(member As Argument)
Call Me.pMembers.AddElement(member)
End Sub
'/**
' * Returns the members of the type.
' *
' * @returns A Vector of Argument objects.
' * @see Argument
' * @see Vector
' */
Public Function GetMembers() As Vector
Set GetMembers = Me.pMembers
End Function
End Class
Private Sub lsdoc_description
%REM
This script library holds classes to describe the different parts of LotusScript (subs, functions, classes etc.).
%END REM
End Sub]]>
1 Then
'the class has a parent class
Me.pParentClazzName = Mid$(source_line, index_as + 4)
End If
'get the class name
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
'public class
If index_as > 1 Then
Me.pName = Mid$(source_line, 14, index_as-14)
Else
Me.pName = Mid$(source_line, 14)
End If
Case Is = PRIVATE_MODIFIER
'private class
If index_as > 1 Then
Me.pName = Mid$(source_line, 15, index_as-15)
Else
Me.pName = Mid$(source_line, 15)
End If
Case Else
'friendly class
If index_as > 1 Then
Me.pName = Mid$(source_line, 7, index_as-7)
Else
Me.pName = Mid$(source_line, 7)
End If
End Select
End Sub
'/**
' * Adds a method to the class.
' *
' * @param The method to add (may not be Nothing)
' */
Public Sub AddMethod(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a method
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTMETHOD" Then
Error 9999, "Unable to add method to class since it is Nothing or not a method"
Else
Call Me.pMethods.AddElement(se)
End If
End Sub
'/**
' * Returns the methods (if any) added to this class.
' *
' * @return Vector of methods (never Nothing).
' */
Public Function GetMethods() As Vector
Set GetMethods = Me.pMethods
End Function
'/**
' * Adds a function to the class.
' *
' * @param The function to add (may not be Nothing)
' */
Public Sub AddFunction(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a function
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTFUNCTION" Then
Error 9999, "Unable to add method to class since it is Nothing or not a function"
Else
Call Me.pFunctions.AddElement(se)
End If
End Sub
'/**
' * Returns the functions (if any) added to this class.
' *
' * @return Vector of functions (never Nothing).
' */
Public Function GetFunctions() As Vector
Set GetFunctions = Me.pFunctions
End Function
'/**
' * Adds a property to the class.
' *
' * @param The property to add (may not be Nothing)
' */
Public Sub AddProperty(se As ScriptElement)
'make sure the passed script element isn't Nothing and
'that indeed is a property
If se Is Nothing Or Typename(se) <> "LOTUSSCRIPTPROPERTY" Then
Error 9999, "Unable to add method to class since it is Nothing or not a property"
Else
Call Me.pProperties.AddElement(se)
End If
End Sub
'/**
' * Returns the properties (if any) added to this class.
' *
' * @return Vector of properties (never Nothing).
' */
Public Function GetProperties() As Vector
Set GetProperties = Me.pProperties
End Function
Public Sub AddSubclass(clazz As LotusScriptClass)
Call Me.pSubclasses.AddElement(clazz)
End Sub
Public Function GetSubClasses() As Vector
Set GetSubClasses = Me.pSubclasses
End Function
'/**
' * Returns the parent class name if any.
' */
Public Property Get ParentClazzName As String
ParentClazzName = Me.pParentClazzName
End Property
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate that this is a class
buf = "[CLASS] ("
'add modifier
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
buf = buf + "PUBLIC) "
Case Is = PRIVATE_MODIFIER
buf = buf + "PRIVATE) "
Case Else
buf = buf + "FRIENDLY) "
End Select
'add the class name
If Me.pParentClazzName <> "" Then
buf = buf + Me.pName + " extends " + Me.pParentClazzName
Else
buf = buf + Me.pName
End If
'return
ToString = buf
End Function
End Class]]>
false
false
1 Then
'the class has a parent class
Me.pParentClazzName = Mid$(source_line, index_as + 4)
End If
'get the class name
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
'public class
If index_as > 1 Then
Me.pName = Mid$(source_line, 14, index_as-14)
Else
Me.pName = Mid$(source_line, 14)
End If
Case Is = PRIVATE_MODIFIER
'private class
If index_as > 1 Then
Me.pName = Mid$(source_line, 15, index_as-15)
Else
Me.pName = Mid$(source_line, 15)
End If
Case Else
'friendly class
If index_as > 1 Then
Me.pName = Mid$(source_line, 7, index_as-7)
Else
Me.pName = Mid$(source_line, 7)
End If
End Select
End Sub]]>
false
false
false
"LOTUSSCRIPTMETHOD" Then
Error 9999, "Unable to add method to class since it is Nothing or not a method"
Else
Call Me.pMethods.AddElement(se)
End If
End Sub]]>
"LOTUSSCRIPTFUNCTION" Then
Error 9999, "Unable to add method to class since it is Nothing or not a function"
Else
Call Me.pFunctions.AddElement(se)
End If
End Sub]]>
"LOTUSSCRIPTPROPERTY" Then
Error 9999, "Unable to add method to class since it is Nothing or not a property"
Else
Call Me.pProperties.AddElement(se)
End If
End Sub]]>
"" Then
buf = buf + Me.pName + " extends " + Me.pParentClazzName
Else
buf = buf + Me.pName
End If
'return
ToString = buf
End Function]]>
ScriptElement
ScriptElement
LotusScriptMethod
0 Then
'there might be arguments (user may have spaces in between
'the parentesis' so we need to test). We need to use the
'StrLeftBack method to extract a substring to work on first
'since the arguments may have parentesis'.
arguments = Strright(Strleftback(source_line, ")"), "(")
If Len(Trim(arguments)) = 0 Then
'no arguments
Exit Sub
End If
'if the name is "New" (a constructor) then the method may call the
'parent class constructor so we need to handle this explicitly
If Left(Me.pName, 3) = "New" Then
'this is a constructor - look for the first unmatched
'right parentesis (")")
Dim start_paren As Boolean
Dim i As Integer
For i=1 To Len(arguments)
Select Case Mid$(arguments, i, 1)
Case Is = "("
'starting paren
start_paren = True
Case Is = ")"
If start_paren Then
'this closing started paren
start_paren = False
Else
'this is the unmatched paren
arguments = Mid$(arguments, 1, i-1)
Exit For
End If
End Select
Next
End If
'split the arguments into tokens
Dim arg_array As Variant
arg_array = Split(arguments, ",")
Forall str_arg In arg_array
'create argument object
Dim arg As New Argument(str_arg)
'add to arguments
Call Me.pArguments.AddElement(arg)
End Forall
End If
'user may have a return type (for functions) without any parentesis'
index_paren = Instr(1, Me.pName, " ")
If index_paren > 0 Then
Me.pName = Strleft(Me.pName, " ")
End If
'make sure the constructor / destructor if propercases
If Lcase(Me.pName) = "new" Then
Me.pName = "New"
Elseif Lcase(Me.pName) = "delete" Then
Me.pName = "Delete"
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is (method/function)
If Typename(Me) = "LOTUSSCRIPTMETHOD" Then
buf = "[SUB] ("
Else
buf = "[FUNCTION] ("
End If
'add modifier
Select Case Me.pModifier
Case Is = PUBLIC_MODIFIER
buf = buf + "PUBLIC) "
Case Is = PRIVATE_MODIFIER
buf = buf + "PRIVATE) "
Case Else
buf = buf + "FRIENDLY) "
End Select
'add the method name
buf = buf + Me.pName
'are there any arguments
If Me.pArguments.Size() > 0 Then
'start arguments
buf = buf + "("
'get enumerator
Dim enum As Enumeration
Dim arg As Argument
Dim arg_string As String
Set enum = Me.pArguments.Elements
While enum.HasMoreElements
Set arg = enum.NextElement
If arg_string = "" Then
arg_string = arg.ArgumentName + " As " + arg.ArgumentDatatype
Else
arg_string = arg_string + ", " + arg.ArgumentName + " As " + arg.ArgumentDatatype
End If
Wend
'stop arguments
buf = buf + arg_string + ")"
End If
'return
ToString = buf
End Function
'/**
' * Returns a Vector of arguments if any.
' */
Public Function GetArguments() As Vector
Set GetArguments = Me.pArguments
End Function
End Class]]>
false
false
0 Then
'there might be arguments (user may have spaces in between
'the parentesis' so we need to test). We need to use the
'StrLeftBack method to extract a substring to work on first
'since the arguments may have parentesis'.
arguments = Strright(Strleftback(source_line, ")"), "(")
If Len(Trim(arguments)) = 0 Then
'no arguments
Exit Sub
End If
'if the name is "New" (a constructor) then the method may call the
'parent class constructor so we need to handle this explicitly
If Left(Me.pName, 3) = "New" Then
'this is a constructor - look for the first unmatched
'right parentesis (")")
Dim start_paren As Boolean
Dim i As Integer
For i=1 To Len(arguments)
Select Case Mid$(arguments, i, 1)
Case Is = "("
'starting paren
start_paren = True
Case Is = ")"
If start_paren Then
'this closing started paren
start_paren = False
Else
'this is the unmatched paren
arguments = Mid$(arguments, 1, i-1)
Exit For
End If
End Select
Next
End If
'split the arguments into tokens
Dim arg_array As Variant
arg_array = Split(arguments, ",")
Forall str_arg In arg_array
'create argument object
Dim arg As New Argument(str_arg)
'add to arguments
Call Me.pArguments.AddElement(arg)
End Forall
End If
'user may have a return type (for functions) without any parentesis'
index_paren = Instr(1, Me.pName, " ")
If index_paren > 0 Then
Me.pName = Strleft(Me.pName, " ")
End If
'make sure the constructor / destructor if propercases
If Lcase(Me.pName) = "new" Then
Me.pName = "New"
Elseif Lcase(Me.pName) = "delete" Then
Me.pName = "Delete"
End If
End Sub]]>
0 Then
'start arguments
buf = buf + "("
'get enumerator
Dim enum As Enumeration
Dim arg As Argument
Dim arg_string As String
Set enum = Me.pArguments.Elements
While enum.HasMoreElements
Set arg = enum.NextElement
If arg_string = "" Then
arg_string = arg.ArgumentName + " As " + arg.ArgumentDatatype
Else
arg_string = arg_string + ", " + arg.ArgumentName + " As " + arg.ArgumentDatatype
End If
Wend
'stop arguments
buf = buf + arg_string + ")"
End If
'return
ToString = buf
End Function]]>
=1 And index_space < index_comment Then
'there is a space at the end - probably a comment
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_space - index_equal - 1)
Elseif index_comment >=1 Then
'there is a comment ping at the end
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_comment - index_equal - 2)
Else
'no space
Me.pReturnValue = Mid$(source_line, index_equal + 1)
End If
'remove any leading space there might be
If Left(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 2)
End If
'remove any trailing space there might be
If Right(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 1, Len(Me.pReturnValue) - 1)
End If
End Sub
'/**
' * @see ScriptElement#ToString
' */
Public Function ToString() As String
'declarations
Dim buf As String
'indicate what this is
buf = "[CONST] ("
'add modifier
If Me.pModifier = PUBLIC_MODIFIER Then
buf = buf + "PUBLIC) "
Else
buf = buf + "PRIVATE) "
End If
'add the const name
buf = buf + Me.pName
'add datatype
buf = buf + " As " + Me.pDatatype
'add return value
buf = buf + " = " + Me.pReturnValue
'return
ToString = buf
End Function
'/**
' * Returns the datatype of the constant.
' */
Public Property Get ConstDatatype As String
ConstDatatype = Me.pDatatype
End Property
'/**
' * Returns the return value of the constant.
' */
Public Property Get ConstReturnValue As String
ConstReturnValue = Me.pReturnValue
End Property
End Class]]>
false
false
=1 And index_space < index_comment Then
'there is a space at the end - probably a comment
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_space - index_equal - 1)
Elseif index_comment >=1 Then
'there is a comment ping at the end
Me.pReturnValue = Mid$(source_line, index_equal + 2, index_comment - index_equal - 2)
Else
'no space
Me.pReturnValue = Mid$(source_line, index_equal + 1)
End If
'remove any leading space there might be
If Left(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 2)
End If
'remove any trailing space there might be
If Right(Me.pReturnValue, 1) = " " Then
Me.pReturnValue = Mid$(Me.pReturnValue, 1, Len(Me.pReturnValue) - 1)
End If
End Sub]]>
2 Then
For i = 0 To items - 2
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
tmp = tmp & ", "
Set node = node.getLink()
Next i
End If
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
toString = tmp
End Function
End Class
Public Class Stack
a As Variant
top As Integer
growth As Integer
Public Sub new()
' Creates a new empty Stack.
Redim a(10)
top = -1
growth = 2
End Sub
Public Function push(element As Variant) As Variant
' Adds an element on top of the stack and returns it.
If top > Ubound(a) Then Redim a(Ubound(a) * growth)
top = top + 1
If Isobject(element) Then
Set Me.a(top) = element
Set Me.push = element
Else
Me.a(top) = element
Me.push = element
End If
End Function
Public Function pop() As Variant
' Returns the element on top of the stack, and removes it from the stack.
' Returns an error if no elements is in the stack.
Set Me.pop = Nothing
If top = -1 Then Exit Function
Dim tmp As Variant
If Isobject(Me.peek()) Then
Set tmp = Me.peek()
Else
tmp = Me.peek()
End If
Set Me.a(top) = Nothing
top = top - 1
If Isobject(tmp) Then
Set Me.pop = tmp
Else
Me.pop = tmp
End If
End Function
Public Function peek() As Variant
' Returns the element on top of the stack without removing it.
' Returns an error if no elements is in the stack.
Set Me.peek = Nothing
If top = -1 Then Exit Function
If Isobject(Me.a(top)) Then
Set Me.peek = Me.a(top)
Else
Me.peek = Me.a(top)
End If
End Function
Public Function isEmpty() As Variant
' Returns true if the stack has no elements, false if not.
Me.isEmpty = (top = -1)
End Function
Public Function toArray() As Variant
' Returns an array representation of this Stack
Set Me.toArray = Nothing
If Me.top = -1 Then Exit Function
Dim tmp As Variant
Redim tmp(Me.top)
Dim i As Integer
For i = 0 To Me.top
If Isobject(Me.a(i)) Then
Set tmp(i) = a(i)
Else
tmp(i) = a(i)
End If
Next i
Me.toArray = tmp
End Function
Public Function toString() As String
' Returns a String representation of this Stack.
Dim tmp As String
tmp = ""
Dim i As Integer
For i = 0 To Me.top-1
If Isobject(a(i)) Then
tmp = tmp & a(i).toString()
Else
tmp = tmp & a(i)
End If
tmp = tmp & ", "
Next
If Isobject(a(top)) Then
tmp = tmp & a(top).toString()
Else
tmp = tmp & a(top)
End If
toString = tmp
End Function
End Class
Public Class Vector
array As Variant
elementLength As Integer
capacityIncrement As Integer
Public Sub new()
elementLength = 0
ensureCapacity(10)
End Sub
Public Sub copyInto(outArray As Variant)
Dim i As Integer
For i=Me.size()-1 To 0 Step -1
outArray(i) = array(i)
Next i
End Sub
Public Sub trimToSize()
If Me.size() < Me.capacity() Then Redim Preserve array(Me.size()-1)
End Sub
Public Sub setCapacityIncrement(increment As Integer)
Me.capacityIncrement = increment
End Sub
Public Sub ensureCapacity(minCapacity As Integer)
On Error Goto handleError
Dim newCapacity As Integer
If capacityIncrement > 0 Then
newCapacity = Me.capacity() + capacityIncrement
Else
newCapacity = Me.capacity() * 2
End If
If newCapacity < minCapacity Then newCapacity = minCapacity
If newCapacity > Me.size() Then
If newCapacity > Me.capacity Then
If size = 0 Then
Redim array(newCapacity)
Else
Redim Preserve array(newCapacity)
End If
End If
End If
handleExit:
Exit Sub
handleError:
Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
Resume handleExit
End Sub
Public Function setSize(newSize As Integer)
If newSize < Me.size() Then
Dim i As Integer
For i = newSize-1 To Me.size()-1
If Isobject(array(i)) Then
Set array(i) = Nothing
Else
array(i) = ""
End If
Next i
Elseif newSize > Me.size() Then
ensureCapacity(newSize)
End If
Me.elementLength = newSize
End Function
Public Function size() As Integer
size = elementLength
End Function
Public Function capacity() As Integer
Me.capacity = 0
If size = 0 Then Exit Function
Me.capacity = Ubound(array) - Lbound(array) + 1
End Function
Public Function isEmpty() As Variant
Me.isEmpty = (elementLength = 0)
End Function
Public Function elements() As Enumeration
Set elements = New VectorEnumeration(Me)
End Function
Public Function contains(element As Variant) As Variant
contains = False
If Not indexOf(element) = -1 Then contains = True
End Function
Public Function indexOf(element As Variant) As Integer
On Error Goto handleError
indexOf = -1
Dim i As Integer
For i = 0 To elementLength - 1
If equals(element, array(i)) Then
indexOf = i
Exit Function
End If
Next
handleExit:
Exit Function
handleError:
Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
Error Err, Error
Resume handleExit
End Function
Public Function lastIndexOf(element As Variant) As Integer
lastIndexOf = -1
Dim i As Integer
For i = Me.size()-1 To 0 Step -1
If equals(element, array(i)) Then
lastIndexOf = i
Exit Function
End If
Next
End Function
Private Function equals(element1 As Variant, element2 As Variant) As Integer
Me.equals = False
If Isobject(element1) And Not Isobject(element2) Then Exit Function
If Isobject(element1) Then
If element1 Is element2 Then equals = True
Else
If element1 = element2 Then equals = True
End If
End Function
Public Function elementAt(index As Integer) As Variant
If (index < 0) Or (index => Me.size()) Then Error 2000, "Array index out of bounds"
If Isobject(array(index)) Then
Set elementAt = array(index)
Else
elementAt = array(index)
End If
End Function
Public Function firstElement() As Variant
If Isobject(elementAt(0)) Then
Set firstElement = elementAt(0)
Else
firstElement = elementAt(0)
End If
End Function
Public Function lastElement() As Variant
If Isobject(elementAt(Me.size()-1)) Then
Set lastElement = elementAt(Me.size()-1)
Else
lastElement = elementAt(Me.size()-1)
End If
End Function
Public Function setElementAt(element As Variant, index As Integer)
If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
If Isobject(element) Then
Set array(index) = element
Else
array(index) = element
End If
End Function
Public Function removeElementAt(index As Integer)
If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
Dim members As Variant
Dim i As Integer
Dim j As Integer
Redim members(Me.size())
j=0
For i = 0 To Me.size-1
If (i <> index) And (Not j > Me.size()) Then
If Isobject(array(i)) Then
Set members(j) = array(i)
Else
members(j) = array(i)
End If
j = j + 1
End If
Next i
elementLength = elementLength - 1
array = members
End Function
Public Function insertElementAt(element As Variant, index As Integer)
Dim newSize As Integer
newSize = Me.size() + 1
If index >= newSize Then Error 2000, "Array index [" & index & "] out of bounds [" & newSize & "]"
If newSize > capacity Then ensureCapacity(newSize)
' Hmmm... Implement the insertion here. But how?
Dim target() As Variant
Redim target(0 To capacity) As Variant
Dim i As Integer
For i = 0 To newSize-1
If i = index Then
If Isobject(element) Then
Set target(i) = element
Else
target(i) = element
End If
Elseif i > index Then
target(i) = array(i-1)
Else
target(i) = array(i)
End If
Next i
array = target
elementLength = elementLength + 1
End Function
Public Sub addElement(element As Variant)
Dim newSize As Integer
newSize = Me.size() + 1
If newSize > capacity Then ensureCapacity(newSize)
If Isobject(element) Then
Set array(Me.size()) = element
Else
array(Me.size()) = element
End If
elementLength = elementLength + 1
End Sub
Public Sub addElements(elements As Variant)
' Adds all elements in the specified array or list
If Not Isarray(elements) And Not Islist(elements) Then
Call Me.addElement(elements)
Else
Forall x In elements
Call Me.addElement(x)
End Forall
End If
End Sub
Public Function removeElement(element As Variant) As Variant
removeElement = False
Dim i As Integer
i = indexOf(element)
If i >= 0 Then
removeElementAt(i)
removeElement = True
Exit Function
End If
End Function
Public Sub removeAllElements()
Dim i As Integer
For i = 0 To Me.size() - 1
If Isobject(array(i)) Then
Set array(i) = Nothing
Else
array(i) = ""
End If
Next i
'reset vector
elementLength = 0
ensureCapacity(10)
End Sub
Public Function implode(Byval separator As String) As String
' Creates a string of all elements in array, and the argument as separator.
Me.implode = ""
If Me.size <= 0 Then Exit Function
Dim i As Integer
Dim s As String
For i = 0 To Me.size-2
If Typename(Me.array(i)) = "STRING" Then
s = s & Me.array(i) & separator
Elseif Isobject(array(i)) Then
s = s & Me.array(i).toString() & separator
Else
s = s & Cstr(Me.array(i)) & separator
End If
Next
s = s & Me.array(size-1) ' Do not append the separator to the last element
Me.implode = s
End Function
Sub unique()
' Removes all duplicates in the internal array. Somewhat slow on really big arrays...
If Me.isEmpty() Then Exit Sub
Dim v As New Vector()
Dim i As Integer
For i = 0 To Me.size-1
If Not v.contains(Me.array(i)) Then Call v.addElement(Me.array(i))
Next i
Dim a As Variant
Redim a(v.size()-1)
Call v.copyInto(a)
Me.array = a
Me.elementLength = Ubound(array) - Lbound(array) + 1
Set v = Nothing
End Sub
Public Function toString() As String
toString = Me.implode(", ")
End Function
End Class
Public Class VectorEnumeration As Enumeration
v As Vector
index As Integer
Public Sub new(v As Vector)
Set Me.v = v
index = 0
End Sub
Public Function hasMoreElements() As Variant
hasMoreElements = (index < v.size())
End Function
Public Function nextElement() As Variant
If Isobject(v.elementAt(index)) Then
Set nextElement = v.elementAt(index)
Else
nextElement = v.elementAt(index)
End If
index = index + 1
End Function
End Class
Public Class SortedVector As Vector
'declarations
Private pAddedElements As Integer
'/**
' * Constructor.
' */
Public Sub New(), Vector()
Me.pAddedElements = -1
End Sub
'/**
' * Adds an element to the Vector sorting the elements after
' * the element has been added.
' *
' * @see Vector#AddElement
' */
Public Sub AddElement(element As Variant)
'call super
Call Vector..AddElement(element)
'increment counter
Me.pAddedElements = Me.pAddedElements + 1
'sort if more than one element
If Me.pAddedElements > 0 Then
Call Me.pSortElements()
End If
End Sub
'/**
' * Utility method to sorts the Vector elements using a
' * bubble sort.
' */
Private Sub pSortElements()
'declarations
Dim lower As Integer
Dim upper As Integer
Dim i As Integer
Dim k As Integer
Dim swapped As Integer
Dim tmp As Variant
Dim comp1 As String
Dim comp2 As String
lower% = Lbound(Me.array)
upper% = Ubound(Me.array)
For i% = 0 To Upper% - Lower%
swapped% = False
For k% = lower% To upper% - 1%
'make sure we do not go out of bounds
If k < (Me.pAddedElements) Then
'get values to compare
comp1 = Me.pGetCompare(Me.array(k%+1))
comp2 = Me.pGetCompare(Me.array(k%))
'compare to see if a swap is necessary
If comp1 < comp2 Then
'swap them
Set tmp = Me.array(k%+1)
Set Me.array(k%+1) = Me.array(k%)
Set Me.array(k%) = tmp
swapped% = True
End If
End If
Next
If Not swapped% Then Exit For
Next
End Sub
Private Function pGetCompare(v As Variant) As String
Dim types(15) As String
Dim str_typename As String
Dim i As Integer
types(0) = "Script"
types(1) = "ScriptLibrary"
types(2) = "IgnoringScript"
types(3) = "Form"
types(4) = "View"
types(5) = "Agent"
types(6) = "DatabaseScript"
types(7) = "SharedAction"
types(8) = "Page"
types(9) = "ScriptElement"
types(10) = "LotusScriptClass"
types(11) = "LotusScriptMethod"
types(12) = "LotusScriptFunction"
types(13) = "LotusScriptProperty"
types(14) = "LotusScriptConst"
types(15) = "LotusScriptType"
str_typename = Lcase(Typename(v))
For i=0 To Ubound(types)
If Lcase(types(i)) = str_typename Then
If i <= 8 Then
pGetCompare = v.ScriptName
Else
pGetCompare = v.ElementName
End If
End If
Next
End Function
End Class
Public Class TypeEnumerationWrapper As Enumeration
'declarations
Private pEnum As Enumeration
Private pTypename As String
Private pNextObj As Variant
'/**
' * Constructor.
' *
' * @param type_name The type name to look for
' * @param enum The Enumeration to wrap
' */
Public Sub New(type_name As String, enum As Enumeration)
Set Me.pEnum = enum
Me.pTypename = Ucase(type_name)
Set Me.pNextObj = Nothing
End Sub
'/**
' * @see Enumeration#HasMoreElements
' */
Public Function HasMoreElements() As Variant
'make sure the user can call the HasMoreElements
'function several times without side effects
If Not (Me.pNextObj Is Nothing) Then
HasMoreElements = True
Exit Function
End If
If Not Me.pEnum.HasMoreElements() Then
HasMoreElements = False
Exit Function
End If
'make sure we have a next element with the requested type
While Me.pEnum.HasMoreElements()
Set Me.pNextObj = Me.pEnum.NextElement()
If Typename(Me.pNextObj) = Me.pTypename Then
'we got a match
HasMoreElements = True
Exit Function
End If
Wend
'no more elements
Set Me.pNextObj = Nothing
HasMoreElements = False
End Function
'/**
' * @see Enumeration#NextElement
' */
Public Function NextElement() As Variant
Set NextElement = Me.pNextObj
Set Me.pNextObj = Nothing
End Function
End Class
Private Sub lsdoc_description()
%REM
Collection classes from http://dev.kanngard.net.
%END REM
End Sub]]>
2 Then
For i = 0 To items - 2
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
tmp = tmp & ", "
Set node = node.getLink()
Next i
End If
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
toString = tmp
End Function
End Class]]>
false
false
2 Then
For i = 0 To items - 2
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
tmp = tmp & ", "
Set node = node.getLink()
Next i
End If
If Isobject(node.getItem()) Then
tmp = tmp & node.getItem().toString()
Else
tmp = tmp & node.getItem()
End If
toString = tmp
End Function]]>
Ubound(a) Then Redim a(Ubound(a) * growth)
top = top + 1
If Isobject(element) Then
Set Me.a(top) = element
Set Me.push = element
Else
Me.a(top) = element
Me.push = element
End If
End Function
Public Function pop() As Variant
' Returns the element on top of the stack, and removes it from the stack.
' Returns an error if no elements is in the stack.
Set Me.pop = Nothing
If top = -1 Then Exit Function
Dim tmp As Variant
If Isobject(Me.peek()) Then
Set tmp = Me.peek()
Else
tmp = Me.peek()
End If
Set Me.a(top) = Nothing
top = top - 1
If Isobject(tmp) Then
Set Me.pop = tmp
Else
Me.pop = tmp
End If
End Function
Public Function peek() As Variant
' Returns the element on top of the stack without removing it.
' Returns an error if no elements is in the stack.
Set Me.peek = Nothing
If top = -1 Then Exit Function
If Isobject(Me.a(top)) Then
Set Me.peek = Me.a(top)
Else
Me.peek = Me.a(top)
End If
End Function
Public Function isEmpty() As Variant
' Returns true if the stack has no elements, false if not.
Me.isEmpty = (top = -1)
End Function
Public Function toArray() As Variant
' Returns an array representation of this Stack
Set Me.toArray = Nothing
If Me.top = -1 Then Exit Function
Dim tmp As Variant
Redim tmp(Me.top)
Dim i As Integer
For i = 0 To Me.top
If Isobject(Me.a(i)) Then
Set tmp(i) = a(i)
Else
tmp(i) = a(i)
End If
Next i
Me.toArray = tmp
End Function
Public Function toString() As String
' Returns a String representation of this Stack.
Dim tmp As String
tmp = ""
Dim i As Integer
For i = 0 To Me.top-1
If Isobject(a(i)) Then
tmp = tmp & a(i).toString()
Else
tmp = tmp & a(i)
End If
tmp = tmp & ", "
Next
If Isobject(a(top)) Then
tmp = tmp & a(top).toString()
Else
tmp = tmp & a(top)
End If
toString = tmp
End Function
End Class]]>
false
false
Ubound(a) Then Redim a(Ubound(a) * growth)
top = top + 1
If Isobject(element) Then
Set Me.a(top) = element
Set Me.push = element
Else
Me.a(top) = element
Me.push = element
End If
End Function]]>
0 Then
newCapacity = Me.capacity() + capacityIncrement
Else
newCapacity = Me.capacity() * 2
End If
If newCapacity < minCapacity Then newCapacity = minCapacity
If newCapacity > Me.size() Then
If newCapacity > Me.capacity Then
If size = 0 Then
Redim array(newCapacity)
Else
Redim Preserve array(newCapacity)
End If
End If
End If
handleExit:
Exit Sub
handleError:
Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
Resume handleExit
End Sub
Public Function setSize(newSize As Integer)
If newSize < Me.size() Then
Dim i As Integer
For i = newSize-1 To Me.size()-1
If Isobject(array(i)) Then
Set array(i) = Nothing
Else
array(i) = ""
End If
Next i
Elseif newSize > Me.size() Then
ensureCapacity(newSize)
End If
Me.elementLength = newSize
End Function
Public Function size() As Integer
size = elementLength
End Function
Public Function capacity() As Integer
Me.capacity = 0
If size = 0 Then Exit Function
Me.capacity = Ubound(array) - Lbound(array) + 1
End Function
Public Function isEmpty() As Variant
Me.isEmpty = (elementLength = 0)
End Function
Public Function elements() As Enumeration
Set elements = New VectorEnumeration(Me)
End Function
Public Function contains(element As Variant) As Variant
contains = False
If Not indexOf(element) = -1 Then contains = True
End Function
Public Function indexOf(element As Variant) As Integer
On Error Goto handleError
indexOf = -1
Dim i As Integer
For i = 0 To elementLength - 1
If equals(element, array(i)) Then
indexOf = i
Exit Function
End If
Next
handleExit:
Exit Function
handleError:
Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
Error Err, Error
Resume handleExit
End Function
Public Function lastIndexOf(element As Variant) As Integer
lastIndexOf = -1
Dim i As Integer
For i = Me.size()-1 To 0 Step -1
If equals(element, array(i)) Then
lastIndexOf = i
Exit Function
End If
Next
End Function
Private Function equals(element1 As Variant, element2 As Variant) As Integer
Me.equals = False
If Isobject(element1) And Not Isobject(element2) Then Exit Function
If Isobject(element1) Then
If element1 Is element2 Then equals = True
Else
If element1 = element2 Then equals = True
End If
End Function
Public Function elementAt(index As Integer) As Variant
If (index < 0) Or (index => Me.size()) Then Error 2000, "Array index out of bounds"
If Isobject(array(index)) Then
Set elementAt = array(index)
Else
elementAt = array(index)
End If
End Function
Public Function firstElement() As Variant
If Isobject(elementAt(0)) Then
Set firstElement = elementAt(0)
Else
firstElement = elementAt(0)
End If
End Function
Public Function lastElement() As Variant
If Isobject(elementAt(Me.size()-1)) Then
Set lastElement = elementAt(Me.size()-1)
Else
lastElement = elementAt(Me.size()-1)
End If
End Function
Public Function setElementAt(element As Variant, index As Integer)
If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
If Isobject(element) Then
Set array(index) = element
Else
array(index) = element
End If
End Function
Public Function removeElementAt(index As Integer)
If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
Dim members As Variant
Dim i As Integer
Dim j As Integer
Redim members(Me.size())
j=0
For i = 0 To Me.size-1
If (i <> index) And (Not j > Me.size()) Then
If Isobject(array(i)) Then
Set members(j) = array(i)
Else
members(j) = array(i)
End If
j = j + 1
End If
Next i
elementLength = elementLength - 1
array = members
End Function
Public Function insertElementAt(element As Variant, index As Integer)
Dim newSize As Integer
newSize = Me.size() + 1
If index >= newSize Then Error 2000, "Array index [" & index & "] out of bounds [" & newSize & "]"
If newSize > capacity Then ensureCapacity(newSize)
' Hmmm... Implement the insertion here. But how?
Dim target() As Variant
Redim target(0 To capacity) As Variant
Dim i As Integer
For i = 0 To newSize-1
If i = index Then
If Isobject(element) Then
Set target(i) = element
Else
target(i) = element
End If
Elseif i > index Then
target(i) = array(i-1)
Else
target(i) = array(i)
End If
Next i
array = target
elementLength = elementLength + 1
End Function
Public Sub addElement(element As Variant)
Dim newSize As Integer
newSize = Me.size() + 1
If newSize > capacity Then ensureCapacity(newSize)
If Isobject(element) Then
Set array(Me.size()) = element
Else
array(Me.size()) = element
End If
elementLength = elementLength + 1
End Sub
Public Sub addElements(elements As Variant)
' Adds all elements in the specified array or list
If Not Isarray(elements) And Not Islist(elements) Then
Call Me.addElement(elements)
Else
Forall x In elements
Call Me.addElement(x)
End Forall
End If
End Sub
Public Function removeElement(element As Variant) As Variant
removeElement = False
Dim i As Integer
i = indexOf(element)
If i >= 0 Then
removeElementAt(i)
removeElement = True
Exit Function
End If
End Function
Public Sub removeAllElements()
Dim i As Integer
For i = 0 To Me.size() - 1
If Isobject(array(i)) Then
Set array(i) = Nothing
Else
array(i) = ""
End If
Next i
'reset vector
elementLength = 0
ensureCapacity(10)
End Sub
Public Function implode(Byval separator As String) As String
' Creates a string of all elements in array, and the argument as separator.
Me.implode = ""
If Me.size <= 0 Then Exit Function
Dim i As Integer
Dim s As String
For i = 0 To Me.size-2
If Typename(Me.array(i)) = "STRING" Then
s = s & Me.array(i) & separator
Elseif Isobject(array(i)) Then
s = s & Me.array(i).toString() & separator
Else
s = s & Cstr(Me.array(i)) & separator
End If
Next
s = s & Me.array(size-1) ' Do not append the separator to the last element
Me.implode = s
End Function
Sub unique()
' Removes all duplicates in the internal array. Somewhat slow on really big arrays...
If Me.isEmpty() Then Exit Sub
Dim v As New Vector()
Dim i As Integer
For i = 0 To Me.size-1
If Not v.contains(Me.array(i)) Then Call v.addElement(Me.array(i))
Next i
Dim a As Variant
Redim a(v.size()-1)
Call v.copyInto(a)
Me.array = a
Me.elementLength = Ubound(array) - Lbound(array) + 1
Set v = Nothing
End Sub
Public Function toString() As String
toString = Me.implode(", ")
End Function
End Class]]>
false
false
0 Then
newCapacity = Me.capacity() + capacityIncrement
Else
newCapacity = Me.capacity() * 2
End If
If newCapacity < minCapacity Then newCapacity = minCapacity
If newCapacity > Me.size() Then
If newCapacity > Me.capacity Then
If size = 0 Then
Redim array(newCapacity)
Else
Redim Preserve array(newCapacity)
End If
End If
End If
handleExit:
Exit Sub
handleError:
Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
Resume handleExit
End Sub]]>
false
false
false
Me.size() Then
ensureCapacity(newSize)
End If
Me.elementLength = newSize
End Function]]>
Me.size()) Then Error 2000, "Array index out of bounds"
If Isobject(array(index)) Then
Set elementAt = array(index)
Else
elementAt = array(index)
End If
End Function]]>
= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
If Isobject(element) Then
Set array(index) = element
Else
array(index) = element
End If
End Function]]>
false
false
false
= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
Dim members As Variant
Dim i As Integer
Dim j As Integer
Redim members(Me.size())
j=0
For i = 0 To Me.size-1
If (i <> index) And (Not j > Me.size()) Then
If Isobject(array(i)) Then
Set members(j) = array(i)
Else
members(j) = array(i)
End If
j = j + 1
End If
Next i
elementLength = elementLength - 1
array = members
End Function]]>
false
false
false
false
false
false
= newSize Then Error 2000, "Array index [" & index & "] out of bounds [" & newSize & "]"
If newSize > capacity Then ensureCapacity(newSize)
' Hmmm... Implement the insertion here. But how?
Dim target() As Variant
Redim target(0 To capacity) As Variant
Dim i As Integer
For i = 0 To newSize-1
If i = index Then
If Isobject(element) Then
Set target(i) = element
Else
target(i) = element
End If
Elseif i > index Then
target(i) = array(i-1)
Else
target(i) = array(i)
End If
Next i
array = target
elementLength = elementLength + 1
End Function]]>
false
false
false
capacity Then ensureCapacity(newSize)
If Isobject(element) Then
Set array(Me.size()) = element
Else
array(Me.size()) = element
End If
elementLength = elementLength + 1
End Sub]]>
false
false
false
= 0 Then
removeElementAt(i)
removeElement = True
Exit Function
End If
End Function]]>
0 Then
Call Me.pSortElements()
End If
End Sub
'/**
' * Utility method to sorts the Vector elements using a
' * bubble sort.
' */
Private Sub pSortElements()
'declarations
Dim lower As Integer
Dim upper As Integer
Dim i As Integer
Dim k As Integer
Dim swapped As Integer
Dim tmp As Variant
Dim comp1 As String
Dim comp2 As String
lower% = Lbound(Me.array)
upper% = Ubound(Me.array)
For i% = 0 To Upper% - Lower%
swapped% = False
For k% = lower% To upper% - 1%
'make sure we do not go out of bounds
If k < (Me.pAddedElements) Then
'get values to compare
comp1 = Me.pGetCompare(Me.array(k%+1))
comp2 = Me.pGetCompare(Me.array(k%))
'compare to see if a swap is necessary
If comp1 < comp2 Then
'swap them
Set tmp = Me.array(k%+1)
Set Me.array(k%+1) = Me.array(k%)
Set Me.array(k%) = tmp
swapped% = True
End If
End If
Next
If Not swapped% Then Exit For
Next
End Sub
Private Function pGetCompare(v As Variant) As String
Dim types(15) As String
Dim str_typename As String
Dim i As Integer
types(0) = "Script"
types(1) = "ScriptLibrary"
types(2) = "IgnoringScript"
types(3) = "Form"
types(4) = "View"
types(5) = "Agent"
types(6) = "DatabaseScript"
types(7) = "SharedAction"
types(8) = "Page"
types(9) = "ScriptElement"
types(10) = "LotusScriptClass"
types(11) = "LotusScriptMethod"
types(12) = "LotusScriptFunction"
types(13) = "LotusScriptProperty"
types(14) = "LotusScriptConst"
types(15) = "LotusScriptType"
str_typename = Lcase(Typename(v))
For i=0 To Ubound(types)
If Lcase(types(i)) = str_typename Then
If i <= 8 Then
pGetCompare = v.ScriptName
Else
pGetCompare = v.ElementName
End If
End If
Next
End Function
End Class]]>
false
false
0 Then
Call Me.pSortElements()
End If
End Sub]]>
' * The array contain NotesDatabase instances.
' *
' * @return Variant array of DatabaseDocument instances.
' * @error 9999 Raised id the method is called in the base class.
' */
Public Function GetDocumentationSource() As DocumentationSource
Error 9999, "Do not call this method in the base class."
End Function
End Class
Public Class SimpleConfigDocument As ConfigDocument
'/**
' * Constructor.
' */
Public Sub New(doc As NotesDocument), ConfigDocument(doc)
End Sub
'/**
' * @see ConfigDocument#GetDocumentationSource
' */
Public Function GetDocumentationSource() As DocumentationSource
'get the database
Dim db As New DatabaseDocument(Me.pDoc)
'create array
Dim v(0) As Variant
Set v(0) = db
'return
Dim ds As New DocumentationSource(db.Database, db)
ds.Title = Me.pDoc.Title(0)
Set GetDocumentationSource = ds
End Function
End Class
Public Class AdvancedConfigDocument As ConfigDocument
'/**
' * Constructor.
' */
Public Sub New(doc As NotesDocument), ConfigDocument(doc)
End Sub
'/**
' * @see ConfigDocument#GetDocumentationSource
' */
Public Function GetDocumentationSource() As DocumentationSource
'declarations
Dim view As NotesView
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim db As DatabaseDocument
Dim i As Integer
Dim db_tv As NotesDatabase
'get the view and the databases for this configuration document
Set view = Me.pDoc.Parentdatabase.GetView("lookupDatabasesByConfig")
Set dc = view.GetAllDocumentsByKey(Me.pDoc.txtUniqueKey(0), True)
'create array
Dim v() As Variant
Redim v(dc.Count-1)
'loop documents
Set doc = dc.GetFirstDocument
While Not (doc Is Nothing)
'get database
Set db = New DatabaseDocument(doc)
Set v(i) = db
If db_tv Is Nothing Then
Set db_tv = db.Database
End If
'get next
Set doc = dc.GetNextDocument(doc)
i = i + 1
Wend
'return
Dim ds As New DocumentationSource(db_tv, v)
ds.Title = dc.GetFirstDocument().Title(0)
Set GetDocumentationSource = ds
End Function
End Class
Private Sub lsdoc_description()
%REM
This script library holds classes for abstracting the access to the documents of
the LotusScript.doc database.
%END REM
End Sub
'/**
' * Factory method to creating ConfigDocument instances
' * based on the supplied document.
' *
' * @param doc The document to represent
' * @return ConfigDocument instance (Nothing is the document is invalid)
' */
Public Function GetInstance(doc As NotesDocument) As ConfigDocument
'declarations
Dim config_doc As ConfigDocument
'error handling
On Error Goto catch
If doc.Form(0) = "lsdoc_config" Then
Set config_doc = New SimpleConfigDocument(doc)
Elseif doc.Form(0) = "advanced_lsdoc_config" Then
Set config_doc = New AdvancedConfigDocument(doc)
Else
Set config_doc = Nothing
End If
'return
Set GetInstance = config_doc
Exit Function
catch:
Resume finally
finally:
Set config_doc = Nothing
Exit Function
End Function]]>
' * The array contain NotesDatabase instances.
' *
' * @return Variant array of DatabaseDocument instances.
' * @error 9999 Raised id the method is called in the base class.
' */
Public Function GetDocumentationSource() As DocumentationSource
Error 9999, "Do not call this method in the base class."
End Function
End Class]]>
false
false
SCRIPT_FORM And source_type <> SCRIPT_VIEW And _
source_type <> SCRIPT_AGENT And source_type <> SCRIPT_LIBRARY And _
source_type <> SCRIPT_DATABASESCRIPT And source_type <> SCRIPT_PAGE And _
source_type <> SCRIPT_ACTION And source_type <> SCRIPT_WEBSERVICE Then
Error 9999, "The supplied script type is invalid."
End If
'store name and type
Me.pSourceName = source_name
Me.pSourceType = source_type
'create hashtable for other events
Set Me.pOtherEvents = New Hashtable()
End Sub
'/**
' * Adds the code for events to the object.
' *
' * @param event_name The name of the event (e.g. "initialize", "terminate" etc.)
' * @param event_code The code of the event
' */
Public Sub AddEventCode(event_name As String, event_code As String)
Select Case event_name
Case Is = EVENT_OPTIONS
If Me.pOptions = "" Then
Me.pOptions = event_code
Else
Me.pOptions = Me.pOptions + Chr(10) + event_code
End If
Case Is = EVENT_DECLARATIONS
If Me.pDeclarations = "" Then
Me.pDeclarations = event_code
Else
Me.pDeclarations = Me.pDeclarations + Chr(10) + event_code
End If
Case Is = EVENT_INITIALIZE
Me.pInitialize = event_code
Case Is = EVENT_TERMINATE
Me.pTerminate = event_code
Case Is = EVENT_DESCRIPTION
Me.pDescription = event_code
Case Else
Call Me.pOtherEvents.Put(event_name, event_code)
End Select
End Sub
'/**
' * Returns the code for a specific event.
' *
' * @param event_name The name of the event to return
' */
Public Function GetEventCode(event_name As String) As String
Select Case event_name
Case Is = EVENT_OPTIONS
GetEventCode = Me.pOptions
Case Is = EVENT_DECLARATIONS
GetEventCode = Me.pDeclarations
Case Is = EVENT_INITIALIZE
GetEventCode = Me.pInitialize
Case Is = EVENT_TERMINATE
GetEventCode = Me.pTerminate
Case Is = EVENT_DESCRIPTION
GetEventCode = Me.pDescription
Case Else
GetEventCode = Me.pOtherEvents.Get(event_name)
End Select
End Function
'/**
' * Returns the code of all other events than the built-in
' * events (see the "EVENT_"-constants)
' *
' */
Public Function GetOtherEventCode() As String
'declarations
Dim enum As Enumeration
Dim event_name As String
Dim code As String
'get enum of keys
Set enum = Me.pOtherEvents.Keys()
While enum.HasMoreElements()
'get next
event_name = enum.NextElement()
'get the code
If code = "" Then
code = Me.pOtherEvents.Get(event_name)
Else
code = code + Chr(10) + Me.pOtherEvents.Get(event_name)
End If
Wend
'return
GetOtherEventCode = code
End Function
'/**
' * Returns a concatenation of the code in all events.
' *
' */
Public Function GetCode() As String
'declarations
Dim code As String
'get the known events
code = Me.pOptions
code = code + Chr(10) + Me.pDeclarations
code = code + Chr(10) + Me.pInitialize
code = code + Chr(10) + Me.pTerminate
'add other events
code = code + Chr(10) + Me.GetOtherEventCode()
'return
GetCode = code
End Function
'/**
' * Returns the name of the source object. This will normally
' * be the name of the design element the source code comes from.
' */
Public Property Get SourceName As String
SourceName = Me.pSourceName
End Property
'/**
' * Returns the type of the source object. The return value
' * should be matched against the "SCRIPT_"-constants to
' * determine type.
' */
Public Property Get SourceType As String
SourceType = Me.pSourceType
End Property
End Class
Private Const SIG_ACTION_LOTUSSCRIPT = 65413
Private Const ODS_WORD = 0
Private Const ODS_DWORD% = 1
Private Const CODESECTION_INITIALIZE% = 1
Private Const CODESECTION_DECLARATIONS% = 2
Private Const CODESECTION_CUSTOM% = 4
Private Type BLOCKID
pool As Long
block As Long ' Integer may not be enough
End Type
Private Type WSIG
signature As Integer
length As Integer
End Type
Private Type CDACTIONLOTUSSCRIPT
header As WSIG
dwFlags As Long
dwScriptLen As Long
End Type
Declare Private Sub Peek Lib "MSVCRT" Alias "memcpy" ( D As Any, Byval P As Long, Byval N As Long)
'separator line - handle code if we have some
If code_section <> "" Then
If code_type = CODESECTION_INITIALIZE Then
Me.pInitialize = code_section
Elseif code_type = CODESECTION_DECLARATIONS Then
Me.pDeclarations = code_section
Elseif code_type = CODESECTION_CUSTOM Then
Dim m As New LotusScriptMethod(code_section_firstline)
Call Me.AddEventCode(m.ElementName, code_section)
End If
End If
'reset section code
code_section = ""
code_section_firstline = ""
'what is coming now
If Right(nextline, 15) = "Initialize:1:10" Then
'initialize
code_type = CODESECTION_INITIALIZE
Elseif Right(nextline, 19) = "(Declarations):0:10" Then
'declarations
code_type = CODESECTION_DECLARATIONS
Elseif Right(nextline, 4) = ":1:8" Then
'custom sub or function
code_type = CODESECTION_CUSTOM
Else
code_type = 0
End If
Else
'probably a code line - add to code section
If code_section_firstline = "" Then
code_section_firstline = nextline
End If
code_section = code_section + Chr(10) + nextline
End If
Else
'probably a code line - add to code section
If code_section_firstline = "" Then
code_section_firstline = nextline
End If
code_section = code_section + Chr(10) + nextline
End If
Wend
End If
End Forall
Msgbox Me.GetCode()
End Sub
'/**
' * Utility method to obtain the code for the webservice using the C API.
' */
Private Function pReadWebServiceScript (doc As Variant, iname As String) As String
Dim rec As CDACTIONLOTUSSCRIPT
Dim i As Integer
Dim memman As memoryManager
Dim head_blckid_last As BlockID, head_blckid As BlockID, val_blckid As BlockID ' content and value block id
Dim iType As Integer ' item type
Dim iRc As Integer ' return code
Dim length As Long
Dim pBuff As Long
On Error Goto err_this
Set memman = New memoryManager
'process the first and hopefully only item
If W32_NSFItemInfo (doc.handle, iName, Len(iName), head_blckid, iType, val_blckid, length)<> 0 Then Exit Function
pBuff = memman.LockObject(val_blckID.pool) + val_blckID.block
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.header.signature, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, unknown, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.dwFlags, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.dwScriptLen, 1)
Dim word As Long
Dim code As String
For i = 0 To rec.dwScriptLen
Peek word, pbuff + i, 1
code = code + Chr(word)
Next
pReadWebServiceScript = code
Call memman.UnlockObject(val_blckID.pool&)
EXIT_THIS:
Exit Function
ERR_THIS:
Messagebox Error$
Resume Exit_THIS
End Function
End Class
Private Sub lsdoc_description
%REM
This script library holds classes to represent the source of LotusScript from a Notes database.
%END REM
End Sub]]>
SCRIPT_FORM And source_type <> SCRIPT_VIEW And _
source_type <> SCRIPT_AGENT And source_type <> SCRIPT_LIBRARY And _
source_type <> SCRIPT_DATABASESCRIPT And source_type <> SCRIPT_PAGE And _
source_type <> SCRIPT_ACTION And source_type <> SCRIPT_WEBSERVICE Then
Error 9999, "The supplied script type is invalid."
End If
'store name and type
Me.pSourceName = source_name
Me.pSourceType = source_type
'create hashtable for other events
Set Me.pOtherEvents = New Hashtable()
End Sub
'/**
' * Adds the code for events to the object.
' *
' * @param event_name The name of the event (e.g. "initialize", "terminate" etc.)
' * @param event_code The code of the event
' */
Public Sub AddEventCode(event_name As String, event_code As String)
Select Case event_name
Case Is = EVENT_OPTIONS
If Me.pOptions = "" Then
Me.pOptions = event_code
Else
Me.pOptions = Me.pOptions + Chr(10) + event_code
End If
Case Is = EVENT_DECLARATIONS
If Me.pDeclarations = "" Then
Me.pDeclarations = event_code
Else
Me.pDeclarations = Me.pDeclarations + Chr(10) + event_code
End If
Case Is = EVENT_INITIALIZE
Me.pInitialize = event_code
Case Is = EVENT_TERMINATE
Me.pTerminate = event_code
Case Is = EVENT_DESCRIPTION
Me.pDescription = event_code
Case Else
Call Me.pOtherEvents.Put(event_name, event_code)
End Select
End Sub
'/**
' * Returns the code for a specific event.
' *
' * @param event_name The name of the event to return
' */
Public Function GetEventCode(event_name As String) As String
Select Case event_name
Case Is = EVENT_OPTIONS
GetEventCode = Me.pOptions
Case Is = EVENT_DECLARATIONS
GetEventCode = Me.pDeclarations
Case Is = EVENT_INITIALIZE
GetEventCode = Me.pInitialize
Case Is = EVENT_TERMINATE
GetEventCode = Me.pTerminate
Case Is = EVENT_DESCRIPTION
GetEventCode = Me.pDescription
Case Else
GetEventCode = Me.pOtherEvents.Get(event_name)
End Select
End Function
'/**
' * Returns the code of all other events than the built-in
' * events (see the "EVENT_"-constants)
' *
' */
Public Function GetOtherEventCode() As String
'declarations
Dim enum As Enumeration
Dim event_name As String
Dim code As String
'get enum of keys
Set enum = Me.pOtherEvents.Keys()
While enum.HasMoreElements()
'get next
event_name = enum.NextElement()
'get the code
If code = "" Then
code = Me.pOtherEvents.Get(event_name)
Else
code = code + Chr(10) + Me.pOtherEvents.Get(event_name)
End If
Wend
'return
GetOtherEventCode = code
End Function
'/**
' * Returns a concatenation of the code in all events.
' *
' */
Public Function GetCode() As String
'declarations
Dim code As String
'get the known events
code = Me.pOptions
code = code + Chr(10) + Me.pDeclarations
code = code + Chr(10) + Me.pInitialize
code = code + Chr(10) + Me.pTerminate
'add other events
code = code + Chr(10) + Me.GetOtherEventCode()
'return
GetCode = code
End Function
'/**
' * Returns the name of the source object. This will normally
' * be the name of the design element the source code comes from.
' */
Public Property Get SourceName As String
SourceName = Me.pSourceName
End Property
'/**
' * Returns the type of the source object. The return value
' * should be matched against the "SCRIPT_"-constants to
' * determine type.
' */
Public Property Get SourceType As String
SourceType = Me.pSourceType
End Property
End Class]]>
false
false
SCRIPT_FORM And source_type <> SCRIPT_VIEW And _
source_type <> SCRIPT_AGENT And source_type <> SCRIPT_LIBRARY And _
source_type <> SCRIPT_DATABASESCRIPT And source_type <> SCRIPT_PAGE And _
source_type <> SCRIPT_ACTION And source_type <> SCRIPT_WEBSERVICE Then
Error 9999, "The supplied script type is invalid."
End If
'store name and type
Me.pSourceName = source_name
Me.pSourceType = source_type
'create hashtable for other events
Set Me.pOtherEvents = New Hashtable()
End Sub]]>
false
false
false
false
false
false
"" Then
If code_type = CODESECTION_INITIALIZE Then
Me.pInitialize = code_section
Elseif code_type = CODESECTION_DECLARATIONS Then
Me.pDeclarations = code_section
Elseif code_type = CODESECTION_CUSTOM Then
Dim m As New LotusScriptMethod(code_section_firstline)
Call Me.AddEventCode(m.ElementName, code_section)
End If
End If
'reset section code
code_section = ""
code_section_firstline = ""
'what is coming now
If Right(nextline, 15) = "Initialize:1:10" Then
'initialize
code_type = CODESECTION_INITIALIZE
Elseif Right(nextline, 19) = "(Declarations):0:10" Then
'declarations
code_type = CODESECTION_DECLARATIONS
Elseif Right(nextline, 4) = ":1:8" Then
'custom sub or function
code_type = CODESECTION_CUSTOM
Else
code_type = 0
End If
Else
'probably a code line - add to code section
If code_section_firstline = "" Then
code_section_firstline = nextline
End If
code_section = code_section + Chr(10) + nextline
End If
Else
'probably a code line - add to code section
If code_section_firstline = "" Then
code_section_firstline = nextline
End If
code_section = code_section + Chr(10) + nextline
End If
Wend
End If
End Forall
Msgbox Me.GetCode()
End Sub
'/**
' * Utility method to obtain the code for the webservice using the C API.
' */
Private Function pReadWebServiceScript (doc As Variant, iname As String) As String
Dim rec As CDACTIONLOTUSSCRIPT
Dim i As Integer
Dim memman As memoryManager
Dim head_blckid_last As BlockID, head_blckid As BlockID, val_blckid As BlockID ' content and value block id
Dim iType As Integer ' item type
Dim iRc As Integer ' return code
Dim length As Long
Dim pBuff As Long
On Error Goto err_this
Set memman = New memoryManager
'process the first and hopefully only item
If W32_NSFItemInfo (doc.handle, iName, Len(iName), head_blckid, iType, val_blckid, length)<> 0 Then Exit Function
pBuff = memman.LockObject(val_blckID.pool) + val_blckID.block
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.header.signature, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, unknown, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.dwFlags, 1)
Call W32_ODSReadMemory (pbuff, ODS_DWORD, rec.dwScriptLen, 1)
Dim word As Long
Dim code As String
For i = 0 To rec.dwScriptLen
Peek word, pbuff + i, 1
code = code + Chr(word)
Next
pReadWebServiceScript = code
Call memman.UnlockObject(val_blckID.pool&)
EXIT_THIS:
Exit Function
ERR_THIS:
Messagebox Error$
Resume Exit_THIS
End Function
End Class]]>
count - 1And count > 0 Then
Redim Preserve results( count - 1) As Variant
End If
If count > 0 Then
getDesignDocuments = results
End If
End If
End Function
Private Function findElementByTitle(Byval title As String, elements As Variant) As NotesDocument
If Not Isempty( elements) Then
title= Trim(Lcase( replaceSubstring( title , "_", "")))
Forall elementdoc In elements
Dim doc As notesdocument
Set doc = elementdoc
If doesMatchTitle( title, doc) Then
Set findElementByTitle = elementdoc
Exit Function
End If
End Forall
End If
End Function
Private Function doesMatchTitle( Byval titletoMatch As String, doc As notesdocument) As Integer
'titletomatch must be all lowercase
Dim aliases As Variant
aliases = designDocumentAliases( doc )
Forall analias In aliases
If replaceSubstring(Lcase(Trim(analias)), "_", "") = titleToMatch Then
doesMatchTitle = True
Exit Function
End If
End Forall
End Function
Private Function replaceSubstring( Byval astring As String, substring As String, newsubstring As String) As String
Dim index As Integer
index = Instr( astring, substring)
Do While index > 0
replaceSubstring = Left$( astring, index - 1) & newsubstring
astring = Right$( astring, Len(astring) - index - Len( substring) + 1 )
index = Instr( astring, substring)
Loop
replaceSubstring = replaceSubstring & astring
End Function
Private Function strExplode( Byval strValue As String, strDelimiter As String, bBlanks As Variant) As Variant
'** This function takes a string and converts it to an array, based on a delimiter
'** Parameters:
'**strValue- the string to explode
'**strDelimiter- the delimiter
'**bBlanks- a boolean value, pass true to have blanks placed in array when two delimiters have nothing between them
'** pass false to ignore the blanks
Dim strTemp As String
Dim strValues() As String
Dim iPlace As Integer
Dim idelimLen As Integer
Dim iValueCount As Integer
idelimLen = Len( strDelimiter)
iPlace = Instr( strValue, strDelimiter)
Do While iPlace <> 0
If (iPlace <> 1 Or bBlanks) Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = Left( strValue, iPlace - 1)
iValueCount = iValueCount + 1
End If
strValue = Right( strValue, Len( strValue) - iPlace - idelimLen + 1)
iPlace = Instr( strValue, strDelimiter)
Loop
If Len( strValue ) <> 0 Or bBlanks Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = strValue
Elseif iValueCount = 0 Then
Redim Preserve strValues(iValueCount) As String
End If
STRExplode = strValues
End Function
End Class
Class API_DBDesign As DatabaseDesign
Private dbhandle As Long
Private Function checkerror( returncode As Integer) As Integer
'this returns zero unless returncode is non-zero
'in which case it throws an error
If returncode <> 0 Then
Error returncode, Hex$( returncode)
End If
End Function
Private Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer
End Function
Private Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
End Function
Private Function apiIDEntries ( Byval tablehandle As Long ) As Long
End Function
Private Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
End Function
Private Function apiOSMemFree (Byval handle As Long) As Integer
End Function
Private Function apiNSFDbClose( Byval dbhandle As Long) As Integer
End Function
Private Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
End Sub
Sub new( db As NotesDatabase)
Dim netpath As String
If Len(db.server) > 0 Then
netpath = db.server & "!!" & db.filepath
Else
netpath = db.filepath
End If
Call checkerror(apiNSFDBOpen(netpath, dbhandle ))
End Sub
Sub delete
If dbhandle <> 0 Then
Call apiNSFDbClose( dbhandle)
End If
End Sub
Private Function getDocuments( classtype As Integer) As Variant
Dim begindate As Double
Dim enddate As Double
Dim idtablehandle As Long
Dim noteid As Long
Call apiTimeConstruct( &hFFFFFFFF, &hFFFFFFFF, begindate )
On Error Goto errhandle
Call checkerror(apiNSFDbGetModifiedNoteTable( dbhandle, classtype, begindate , enddate , idtablehandle ))
If apiIDEntries( idtablehandle) <>0 Then
Redim returnval (apiIDEntries( idtablehandle)-1) As NotesDocument
Dim count As Long
If apiIDScan( idtablehandle, True, noteid ) Then
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Do While apiIDScan( idtablehandle, False, noteid )
count = count + 1
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Loop
End If
getDocuments = returnval
End If
done:
If idtablehandle <>0 Then
Call apiOsMemFree( idtablehandle)
End If
Exit Function
errhandle:
Resume done
End Function
End Class
Declare Private Function WinNSFDbOpen Lib "nnotes" Alias "NSFDbOpen" ( Byval dbname As Lmbcs String, dbhandle As Long ) As Integer
Declare Private Function WinIDScan Lib "nnotes" Alias "IDScan"( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
Declare Private Function WinOSMemFree Lib "nnotes" Alias "OSMemFree" (Byval handle As Long) As Integer
Declare Private Function WinNSFDbClose Lib "nnotes" Alias "NSFDbClose" ( Byval dbhandle As Long) As Integer
Declare Private Sub WinTimeConstruct Lib "nnotes" Alias "TimeConstruct" ( Byval adate As Long, Byval atime As Long, datetime As Double)
Class Win32DatabaseDesign As API_DBDesign
Sub new( db As NotesDatabase)
End Sub
Private Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer
apiNSFDbOpen = winNSFDbOpen ( dbname, dbhandle )
End Function
Private Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
apiNSFDbGetModifiedNoteTable = winNSFDbGetModifiedNoteTable(dbhandle, classmask,startdate , endate , returntablehandle )
End Function
Private Function apiIDEntries ( Byval tablehandle As Long ) As Long
apiIDEntries = winIDEntries(tablehandle)
End Function
Private Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
apiIDScan = winIDScan( tablehandle , firstbool, returnid)
End Function
Private Function apiOSMemFree (Byval handle As Long) As Integer
apiOSMemFree = winOSMemFree (handle)
End Function
Private Function apiNSFDbClose( Byval dbhandle As Long) As Integer
apiNSFDbClose = winNSFDbClose(dbhandle)
End Function
Private Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
Call winTimeConstruct( adate ,atime, datetime)
End Sub
Private Function isAbstractClass As Integer
isAbstractClass = False
End Function
End Class
Declare Private Function macNSFDbOpen Lib "noteslib" Alias "NSFDbOpen" ( Byval dbname As Lmbcs String, dbhandle As Long ) As Integer
Declare Private Function macIDScan Lib "noteslib" Alias "IDScan"( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
Declare Private Function macOSMemFree Lib "noteslib" Alias "OSMemFree" (Byval handle As Long) As Integer
Declare Private Function macNSFDbClose Lib "noteslib" Alias "NSFDbClose" ( Byval dbhandle As Long) As Integer
Declare Private Sub macTimeConstruct Lib "noteslib" Alias "TimeConstruct" ( Byval adate As Long, Byval atime As Long, datetime As Double)
Class MacDatabaseDesign As API_DBDesign
Sub new( db As NotesDatabase)
End Sub
Private Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer
apiNSFDbOpen = macNSFDbOpen ( dbname, dbhandle )
End Function
Private Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
apiNSFDbGetModifiedNoteTable = macNSFDbGetModifiedNoteTable(dbhandle, classmask,startdate , endate , returntablehandle )
End Function
Private Function apiIDEntries ( Byval tablehandle As Long ) As Long
apiIDEntries = macIDEntries(tablehandle)
End Function
Private Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
apiIDScan = macIDScan( tablehandle , firstbool, returnid)
End Function
Private Function apiOSMemFree (Byval handle As Long) As Integer
apiOSMemFree = macOSMemFree (handle)
End Function
Private Function apiNSFDbClose( Byval dbhandle As Long) As Integer
apiNSFDbClose = macNSFDbClose(dbhandle)
End Function
Private Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
Call macTimeConstruct( adate ,atime, datetime)
End Sub
Private Function isAbstractClass As Integer
isAbstractClass = False
End Function
End Class
Const DB_DESIGN_LOOKUP_VIEW = "($DBDesignLookup)"
Class PlatformIndependentDatabaseDesign As DatabaseDesign
Private session As NotesSession
Private currentDB As NotesDatabase
Private designViewNote As NotesDocument
Sub new( db As NotesDatabase)
Dim designViewTemplateNote As NotesDocument
Dim tempView As NotesView
Dim designCollectionNote As NotesDocument
'get a view any view will do
Set tempView = db.views(0)
Set designViewTemplateNote = db.getDocumentByUnid( tempView.universalID)
Set designViewNote = designViewTemplateNote.copyToDatabase(db)
Set designCollectionNote = db.getdocumentbyid( "FFFF0020")
'strip off all the items
Forall item In designViewNote.items
item.remove
End Forall
designCollectionNote.copyAllItems designViewNote
designViewNote.replaceItemValue DESIGN_NOTE_NAME_ITEM, "(TemporaryDesignViewNote" & designViewNote.noteID & ")"
End Sub
Sub delete
If Not designViewNote.isNewNote Then
designViewNote.remove True
End If
End Sub
Private Function isAbstractClass As Integer
isAbstractClass = False
End Function
Private Function getDocuments( classtype As Integer) As Variant
Dim view As NotesView
Dim note As NotesDocument
Dim count As Integer
Dim results() As Variant
'reset the design view note so it refreshs
designViewNote.removeItem "$Collection"
designViewNote.replaceItemValue "$Collection", ""
'set the classtype
designViewNote.replaceItemValue "$FormulaClass", Cstr(classType)
designViewNote.save True, True
Set view = db.getView( designViewNote.getItemValue( DESIGN_NOTE_NAME_ITEM)(0))
view.refresh
Set note = view.getFirstDocument
Do While Not note Is Nothing
If note.noteID <> designViewNote.noteID Then 'Don't return the temp design view
Redim Preserve results(count) As Variant
Set results(count) = note
count = count + 1
End If
Set note = view.getNextDocument( note)
Loop
Delete view
If count > 0 Then
getDocuments = results
End If
End Function
End Class
Public Function createDatabaseDesign( db As NotesDatabase ) As DatabaseDesign
'This function should be called to instantiate
On Error Goto errhandle
Dim session As New notessession
If FLAG_NEVER_USE_NATIVE_API_CALLS Then
Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
Else
Select Case session.platform
Case "Windows/32":
Set createDatabaseDesign = New Win32DatabaseDesign( db)
%REM
This is commented out because getting it to work on the mac was problematic
Case "Macintosh":
Set createDatabaseDesign = New MacDatabaseDesign( db)
%END REM
Case Else:
On Error Goto 0
Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
End Select
End If
done:
Exit Function
errhandle:
Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
Resume done
End Function]]>
count - 1And count > 0 Then
Redim Preserve results( count - 1) As Variant
End If
If count > 0 Then
getDesignDocuments = results
End If
End If
End Function
Private Function findElementByTitle(Byval title As String, elements As Variant) As NotesDocument
If Not Isempty( elements) Then
title= Trim(Lcase( replaceSubstring( title , "_", "")))
Forall elementdoc In elements
Dim doc As notesdocument
Set doc = elementdoc
If doesMatchTitle( title, doc) Then
Set findElementByTitle = elementdoc
Exit Function
End If
End Forall
End If
End Function
Private Function doesMatchTitle( Byval titletoMatch As String, doc As notesdocument) As Integer
'titletomatch must be all lowercase
Dim aliases As Variant
aliases = designDocumentAliases( doc )
Forall analias In aliases
If replaceSubstring(Lcase(Trim(analias)), "_", "") = titleToMatch Then
doesMatchTitle = True
Exit Function
End If
End Forall
End Function
Private Function replaceSubstring( Byval astring As String, substring As String, newsubstring As String) As String
Dim index As Integer
index = Instr( astring, substring)
Do While index > 0
replaceSubstring = Left$( astring, index - 1) & newsubstring
astring = Right$( astring, Len(astring) - index - Len( substring) + 1 )
index = Instr( astring, substring)
Loop
replaceSubstring = replaceSubstring & astring
End Function
Private Function strExplode( Byval strValue As String, strDelimiter As String, bBlanks As Variant) As Variant
'** This function takes a string and converts it to an array, based on a delimiter
'** Parameters:
'**strValue- the string to explode
'**strDelimiter- the delimiter
'**bBlanks- a boolean value, pass true to have blanks placed in array when two delimiters have nothing between them
'** pass false to ignore the blanks
Dim strTemp As String
Dim strValues() As String
Dim iPlace As Integer
Dim idelimLen As Integer
Dim iValueCount As Integer
idelimLen = Len( strDelimiter)
iPlace = Instr( strValue, strDelimiter)
Do While iPlace <> 0
If (iPlace <> 1 Or bBlanks) Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = Left( strValue, iPlace - 1)
iValueCount = iValueCount + 1
End If
strValue = Right( strValue, Len( strValue) - iPlace - idelimLen + 1)
iPlace = Instr( strValue, strDelimiter)
Loop
If Len( strValue ) <> 0 Or bBlanks Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = strValue
Elseif iValueCount = 0 Then
Redim Preserve strValues(iValueCount) As String
End If
STRExplode = strValues
End Function
End Class]]>
false
false
count - 1And count > 0 Then
Redim Preserve results( count - 1) As Variant
End If
If count > 0 Then
getDesignDocuments = results
End If
End If
End Function]]>
false
false
true
false
false
false
0
replaceSubstring = Left$( astring, index - 1) & newsubstring
astring = Right$( astring, Len(astring) - index - Len( substring) + 1 )
index = Instr( astring, substring)
Loop
replaceSubstring = replaceSubstring & astring
End Function]]>
false
false
false
false
false
false
false
false
false
false
false
false
0
If (iPlace <> 1 Or bBlanks) Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = Left( strValue, iPlace - 1)
iValueCount = iValueCount + 1
End If
strValue = Right( strValue, Len( strValue) - iPlace - idelimLen + 1)
iPlace = Instr( strValue, strDelimiter)
Loop
If Len( strValue ) <> 0 Or bBlanks Then
Redim Preserve strValues(iValueCount) As String
strValues(iValueCount) = strValue
Elseif iValueCount = 0 Then
Redim Preserve strValues(iValueCount) As String
End If
STRExplode = strValues
End Function]]>
0 Then
Error returncode, Hex$( returncode)
End If
End Function
Private Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer
End Function
Private Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
End Function
Private Function apiIDEntries ( Byval tablehandle As Long ) As Long
End Function
Private Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
End Function
Private Function apiOSMemFree (Byval handle As Long) As Integer
End Function
Private Function apiNSFDbClose( Byval dbhandle As Long) As Integer
End Function
Private Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
End Sub
Sub new( db As NotesDatabase)
Dim netpath As String
If Len(db.server) > 0 Then
netpath = db.server & "!!" & db.filepath
Else
netpath = db.filepath
End If
Call checkerror(apiNSFDBOpen(netpath, dbhandle ))
End Sub
Sub delete
If dbhandle <> 0 Then
Call apiNSFDbClose( dbhandle)
End If
End Sub
Private Function getDocuments( classtype As Integer) As Variant
Dim begindate As Double
Dim enddate As Double
Dim idtablehandle As Long
Dim noteid As Long
Call apiTimeConstruct( &hFFFFFFFF, &hFFFFFFFF, begindate )
On Error Goto errhandle
Call checkerror(apiNSFDbGetModifiedNoteTable( dbhandle, classtype, begindate , enddate , idtablehandle ))
If apiIDEntries( idtablehandle) <>0 Then
Redim returnval (apiIDEntries( idtablehandle)-1) As NotesDocument
Dim count As Long
If apiIDScan( idtablehandle, True, noteid ) Then
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Do While apiIDScan( idtablehandle, False, noteid )
count = count + 1
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Loop
End If
getDocuments = returnval
End If
done:
If idtablehandle <>0 Then
Call apiOsMemFree( idtablehandle)
End If
Exit Function
errhandle:
Resume done
End Function
End Class]]>
false
false
0 Then
Error returncode, Hex$( returncode)
End If
End Function]]>
false
false
false
false
false
false
false
false
false
0 Then
netpath = db.server & "!!" & db.filepath
Else
netpath = db.filepath
End If
Call checkerror(apiNSFDBOpen(netpath, dbhandle ))
End Sub]]>
0 Then
Call apiNSFDbClose( dbhandle)
End If
End Sub]]>
false
false
false
0 Then
Redim returnval (apiIDEntries( idtablehandle)-1) As NotesDocument
Dim count As Long
If apiIDScan( idtablehandle, True, noteid ) Then
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Do While apiIDScan( idtablehandle, False, noteid )
count = count + 1
Set returnval( count) = db.getDocumentByID(Hex$( noteId))
Loop
End If
getDocuments = returnval
End If
done:
If idtablehandle <>0 Then
Call apiOsMemFree( idtablehandle)
End If
Exit Function
errhandle:
Resume done
End Function]]>
NSFDbOpen
true
nnotes
false
false
false
false
false
false
false
false
false
false
false
false
designViewNote.noteID Then 'Don't return the temp design view
Redim Preserve results(count) As Variant
Set results(count) = note
count = count + 1
End If
Set note = view.getNextDocument( note)
Loop
Delete view
If count > 0 Then
getDocuments = results
End If
End Function
End Class]]>
false
false
designViewNote.noteID Then 'Don't return the temp design view
Redim Preserve results(count) As Variant
Set results(count) = note
count = count + 1
End If
Set note = view.getNextDocument( note)
Loop
Delete view
If count > 0 Then
getDocuments = results
End If
End Function]]>
false
false
false
"" Then
'the class has a parent class - build and add stack
Call Me.pBuildHierarchyStack(script_elem)
End If
End If
Wend
Wend
End Sub
'/**
' * Returns a Stack instance of the hierarchy for the supplied
' * name.
' *
' * @param script_name The name of type to look for.
' * @return If the name isn't found Nothing is returned. If the name is found a stack is returned with the top-most type at the top.
' */
Public Function GetStack(script_name As String) As Stack
On Error Goto catch
Set GetStack = Me.pIndex(script_name)
Exit Function
catch:
Set GetStack = Nothing
Exit Function
End Function
'/**
' * Utility method to build the hierarchy for a ScriptElement. If
' * any parent class along the chain cannot be located (can
' * happen if we only build documentation for agents and a class
' * in an agent extends a class in a script library) we will
' * ignore the entire hierarchy. This in turns means that the
' * documentation will only show the parent class by name (and
' * not as a link).
' *
' */
Private Sub pBuildHierarchyStack(script_elem As Variant)
'declarations
Dim stack As New Stack()
Dim parent_clazz As LotusScriptClass
Dim sub_clazz As LotusScriptClass
'we need to have a parent class to proceed
If script_elem.ParentClazzName = "" Then
'no parent class - abort
Exit Sub
End If
'set up error handler
On Error Goto catch
'start by pushing the element it self on the stack
'so it is at the bottom
Call stack.Push(script_elem)
'set the passed class as the sub_class
Set sub_clazz = script_elem
'loop hierarchy
Set parent_clazz = Me.pClazzIndex(script_elem.ParentClazzName)
While Not (parent_clazz Is Nothing)
'add subclass
Call parent_clazz.AddSubclass(sub_clazz)
'push on stack
Call stack.Push(parent_clazz)
'get parent class of parent
If parent_clazz.ParentClazzName <> "" Then
Set parent_clazz = Me.pClazzIndex(parent_clazz.ParentClazzName)
Else
Set parent_clazz = Nothing
End If
Wend
'now we have a stack with the top-most class in the hierarchy at
'the top of the stack - add the stack to the index indexed by the
'class name of the original class
Set Me.pIndex(script_elem.ElementName) = stack
'exit
Exit Sub
catch:
'we were probably unable to find a parent class (may happen if
'the user doesn't build an entire database) - just exit
Exit Sub
End Sub
End Class
Private Sub lsdoc_description()
%REM
Classes for managing and handling the class hierarchy index for the
DocumentWriter classes.
%END REM
End Sub]]>
"" Then
'the class has a parent class - build and add stack
Call Me.pBuildHierarchyStack(script_elem)
End If
End If
Wend
Wend
End Sub
'/**
' * Returns a Stack instance of the hierarchy for the supplied
' * name.
' *
' * @param script_name The name of type to look for.
' * @return If the name isn't found Nothing is returned. If the name is found a stack is returned with the top-most type at the top.
' */
Public Function GetStack(script_name As String) As Stack
On Error Goto catch
Set GetStack = Me.pIndex(script_name)
Exit Function
catch:
Set GetStack = Nothing
Exit Function
End Function
'/**
' * Utility method to build the hierarchy for a ScriptElement. If
' * any parent class along the chain cannot be located (can
' * happen if we only build documentation for agents and a class
' * in an agent extends a class in a script library) we will
' * ignore the entire hierarchy. This in turns means that the
' * documentation will only show the parent class by name (and
' * not as a link).
' *
' */
Private Sub pBuildHierarchyStack(script_elem As Variant)
'declarations
Dim stack As New Stack()
Dim parent_clazz As LotusScriptClass
Dim sub_clazz As LotusScriptClass
'we need to have a parent class to proceed
If script_elem.ParentClazzName = "" Then
'no parent class - abort
Exit Sub
End If
'set up error handler
On Error Goto catch
'start by pushing the element it self on the stack
'so it is at the bottom
Call stack.Push(script_elem)
'set the passed class as the sub_class
Set sub_clazz = script_elem
'loop hierarchy
Set parent_clazz = Me.pClazzIndex(script_elem.ParentClazzName)
While Not (parent_clazz Is Nothing)
'add subclass
Call parent_clazz.AddSubclass(sub_clazz)
'push on stack
Call stack.Push(parent_clazz)
'get parent class of parent
If parent_clazz.ParentClazzName <> "" Then
Set parent_clazz = Me.pClazzIndex(parent_clazz.ParentClazzName)
Else
Set parent_clazz = Nothing
End If
Wend
'now we have a stack with the top-most class in the hierarchy at
'the top of the stack - add the stack to the index indexed by the
'class name of the original class
Set Me.pIndex(script_elem.ElementName) = stack
'exit
Exit Sub
catch:
'we were probably unable to find a parent class (may happen if
'the user doesn't build an entire database) - just exit
Exit Sub
End Sub
End Class]]>
true
false
"" Then
'the class has a parent class - build and add stack
Call Me.pBuildHierarchyStack(script_elem)
End If
End If
Wend
Wend
End Sub]]>
false
false
false
"" Then
Set parent_clazz = Me.pClazzIndex(parent_clazz.ParentClazzName)
Else
Set parent_clazz = Nothing
End If
Wend
'now we have a stack with the top-most class in the hierarchy at
'the top of the stack - add the stack to the index indexed by the
'class name of the original class
Set Me.pIndex(script_elem.ElementName) = stack
'exit
Exit Sub
catch:
'we were probably unable to find a parent class (may happen if
'the user doesn't build an entire database) - just exit
Exit Sub
End Sub]]>
0
If (intPlace <> 1 Or varBlanks) Then
Redim Preserve strValues(intValueCount) As String
strValues(intValueCount) = Left( strValue, intPlace - 1)
intValueCount = intValueCount + 1
End If
strValue = Right( strValue, Len( strValue) - intPlace - intDelimLen + 1)
intPlace = Instr( strValue, strDelimiter)
Loop
If Len( strValue ) <> 0 Or varBlanks Then
Redim Preserve strValues(intValueCount) As String
strValues(intValueCount) = strValue
Elseif intValueCount = 0 Then
Redim Preserve strValues(intValueCount) As String
End If
shExplode = strValues
End Function
Function shReplaceSubstring( Byval strAstring As String, strSubstring As String, strNewSubstring As String) As String
Dim intIndex As Integer
intIndex = Instr( strAstring, strSubstring)
Do While intIndex > 0
shReplaceSubstring = Left$( strAstring, intIndex - 1) & strNewSubstring
strAstring = Right$( strAstring, Len(strAstring) -intIndex - Len( strSubstring) + 1 )
intIndex = Instr( strAstring, strSubstring)
Loop
shReplaceSubstring = shReplaceSubstring & strAstring
End Function]]>
0
If (intPlace <> 1 Or varBlanks) Then
Redim Preserve strValues(intValueCount) As String
strValues(intValueCount) = Left( strValue, intPlace - 1)
intValueCount = intValueCount + 1
End If
strValue = Right( strValue, Len( strValue) - intPlace - intDelimLen + 1)
intPlace = Instr( strValue, strDelimiter)
Loop
If Len( strValue ) <> 0 Or varBlanks Then
Redim Preserve strValues(intValueCount) As String
strValues(intValueCount) = strValue
Elseif intValueCount = 0 Then
Redim Preserve strValues(intValueCount) As String
End If
shExplode = strValues
End Function]]>
false
false
false
false
false
false
false
false
false
false
false
false
0
shReplaceSubstring = Left$( strAstring, intIndex - 1) & strNewSubstring
strAstring = Right$( strAstring, Len(strAstring) -intIndex - Len( strSubstring) + 1 )
intIndex = Instr( strAstring, strSubstring)
Loop
shReplaceSubstring = shReplaceSubstring & strAstring
End Function]]>
9D1D5FD8D45F7BC0C1257003003E4F19
1506
16-05-2005 13:20:34
29-11-2006 14:53:44
CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration
33
16-05-2005 13:20:51
29-11-2006 13:47:38
11-12-2005 12:59:32
CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration
"DOCUMENTATIONSOURCE" Then
'not a DocumentationSource object - raise error
Error 9999, "You must supply a DocumentationSource object."
End If
Set Me.pDocSource = doc_source
Set Me.pOutFactory = output_factory
'get the scripts to process from the DocumentationSource
Set Me.pScripts = Me.pDocSource.Scripts
End Sub
'/**
' * Set a DecisionMaker chain.
' */
Public Property Set DecisionMaker As DecisionMaker
Set Me.pDecisionMaker = DecisionMaker
End Property
'/**
' * Called to write the documentation.
' *
' */
Public Sub Write()
End Sub
End Class
Public Class FramesDocumentationWriter As DocumentationWriter
'declarations
Private pIndex As Index
Private pDbScript As Variant
Private pForms As Vector
Private pViews As Vector
Private pAgents As Vector
Private pScriptlibs As Vector
Private pPages As Vector
Private pActions As Vector
Private pClazzes As Vector
Private pTypes As Vector
Private pHierarchyIndex As ClassHierarchyIndex
'/**
' * Constructor.
' *
' */
Public Sub New(doc_source As Variant, output_factory As OutputStreamFactory), DocumentationWriter(doc_source, output_factory)
'declarations
Dim enum As Enumeration
Dim enum_wr As Enumeration
Dim script As Variant
Dim script_elem As Variant
'create vectors
Set Me.pForms = New SortedVector()
Set Me.pViews = New SortedVector()
Set Me.pAgents = New SortedVector()
Set Me.pScriptlibs = New SortedVector()
Set Me.pPages = New SortedVector()
Set Me.pActions = New SortedVector()
Set Me.pClazzes = New SortedVector()
Set Me.pTypes = New SortedVector()
'get enumeration and loop scripts and split into types
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
Select Case script.ScriptType
Case Is = SCRIPTTYPE_FORM
Call Me.pForms.AddElement(script)
Case Is = SCRIPTTYPE_VIEW
Call Me.pViews.AddElement(script)
Case Is = SCRIPTTYPE_AGENT
Call Me.pAgents.AddElement(script)
Case Is = SCRIPTTYPE_PAGE
Call Me.pPages.AddElement(script)
Case Is = SCRIPTTYPE_ACTION
Call Me.pActions.AddElement(script)
Case Is = SCRIPTTYPE_LIBRARY
Call Me.pScriptlibs.AddElement(script)
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
Case Is = SCRIPTTYPE_DBSCRIPT
Set Me.pDbScript = script
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
End Select
Wend
'create an index of the types
Set Me.pIndex = New Index(Me.pScripts)
'build class hierarchy index
Set Me.pHierarchyIndex = New ClassHierarchyIndex(Me.pScripts)
End Sub
'/**
' * @see DocumentationWriter#Write
' */
Public Sub Write()
'if no DecisionMaker is set we use a Noop implementation
If Me.pDecisionMaker Is Nothing Then
Set Me.pDecisionMaker = New NoopDecisionMaker(Nothing)
End If
'write the index page
Call Me.pWriteIndexPage()
'write the top left frame
Call Me.pWriteOverviewFrame()
'write the bottom-left class overview frame
Call Me.pWriteClassTypeList()
'write the overview summary page
Call Me.pWriteOverviewSummary()
'write detail pages for classes
Call Me.pWriteClassDetailPages()
'write detail pages for types
Call Me.pWriteTypeDetailPages()
If Not Isempty(Me.pDbScript) Then
'write detail page for the database script
Call Me.pWriteDatabaseScriptDetailPage()
End If
'write detail pages for script libraries
Call Me.pWriteScriptLibDetailPages()
'write detail pages for forms
Call Me.pWriteFormDetailPages()
'write detail pages for views
Call Me.pWriteViewDetailPages()
'write detail pages for agents
Call Me.pWriteAgentDetailPages()
'write detail pages for pages
Call Me.pWritePageDetailPages()
'write detail pages for shared actions
Call Me.pWriteActionDetailPages()
End Sub
'/**
' * Utility method to affirm or not affirm a script element
' * based on the decision chain.
' */
Private Function pAffirm(se As Variant) As Boolean
If Me.pDecisionMaker Is Nothing Then
pAffirm = True
Else
Dim rc As Boolean
Call Me.pDecisionMaker.HandleRequest(se, rc)
pAffirm = rc
End If
End Function
'/**
' * Writes the index page.
' */
Private Sub pWriteIndexPage()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
'get output stream
Set o = Me.pOutFactory.GetOutputStream("index.html")
'write
Call o.Write(||)
Call o.Write(||)
Call o.Write(||)
Call o.Write(|LotusScript.doc - |)
Call o.Write(Me.pDocSource.Title)
Call o.Write(||)
Call o.Write(|<![CDATA[<H2>Frame Alert</H2><P>This document is designed to be viewed using the frames feature.</HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes the top-left overview frame page.
' */
Private Sub pWriteOverviewFrame()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-frame.html")
'write start
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title + | - overview frame|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%"><TR><TD NOWRAP><FONT size="+1" CLASS="FrameTitleFont">|)
Call o.Write(|<a href="|)
Call o.Write(Me.pOutFactory.GetUrl("index"))
Call o.Write(|" target="_top"><b>| + Me.pDocSource.Title + |</b></a>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'is there a database script
If Not Isempty(Me.pDbScript) Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">Database script</FONT>|)
Call o.Write(|<br />|)
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(|Database script|)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
'write spacer
Call o.Write(|<p />|)
End If
'loop pages and write
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewFrameSection("Pages", o, enum)
'loop forms and write
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewFrameSection("Forms", o, enum)
'loop views and write
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewFrameSection("Views", o, enum)
'loop agents and write
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewFrameSection("Agents", o, enum)
'loop script libraries and write
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewFrameSection("Script libraries", o, enum)
'loop shared actions and write
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewFrameSection("Shared actions", o, enum)
'write close of page
Call o.Write(|</TD></TR></TABLE></BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes a section (that is a list forms, views etc.) for the overview frame.
' */
Private Sub pWriteOverviewFrameSection(title As String, o As OutputStream, enum As Enumeration)
'declarations
Dim script As Variant
If enum.HasMoreElements() Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">| + title + |</FONT>|)
Call o.Write(|<br />|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ScriptName)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
Wend
'write spacer
Call o.Write(|<p />|)
End If
End Sub
'/**
' * Writes the bottom-left class overview frame.
' */
Private Sub pWriteClassTypeList()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim affirm As Boolean
'get output stream
Set o = Me.pOutFactory.GetOutputStream("allclasses-frame.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|All Classes|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
'get enumeration
Set enum = Me.pClazzes.Elements()
If enum.HasMoreElements() Then
'start list of classes
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Classes</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private class
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<P></P>|)
End If
'get enumeration and loop
Set enum = Me.pTypes.Elements()
If enum.HasMoreElements() Then
'start list of types
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Types</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private type
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
End If
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes an overview summary page section (that is a summary of forms, views etc.)
' */
Private Sub pWriteOverviewSummarySection(enum As Enumeration, o As OutputStream, title As String, add_alias As Boolean)
'declarations
Dim script As Variant
Dim comment As Comment
'write out if any
If enum.HasMoreElements() Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(title)
Call o.Write(|</B></FONT></TD></TR>|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|">|)
Call o.Write(script.ScriptName)
If add_alias Then
If script.ScriptAlias <> "" Then
Call o.Write(| (alias: |)
Call o.Write(script.ScriptAlias)
Call o.Write(|)|)
End If
End If
Call o.Write(|</A></B>|)
'if there a comment
Set comment = script.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
End Sub
'/**
' * Writes the overview summary page shown as default in the
' * ContentFrame.
' */
Private Sub pWriteOverviewSummary()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim comment As Comment
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-summary.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<A NAME="top"><!-- --></A>|)
Call o.Write(|<CENTER>|)
Call o.Write(|<H2>| + Me.pDocSource.Title + | </H2>|)
Call o.Write(|</CENTER>|)
Call o.Write(|<body>|)
'output database script if any
If Not Isempty(Me.pDbScript) Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(|Database script|)
Call o.Write(|</B></FONT></TD></TR>|)
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|">|)
Call o.Write(Me.pDbScript.ScriptName)
Call o.Write(|</A></B>|)
'if there a comment
Set comment = Me.pDbScript.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
'get pages and write pages if any
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Pages", False)
'get forms and write forms if any
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Forms", True)
'get views and write views if any
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Views", False)
'get agents and write agents if any
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Agents", False)
'get script libraries and write script libraries if any
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Script libraries", False)
'get shared actions and write shared actions if any
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Shared actions", False)
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Method to write the detailed pages for classes.
' */
Private Sub pWriteClassDetailPages()
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_wr As TypeEnumerationWrapper
Dim script_elem As Variant
Dim o As OutputStream
Dim enum_type As Enumeration
Dim enum_param As Enumeration
Dim obj As Variant
Dim flag As Boolean
Dim sub_enum As Enumeration
Dim hier_stack As Stack
Dim hier_elem As Variant
Dim hier_index As Integer
'get enumeration and loop scripts and find classes
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'loop script elements and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get classes - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Class | + script_elem.ElementName + |</H2>|)
'get the stack for the hierarchy
Set hier_stack = Me.pHierarchyIndex.GetStack(script_elem.ElementName)
If script_elem.ParentClazzName <> "" Then
If Not (hier_stack Is Nothing) Then
'we have an entire hierarchy - reset hier index
hier_index = 0
'start hierarchy
Call o.Write(|<PRE>|)
'loop the stack
Set hier_elem = hier_stack.Pop()
While Not (hier_elem Is Nothing)
'is this is first one ?
If hier_index = 0 Then
'yes it is - output as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
'nope
Call o.Write(Space(2 * hier_index))
Call o.Write("|")
Call o.Write("<br />")
Call o.Write(Space(2 * hier_index))
Call o.Write(|+--|)
'make as a link if this isn't the class itself
If hier_elem.ElementName <> script_elem.ElementName Then
'make as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
Call o.Write(|<B>|)
Call o.Write(hier_elem.ElementName)
Call o.Write(|</B>|)
End If
End If
'pop the next element
Set hier_elem = hier_stack.Pop()
'increment
hier_index = hier_index + 1
Wend
'end hierarchy
Call o.Write(|</PRE>|)
Else
'we only have one parent class available - start it
Call o.Write(|<PRE>|)
Call o.Write(script_elem.ParentClazzName)
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write("|")
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write(|+--|)
Call o.Write(|<B>|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</B>|)
Call o.Write(|</PRE>|)
End If
End If
'display known sub-classes if any
flag = True
Set sub_enum = script_elem.GetSubclasses().Elements()
If sub_enum.HasMoreElements() Then
Call o.Write(|Known sub-classes: |)
While sub_enum.HasMoreElements()
If Not flag Then
Call o.Write(|, |)
Else
flag = False
End If
'write link
Set hier_elem = sub_enum.NextElement()
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Wend
End If
'outout comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, script_elem.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, script_elem.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any version @-parameter
Call Me.pWriteParameters(AT_PARAM_VERSION, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write property summary (if any)
Set enum_type = script_elem.GetProperties().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWritePropertySummaryTable(enum_type, o)
End If
'write method summary (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(enum_type, o)
End If
'write function summary (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(enum_type, o)
End If
'write method details (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_type, o)
End If
'write function details (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
Wend
End Sub
'/**
' * Method to write the detailed pages for types.
' */
Private Sub pWriteTypeDetailPages()
'declarations
Dim enum As Enumeration
Dim script_elem As Variant
Dim o As OutputStream
Dim obj As Variant
Dim affirm As Boolean
Dim enum_type As Enumeration
Dim enum_param As Enumeration
'get enumeration and loop types
Set enum = Me.pTypes.Elements()
While enum.HasMoreElements()
'get next
Set script_elem = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get types - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Type | + script_elem.ElementName + |</H2>|)
'output comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write member details (if any)
Set enum_type = script_elem.GetMembers().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteTypeMembersSummaryTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
End Sub
'/**
' * Write detail page for the database script.
' */
Private Sub pWriteDatabaseScriptDetailPage()
'declarations
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = Me.pDbScript.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages("Database script", Me.pDbScript, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
End Sub
'/**
' * Write detail pages for script libraries.
' */
Private Sub pWriteScriptLibDetailPages()
Call Me.pWriteGenericDetailPages("Script library", Me.pScriptLibs)
End Sub
'/**
' * Write detail pages for forms.
' */
Private Sub pWriteFormDetailPages()
Call Me.pWriteGenericDetailPages("Form", Me.pForms)
End Sub
'/**
' * Write detail pages for views.
' */
Private Sub pWriteViewDetailPages()
Call Me.pWriteGenericDetailPages("View", Me.pViews)
End Sub
'/**
' * Write detail pages for agents.
' */
Private Sub pWriteAgentDetailPages()
Call Me.pWriteGenericDetailPages("Agent", Me.pAgents)
End Sub
'/**
' * Write detail pages for pages.
' */
Private Sub pWritePageDetailPages()
Call Me.pWriteGenericDetailPages("Page", Me.pPages)
End Sub
'/**
' * Write detail pages for shared actions.
' */
Private Sub pWriteActionDetailPages()
Call Me.pWriteGenericDetailPages("Shared action", Me.pActions)
End Sub
'/**
' * Generic method that takes a title and a Vector of scripts and
' * creates an Enumeration for each of the types and writes a page.
' */
Private Sub pWriteGenericDetailPages(title As String, scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'loop scripts
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next script
Set script = enum.NextElement()
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages(title, script, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
Wend
End Sub
'/**
' * Utility method used to write detail pages for:
' * <ul>
' * <li>forms</li>
' * <li>views</li>
' * <li>agents</li>
' * <li>script libraries</li>
' * </ul>
' */
Private Sub pWriteFVASDetailPages(title As String, script As Variant, consts As Enumeration, classes As Enumeration, properties As Enumeration, methods As Enumeration, functions As Enumeration, types As Enumeration)
'declarations
Dim o As OutputStream
Dim obj As Variant
'get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script.ScriptName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(title + " " + script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br>|)
Call o.Write(script.ScriptName + |</H2>|)
'write comment if any
If Not (script.Comment Is Nothing) Then
Call o.Write(script.Comment.Comment)
Call o.Write(|<p></p>|)
End If
'write const summary (if any)
If Not (consts Is Nothing) And consts.HasMoreElements() Then
Call Me.pWriteConstSummaryTable(consts, o)
End If
'write classes summary (if any)
If Not (classes Is Nothing) And classes.HasMoreElements() Then
Call Me.pWriteClassSummaryTable(classes, o)
End If
'write types summary (if any)
If Not (types Is Nothing) And types.HasMoreElements() Then
Call Me.pWriteTypeSummaryTable(types, o)
End If
'write methods summary (if any)
If Not (methods Is Nothing) And methods.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(methods, o)
End If
'write function summary (if any)
If Not (functions Is Nothing) And functions.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(functions, o)
End If
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
'separate
Call o.Write(|<hr size="1">|)
'write methods summary (if any)
If Not (enum_methods Is Nothing) And enum_methods.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_methods, o)
End If
'write function details (if any)
If Not (enum_functions Is Nothing) And enum_functions.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_functions, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End Sub
'/**
' * Writes a summary table of properties.
' */
Private Sub pWritePropertySummaryTable(properties As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="properties_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Property Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While properties.HasMoreElements()
'get next
Set obj = properties.NextElement()
'should we ignore the property because it is private
If Not Me.pAffirm(obj) Then
'ignore private property
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.PropertyDatatype) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.PropertyDatatype)))
Call o.Write(|">|)
Call o.Write(obj.PropertyDatatype)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.PropertyDatatype)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the property
Call o.Write(obj.ElementName)
If obj.PropertyWrite Then
o.Write(| (Set)|)
Else
o.Write(| (Get)|)
End If
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
End If
'close
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of constants.
' */
Private Sub pWriteConstSummaryTable(consts As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Constants Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While consts.HasMoreElements()
'get next
Set obj = consts.NextElement()
'should we ignore the constant because it is private
If Not Me.pAffirm(obj) Then
'ignore constant
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
Call o.Write(obj.ConstDatatype)
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the const
Call o.Write(obj.ElementName)
Call o.Write(| = |)
'write the value of the constant
Call o.Write(obj.ConstReturnValue)
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of classes.
' */
Private Sub pWriteClassSummaryTable(classes As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Class Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While classes.HasMoreElements()
'get next
Set obj = classes.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of types.
' */
Private Sub pWriteTypeSummaryTable(types As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="types_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Type Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While types.HasMoreElements()
'get next
Set obj = types.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of methods.
' */
Private Sub pWriteMethodSummaryTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Methods Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since it is private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
If obj.ModifierString = "" Then
Call o.Write(HTML_NBSP)
Else
Call o.Write(obj.ModifierString)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the method
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a detailed table of methods.
' */
Private Sub pWriteMethodDetailsTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Method Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
If obj.ElementName <> "New" Then
Call o.Write(|Sub |)
End If
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a summary table of functions.
' */
Private Sub pWriteFunctionSummaryTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="functions_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Functions Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.ReturnValue) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ReturnValue)))
Call o.Write(|">|)
Call o.Write(obj.ReturnValue)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.ReturnValue)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the function
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a detailed table of functions.
' */
Private Sub pWriteFunctionDetailsTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
Dim enum_param As Enumeration
Dim param As Variant
'write
Call o.Write(|<A NAME="functions_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Function Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
Call o.Write(|Function |)
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'add return type
Call o.Write(| As |)
Call o.Write(obj.ReturnValue)
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any return @-parameters
Call Me.pWriteParameters(AT_PARAM_RETURN, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a summary table of type members.
' */
Private Sub pWriteTypeMembersSummaryTable(members As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="members_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Members Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While members.HasMoreElements()
'get next
Set obj = members.NextElement()
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="1%">|)
Call o.Write(obj.ArgumentName)
Call o.Write(| As |)
If Me.pIndex.GetKey(obj.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ArgumentDatatype)) + |">| + obj.ArgumentDatatype + |</a>|)
Else
Call o.Write(obj.ArgumentDatatype)
End If
'stop row
Call o.Write(|</TD></TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes the parameters with the supplied name (if any) to the
' * provided OutputStream.
' */
Private Sub pWriteParameters(param_name As String, comment As Comment, o As OutputStream)
'declarations
Dim enum_param As Enumeration
Dim parameters As Variant
Dim param As Variant
Dim type_key As String
'get parameters
Set parameters = comment.GetParameters(param_name)
If Not (parameters Is Nothing) Then
Call o.Write(|<DL><DT><B>|)
Select Case param_name
Case Is = AT_PARAM_DEPENDS
Call o.Write(|Depends on:|)
Case Is = AT_PARAM_ERROR
Call o.Write(|Error(s):|)
Case Is = AT_PARAM_PARAM
Call o.Write(|Parameter(s):|)
Case Is = AT_PARAM_RETURN
Call o.Write(|Returns:|)
Case Is = AT_PARAM_SEE
Call o.Write(|See:|)
Case Is = AT_PARAM_VERSION
Call o.Write(|Version:|)
Case Is = AT_PARAM_AUTHOR
Call o.Write(|Author:|)
End Select
Call o.Write(|</B>|)
Set enum_param = parameters.Elements()
While enum_param.HasMoreElements()
Select Case param_name
Case Is = AT_PARAM_SEE
'get parameter
Set param = enum_param.NextElement()
'get link
type_key = Me.pIndex.GetKey(param.MainPart)
'start param entry
Call o.Write(|<DD>|)
'create link is possible
If type_key <> "" Then
'know type - create link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(type_key))
If param.SubPart <> "" Then
Call o.Write("#" + param.SubPart)
End If
'close link
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(param.ParamText)
Call o.Write(|</A>|)
Else
'link not found - output all text
Call o.Write(param.ParamText)
End If
'terminate param-entry
Call o.Write(|</DD>|)
Case Is = AT_PARAM_PARAM
Set param = enum_param.NextElement()
Call o.Write(|<DD><CODE>| + param.MainPart + |</CODE> - | + param.SubPart + |</DD>|)
Case Else
Call o.Write(|<DD>| + enum_param.NextElement().ParamText + |</DD>|)
End Select
Wend
Call o.Write(|</DT></DL>|)
End If
End Sub
End Class
Private Sub lsdoc_description
%REM
Classes that know how to format the source hierarchy for browsable documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: OutputStream" />
<usereference name="CLASS: Script" />
<usereference name="CLASS: OutputStreamFactory" />
<usereference name="CLASS: Index" />
<usereference name="CLASS: ClassHierarchyIndex" />
<usereference name="CLASS: LSDocConstants" />
<usereference name="CLASS: DecisionMaker" />
<usereference name="CLASS: Collections" />
<class name="DocumentationWriter" visibility="Public">
<code><![CDATA[Public Class DocumentationWriter
'declarations
Private pDocSource As Variant
Private pScripts As Vector
Private pOutFactory As OutputStreamFactory
Private pDecisionMaker As DecisionMaker
'/**
' * Constructor.
' *
' * @param title The window title of the documentation.
' * @param scripts Vector of scripts (forms, views etc.) to process.
' * @param output_factory OutputStreamFactory to provide OutputStream objects.
' */
Public Sub New(doc_source As Variant, output_factory As OutputStreamFactory)
If Typename(doc_source) <> "DOCUMENTATIONSOURCE" Then
'not a DocumentationSource object - raise error
Error 9999, "You must supply a DocumentationSource object."
End If
Set Me.pDocSource = doc_source
Set Me.pOutFactory = output_factory
'get the scripts to process from the DocumentationSource
Set Me.pScripts = Me.pDocSource.Scripts
End Sub
'/**
' * Set a DecisionMaker chain.
' */
Public Property Set DecisionMaker As DecisionMaker
Set Me.pDecisionMaker = DecisionMaker
End Property
'/**
' * Called to write the documentation.
' *
' */
Public Sub Write()
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pDocSource" visibility="Private">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDocSource As Variant]]]]><![CDATA[></code>
<comment />
</member>
<member name="pScripts" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pScripts As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pOutFactory" visibility="Private">
<datatype idref="OutputStreamFactory" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pOutFactory As OutputStreamFactory]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDecisionMaker" visibility="Private">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDecisionMaker As DecisionMaker]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="doc_source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="output_factory">
<datatype idref="OutputStreamFactory" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(doc_source As Variant, output_factory As OutputStreamFactory)
If Typename(doc_source) <> "DOCUMENTATIONSOURCE" Then
'not a DocumentationSource object - raise error
Error 9999, "You must supply a DocumentationSource object."
End If
Set Me.pDocSource = doc_source
Set Me.pOutFactory = output_factory
'get the scripts to process from the DocumentationSource
Set Me.pScripts = Me.pDocSource.Scripts
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="DecisionMaker" visibility="Public" setter="true">
<datatype idref="DecisionMaker" />
<code><![CDATA[Public Property Set DecisionMaker As DecisionMaker
Set Me.pDecisionMaker = DecisionMaker
End Property]]]]><![CDATA[></code>
<comment />
</property>
<sub name="Write" visibility="Public">
<code><![CDATA[Public Sub Write()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="FramesDocumentationWriter" visibility="Public">
<parentClass>DocumentationWriter</parentClass>
<hierarchy>
<class>DocumentationWriter</class>
<class>FramesDocumentationWriter</class>
</hierarchy>
<code><![CDATA[Public Class FramesDocumentationWriter As DocumentationWriter
'declarations
Private pIndex As Index
Private pDbScript As Variant
Private pForms As Vector
Private pViews As Vector
Private pAgents As Vector
Private pScriptlibs As Vector
Private pPages As Vector
Private pActions As Vector
Private pClazzes As Vector
Private pTypes As Vector
Private pHierarchyIndex As ClassHierarchyIndex
'/**
' * Constructor.
' *
' */
Public Sub New(doc_source As Variant, output_factory As OutputStreamFactory), DocumentationWriter(doc_source, output_factory)
'declarations
Dim enum As Enumeration
Dim enum_wr As Enumeration
Dim script As Variant
Dim script_elem As Variant
'create vectors
Set Me.pForms = New SortedVector()
Set Me.pViews = New SortedVector()
Set Me.pAgents = New SortedVector()
Set Me.pScriptlibs = New SortedVector()
Set Me.pPages = New SortedVector()
Set Me.pActions = New SortedVector()
Set Me.pClazzes = New SortedVector()
Set Me.pTypes = New SortedVector()
'get enumeration and loop scripts and split into types
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
Select Case script.ScriptType
Case Is = SCRIPTTYPE_FORM
Call Me.pForms.AddElement(script)
Case Is = SCRIPTTYPE_VIEW
Call Me.pViews.AddElement(script)
Case Is = SCRIPTTYPE_AGENT
Call Me.pAgents.AddElement(script)
Case Is = SCRIPTTYPE_PAGE
Call Me.pPages.AddElement(script)
Case Is = SCRIPTTYPE_ACTION
Call Me.pActions.AddElement(script)
Case Is = SCRIPTTYPE_LIBRARY
Call Me.pScriptlibs.AddElement(script)
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
Case Is = SCRIPTTYPE_DBSCRIPT
Set Me.pDbScript = script
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
End Select
Wend
'create an index of the types
Set Me.pIndex = New Index(Me.pScripts)
'build class hierarchy index
Set Me.pHierarchyIndex = New ClassHierarchyIndex(Me.pScripts)
End Sub
'/**
' * @see DocumentationWriter#Write
' */
Public Sub Write()
'if no DecisionMaker is set we use a Noop implementation
If Me.pDecisionMaker Is Nothing Then
Set Me.pDecisionMaker = New NoopDecisionMaker(Nothing)
End If
'write the index page
Call Me.pWriteIndexPage()
'write the top left frame
Call Me.pWriteOverviewFrame()
'write the bottom-left class overview frame
Call Me.pWriteClassTypeList()
'write the overview summary page
Call Me.pWriteOverviewSummary()
'write detail pages for classes
Call Me.pWriteClassDetailPages()
'write detail pages for types
Call Me.pWriteTypeDetailPages()
If Not Isempty(Me.pDbScript) Then
'write detail page for the database script
Call Me.pWriteDatabaseScriptDetailPage()
End If
'write detail pages for script libraries
Call Me.pWriteScriptLibDetailPages()
'write detail pages for forms
Call Me.pWriteFormDetailPages()
'write detail pages for views
Call Me.pWriteViewDetailPages()
'write detail pages for agents
Call Me.pWriteAgentDetailPages()
'write detail pages for pages
Call Me.pWritePageDetailPages()
'write detail pages for shared actions
Call Me.pWriteActionDetailPages()
End Sub
'/**
' * Utility method to affirm or not affirm a script element
' * based on the decision chain.
' */
Private Function pAffirm(se As Variant) As Boolean
If Me.pDecisionMaker Is Nothing Then
pAffirm = True
Else
Dim rc As Boolean
Call Me.pDecisionMaker.HandleRequest(se, rc)
pAffirm = rc
End If
End Function
'/**
' * Writes the index page.
' */
Private Sub pWriteIndexPage()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
'get output stream
Set o = Me.pOutFactory.GetOutputStream("index.html")
'write
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd>|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>LotusScript.doc - |)
Call o.Write(Me.pDocSource.Title)
Call o.Write(|</TITLE></HEAD>|)
Call o.Write(|<FRAMESET cols="20%,80%">|)
Call o.Write(|<FRAMESET rows="50%,50%">|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("overview-frame"))
Call o.Write(|" name="scriptListFrame">|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("allclasses-frame"))
Call o.Write(|" name="classFrame">|)
Call o.Write(|</FRAMESET>|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("overview-summary"))
Call o.Write(|" name="ContentFrame">|)
Call o.Write(|</FRAMESET><NOFRAMES><H2>Frame Alert</H2><P>This document is designed to be viewed using the frames feature.</HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes the top-left overview frame page.
' */
Private Sub pWriteOverviewFrame()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-frame.html")
'write start
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title + | - overview frame|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%"><TR><TD NOWRAP><FONT size="+1" CLASS="FrameTitleFont">|)
Call o.Write(|<a href="|)
Call o.Write(Me.pOutFactory.GetUrl("index"))
Call o.Write(|" target="_top"><b>| + Me.pDocSource.Title + |</b></a>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'is there a database script
If Not Isempty(Me.pDbScript) Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">Database script</FONT>|)
Call o.Write(|<br />|)
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(|Database script|)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
'write spacer
Call o.Write(|<p />|)
End If
'loop pages and write
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewFrameSection("Pages", o, enum)
'loop forms and write
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewFrameSection("Forms", o, enum)
'loop views and write
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewFrameSection("Views", o, enum)
'loop agents and write
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewFrameSection("Agents", o, enum)
'loop script libraries and write
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewFrameSection("Script libraries", o, enum)
'loop shared actions and write
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewFrameSection("Shared actions", o, enum)
'write close of page
Call o.Write(|</TD></TR></TABLE></BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes a section (that is a list forms, views etc.) for the overview frame.
' */
Private Sub pWriteOverviewFrameSection(title As String, o As OutputStream, enum As Enumeration)
'declarations
Dim script As Variant
If enum.HasMoreElements() Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">| + title + |</FONT>|)
Call o.Write(|<br />|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ScriptName)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
Wend
'write spacer
Call o.Write(|<p />|)
End If
End Sub
'/**
' * Writes the bottom-left class overview frame.
' */
Private Sub pWriteClassTypeList()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim affirm As Boolean
'get output stream
Set o = Me.pOutFactory.GetOutputStream("allclasses-frame.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|All Classes|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
'get enumeration
Set enum = Me.pClazzes.Elements()
If enum.HasMoreElements() Then
'start list of classes
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Classes</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private class
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<P></P>|)
End If
'get enumeration and loop
Set enum = Me.pTypes.Elements()
If enum.HasMoreElements() Then
'start list of types
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Types</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private type
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
End If
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Writes an overview summary page section (that is a summary of forms, views etc.)
' */
Private Sub pWriteOverviewSummarySection(enum As Enumeration, o As OutputStream, title As String, add_alias As Boolean)
'declarations
Dim script As Variant
Dim comment As Comment
'write out if any
If enum.HasMoreElements() Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(title)
Call o.Write(|</B></FONT></TD></TR>|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|">|)
Call o.Write(script.ScriptName)
If add_alias Then
If script.ScriptAlias <> "" Then
Call o.Write(| (alias: |)
Call o.Write(script.ScriptAlias)
Call o.Write(|)|)
End If
End If
Call o.Write(|</A></B>|)
'if there a comment
Set comment = script.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
End Sub
'/**
' * Writes the overview summary page shown as default in the
' * ContentFrame.
' */
Private Sub pWriteOverviewSummary()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim comment As Comment
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-summary.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<A NAME="top"><!-- --></A>|)
Call o.Write(|<CENTER>|)
Call o.Write(|<H2>| + Me.pDocSource.Title + | </H2>|)
Call o.Write(|</CENTER>|)
Call o.Write(|<body>|)
'output database script if any
If Not Isempty(Me.pDbScript) Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(|Database script|)
Call o.Write(|</B></FONT></TD></TR>|)
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|">|)
Call o.Write(Me.pDbScript.ScriptName)
Call o.Write(|</A></B>|)
'if there a comment
Set comment = Me.pDbScript.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
'get pages and write pages if any
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Pages", False)
'get forms and write forms if any
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Forms", True)
'get views and write views if any
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Views", False)
'get agents and write agents if any
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Agents", False)
'get script libraries and write script libraries if any
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Script libraries", False)
'get shared actions and write shared actions if any
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Shared actions", False)
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub
'/**
' * Method to write the detailed pages for classes.
' */
Private Sub pWriteClassDetailPages()
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_wr As TypeEnumerationWrapper
Dim script_elem As Variant
Dim o As OutputStream
Dim enum_type As Enumeration
Dim enum_param As Enumeration
Dim obj As Variant
Dim flag As Boolean
Dim sub_enum As Enumeration
Dim hier_stack As Stack
Dim hier_elem As Variant
Dim hier_index As Integer
'get enumeration and loop scripts and find classes
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'loop script elements and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get classes - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Class | + script_elem.ElementName + |</H2>|)
'get the stack for the hierarchy
Set hier_stack = Me.pHierarchyIndex.GetStack(script_elem.ElementName)
If script_elem.ParentClazzName <> "" Then
If Not (hier_stack Is Nothing) Then
'we have an entire hierarchy - reset hier index
hier_index = 0
'start hierarchy
Call o.Write(|<PRE>|)
'loop the stack
Set hier_elem = hier_stack.Pop()
While Not (hier_elem Is Nothing)
'is this is first one ?
If hier_index = 0 Then
'yes it is - output as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
'nope
Call o.Write(Space(2 * hier_index))
Call o.Write("|")
Call o.Write("<br />")
Call o.Write(Space(2 * hier_index))
Call o.Write(|+--|)
'make as a link if this isn't the class itself
If hier_elem.ElementName <> script_elem.ElementName Then
'make as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
Call o.Write(|<B>|)
Call o.Write(hier_elem.ElementName)
Call o.Write(|</B>|)
End If
End If
'pop the next element
Set hier_elem = hier_stack.Pop()
'increment
hier_index = hier_index + 1
Wend
'end hierarchy
Call o.Write(|</PRE>|)
Else
'we only have one parent class available - start it
Call o.Write(|<PRE>|)
Call o.Write(script_elem.ParentClazzName)
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write("|")
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write(|+--|)
Call o.Write(|<B>|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</B>|)
Call o.Write(|</PRE>|)
End If
End If
'display known sub-classes if any
flag = True
Set sub_enum = script_elem.GetSubclasses().Elements()
If sub_enum.HasMoreElements() Then
Call o.Write(|Known sub-classes: |)
While sub_enum.HasMoreElements()
If Not flag Then
Call o.Write(|, |)
Else
flag = False
End If
'write link
Set hier_elem = sub_enum.NextElement()
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Wend
End If
'outout comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, script_elem.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, script_elem.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any version @-parameter
Call Me.pWriteParameters(AT_PARAM_VERSION, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write property summary (if any)
Set enum_type = script_elem.GetProperties().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWritePropertySummaryTable(enum_type, o)
End If
'write method summary (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(enum_type, o)
End If
'write function summary (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(enum_type, o)
End If
'write method details (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_type, o)
End If
'write function details (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
Wend
End Sub
'/**
' * Method to write the detailed pages for types.
' */
Private Sub pWriteTypeDetailPages()
'declarations
Dim enum As Enumeration
Dim script_elem As Variant
Dim o As OutputStream
Dim obj As Variant
Dim affirm As Boolean
Dim enum_type As Enumeration
Dim enum_param As Enumeration
'get enumeration and loop types
Set enum = Me.pTypes.Elements()
While enum.HasMoreElements()
'get next
Set script_elem = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get types - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Type | + script_elem.ElementName + |</H2>|)
'output comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write member details (if any)
Set enum_type = script_elem.GetMembers().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteTypeMembersSummaryTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
End Sub
'/**
' * Write detail page for the database script.
' */
Private Sub pWriteDatabaseScriptDetailPage()
'declarations
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = Me.pDbScript.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages("Database script", Me.pDbScript, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
End Sub
'/**
' * Write detail pages for script libraries.
' */
Private Sub pWriteScriptLibDetailPages()
Call Me.pWriteGenericDetailPages("Script library", Me.pScriptLibs)
End Sub
'/**
' * Write detail pages for forms.
' */
Private Sub pWriteFormDetailPages()
Call Me.pWriteGenericDetailPages("Form", Me.pForms)
End Sub
'/**
' * Write detail pages for views.
' */
Private Sub pWriteViewDetailPages()
Call Me.pWriteGenericDetailPages("View", Me.pViews)
End Sub
'/**
' * Write detail pages for agents.
' */
Private Sub pWriteAgentDetailPages()
Call Me.pWriteGenericDetailPages("Agent", Me.pAgents)
End Sub
'/**
' * Write detail pages for pages.
' */
Private Sub pWritePageDetailPages()
Call Me.pWriteGenericDetailPages("Page", Me.pPages)
End Sub
'/**
' * Write detail pages for shared actions.
' */
Private Sub pWriteActionDetailPages()
Call Me.pWriteGenericDetailPages("Shared action", Me.pActions)
End Sub
'/**
' * Generic method that takes a title and a Vector of scripts and
' * creates an Enumeration for each of the types and writes a page.
' */
Private Sub pWriteGenericDetailPages(title As String, scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'loop scripts
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next script
Set script = enum.NextElement()
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages(title, script, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
Wend
End Sub
'/**
' * Utility method used to write detail pages for:
' * <ul>
' * <li>forms</li>
' * <li>views</li>
' * <li>agents</li>
' * <li>script libraries</li>
' * </ul>
' */
Private Sub pWriteFVASDetailPages(title As String, script As Variant, consts As Enumeration, classes As Enumeration, properties As Enumeration, methods As Enumeration, functions As Enumeration, types As Enumeration)
'declarations
Dim o As OutputStream
Dim obj As Variant
'get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script.ScriptName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(title + " " + script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br>|)
Call o.Write(script.ScriptName + |</H2>|)
'write comment if any
If Not (script.Comment Is Nothing) Then
Call o.Write(script.Comment.Comment)
Call o.Write(|<p></p>|)
End If
'write const summary (if any)
If Not (consts Is Nothing) And consts.HasMoreElements() Then
Call Me.pWriteConstSummaryTable(consts, o)
End If
'write classes summary (if any)
If Not (classes Is Nothing) And classes.HasMoreElements() Then
Call Me.pWriteClassSummaryTable(classes, o)
End If
'write types summary (if any)
If Not (types Is Nothing) And types.HasMoreElements() Then
Call Me.pWriteTypeSummaryTable(types, o)
End If
'write methods summary (if any)
If Not (methods Is Nothing) And methods.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(methods, o)
End If
'write function summary (if any)
If Not (functions Is Nothing) And functions.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(functions, o)
End If
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
'separate
Call o.Write(|<hr size="1">|)
'write methods summary (if any)
If Not (enum_methods Is Nothing) And enum_methods.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_methods, o)
End If
'write function details (if any)
If Not (enum_functions Is Nothing) And enum_functions.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_functions, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End Sub
'/**
' * Writes a summary table of properties.
' */
Private Sub pWritePropertySummaryTable(properties As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="properties_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Property Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While properties.HasMoreElements()
'get next
Set obj = properties.NextElement()
'should we ignore the property because it is private
If Not Me.pAffirm(obj) Then
'ignore private property
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.PropertyDatatype) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.PropertyDatatype)))
Call o.Write(|">|)
Call o.Write(obj.PropertyDatatype)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.PropertyDatatype)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the property
Call o.Write(obj.ElementName)
If obj.PropertyWrite Then
o.Write(| (Set)|)
Else
o.Write(| (Get)|)
End If
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
End If
'close
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of constants.
' */
Private Sub pWriteConstSummaryTable(consts As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Constants Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While consts.HasMoreElements()
'get next
Set obj = consts.NextElement()
'should we ignore the constant because it is private
If Not Me.pAffirm(obj) Then
'ignore constant
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
Call o.Write(obj.ConstDatatype)
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the const
Call o.Write(obj.ElementName)
Call o.Write(| = |)
'write the value of the constant
Call o.Write(obj.ConstReturnValue)
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of classes.
' */
Private Sub pWriteClassSummaryTable(classes As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Class Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While classes.HasMoreElements()
'get next
Set obj = classes.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of types.
' */
Private Sub pWriteTypeSummaryTable(types As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="types_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Type Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While types.HasMoreElements()
'get next
Set obj = types.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a summary table of methods.
' */
Private Sub pWriteMethodSummaryTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Methods Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since it is private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
If obj.ModifierString = "" Then
Call o.Write(HTML_NBSP)
Else
Call o.Write(obj.ModifierString)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the method
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes a detailed table of methods.
' */
Private Sub pWriteMethodDetailsTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Method Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
If obj.ElementName <> "New" Then
Call o.Write(|Sub |)
End If
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a summary table of functions.
' */
Private Sub pWriteFunctionSummaryTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="functions_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Functions Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.ReturnValue) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ReturnValue)))
Call o.Write(|">|)
Call o.Write(obj.ReturnValue)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.ReturnValue)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the function
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a detailed table of functions.
' */
Private Sub pWriteFunctionDetailsTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
Dim enum_param As Enumeration
Dim param As Variant
'write
Call o.Write(|<A NAME="functions_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Function Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
Call o.Write(|Function |)
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'add return type
Call o.Write(| As |)
Call o.Write(obj.ReturnValue)
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any return @-parameters
Call Me.pWriteParameters(AT_PARAM_RETURN, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub
'/**
' * Writes a summary table of type members.
' */
Private Sub pWriteTypeMembersSummaryTable(members As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="members_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Members Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While members.HasMoreElements()
'get next
Set obj = members.NextElement()
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="1%">|)
Call o.Write(obj.ArgumentName)
Call o.Write(| As |)
If Me.pIndex.GetKey(obj.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ArgumentDatatype)) + |">| + obj.ArgumentDatatype + |</a>|)
Else
Call o.Write(obj.ArgumentDatatype)
End If
'stop row
Call o.Write(|</TD></TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub
'/**
' * Writes the parameters with the supplied name (if any) to the
' * provided OutputStream.
' */
Private Sub pWriteParameters(param_name As String, comment As Comment, o As OutputStream)
'declarations
Dim enum_param As Enumeration
Dim parameters As Variant
Dim param As Variant
Dim type_key As String
'get parameters
Set parameters = comment.GetParameters(param_name)
If Not (parameters Is Nothing) Then
Call o.Write(|<DL><DT><B>|)
Select Case param_name
Case Is = AT_PARAM_DEPENDS
Call o.Write(|Depends on:|)
Case Is = AT_PARAM_ERROR
Call o.Write(|Error(s):|)
Case Is = AT_PARAM_PARAM
Call o.Write(|Parameter(s):|)
Case Is = AT_PARAM_RETURN
Call o.Write(|Returns:|)
Case Is = AT_PARAM_SEE
Call o.Write(|See:|)
Case Is = AT_PARAM_VERSION
Call o.Write(|Version:|)
Case Is = AT_PARAM_AUTHOR
Call o.Write(|Author:|)
End Select
Call o.Write(|</B>|)
Set enum_param = parameters.Elements()
While enum_param.HasMoreElements()
Select Case param_name
Case Is = AT_PARAM_SEE
'get parameter
Set param = enum_param.NextElement()
'get link
type_key = Me.pIndex.GetKey(param.MainPart)
'start param entry
Call o.Write(|<DD>|)
'create link is possible
If type_key <> "" Then
'know type - create link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(type_key))
If param.SubPart <> "" Then
Call o.Write("#" + param.SubPart)
End If
'close link
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(param.ParamText)
Call o.Write(|</A>|)
Else
'link not found - output all text
Call o.Write(param.ParamText)
End If
'terminate param-entry
Call o.Write(|</DD>|)
Case Is = AT_PARAM_PARAM
Set param = enum_param.NextElement()
Call o.Write(|<DD><CODE>| + param.MainPart + |</CODE> - | + param.SubPart + |</DD>|)
Case Else
Call o.Write(|<DD>| + enum_param.NextElement().ParamText + |</DD>|)
End Select
Wend
Call o.Write(|</DT></DL>|)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pIndex" visibility="Private">
<datatype idref="Index" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pIndex As Index]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDbScript" visibility="Private">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDbScript As Variant]]]]><![CDATA[></code>
<comment />
</member>
<member name="pForms" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pForms As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pViews" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pViews As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pAgents" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pAgents As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pScriptlibs" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pScriptlibs As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pPages" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pPages As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pActions" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pActions As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pClazzes" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pClazzes As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pTypes" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pTypes As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pHierarchyIndex" visibility="Private">
<datatype idref="ClassHierarchyIndex" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pHierarchyIndex As ClassHierarchyIndex]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="doc_source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="output_factory">
<datatype idref="OutputStreamFactory" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="DocumentationWriter">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="doc_source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="output_factory">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(doc_source As Variant, output_factory As OutputStreamFactory), DocumentationWriter(doc_source, output_factory)
'declarations
Dim enum As Enumeration
Dim enum_wr As Enumeration
Dim script As Variant
Dim script_elem As Variant
'create vectors
Set Me.pForms = New SortedVector()
Set Me.pViews = New SortedVector()
Set Me.pAgents = New SortedVector()
Set Me.pScriptlibs = New SortedVector()
Set Me.pPages = New SortedVector()
Set Me.pActions = New SortedVector()
Set Me.pClazzes = New SortedVector()
Set Me.pTypes = New SortedVector()
'get enumeration and loop scripts and split into types
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
Select Case script.ScriptType
Case Is = SCRIPTTYPE_FORM
Call Me.pForms.AddElement(script)
Case Is = SCRIPTTYPE_VIEW
Call Me.pViews.AddElement(script)
Case Is = SCRIPTTYPE_AGENT
Call Me.pAgents.AddElement(script)
Case Is = SCRIPTTYPE_PAGE
Call Me.pPages.AddElement(script)
Case Is = SCRIPTTYPE_ACTION
Call Me.pActions.AddElement(script)
Case Is = SCRIPTTYPE_LIBRARY
Call Me.pScriptlibs.AddElement(script)
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
Case Is = SCRIPTTYPE_DBSCRIPT
Set Me.pDbScript = script
'loop and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get classes
Call Me.pClazzes.AddElement(script_elem)
Wend
'loop and get types
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'we only get types
Call Me.pTypes.AddElement(script_elem)
Wend
End Select
Wend
'create an index of the types
Set Me.pIndex = New Index(Me.pScripts)
'build class hierarchy index
Set Me.pHierarchyIndex = New ClassHierarchyIndex(Me.pScripts)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Write" visibility="Public">
<code><![CDATA[Public Sub Write()
'if no DecisionMaker is set we use a Noop implementation
If Me.pDecisionMaker Is Nothing Then
Set Me.pDecisionMaker = New NoopDecisionMaker(Nothing)
End If
'write the index page
Call Me.pWriteIndexPage()
'write the top left frame
Call Me.pWriteOverviewFrame()
'write the bottom-left class overview frame
Call Me.pWriteClassTypeList()
'write the overview summary page
Call Me.pWriteOverviewSummary()
'write detail pages for classes
Call Me.pWriteClassDetailPages()
'write detail pages for types
Call Me.pWriteTypeDetailPages()
If Not Isempty(Me.pDbScript) Then
'write detail page for the database script
Call Me.pWriteDatabaseScriptDetailPage()
End If
'write detail pages for script libraries
Call Me.pWriteScriptLibDetailPages()
'write detail pages for forms
Call Me.pWriteFormDetailPages()
'write detail pages for views
Call Me.pWriteViewDetailPages()
'write detail pages for agents
Call Me.pWriteAgentDetailPages()
'write detail pages for pages
Call Me.pWritePageDetailPages()
'write detail pages for shared actions
Call Me.pWriteActionDetailPages()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="pAffirm" visibility="Private">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Boolean" />
<code><![CDATA[Private Function pAffirm(se As Variant) As Boolean
If Me.pDecisionMaker Is Nothing Then
pAffirm = True
Else
Dim rc As Boolean
Call Me.pDecisionMaker.HandleRequest(se, rc)
pAffirm = rc
End If
End Function]]]]><![CDATA[></code>
<comment />
</function>
<sub name="pWriteIndexPage" visibility="Private">
<code><![CDATA[Private Sub pWriteIndexPage()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
'get output stream
Set o = Me.pOutFactory.GetOutputStream("index.html")
'write
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd>|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>LotusScript.doc - |)
Call o.Write(Me.pDocSource.Title)
Call o.Write(|</TITLE></HEAD>|)
Call o.Write(|<FRAMESET cols="20%,80%">|)
Call o.Write(|<FRAMESET rows="50%,50%">|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("overview-frame"))
Call o.Write(|" name="scriptListFrame">|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("allclasses-frame"))
Call o.Write(|" name="classFrame">|)
Call o.Write(|</FRAMESET>|)
Call o.Write(|<FRAME src="|)
Call o.Write(Me.pOutFactory.GetUrl("overview-summary"))
Call o.Write(|" name="ContentFrame">|)
Call o.Write(|</FRAMESET><NOFRAMES><H2>Frame Alert</H2><P>This document is designed to be viewed using the frames feature.</HTML>|)
'close
Call o.Close()
Delete o
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteOverviewFrame" visibility="Private">
<code><![CDATA[Private Sub pWriteOverviewFrame()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-frame.html")
'write start
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title + | - overview frame|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%"><TR><TD NOWRAP><FONT size="+1" CLASS="FrameTitleFont">|)
Call o.Write(|<a href="|)
Call o.Write(Me.pOutFactory.GetUrl("index"))
Call o.Write(|" target="_top"><b>| + Me.pDocSource.Title + |</b></a>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'is there a database script
If Not Isempty(Me.pDbScript) Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">Database script</FONT>|)
Call o.Write(|<br />|)
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(|Database script|)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
'write spacer
Call o.Write(|<p />|)
End If
'loop pages and write
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewFrameSection("Pages", o, enum)
'loop forms and write
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewFrameSection("Forms", o, enum)
'loop views and write
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewFrameSection("Views", o, enum)
'loop agents and write
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewFrameSection("Agents", o, enum)
'loop script libraries and write
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewFrameSection("Script libraries", o, enum)
'loop shared actions and write
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewFrameSection("Shared actions", o, enum)
'write close of page
Call o.Write(|</TD></TR></TABLE></BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteOverviewFrameSection" visibility="Private">
<params>
<param name="title">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="enum">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteOverviewFrameSection(title As String, o As OutputStream, enum As Enumeration)
'declarations
Dim script As Variant
If enum.HasMoreElements() Then
'write form header
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">| + title + |</FONT>|)
Call o.Write(|<br />|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'write
Call o.Write(|<FONT CLASS="FrameItemFont"><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ScriptName)
Call o.Write(|</A></FONT>|)
Call o.Write(|<br />|)
Wend
'write spacer
Call o.Write(|<p />|)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteClassTypeList" visibility="Private">
<code><![CDATA[Private Sub pWriteClassTypeList()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim affirm As Boolean
'get output stream
Set o = Me.pOutFactory.GetOutputStream("allclasses-frame.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|All Classes|)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
'get enumeration
Set enum = Me.pClazzes.Elements()
If enum.HasMoreElements() Then
'start list of classes
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Classes</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private class
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
Call o.Write(|<P></P>|)
End If
'get enumeration and loop
Set enum = Me.pTypes.Elements()
If enum.HasMoreElements() Then
'start list of types
Call o.Write(|<FONT size="+1" CLASS="FrameHeadingFont">|)
Call o.Write(|<B>Types</B></FONT>|)
Call o.Write(|<br />|)
Call o.Write(|<TABLE BORDER="0" WIDTH="100%">|)
Call o.Write(|<TR>|)
Call o.Write(|<TD NOWRAP>|)
'loop
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script) Then
'ignore private type
Else
'write element
Call o.Write(|<FONT CLASS="FrameItemFont">|)
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(script.ElementName)
Call o.Write(|</A>|)
Call o.Write(|<br />|)
End If
Wend
'stop classes
Call o.Write(|</FONT></TD></TR></TABLE>|)
End If
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteOverviewSummarySection" visibility="Private">
<params>
<param name="enum">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="title">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="add_alias">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteOverviewSummarySection(enum As Enumeration, o As OutputStream, title As String, add_alias As Boolean)
'declarations
Dim script As Variant
Dim comment As Comment
'write out if any
If enum.HasMoreElements() Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(title)
Call o.Write(|</B></FONT></TD></TR>|)
While enum.HasMoreElements()
'get next
Set script = enum.NextElement
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(script)))
Call o.Write(|">|)
Call o.Write(script.ScriptName)
If add_alias Then
If script.ScriptAlias <> "" Then
Call o.Write(| (alias: |)
Call o.Write(script.ScriptAlias)
Call o.Write(|)|)
End If
End If
Call o.Write(|</A></B>|)
'if there a comment
Set comment = script.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteOverviewSummary" visibility="Private">
<code><![CDATA[Private Sub pWriteOverviewSummary()
'declarations
Dim session As New NotesSession
Dim o As OutputStream
Dim enum As Enumeration
Dim script As Variant
Dim comment As Comment
'get output stream
Set o = Me.pOutFactory.GetOutputStream("overview-summary.html")
'start page
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(Me.pDocSource.Title)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<A NAME="top"><!-- --></A>|)
Call o.Write(|<CENTER>|)
Call o.Write(|<H2>| + Me.pDocSource.Title + | </H2>|)
Call o.Write(|</CENTER>|)
Call o.Write(|<body>|)
'output database script if any
If Not Isempty(Me.pDbScript) Then
'write header
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1"><B>|)
Call o.Write(|Database script|)
Call o.Write(|</B></FONT></TD></TR>|)
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor"><TD WIDTH="20%">|)
Call o.Write(|<B><A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(Me.pDbScript)))
Call o.Write(|">|)
Call o.Write(Me.pDbScript.ScriptName)
Call o.Write(|</A></B>|)
'if there a comment
Set comment = Me.pDbScript.Comment
If Not (comment Is Nothing) Then
Call o.Write("<br>")
Call o.Write(comment.FirstSentence)
End If
'close row
Call o.Write(|</TD><!-- <TD></TD> -->|)
Call o.Write(|</TR>|)
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End If
'get pages and write pages if any
Set enum = Me.pPages.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Pages", False)
'get forms and write forms if any
Set enum = Me.pForms.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Forms", True)
'get views and write views if any
Set enum = Me.pViews.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Views", False)
'get agents and write agents if any
Set enum = Me.pAgents.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Agents", False)
'get script libraries and write script libraries if any
Set enum = Me.pScriptlibs.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Script libraries", False)
'get shared actions and write shared actions if any
Set enum = Me.pActions.Elements()
Call Me.pWriteOverviewSummarySection(enum, o, "Shared actions", False)
'stop page
Call o.Write(|</BODY></HTML>|)
'close
Call o.Close()
Delete o
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteClassDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteClassDetailPages()
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_wr As TypeEnumerationWrapper
Dim script_elem As Variant
Dim o As OutputStream
Dim enum_type As Enumeration
Dim enum_param As Enumeration
Dim obj As Variant
Dim flag As Boolean
Dim sub_enum As Enumeration
Dim hier_stack As Stack
Dim hier_elem As Variant
Dim hier_index As Integer
'get enumeration and loop scripts and find classes
Set enum = Me.pScripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'loop script elements and get classes
Set enum_wr = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, script.GetScriptElements().Elements())
While enum_wr.HasMoreElements()
'get next
Set script_elem = enum_wr.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get classes - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Class | + script_elem.ElementName + |</H2>|)
'get the stack for the hierarchy
Set hier_stack = Me.pHierarchyIndex.GetStack(script_elem.ElementName)
If script_elem.ParentClazzName <> "" Then
If Not (hier_stack Is Nothing) Then
'we have an entire hierarchy - reset hier index
hier_index = 0
'start hierarchy
Call o.Write(|<PRE>|)
'loop the stack
Set hier_elem = hier_stack.Pop()
While Not (hier_elem Is Nothing)
'is this is first one ?
If hier_index = 0 Then
'yes it is - output as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
'nope
Call o.Write(Space(2 * hier_index))
Call o.Write("|")
Call o.Write("<br />")
Call o.Write(Space(2 * hier_index))
Call o.Write(|+--|)
'make as a link if this isn't the class itself
If hier_elem.ElementName <> script_elem.ElementName Then
'make as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Call o.Write("<br>")
Else
Call o.Write(|<B>|)
Call o.Write(hier_elem.ElementName)
Call o.Write(|</B>|)
End If
End If
'pop the next element
Set hier_elem = hier_stack.Pop()
'increment
hier_index = hier_index + 1
Wend
'end hierarchy
Call o.Write(|</PRE>|)
Else
'we only have one parent class available - start it
Call o.Write(|<PRE>|)
Call o.Write(script_elem.ParentClazzName)
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write("|")
Call o.Write("<br>")
Call o.Write(Space(2 * 1))
Call o.Write(|+--|)
Call o.Write(|<B>|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</B>|)
Call o.Write(|</PRE>|)
End If
End If
'display known sub-classes if any
flag = True
Set sub_enum = script_elem.GetSubclasses().Elements()
If sub_enum.HasMoreElements() Then
Call o.Write(|Known sub-classes: |)
While sub_enum.HasMoreElements()
If Not flag Then
Call o.Write(|, |)
Else
flag = False
End If
'write link
Set hier_elem = sub_enum.NextElement()
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(hier_elem)))
Call o.Write(|">| + hier_elem.ElementName + |</A>|)
Wend
End If
'outout comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, script_elem.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, script_elem.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any version @-parameter
Call Me.pWriteParameters(AT_PARAM_VERSION, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write property summary (if any)
Set enum_type = script_elem.GetProperties().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWritePropertySummaryTable(enum_type, o)
End If
'write method summary (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(enum_type, o)
End If
'write function summary (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(enum_type, o)
End If
'write method details (if any)
Set enum_type = script_elem.GetMethods().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_type, o)
End If
'write function details (if any)
Set enum_type = script_elem.GetFunctions().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteTypeDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteTypeDetailPages()
'declarations
Dim enum As Enumeration
Dim script_elem As Variant
Dim o As OutputStream
Dim obj As Variant
Dim affirm As Boolean
Dim enum_type As Enumeration
Dim enum_param As Enumeration
'get enumeration and loop types
Set enum = Me.pTypes.Elements()
While enum.HasMoreElements()
'get next
Set script_elem = enum.NextElement()
'should we ignore the element since it is private and
'we have been asked to ignore private content
If Not Me.pAffirm(script_elem) Then
'ignore private class
Else
'we only get types - get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script_elem) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script_elem.ElementName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(script_elem.ElementName)
Call o.Write(|</FONT>|)
Call o.Write(|<br />|)
Call o.Write(|Type | + script_elem.ElementName + |</H2>|)
'output comment
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
Call o.Write(script_elem.Comment.Comment)
End If
Call o.Write(|</p>|)
'output parameters if any
Call o.Write(|<p>|)
If Not (script_elem.Comment Is Nothing) Then
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, script_elem.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, script_elem.Comment, o)
End If
Call o.Write(|</p>|)
'output hr
Call o.Write(|<HR>|)
'write member details (if any)
Set enum_type = script_elem.GetMembers().Elements()
If enum_type.HasMoreElements() Then
Call Me.pWriteTypeMembersSummaryTable(enum_type, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End If
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteDatabaseScriptDetailPage" visibility="Private">
<code><![CDATA[Private Sub pWriteDatabaseScriptDetailPage()
'declarations
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = Me.pDbScript.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages("Database script", Me.pDbScript, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteScriptLibDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteScriptLibDetailPages()
Call Me.pWriteGenericDetailPages("Script library", Me.pScriptLibs)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteFormDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteFormDetailPages()
Call Me.pWriteGenericDetailPages("Form", Me.pForms)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteViewDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteViewDetailPages()
Call Me.pWriteGenericDetailPages("View", Me.pViews)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteAgentDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteAgentDetailPages()
Call Me.pWriteGenericDetailPages("Agent", Me.pAgents)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWritePageDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWritePageDetailPages()
Call Me.pWriteGenericDetailPages("Page", Me.pPages)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteActionDetailPages" visibility="Private">
<code><![CDATA[Private Sub pWriteActionDetailPages()
Call Me.pWriteGenericDetailPages("Shared action", Me.pActions)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteGenericDetailPages" visibility="Private">
<params>
<param name="title">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="scripts">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteGenericDetailPages(title As String, scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'loop scripts
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next script
Set script = enum.NextElement()
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_classes = New TypeEnumerationWrapper(SCRIPTELEM_CLASS, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
Set enum_types = New TypeEnumerationWrapper(SCRIPTELEM_TYPE, elements.Elements())
'build documentation for script
Call Me.pWriteFVASDetailPages(title, script, enum_consts, enum_classes, Nothing, enum_methods, enum_functions, enum_types)
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteFVASDetailPages" visibility="Private">
<params>
<param name="title">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="consts">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="classes">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="properties">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="methods">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="functions">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="types">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteFVASDetailPages(title As String, script As Variant, consts As Enumeration, classes As Enumeration, properties As Enumeration, methods As Enumeration, functions As Enumeration, types As Enumeration)
'declarations
Dim o As OutputStream
Dim obj As Variant
'get the output stream
Set o = Me.pOutFactory.GetOutputStream(Me.pIndex.GetKey(script) + ".html")
'write header
Call o.Write(|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN""http://www.w3.org/TR/REC-html40/frameset.dtd">|)
Call o.Write(|<HTML><HEAD>|)
Call o.Write(|<!-- | + LSDOC_HTML_HEADER + | -->|)
Call o.Write(|<TITLE>|)
Call o.Write(|LotusScript.doc - | + script.ScriptName)
Call o.Write(|</TITLE>|)
Call o.Write(|<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">|)
Call o.Write(|</HEAD>|)
Call o.Write(|<BODY BGCOLOR="white">|)
Call o.Write(|<H2><FONT SIZE="-1">|)
Call o.Write(title + " " + script.ScriptName)
Call o.Write(|</FONT>|)
Call o.Write(|<br>|)
Call o.Write(script.ScriptName + |</H2>|)
'write comment if any
If Not (script.Comment Is Nothing) Then
Call o.Write(script.Comment.Comment)
Call o.Write(|<p></p>|)
End If
'write const summary (if any)
If Not (consts Is Nothing) And consts.HasMoreElements() Then
Call Me.pWriteConstSummaryTable(consts, o)
End If
'write classes summary (if any)
If Not (classes Is Nothing) And classes.HasMoreElements() Then
Call Me.pWriteClassSummaryTable(classes, o)
End If
'write types summary (if any)
If Not (types Is Nothing) And types.HasMoreElements() Then
Call Me.pWriteTypeSummaryTable(types, o)
End If
'write methods summary (if any)
If Not (methods Is Nothing) And methods.HasMoreElements() Then
Call Me.pWriteMethodSummaryTable(methods, o)
End If
'write function summary (if any)
If Not (functions Is Nothing) And functions.HasMoreElements() Then
Call Me.pWriteFunctionSummaryTable(functions, o)
End If
Dim elements As Vector
Dim enum_consts As Enumeration, enum_types As Enumeration, enum_classes As Enumeration, enum_methods As Enumeration, enum_functions As Enumeration
'get script elements
Set elements = script.GetScriptElements()
'create wrappers
Set enum_consts = New TypeEnumerationWrapper(SCRIPTELEM_CONST, elements.Elements())
Set enum_methods = New TypeEnumerationWrapper(SCRIPTELEM_METHOD, elements.Elements())
Set enum_functions = New TypeEnumerationWrapper(SCRIPTELEM_FUNCTION, elements.Elements())
'separate
Call o.Write(|<hr size="1">|)
'write methods summary (if any)
If Not (enum_methods Is Nothing) And enum_methods.HasMoreElements() Then
Call Me.pWriteMethodDetailsTable(enum_methods, o)
End If
'write function details (if any)
If Not (enum_functions Is Nothing) And enum_functions.HasMoreElements() Then
Call Me.pWriteFunctionDetailsTable(enum_functions, o)
End If
'write footer
Call o.write(|</BODY></HTML>|)
'close out
Call o.Close()
Delete o
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWritePropertySummaryTable" visibility="Private">
<params>
<param name="properties">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWritePropertySummaryTable(properties As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="properties_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Property Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While properties.HasMoreElements()
'get next
Set obj = properties.NextElement()
'should we ignore the property because it is private
If Not Me.pAffirm(obj) Then
'ignore private property
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.PropertyDatatype) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.PropertyDatatype)))
Call o.Write(|">|)
Call o.Write(obj.PropertyDatatype)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.PropertyDatatype)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the property
Call o.Write(obj.ElementName)
If obj.PropertyWrite Then
o.Write(| (Set)|)
Else
o.Write(| (Get)|)
End If
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
End If
'close
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteConstSummaryTable" visibility="Private">
<params>
<param name="consts">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteConstSummaryTable(consts As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Constants Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While consts.HasMoreElements()
'get next
Set obj = consts.NextElement()
'should we ignore the constant because it is private
If Not Me.pAffirm(obj) Then
'ignore constant
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
Call o.Write(obj.ConstDatatype)
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the const
Call o.Write(obj.ElementName)
Call o.Write(| = |)
'write the value of the constant
Call o.Write(obj.ConstReturnValue)
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteClassSummaryTable" visibility="Private">
<params>
<param name="classes">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteClassSummaryTable(classes As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="constants_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Class Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While classes.HasMoreElements()
'get next
Set obj = classes.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteTypeSummaryTable" visibility="Private">
<params>
<param name="types">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteTypeSummaryTable(types As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="types_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Type Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While types.HasMoreElements()
'get next
Set obj = types.NextElement()
'should we ignore the class since it is private
If Not Me.pAffirm(obj) Then
'ignore private class
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="100%">|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'write name as link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj)))
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(obj.ElementName)
Call o.Write(|</A>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<br>|)
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
End If
'stop row
Call o.Write(|</TD>|)
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteMethodSummaryTable" visibility="Private">
<params>
<param name="methods">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteMethodSummaryTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Methods Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since it is private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
If obj.ModifierString = "" Then
Call o.Write(HTML_NBSP)
Else
Call o.Write(obj.ModifierString)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the method
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteMethodDetailsTable" visibility="Private">
<params>
<param name="methods">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteMethodDetailsTable(methods As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="methods_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Method Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While methods.HasMoreElements()
'get next
Set obj = methods.NextElement()
'should we ignore the method since private
If Not Me.pAffirm(obj) Then
'ignore private method
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
If obj.ElementName <> "New" Then
Call o.Write(|Sub |)
End If
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteFunctionSummaryTable" visibility="Private">
<params>
<param name="functions">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteFunctionSummaryTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
'write
Call o.Write(|<A NAME="functions_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Functions Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">|)
Call o.Write(|<CODE>|)
'write modifier
Call o.Write(obj.ModifierString)
Call o.Write(| |)
'see if this is a data type we know
If Me.pIndex.GetKey(obj.ReturnValue) <> "" Then
'it is
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ReturnValue)))
Call o.Write(|">|)
Call o.Write(obj.ReturnValue)
Call o.Write(|</A>|)
Else
'no we dont - just write it
Call o.Write(obj.ReturnValue)
End If
Call o.Write(|</CODE></FONT></TD>|)
Call o.Write(|<TD><CODE>|)
'write the name of the function
Call o.Write(|<a href="#| + obj.ElementName + |">| + obj.ElementName + |</a>|)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
If Me.pIndex.GetKey(arg.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(arg.ArgumentDatatype)) + |">| + arg.ArgumentDatatype + |</a>|)
Else
Call o.Write(arg.ArgumentDatatype)
End If
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
Call o.Write(|</CODE><BR>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(| |)
Call o.Write(obj.Comment.FirstSentence)
Call o.Write(|</TD>|)
End If
'stop row
Call o.Write(|</TR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteFunctionDetailsTable" visibility="Private">
<params>
<param name="functions">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteFunctionDetailsTable(functions As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
Dim arg As Variant
Dim enum_arg As Enumeration
Dim arg_first As Boolean
Dim enum_param As Enumeration
Dim param As Variant
'write
Call o.Write(|<A NAME="functions_detail"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD><FONT SIZE="+1">|)
Call o.Write(|<B>Function Detail</B>|)
Call o.Write(|</FONT></TD></TR></TABLE>|)
'loop
While functions.HasMoreElements()
'get next
Set obj = functions.NextElement()
'should we ignore the function since private
If Not Me.pAffirm(obj) Then
'ignore private function
Else
'write
Call o.Write(|<A NAME="|)
Call o.Write(obj.ElementName)
Call o.Write(|"><!-- --></A><H3>|)
Call o.Write(obj.ElementName)
Call o.Write(|</H3><PRE>|)
'write modifier
If obj.Modifier <> FRIENDLY_MODIFIER Then
Call o.Write(obj.ModifierString)
Call o.Write(| |)
End If
Call o.Write(|Function |)
Call o.Write(obj.ElementName)
'write arguments if any
Set enum_arg = obj.GetArguments().Elements
If enum_arg.HasMoreElements() Then
arg_first = True
Call o.Write(|(|)
While enum_arg.HasMoreElements()
'get next
Set arg = enum_arg.NextElement()
If Not arg_first Then
o.Write(|, |)
Else
arg_first = False
End If
o.Write(arg.ArgumentName + " As ")
Call o.Write(arg.ArgumentDatatype)
Wend
Call o.Write(|)|)
Else
'no arguments
Call o.Write(|()|)
End If
'add return type
Call o.Write(| As |)
Call o.Write(obj.ReturnValue)
'close pre
Call o.Write(|</PRE>|)
'write the comment if any
If Not (obj.Comment Is Nothing) Then
Call o.Write(|<DL><DD>|)
Call o.Write(obj.Comment.Comment)
Call o.Write(|</DD></DL>|)
'any param @-parameters
Call Me.pWriteParameters(AT_PARAM_PARAM, obj.Comment, o)
'any return @-parameters
Call Me.pWriteParameters(AT_PARAM_RETURN, obj.Comment, o)
'any error @-parameters
Call Me.pWriteParameters(AT_PARAM_ERROR, obj.Comment, o)
'any depend @-parameters
Call Me.pWriteParameters(AT_PARAM_DEPENDS, obj.Comment, o)
'any see @-parameters
Call Me.pWriteParameters(AT_PARAM_SEE, obj.Comment, o)
'any version @-parameters
Call Me.pWriteParameters(AT_PARAM_VERSION, obj.Comment, o)
'any author @-parameter
Call Me.pWriteParameters(AT_PARAM_AUTHOR, obj.Comment, o)
End If
'add spacer
Call o.Write(|<HR>|)
End If
Wend
'stop table
Call o.Write(|</TABLE><p>|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteTypeMembersSummaryTable" visibility="Private">
<params>
<param name="members">
<datatype idref="Enumeration" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteTypeMembersSummaryTable(members As Enumeration, o As OutputStream)
'declarations
Dim obj As Variant
'write
Call o.Write(|<A NAME="members_summary"><!-- --></A>|)
Call o.Write(|<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">|)
Call o.Write(|<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor"><TD COLSPAN=2><FONT SIZE="+1">|)
Call o.Write(|<B>Members Summary</B>|)
Call o.Write(|</FONT></TD></TR>|)
'loop
While members.HasMoreElements()
'get next
Set obj = members.NextElement()
'write
Call o.Write(|<TR BGCOLOR="white" CLASS="TableRowColor">|)
Call o.Write(|<TD VALIGN="top" WIDTH="1%">|)
Call o.Write(obj.ArgumentName)
Call o.Write(| As |)
If Me.pIndex.GetKey(obj.ArgumentDatatype) <> "" Then
o.Write(|<a href="| + Me.pOutFactory.GetUrl(Me.pIndex.GetKey(obj.ArgumentDatatype)) + |">| + obj.ArgumentDatatype + |</a>|)
Else
Call o.Write(obj.ArgumentDatatype)
End If
'stop row
Call o.Write(|</TD></TR>|)
Wend
'stop table
Call o.Write(|</TABLE>|)
Call o.Write(|<p />|)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pWriteParameters" visibility="Private">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="comment">
<datatype idref="Comment" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="o">
<datatype idref="OutputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pWriteParameters(param_name As String, comment As Comment, o As OutputStream)
'declarations
Dim enum_param As Enumeration
Dim parameters As Variant
Dim param As Variant
Dim type_key As String
'get parameters
Set parameters = comment.GetParameters(param_name)
If Not (parameters Is Nothing) Then
Call o.Write(|<DL><DT><B>|)
Select Case param_name
Case Is = AT_PARAM_DEPENDS
Call o.Write(|Depends on:|)
Case Is = AT_PARAM_ERROR
Call o.Write(|Error(s):|)
Case Is = AT_PARAM_PARAM
Call o.Write(|Parameter(s):|)
Case Is = AT_PARAM_RETURN
Call o.Write(|Returns:|)
Case Is = AT_PARAM_SEE
Call o.Write(|See:|)
Case Is = AT_PARAM_VERSION
Call o.Write(|Version:|)
Case Is = AT_PARAM_AUTHOR
Call o.Write(|Author:|)
End Select
Call o.Write(|</B>|)
Set enum_param = parameters.Elements()
While enum_param.HasMoreElements()
Select Case param_name
Case Is = AT_PARAM_SEE
'get parameter
Set param = enum_param.NextElement()
'get link
type_key = Me.pIndex.GetKey(param.MainPart)
'start param entry
Call o.Write(|<DD>|)
'create link is possible
If type_key <> "" Then
'know type - create link
Call o.Write(|<A HREF="|)
Call o.Write(Me.pOutFactory.GetUrl(type_key))
If param.SubPart <> "" Then
Call o.Write("#" + param.SubPart)
End If
'close link
Call o.Write(|" TARGET="ContentFrame">|)
Call o.Write(param.ParamText)
Call o.Write(|</A>|)
Else
'link not found - output all text
Call o.Write(param.ParamText)
End If
'terminate param-entry
Call o.Write(|</DD>|)
Case Is = AT_PARAM_PARAM
Set param = enum_param.NextElement()
Call o.Write(|<DD><CODE>| + param.MainPart + |</CODE> - | + param.SubPart + |</DD>|)
Case Else
Call o.Write(|<DD>| + enum_param.NextElement().ParamText + |</DD>|)
End Select
Wend
Call o.Write(|</DT></DL>|)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Classes that know how to format the source hierarchy for browsable documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: DecisionMaker" alias="" language="lotusscript">
<noteinfo>
<unid>6FA2655725A782FCC125703300239A96</unid>
<noteid>1586</noteid>
<created>03-07-2005 08:28:53</created>
<modified>19-10-2005 14:18:21</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>37</sequence>
<addedtofile>03-07-2005 08:42:09</addedtofile>
<lastaccessed>19-10-2005 14:18:21</lastaccessed>
<revised>12-08-2005 14:50:25</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: LSDocConstants"
Use "CLASS: ScriptElement"
Public Class DecisionMaker
'declarations
Private pNext As DecisionMaker
'/**
' * Constructor.
' *
' * @param next The next DecisionMaker in the chain (should be Nothing if no next DecisionMaker).
' */
Public Sub New(next_dm As DecisionMaker)
If Not next_dm Is Nothing Then
Set Me.pNext = next_dm
End If
End Sub
'/**
' * Called to get an answer to a question. Calling the method on the base class will
' * result in an error.
' *
' * @param obj The object we are to make a decision about. The object may be an instance of Script or ScriptElement (use the IsA() function to find out which).
' * @param affirm Affirm the question asked.
' * @see ScriptElement
' * @error 9999 If the method is called on the base class.
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
Error 9999, "Do not call this method on the base class."
End Sub
'/**
' * Utility method to send the request down the chain if applicable.
' *
' */
Private Sub pDelegate(se As Variant, affirm As Boolean)
If Not Me.pNext Is Nothing Then
Call Me.pNext.HandleRequest(se, affirm)
End If
End Sub
End Class
Public Class NoopDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * Affirms everything.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
affirm = True
Exit Sub
End Sub
End Class
Public Class NoPrivateDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * We check the modifier and affirm the decision if the modifier is Public
' * or Friendly.
' * <p></p>
' * We do not continue down the chain if the class does not affirm.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
'check type of object - look at the modifier
If se.Modifier = PUBLIC_MODIFIER Or se.Modifier = FRIENDLY_MODIFIER Then
'affirm
affirm = True
Else
affirm = False
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub
End Class
Public Class OnlyWithCommentDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * Checks to see whether the passed obj is a ScriptElement. If it is we
' * check that there is a comment. If there is no comment of the comment
' * is empty we do not affirm.
' * <p></p>
' * We may toggle the affirm flag though it is already True/False.
' * <p></p>
' * We do not continue down the chain if the class does not affirm.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
'declarations
Dim comment As Comment
'get the comment
Set comment = se.Comment
'look at the comment
If comment Is Nothing Then
'no comment - cannot affirm
affirm = False
Else
If comment.Comment = "" Then
affirm = False
Else
'affirm
affirm = True
End If
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub
End Class
Private Sub lsdoc_description()
%REM
This script element holds classes to make decisions at runtime about which
elements to include in the documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: LSDocConstants" />
<usereference name="CLASS: ScriptElement" />
<class name="DecisionMaker" visibility="Public">
<code><![CDATA[Public Class DecisionMaker
'declarations
Private pNext As DecisionMaker
'/**
' * Constructor.
' *
' * @param next The next DecisionMaker in the chain (should be Nothing if no next DecisionMaker).
' */
Public Sub New(next_dm As DecisionMaker)
If Not next_dm Is Nothing Then
Set Me.pNext = next_dm
End If
End Sub
'/**
' * Called to get an answer to a question. Calling the method on the base class will
' * result in an error.
' *
' * @param obj The object we are to make a decision about. The object may be an instance of Script or ScriptElement (use the IsA() function to find out which).
' * @param affirm Affirm the question asked.
' * @see ScriptElement
' * @error 9999 If the method is called on the base class.
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
Error 9999, "Do not call this method on the base class."
End Sub
'/**
' * Utility method to send the request down the chain if applicable.
' *
' */
Private Sub pDelegate(se As Variant, affirm As Boolean)
If Not Me.pNext Is Nothing Then
Call Me.pNext.HandleRequest(se, affirm)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pNext" visibility="Private">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pNext As DecisionMaker]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="next_dm">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(next_dm As DecisionMaker)
If Not next_dm Is Nothing Then
Set Me.pNext = next_dm
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="HandleRequest" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="affirm">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub HandleRequest(se As Variant, affirm As Boolean)
Error 9999, "Do not call this method on the base class."
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pDelegate" visibility="Private">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="affirm">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pDelegate(se As Variant, affirm As Boolean)
If Not Me.pNext Is Nothing Then
Call Me.pNext.HandleRequest(se, affirm)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="NoopDecisionMaker" visibility="Public">
<parentClass>DecisionMaker</parentClass>
<hierarchy>
<class>DecisionMaker</class>
<class>NoopDecisionMaker</class>
</hierarchy>
<code><![CDATA[Public Class NoopDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * Affirms everything.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
affirm = True
Exit Sub
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="next_dm">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="DecisionMaker">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="next_dm">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="HandleRequest" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="affirm">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub HandleRequest(se As Variant, affirm As Boolean)
affirm = True
Exit Sub
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="NoPrivateDecisionMaker" visibility="Public">
<parentClass>DecisionMaker</parentClass>
<hierarchy>
<class>DecisionMaker</class>
<class>NoPrivateDecisionMaker</class>
</hierarchy>
<code><![CDATA[Public Class NoPrivateDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * We check the modifier and affirm the decision if the modifier is Public
' * or Friendly.
' * <p></p>
' * We do not continue down the chain if the class does not affirm.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
'check type of object - look at the modifier
If se.Modifier = PUBLIC_MODIFIER Or se.Modifier = FRIENDLY_MODIFIER Then
'affirm
affirm = True
Else
affirm = False
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="next_dm">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="DecisionMaker">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="next_dm">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="HandleRequest" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="affirm">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub HandleRequest(se As Variant, affirm As Boolean)
'check type of object - look at the modifier
If se.Modifier = PUBLIC_MODIFIER Or se.Modifier = FRIENDLY_MODIFIER Then
'affirm
affirm = True
Else
affirm = False
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="OnlyWithCommentDecisionMaker" visibility="Public">
<parentClass>DecisionMaker</parentClass>
<hierarchy>
<class>DecisionMaker</class>
<class>OnlyWithCommentDecisionMaker</class>
</hierarchy>
<code><![CDATA[Public Class OnlyWithCommentDecisionMaker As DecisionMaker
'/**
' * @see DecisionMaker#New
' */
Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub
'/**
' * Checks to see whether the passed obj is a ScriptElement. If it is we
' * check that there is a comment. If there is no comment of the comment
' * is empty we do not affirm.
' * <p></p>
' * We may toggle the affirm flag though it is already True/False.
' * <p></p>
' * We do not continue down the chain if the class does not affirm.
' *
' * @see DecisionMaker#HandleRequest
' */
Public Sub HandleRequest(se As Variant, affirm As Boolean)
'declarations
Dim comment As Comment
'get the comment
Set comment = se.Comment
'look at the comment
If comment Is Nothing Then
'no comment - cannot affirm
affirm = False
Else
If comment.Comment = "" Then
affirm = False
Else
'affirm
affirm = True
End If
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="next_dm">
<datatype idref="DecisionMaker" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="DecisionMaker">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="next_dm">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(next_dm As DecisionMaker), DecisionMaker(next_dm)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="HandleRequest" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="affirm">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub HandleRequest(se As Variant, affirm As Boolean)
'declarations
Dim comment As Comment
'get the comment
Set comment = se.Comment
'look at the comment
If comment Is Nothing Then
'no comment - cannot affirm
affirm = False
Else
If comment.Comment = "" Then
affirm = False
Else
'affirm
affirm = True
End If
End If
If affirm Then
'send down the chain if applicable
Call Me.pDelegate(se, affirm)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description()
%REM
This script element holds classes to make decisions at runtime about which
elements to include in the documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: OutputStream" alias="" language="lotusscript">
<noteinfo>
<unid>DA92C1E77B1B1E74C1256FD7007DFB33</unid>
<noteid>4ba</noteid>
<created>03-04-2005 00:56:03</created>
<modified>19-10-2005 14:18:21</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>20</sequence>
<addedtofile>03-04-2005 00:56:03</addedtofile>
<lastaccessed>19-10-2005 14:18:21</lastaccessed>
<revised>15-10-2005 14:52:49</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: LsDocConstants"
Public Class OutputStream
'declarations
Private pSession As NotesSession
Private pStream As NotesStream
Private pCharset As String
'/**
' * Constructor.
' */
Public Sub New()
'get session
Set Me.pSession = New NotesSession
End Sub
'/**
' * Destructor.
' */
Public Sub Delete()
'make sure the stream has been closed
Call Me.Close()
End Sub
'/**
' * Sets the charset to use.
' */
Public Property Set Charset(charzet As String)
Me.pCharset = charzet
End Property
'/**
' * Opens the OutputStream.
' */
Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
End Sub
'/**
' * Closes the stream.
' */
Public Sub Close()
If Not (Me.pStream Is Nothing) Then
Call Me.pStream.Close()
Set Me.pStream = Nothing
End If
End Sub
'/**
' * Writes data to the stream.
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The OutputStream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub
End Class
Public Class FileOutputStream As OutputStream
'declarations
Private pFilename As String
Private pReplaceExisting As Boolean
'/**
' * Constructor.
' */
Public Sub New(filename As String, replace_existing As Boolean), OutputStream()
Me.pFilename = filename
Me.pReplaceExisting = replace_existing
End Sub
'/**
' * Opens the file.
' */
Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
'should we replace ?
If Me.pReplaceExisting Then
'set up error handling
On Error Goto catch_fileexist
'does the file exist already
If Filelen(Me.pFilename) Then
'the file exists - delete it
Kill Me.pFilename
End If
Goto finally_fileexist
catch_fileexist:
'the file doesn't exist
Resume finally_fileexist
finally_fileexist:
'reset error handling
On Error Goto 0
End If
'try and open the file
If Me.pCharset <> "" Then
'use custom charset
rc = Me.pStream.Open(Me.pFilename, Me.pCharset)
Else
'use default charset
rc = Me.pStream.Open(Me.pFilename, DEFAULT_CHARSET)
End If
'did we open the file correctly ?
If Not rc Then
'could not open the file
Error ERROR_OUTPUT_UNABLE_TO_OPEN_FILE, "Unable to open file: " + Me.pFilename
End If
End Sub
'/**
' * Writes text to the writer.
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub
End Class
Public Class LineFileOutputStream As FileOutputStream
'/**
' * Constructor.
' */
Public Sub New(filename As String, replace_existing As Boolean), FileOutputStream(filename, replace_existing)
End Sub
'/**
' * Overrides the parent implementation to make sure text is written as
' * lines. Also a check is made that only strings are written to to
' * the writer.
' *
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer, EOL_PLATFORM)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub
End Class
Public Class RichTextOutputStream As OutputStream
'declarations
Private pItemname As String
Private pDoc As NotesDocument
Private pRt As NotesRichTextItem
'/**
' * Constructor.
' */
Public Sub New(itemname As String, doc As NotesDocument), OutputStream()
'store itemname
Me.pItemname = itemname
'store document
Set Me.pDoc = doc
End Sub
'/**
' * Creates the richtext item.
' *
' */
Public Sub Open()
'see if the item is already there
If Me.pDoc.HasItem(Me.pItemname) Then
'remove item
Call Me.pDoc.RemoveItem(Me.pItemname)
End If
'create item
Set Me.pRt = New NotesRichTextItem(Me.pDoc, Me.pItemname)
End Sub
'/**
' * Closes the stream.
' *
' */
Public Sub Close()
'clear reference
Set Me.pRt = Nothing
End Sub
'/**
' * Overrides the parent implementation to make sure text is written
' * directly to the rich text item.
' *
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pRt Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pRt.AppendText(buffer)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub
End Class
Private Sub lsdoc_description
%REM
An OutputStream is an abstraction to hide the details of writing to files, NotesDocuments etc.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: LsDocConstants" />
<class name="OutputStream" visibility="Public">
<code><![CDATA[Public Class OutputStream
'declarations
Private pSession As NotesSession
Private pStream As NotesStream
Private pCharset As String
'/**
' * Constructor.
' */
Public Sub New()
'get session
Set Me.pSession = New NotesSession
End Sub
'/**
' * Destructor.
' */
Public Sub Delete()
'make sure the stream has been closed
Call Me.Close()
End Sub
'/**
' * Sets the charset to use.
' */
Public Property Set Charset(charzet As String)
Me.pCharset = charzet
End Property
'/**
' * Opens the OutputStream.
' */
Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
End Sub
'/**
' * Closes the stream.
' */
Public Sub Close()
If Not (Me.pStream Is Nothing) Then
Call Me.pStream.Close()
Set Me.pStream = Nothing
End If
End Sub
'/**
' * Writes data to the stream.
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The OutputStream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pSession" visibility="Private">
<datatype idref="NotesSession" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSession As NotesSession]]]]><![CDATA[></code>
<comment />
</member>
<member name="pStream" visibility="Private">
<datatype idref="NotesStream" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pStream As NotesStream]]]]><![CDATA[></code>
<comment />
</member>
<member name="pCharset" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pCharset As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<code><![CDATA[Public Sub New()
'get session
Set Me.pSession = New NotesSession
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Delete" visibility="Public">
<code><![CDATA[Public Sub Delete()
'make sure the stream has been closed
Call Me.Close()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="Charset" visibility="Public" setter="true">
<datatype idref="Variant" />
<code><![CDATA[Public Property Set Charset(charzet As String)
Me.pCharset = charzet
End Property]]]]><![CDATA[></code>
<comment />
</property>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Close" visibility="Public">
<code><![CDATA[Public Sub Close()
If Not (Me.pStream Is Nothing) Then
Call Me.pStream.Close()
Set Me.pStream = Nothing
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Write" visibility="Public">
<params>
<param name="buffer">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The OutputStream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="FileOutputStream" visibility="Public">
<parentClass>OutputStream</parentClass>
<hierarchy>
<class>OutputStream</class>
<class>FileOutputStream</class>
</hierarchy>
<code><![CDATA[Public Class FileOutputStream As OutputStream
'declarations
Private pFilename As String
Private pReplaceExisting As Boolean
'/**
' * Constructor.
' */
Public Sub New(filename As String, replace_existing As Boolean), OutputStream()
Me.pFilename = filename
Me.pReplaceExisting = replace_existing
End Sub
'/**
' * Opens the file.
' */
Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
'should we replace ?
If Me.pReplaceExisting Then
'set up error handling
On Error Goto catch_fileexist
'does the file exist already
If Filelen(Me.pFilename) Then
'the file exists - delete it
Kill Me.pFilename
End If
Goto finally_fileexist
catch_fileexist:
'the file doesn't exist
Resume finally_fileexist
finally_fileexist:
'reset error handling
On Error Goto 0
End If
'try and open the file
If Me.pCharset <> "" Then
'use custom charset
rc = Me.pStream.Open(Me.pFilename, Me.pCharset)
Else
'use default charset
rc = Me.pStream.Open(Me.pFilename, DEFAULT_CHARSET)
End If
'did we open the file correctly ?
If Not rc Then
'could not open the file
Error ERROR_OUTPUT_UNABLE_TO_OPEN_FILE, "Unable to open file: " + Me.pFilename
End If
End Sub
'/**
' * Writes text to the writer.
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pFilename" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pFilename As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pReplaceExisting" visibility="Private">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pReplaceExisting As Boolean]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="filename">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="replace_existing">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="OutputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>true</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(filename As String, replace_existing As Boolean), OutputStream()
Me.pFilename = filename
Me.pReplaceExisting = replace_existing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'declarations
Dim rc As Boolean
'cannot open an open stream
If Not (Me.pStream Is Nothing) Then
Error ERROR_OUTPUT_ALREADY_OPEN, "Cannot open an already open stream."
End If
'create stream
Set Me.pStream = Me.pSession.CreateStream()
'should we replace ?
If Me.pReplaceExisting Then
'set up error handling
On Error Goto catch_fileexist
'does the file exist already
If Filelen(Me.pFilename) Then
'the file exists - delete it
Kill Me.pFilename
End If
Goto finally_fileexist
catch_fileexist:
'the file doesn't exist
Resume finally_fileexist
finally_fileexist:
'reset error handling
On Error Goto 0
End If
'try and open the file
If Me.pCharset <> "" Then
'use custom charset
rc = Me.pStream.Open(Me.pFilename, Me.pCharset)
Else
'use default charset
rc = Me.pStream.Open(Me.pFilename, DEFAULT_CHARSET)
End If
'did we open the file correctly ?
If Not rc Then
'could not open the file
Error ERROR_OUTPUT_UNABLE_TO_OPEN_FILE, "Unable to open file: " + Me.pFilename
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Write" visibility="Public">
<params>
<param name="buffer">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer)
Else
'write as bytes
Call Me.pStream.Write(buffer)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="LineFileOutputStream" visibility="Public">
<parentClass>FileOutputStream</parentClass>
<hierarchy>
<class>OutputStream</class>
<class>FileOutputStream</class>
<class>LineFileOutputStream</class>
</hierarchy>
<code><![CDATA[Public Class LineFileOutputStream As FileOutputStream
'/**
' * Constructor.
' */
Public Sub New(filename As String, replace_existing As Boolean), FileOutputStream(filename, replace_existing)
End Sub
'/**
' * Overrides the parent implementation to make sure text is written as
' * lines. Also a check is made that only strings are written to to
' * the writer.
' *
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer, EOL_PLATFORM)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="filename">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="replace_existing">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="FileOutputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="filename">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="replace_existing">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(filename As String, replace_existing As Boolean), FileOutputStream(filename, replace_existing)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Write" visibility="Public">
<params>
<param name="buffer">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pStream Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pStream.WriteText(buffer, EOL_PLATFORM)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="RichTextOutputStream" visibility="Public">
<parentClass>OutputStream</parentClass>
<hierarchy>
<class>OutputStream</class>
<class>RichTextOutputStream</class>
</hierarchy>
<code><![CDATA[Public Class RichTextOutputStream As OutputStream
'declarations
Private pItemname As String
Private pDoc As NotesDocument
Private pRt As NotesRichTextItem
'/**
' * Constructor.
' */
Public Sub New(itemname As String, doc As NotesDocument), OutputStream()
'store itemname
Me.pItemname = itemname
'store document
Set Me.pDoc = doc
End Sub
'/**
' * Creates the richtext item.
' *
' */
Public Sub Open()
'see if the item is already there
If Me.pDoc.HasItem(Me.pItemname) Then
'remove item
Call Me.pDoc.RemoveItem(Me.pItemname)
End If
'create item
Set Me.pRt = New NotesRichTextItem(Me.pDoc, Me.pItemname)
End Sub
'/**
' * Closes the stream.
' *
' */
Public Sub Close()
'clear reference
Set Me.pRt = Nothing
End Sub
'/**
' * Overrides the parent implementation to make sure text is written
' * directly to the rich text item.
' *
' */
Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pRt Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pRt.AppendText(buffer)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pItemname" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pItemname As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDoc" visibility="Private">
<datatype idref="NotesDocument" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDoc As NotesDocument]]]]><![CDATA[></code>
<comment />
</member>
<member name="pRt" visibility="Private">
<datatype idref="NotesRichTextItem" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pRt As NotesRichTextItem]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="itemname">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="doc">
<datatype idref="NotesDocument" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="OutputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>true</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(itemname As String, doc As NotesDocument), OutputStream()
'store itemname
Me.pItemname = itemname
'store document
Set Me.pDoc = doc
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'see if the item is already there
If Me.pDoc.HasItem(Me.pItemname) Then
'remove item
Call Me.pDoc.RemoveItem(Me.pItemname)
End If
'create item
Set Me.pRt = New NotesRichTextItem(Me.pDoc, Me.pItemname)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Close" visibility="Public">
<code><![CDATA[Public Sub Close()
'clear reference
Set Me.pRt = Nothing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Write" visibility="Public">
<params>
<param name="buffer">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub Write(buffer As Variant)
'make sure the stream is open
If Me.pRt Is Nothing Then
Error ERROR_OUTPUT_NOT_OPEN, "The stream hasn't been opened yet or has been closed."
End If
If Typename(buffer) = "STRING" Then
'write as text
Call Me.pRt.AppendText(buffer)
Else
'only allow text
Error ERROR_OUTPUT_ONLY_STRING_DATA, "You may only write strings."
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
An OutputStream is an abstraction to hide the details of writing to files, NotesDocuments etc.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: DocumentationBuilder" alias="" language="lotusscript">
<noteinfo>
<unid>9CE0A4291BAC225FC1256FEB00354EB9</unid>
<noteid>1382</noteid>
<created>22-04-2005 11:42:15</created>
<modified>29-11-2006 14:53:44</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>79</sequence>
<addedtofile>22-04-2005 11:42:43</addedtofile>
<lastaccessed>29-11-2006 13:47:38</lastaccessed>
<revised>11-12-2005 14:02:43</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: ScriptFactory"
Use "CLASS: DocumentationWriter"
Use "CLASS: DecisionMaker"
Use "CLASS: ConfigDocuments"
Public Class DocumentationBuilder
'declarations
Private pStreamFactory As OutputStreamFactory
'/**
' * Sets the OutputStreamFactory to use for writing the
' * documentation.
' *
' */
Public Property Set OutputStreamFactory As OutputStreamFactory
Set Me.pStreamFactory = OutputStreamFactory
End Property
'/**
' * Builds documentation based on the supplied configuration
' * document.
' *
' */
Public Sub BuildFromConfiguration(doc As NotesDocument)
'declarations
Dim session As New NotesSession
Dim v_temp As Vector
Dim e As Enumeration
Dim v As New Vector()
Dim dbProcess As DatabaseDocument
Dim factory As DxlScriptFactory
Dim dm_private As DecisionMaker
Dim dm_comment As DecisionMaker
Dim config_doc As ConfigDocument
Dim i As Integer
Dim doc_source As DocumentationSource
Dim sources As Variant
'create ConfigDocument object
Set config_doc = GetInstance(doc)
'get source
Set doc_source = config_doc.GetDocumentationSource()
sources = doc_source.Databases
'loop the source
For i=0 To Ubound(sources)
'get database
Set dbProcess = sources(i)
If dbProcess Is Nothing Or Not dbProcess.Database.IsOpen Then
Error 9999, "Unable to open database to process (server: " + dbProcess.Document.Server(0) + ", " + dbProcess.Document.Filepath(0) + ")"
End If
'create script factory
Set factory = New DxlScriptFactory(dbProcess.Database)
'add design elements
If dbProcess.Document.IncludeForms(0) = "2" Then
'include all forms
Call factory.AddForms()
Elseif dbProcess.Document.IncludeForms(0) = "1" Then
'include some forms
Forall elem_name In doc.GetItemValue("Forms")
Call factory.AddForm(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeViews(0) = "2" Then
'include all views
Call factory.AddViews()
Elseif dbProcess.Document.IncludeViews(0) = "1" Then
'include some views
Forall elem_name In doc.GetItemValue("Views")
Call factory.AddView(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeAgents(0) = "2" Then
'include all agents
Call factory.AddAgents()
Elseif dbProcess.Document.IncludeAgents(0) = "1" Then
'include some agents
Forall elem_name In doc.GetItemValue("Agents")
Call factory.AddAgent(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeScriptLibraries(0) = "2" Then
'include all script libs
Call factory.AddScriptLibraries()
Elseif dbProcess.Document.IncludeScriptLibraries(0) = "1" Then
'include some script libs
Forall elem_name In doc.GetItemValue("ScriptLibraries")
Call factory.AddScriptLibrary(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeDatabaseScript(0) = "2" Then
'include all database script
Call factory.AddDatabaseScript()
End If
If dbProcess.Document.IncludePages(0) = "2" Then
'include all pages
Call factory.AddPages()
Elseif dbProcess.Document.IncludePages(0) = "1" Then
'include some pages
Forall elem_name In doc.GetItemValue("Pages")
Call factory.AddPage(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeWebservices(0) = "2" Then
'include all web services
Call factory.AddWebservices()
Elseif dbProcess.Document.IncludeWebservices(0) = "1" Then
'include some web services
Forall elem_name In doc.GetItemValue("Webservices")
Call factory.AddWebservice(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeSharedActions(0) = "2" Then
'include all shared actions
Call factory.AddSharedActions()
End If
'process the factory
Set v_temp = factory.Process()
'add scripts to vector
Set e = v_temp.Elements
While e.HasMoreElements()
Call v.AddElement(e.NextElement())
Wend
Next
'store the scripts in the DocumentationSource object
Set doc_source.Scripts = v
'should we create an output stream factory (pointing to current
'database)
Set Me.pStreamFactory = New NotesOutputStreamFactory(Nothing, doc_source.Title, doc.txtUniqueKey(0))
'prepare stream factory
Call Me.pStreamFactory.Prepare()
'create documentation writer
Dim w As New FramesDocumentationWriter(doc_source, Me.pStreamFactory)
'should we ignore private ?
If doc.IgnorePrivate(0) = "1" Then
Set dm_private = New NoPrivateDecisionMaker(Nothing)
Set w.DecisionMaker = dm_private
End If
'should we ignore non-commented ?
If doc.IgnoreNoComment(0) = "1" Then
Set dm_comment = New OnlyWithCommentDecisionMaker(dm_private)
Set w.DecisionMaker = dm_comment
End If
'write
Call w.Write()
End Sub
End Class
Private Sub lsdoc_description
%REM
Facade to building documentation from configuration documents.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: ScriptFactory" />
<usereference name="CLASS: DocumentationWriter" />
<usereference name="CLASS: DecisionMaker" />
<usereference name="CLASS: ConfigDocuments" />
<class name="DocumentationBuilder" visibility="Public">
<code><![CDATA[Public Class DocumentationBuilder
'declarations
Private pStreamFactory As OutputStreamFactory
'/**
' * Sets the OutputStreamFactory to use for writing the
' * documentation.
' *
' */
Public Property Set OutputStreamFactory As OutputStreamFactory
Set Me.pStreamFactory = OutputStreamFactory
End Property
'/**
' * Builds documentation based on the supplied configuration
' * document.
' *
' */
Public Sub BuildFromConfiguration(doc As NotesDocument)
'declarations
Dim session As New NotesSession
Dim v_temp As Vector
Dim e As Enumeration
Dim v As New Vector()
Dim dbProcess As DatabaseDocument
Dim factory As DxlScriptFactory
Dim dm_private As DecisionMaker
Dim dm_comment As DecisionMaker
Dim config_doc As ConfigDocument
Dim i As Integer
Dim doc_source As DocumentationSource
Dim sources As Variant
'create ConfigDocument object
Set config_doc = GetInstance(doc)
'get source
Set doc_source = config_doc.GetDocumentationSource()
sources = doc_source.Databases
'loop the source
For i=0 To Ubound(sources)
'get database
Set dbProcess = sources(i)
If dbProcess Is Nothing Or Not dbProcess.Database.IsOpen Then
Error 9999, "Unable to open database to process (server: " + dbProcess.Document.Server(0) + ", " + dbProcess.Document.Filepath(0) + ")"
End If
'create script factory
Set factory = New DxlScriptFactory(dbProcess.Database)
'add design elements
If dbProcess.Document.IncludeForms(0) = "2" Then
'include all forms
Call factory.AddForms()
Elseif dbProcess.Document.IncludeForms(0) = "1" Then
'include some forms
Forall elem_name In doc.GetItemValue("Forms")
Call factory.AddForm(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeViews(0) = "2" Then
'include all views
Call factory.AddViews()
Elseif dbProcess.Document.IncludeViews(0) = "1" Then
'include some views
Forall elem_name In doc.GetItemValue("Views")
Call factory.AddView(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeAgents(0) = "2" Then
'include all agents
Call factory.AddAgents()
Elseif dbProcess.Document.IncludeAgents(0) = "1" Then
'include some agents
Forall elem_name In doc.GetItemValue("Agents")
Call factory.AddAgent(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeScriptLibraries(0) = "2" Then
'include all script libs
Call factory.AddScriptLibraries()
Elseif dbProcess.Document.IncludeScriptLibraries(0) = "1" Then
'include some script libs
Forall elem_name In doc.GetItemValue("ScriptLibraries")
Call factory.AddScriptLibrary(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeDatabaseScript(0) = "2" Then
'include all database script
Call factory.AddDatabaseScript()
End If
If dbProcess.Document.IncludePages(0) = "2" Then
'include all pages
Call factory.AddPages()
Elseif dbProcess.Document.IncludePages(0) = "1" Then
'include some pages
Forall elem_name In doc.GetItemValue("Pages")
Call factory.AddPage(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeWebservices(0) = "2" Then
'include all web services
Call factory.AddWebservices()
Elseif dbProcess.Document.IncludeWebservices(0) = "1" Then
'include some web services
Forall elem_name In doc.GetItemValue("Webservices")
Call factory.AddWebservice(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeSharedActions(0) = "2" Then
'include all shared actions
Call factory.AddSharedActions()
End If
'process the factory
Set v_temp = factory.Process()
'add scripts to vector
Set e = v_temp.Elements
While e.HasMoreElements()
Call v.AddElement(e.NextElement())
Wend
Next
'store the scripts in the DocumentationSource object
Set doc_source.Scripts = v
'should we create an output stream factory (pointing to current
'database)
Set Me.pStreamFactory = New NotesOutputStreamFactory(Nothing, doc_source.Title, doc.txtUniqueKey(0))
'prepare stream factory
Call Me.pStreamFactory.Prepare()
'create documentation writer
Dim w As New FramesDocumentationWriter(doc_source, Me.pStreamFactory)
'should we ignore private ?
If doc.IgnorePrivate(0) = "1" Then
Set dm_private = New NoPrivateDecisionMaker(Nothing)
Set w.DecisionMaker = dm_private
End If
'should we ignore non-commented ?
If doc.IgnoreNoComment(0) = "1" Then
Set dm_comment = New OnlyWithCommentDecisionMaker(dm_private)
Set w.DecisionMaker = dm_comment
End If
'write
Call w.Write()
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pStreamFactory" visibility="Private">
<datatype idref="OutputStreamFactory" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pStreamFactory As OutputStreamFactory]]]]><![CDATA[></code>
<comment />
</member>
<property name="OutputStreamFactory" visibility="Public" setter="true">
<datatype idref="OutputStreamFactory" />
<code><![CDATA[Public Property Set OutputStreamFactory As OutputStreamFactory
Set Me.pStreamFactory = OutputStreamFactory
End Property]]]]><![CDATA[></code>
<comment />
</property>
<sub name="BuildFromConfiguration" visibility="Public">
<params>
<param name="doc">
<datatype idref="NotesDocument" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub BuildFromConfiguration(doc As NotesDocument)
'declarations
Dim session As New NotesSession
Dim v_temp As Vector
Dim e As Enumeration
Dim v As New Vector()
Dim dbProcess As DatabaseDocument
Dim factory As DxlScriptFactory
Dim dm_private As DecisionMaker
Dim dm_comment As DecisionMaker
Dim config_doc As ConfigDocument
Dim i As Integer
Dim doc_source As DocumentationSource
Dim sources As Variant
'create ConfigDocument object
Set config_doc = GetInstance(doc)
'get source
Set doc_source = config_doc.GetDocumentationSource()
sources = doc_source.Databases
'loop the source
For i=0 To Ubound(sources)
'get database
Set dbProcess = sources(i)
If dbProcess Is Nothing Or Not dbProcess.Database.IsOpen Then
Error 9999, "Unable to open database to process (server: " + dbProcess.Document.Server(0) + ", " + dbProcess.Document.Filepath(0) + ")"
End If
'create script factory
Set factory = New DxlScriptFactory(dbProcess.Database)
'add design elements
If dbProcess.Document.IncludeForms(0) = "2" Then
'include all forms
Call factory.AddForms()
Elseif dbProcess.Document.IncludeForms(0) = "1" Then
'include some forms
Forall elem_name In doc.GetItemValue("Forms")
Call factory.AddForm(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeViews(0) = "2" Then
'include all views
Call factory.AddViews()
Elseif dbProcess.Document.IncludeViews(0) = "1" Then
'include some views
Forall elem_name In doc.GetItemValue("Views")
Call factory.AddView(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeAgents(0) = "2" Then
'include all agents
Call factory.AddAgents()
Elseif dbProcess.Document.IncludeAgents(0) = "1" Then
'include some agents
Forall elem_name In doc.GetItemValue("Agents")
Call factory.AddAgent(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeScriptLibraries(0) = "2" Then
'include all script libs
Call factory.AddScriptLibraries()
Elseif dbProcess.Document.IncludeScriptLibraries(0) = "1" Then
'include some script libs
Forall elem_name In doc.GetItemValue("ScriptLibraries")
Call factory.AddScriptLibrary(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeDatabaseScript(0) = "2" Then
'include all database script
Call factory.AddDatabaseScript()
End If
If dbProcess.Document.IncludePages(0) = "2" Then
'include all pages
Call factory.AddPages()
Elseif dbProcess.Document.IncludePages(0) = "1" Then
'include some pages
Forall elem_name In doc.GetItemValue("Pages")
Call factory.AddPage(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeWebservices(0) = "2" Then
'include all web services
Call factory.AddWebservices()
Elseif dbProcess.Document.IncludeWebservices(0) = "1" Then
'include some web services
Forall elem_name In doc.GetItemValue("Webservices")
Call factory.AddWebservice(Cstr(elem_name))
End Forall
End If
If dbProcess.Document.IncludeSharedActions(0) = "2" Then
'include all shared actions
Call factory.AddSharedActions()
End If
'process the factory
Set v_temp = factory.Process()
'add scripts to vector
Set e = v_temp.Elements
While e.HasMoreElements()
Call v.AddElement(e.NextElement())
Wend
Next
'store the scripts in the DocumentationSource object
Set doc_source.Scripts = v
'should we create an output stream factory (pointing to current
'database)
Set Me.pStreamFactory = New NotesOutputStreamFactory(Nothing, doc_source.Title, doc.txtUniqueKey(0))
'prepare stream factory
Call Me.pStreamFactory.Prepare()
'create documentation writer
Dim w As New FramesDocumentationWriter(doc_source, Me.pStreamFactory)
'should we ignore private ?
If doc.IgnorePrivate(0) = "1" Then
Set dm_private = New NoPrivateDecisionMaker(Nothing)
Set w.DecisionMaker = dm_private
End If
'should we ignore non-commented ?
If doc.IgnoreNoComment(0) = "1" Then
Set dm_comment = New OnlyWithCommentDecisionMaker(dm_private)
Set w.DecisionMaker = dm_comment
End If
'write
Call w.Write()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Facade to building documentation from configuration documents.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: Index" alias="" language="lotusscript">
<noteinfo>
<unid>B8A6109ADC4F8C9CC1256FD900781DD8</unid>
<noteid>62e</noteid>
<created>04-04-2005 23:51:59</created>
<modified>26-10-2005 09:58:10</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>50</sequence>
<addedtofile>04-04-2005 23:58:21</addedtofile>
<lastaccessed>26-10-2005 09:54:46</lastaccessed>
<revised>25-10-2005 00:07:50</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: Collections"
Use "CLASS: Script"
Use "CLASS: ScriptElement"
Public Class Index
'declarations
Private pIndex List As String
'/**
' * Constructor. The constructor constructs a list of
' * all the classes in the supplied Vector and assign
' * each a key.
' *
' * @param scripts Vector of ScriptElements
' */
Public Sub New(scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_se As Enumeration
Dim script_elem As Variant
Dim v As Variant
'get enumeration and loop scripts and split into types
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'add to the index
Call Me.pAddIndexElement(script)
'loop script elements and get types, classes and global
'function/methods
Set enum_se = script.GetScriptElements().Elements()
While enum_se.HasMoreElements()
'get next
Set script_elem = enum_se.NextElement()
'only get specific types
If Typename(script_elem) = "LOTUSSCRIPTCLASS" Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTMETHOD") Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTFUNCTION") Or _
Typename(script_elem) = "LOTUSSCRIPTTYPE" Then
'add to the index
Call Me.pAddIndexElement(script_elem)
End If
Wend
Wend
End Sub
'/**
' * Utility method used to add an element to the index
' * assigning a unique key. The element is added
' * in two ways:
' * <ul>
' * <li>If it is a Script object it is added prefixed with
' * the typename as a "namespace" to prevent collision between
' * different design element types with the same name (e.g. a
' * form and an agent)</li>
' * <li>If it is a ScriptElement object it is added only with its name.</li>
' * </ul>
' *
' * @param n The Script or ScriptElement to add.
' * @error 9999 If the supplied argument isn't a Script or a ScriptElement
' */
Private Sub pAddIndexElement(n As Variant)
'declarations
Dim v As Variant
Dim element_name As String
If n Isa "Script" Or n Isa "ScriptElement" Then
element_name = Me.pGetIndexKey(n)
Else
Error 9999, "The supplied argument is not a Script or a ScriptElement"
End If
'next element - get a key for it
v = Evaluate(|@Password("| + element_name + |")|)
'store name in list
Me.pIndex(element_name) = v(0)
End Sub
'/**
' * Returns the index key to use for the element.
' *
' */
Private Function pGetIndexKey(n As Variant) As String
'declarations
Dim element_name As String
'get the element name to use
If Typename(n) = "STRING" Then
element_name = "x" + Cstr(n)
Elseif n Isa "Script" Then
'prefix with "namespace"
element_name = Typename(n) + "_" + Ucase(n.ScriptName)
Elseif n Isa "ScriptElement" Then
'prefix with an "x" since the @Password function ignores it
'parameter if it starts with a "("
element_name = "x" + n.ElementName
Else
Error 9999, "Can only get index key for Scripts, ScriptElements or Strings"
End If
'return
pGetIndexKey = element_name
End Function
'/**
' * Returns the key for the supplied datatype. If the datatype
' * isn't found we return an empty string.
' *
' * @param n The Script, ScriptElement or String to get key for.
' * @return String key
' */
Public Function GetKey(n As Variant) As String
'declarations
Dim key As String
'get the index key to use
key = Me.pGetIndexKey(n)
'get key
On Error Goto catch
GetKey = Me.pIndex(key)
Exit Function
catch:
GetKey = ""
Exit Function
End Function
End Class
Private Sub lsdoc_description
%REM
Helper classes used when generating the documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: Collections" />
<usereference name="CLASS: Script" />
<usereference name="CLASS: ScriptElement" />
<class name="Index" visibility="Public">
<code><![CDATA[Public Class Index
'declarations
Private pIndex List As String
'/**
' * Constructor. The constructor constructs a list of
' * all the classes in the supplied Vector and assign
' * each a key.
' *
' * @param scripts Vector of ScriptElements
' */
Public Sub New(scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_se As Enumeration
Dim script_elem As Variant
Dim v As Variant
'get enumeration and loop scripts and split into types
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'add to the index
Call Me.pAddIndexElement(script)
'loop script elements and get types, classes and global
'function/methods
Set enum_se = script.GetScriptElements().Elements()
While enum_se.HasMoreElements()
'get next
Set script_elem = enum_se.NextElement()
'only get specific types
If Typename(script_elem) = "LOTUSSCRIPTCLASS" Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTMETHOD") Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTFUNCTION") Or _
Typename(script_elem) = "LOTUSSCRIPTTYPE" Then
'add to the index
Call Me.pAddIndexElement(script_elem)
End If
Wend
Wend
End Sub
'/**
' * Utility method used to add an element to the index
' * assigning a unique key. The element is added
' * in two ways:
' * <ul>
' * <li>If it is a Script object it is added prefixed with
' * the typename as a "namespace" to prevent collision between
' * different design element types with the same name (e.g. a
' * form and an agent)</li>
' * <li>If it is a ScriptElement object it is added only with its name.</li>
' * </ul>
' *
' * @param n The Script or ScriptElement to add.
' * @error 9999 If the supplied argument isn't a Script or a ScriptElement
' */
Private Sub pAddIndexElement(n As Variant)
'declarations
Dim v As Variant
Dim element_name As String
If n Isa "Script" Or n Isa "ScriptElement" Then
element_name = Me.pGetIndexKey(n)
Else
Error 9999, "The supplied argument is not a Script or a ScriptElement"
End If
'next element - get a key for it
v = Evaluate(|@Password("| + element_name + |")|)
'store name in list
Me.pIndex(element_name) = v(0)
End Sub
'/**
' * Returns the index key to use for the element.
' *
' */
Private Function pGetIndexKey(n As Variant) As String
'declarations
Dim element_name As String
'get the element name to use
If Typename(n) = "STRING" Then
element_name = "x" + Cstr(n)
Elseif n Isa "Script" Then
'prefix with "namespace"
element_name = Typename(n) + "_" + Ucase(n.ScriptName)
Elseif n Isa "ScriptElement" Then
'prefix with an "x" since the @Password function ignores it
'parameter if it starts with a "("
element_name = "x" + n.ElementName
Else
Error 9999, "Can only get index key for Scripts, ScriptElements or Strings"
End If
'return
pGetIndexKey = element_name
End Function
'/**
' * Returns the key for the supplied datatype. If the datatype
' * isn't found we return an empty string.
' *
' * @param n The Script, ScriptElement or String to get key for.
' * @return String key
' */
Public Function GetKey(n As Variant) As String
'declarations
Dim key As String
'get the index key to use
key = Me.pGetIndexKey(n)
'get key
On Error Goto catch
GetKey = Me.pIndex(key)
Exit Function
catch:
GetKey = ""
Exit Function
End Function
End Class]]]]><![CDATA[></code>
<comment />
<member name="pIndex" visibility="Private">
<datatype idref="String" />
<isList>true</isList>
<isArray>false</isArray>
<code><![CDATA[Private pIndex List As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="scripts">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(scripts As Vector)
'declarations
Dim enum As Enumeration
Dim script As Variant
Dim enum_se As Enumeration
Dim script_elem As Variant
Dim v As Variant
'get enumeration and loop scripts and split into types
Set enum = scripts.Elements()
While enum.HasMoreElements()
'get next
Set script = enum.NextElement()
'add to the index
Call Me.pAddIndexElement(script)
'loop script elements and get types, classes and global
'function/methods
Set enum_se = script.GetScriptElements().Elements()
While enum_se.HasMoreElements()
'get next
Set script_elem = enum_se.NextElement()
'only get specific types
If Typename(script_elem) = "LOTUSSCRIPTCLASS" Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTMETHOD") Or _
(script.ScriptType = SCRIPTTYPE_LIBRARY And _
Typename(script_elem) = "LOTUSSCRIPTFUNCTION") Or _
Typename(script_elem) = "LOTUSSCRIPTTYPE" Then
'add to the index
Call Me.pAddIndexElement(script_elem)
End If
Wend
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pAddIndexElement" visibility="Private">
<params>
<param name="n">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pAddIndexElement(n As Variant)
'declarations
Dim v As Variant
Dim element_name As String
If n Isa "Script" Or n Isa "ScriptElement" Then
element_name = Me.pGetIndexKey(n)
Else
Error 9999, "The supplied argument is not a Script or a ScriptElement"
End If
'next element - get a key for it
v = Evaluate(|@Password("| + element_name + |")|)
'store name in list
Me.pIndex(element_name) = v(0)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="pGetIndexKey" visibility="Private">
<params>
<param name="n">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="String" />
<code><![CDATA[Private Function pGetIndexKey(n As Variant) As String
'declarations
Dim element_name As String
'get the element name to use
If Typename(n) = "STRING" Then
element_name = "x" + Cstr(n)
Elseif n Isa "Script" Then
'prefix with "namespace"
element_name = Typename(n) + "_" + Ucase(n.ScriptName)
Elseif n Isa "ScriptElement" Then
'prefix with an "x" since the @Password function ignores it
'parameter if it starts with a "("
element_name = "x" + n.ElementName
Else
Error 9999, "Can only get index key for Scripts, ScriptElements or Strings"
End If
'return
pGetIndexKey = element_name
End Function]]]]><![CDATA[></code>
<comment />
</function>
<function name="GetKey" visibility="Public">
<params>
<param name="n">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="String" />
<code><![CDATA[Public Function GetKey(n As Variant) As String
'declarations
Dim key As String
'get the index key to use
key = Me.pGetIndexKey(n)
'get key
On Error Goto catch
GetKey = Me.pIndex(key)
Exit Function
catch:
GetKey = ""
Exit Function
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Helper classes used when generating the documentation.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: ScriptParser" alias="" language="lotusscript">
<noteinfo>
<unid>2ADAEE03304A738EC1256FD7005F2BE0</unid>
<noteid>3a2</noteid>
<created>02-04-2005 19:19:31</created>
<modified>29-11-2006 14:53:44</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>207</sequence>
<addedtofile>02-04-2005 19:19:57</addedtofile>
<lastaccessed>29-11-2006 13:47:38</lastaccessed>
<revised>09-11-2005 20:54:43</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: InputStream"
Use "CLASS: ScriptElement"
Public Class ScriptParser
'declarations
Private pLineIn As LineInputStream
'/**
' * Constructor.
' *
' * @param line_in The LineInputStream to read the source code from.
' */
Public Sub New(line_in As LineInputStream)
Set Me.pLineIn = line_in
End Sub
'/**
' * Parses the source given to the parser in the constructor. The method uses
' * the LineInputStream and it doesn't reset it before starting so the method
' * cannot be called two times in a row on the same LineInputStream.
' *
' * @return Vector of ScriptElements
' */
Public Function Parse() As Vector
'declarations
Dim script_elements As New Vector()
'process the source into the vector
Call ParseToVector(script_elements)
'return
Set Parse = script_elements
End Function
'/**
' * Parses the source given to the parser in the constructor into the vector.
' * The method uses the LineInputStream and it doesn't reset it before
' * starting so the method cannot be called two times in a row
' * on the same LineInputStream.
' *
' * @param script_elements The Vector to store the found ScriptElement objects in.
' */
Public Sub ParseToVector(script_elements As Vector)
'declarations
Dim string_in As InputStream
Dim line_in As InputStream
Dim rc As Integer
Dim nextline As String
Dim continuing_line As String
Dim comment As Comment
Dim modifier As Integer
Dim clazz_element As LotusScriptClass
Dim type_element As LotusScriptType
Dim element As ScriptElement
Dim inside_rem As Boolean
Dim includefile_name As String
Dim includefile_filestream As FileInputStream
Dim includefile_linestream As LineInputStream
Dim includefile_parser As ScriptParser
'loop the source
While rc = 0
'read next line
rc = Me.pLineIn.ReadStream(nextline)
'is this line the start or end of a %REM section
If Left(nextline, 4) = "%REM" Then
'we are starting a %REM section
inside_rem = True
Elseif Left(nextline, 8) = "%END REM" Or Left(nextline, 7) = "%ENDREM" Then
'we are finishing a %REM section
inside_rem = False
End If
'skip ahead if we are inside a %REM section
If Not inside_rem Then
'make sure the line doesn't start or end with a tab or newline
If Len(nextline) > 0 Then
Dim first_char As Integer
first_char = Asc(Left(nextline, 1))
While Len(nextline) > 0 And (first_char = 9 Or first_char = 10 Or first_char = 13)
nextline = Mid$(nextline, 2)
If Len(nextline) > 0 Then
first_char = Asc(Left(nextline, 1))
End If
Wend
End If
If Len(nextline) > 0 Then
Dim last_char As Integer
last_char = Asc(Right(nextline, 1))
While Len(nextline) > 0 And (last_char = 10 Or last_char = 13)
nextline = Mid$(nextline, 1, Len(nextline)-1)
If Len(nextline) > 0 Then
last_char = Asc(Right(nextline, 1))
End If
Wend
End If
'if the line contains a comment only read to the start of the comment
'except if the line contains LotusScript.doc markup
If Left(nextline, 4) <> "'/**" And Left(nextline, 4) <> "' * " And Left(nextline, 4) <> "' */" Then
Dim comment_index As Integer
comment_index = Instr(1, nextline, |'|)
If comment_index >= 1 Then
'there is a comment
nextline = Mid$(nextline, 1, comment_index-1)
End If
End If
'process %INCLUDE files
If Me.pCheckLeft(nextline, 8, "%INCLUDE") Then
includefile_name = Strleft(Strright(nextline , |"| ) , |"|)
If Dir(includefile_name) <> "" Then
'create a new ScriptParser pointing to our include file
Set includefile_filestream = New FileInputStream(includefile_name)
Set includefile_linestream = New LineInputStream(includefile_filestream)
Set includefile_parser = New ScriptParser(includefile_linestream)
'parse into our existing vector
Call includefile_parser.ParseToVector(script_elements)
'reset
Set includefile_parser = Nothing
Set includefile_linestream = Nothing
Set includefile_filestream = Nothing
Else
'could not find include file
Print "LotusScript.doc - Cannot find %INCLUDE file : " + includefile_name
End If
End If
'we only look at lines that doesn't contain the declare-token
If Instr(1, nextline, " Declare ") = 0 Then
'we have a line to parse - look at it
If Me.pCheckLeft(nextline, 4, "'/**") Then
'starting comment
Set comment = New Comment()
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' */") >= 1 Then
'comment is done - if we are NOT processing a class we'll allow and
'set the comment even if it occurs inside the function or sub
If Not element Is Nothing And clazz_element Is Nothing Then
If element Isa "LotusScriptMethod" And element.Comment Is Nothing Then
'this comment should be set for the active ScriptElement
Set element.Comment = comment
Set comment = Nothing
End If
End If
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' *") >= 1 Then
'add part of commment
Call comment.AddCommentPart(Mid$(nextline, 5))
Elseif Right(nextline, 1) = "_" Then
'the line is set to continue on the next line -
'add to any existing continuing line we might
'have before getting next code line
continuing_line = continuing_line + Mid$(nextline, 1, Len(nextline)-1)
Else
'if we have a continuing line it means that this is
'the last part of a continuing line
If continuing_line <> "" Then
nextline = continuing_line + nextline
'reset continuing line
continuing_line = ""
End If
If Me.pCheckLeft(nextline, 4, "Sub ") Or Me.pCheckLeft(nextline, 12, "Private Sub ") Or Me.pCheckLeft(nextline, 11, "Public Sub ") Then
'we found a method definition - create method object
Set element = New LotusScriptMethod(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the sub to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddMethod(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Function ") Or Me.pCheckLeft(nextline, 17, "Private Function ") Or Me.pCheckLeft(nextline, 16, "Public Function ") Then
'we found a function definition - create function object
Set element = New LotusScriptFunction(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the function to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddFunction(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Property ") Or Me.pCheckLeft(nextline, 17, "Private Property ") Or Me.pCheckLeft(nextline, 16, "Public Property ") Then
'we found a property definition - create property object
Set element = New LotusScriptProperty(nextline)
'add comment id there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the property to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddProperty(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 6, "Const ") Or Me.pCheckLeft(nextline, 13, "Public Const ") Or Me.pCheckLeft(nextline, 14, "Private Const ") Then
'we found a const not inside a class
Set element = New LotusScriptConst(nextline)
'if there is a comment add it
Set element.Comment = comment
'clear comment
Set comment = Nothing
'add as script element
Call script_elements.AddElement(element)
Elseif Me.pCheckLeft(nextline, 6, "Class ") Or Me.pCheckLeft(nextline, 14, "Private Class ") Or Me.pCheckLeft(nextline, 13, "Public Class ") Then
'found class declaration - create class object
Set clazz_element = New LotusScriptClass(nextline)
'set the comment if any
Set clazz_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 5, "Type ") Or Me.pCheckLeft(nextline, 13, "Private Type ") Or Me.pCheckLeft(nextline, 12, "Public Type ") Then
'found type declaration - create type object
Set type_element = New LotusScriptType(nextline)
'set the comment if any
Set type_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 9, "End Class
Private Sub lsdoc_description
%REM
This script library holds the classes for parsing LotusScript source code.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: InputStream" />
<usereference name="CLASS: ScriptElement" />
<class name="ScriptParser" visibility="Public">
<code><![CDATA[Public Class ScriptParser
'declarations
Private pLineIn As LineInputStream
'/**
' * Constructor.
' *
' * @param line_in The LineInputStream to read the source code from.
' */
Public Sub New(line_in As LineInputStream)
Set Me.pLineIn = line_in
End Sub
'/**
' * Parses the source given to the parser in the constructor. The method uses
' * the LineInputStream and it doesn't reset it before starting so the method
' * cannot be called two times in a row on the same LineInputStream.
' *
' * @return Vector of ScriptElements
' */
Public Function Parse() As Vector
'declarations
Dim script_elements As New Vector()
'process the source into the vector
Call ParseToVector(script_elements)
'return
Set Parse = script_elements
End Function
'/**
' * Parses the source given to the parser in the constructor into the vector.
' * The method uses the LineInputStream and it doesn't reset it before
' * starting so the method cannot be called two times in a row
' * on the same LineInputStream.
' *
' * @param script_elements The Vector to store the found ScriptElement objects in.
' */
Public Sub ParseToVector(script_elements As Vector)
'declarations
Dim string_in As InputStream
Dim line_in As InputStream
Dim rc As Integer
Dim nextline As String
Dim continuing_line As String
Dim comment As Comment
Dim modifier As Integer
Dim clazz_element As LotusScriptClass
Dim type_element As LotusScriptType
Dim element As ScriptElement
Dim inside_rem As Boolean
Dim includefile_name As String
Dim includefile_filestream As FileInputStream
Dim includefile_linestream As LineInputStream
Dim includefile_parser As ScriptParser
'loop the source
While rc = 0
'read next line
rc = Me.pLineIn.ReadStream(nextline)
'is this line the start or end of a %REM section
If Left(nextline, 4) = "%REM" Then
'we are starting a %REM section
inside_rem = True
Elseif Left(nextline, 8) = "%END REM" Or Left(nextline, 7) = "%ENDREM" Then
'we are finishing a %REM section
inside_rem = False
End If
'skip ahead if we are inside a %REM section
If Not inside_rem Then
'make sure the line doesn't start or end with a tab or newline
If Len(nextline) > 0 Then
Dim first_char As Integer
first_char = Asc(Left(nextline, 1))
While Len(nextline) > 0 And (first_char = 9 Or first_char = 10 Or first_char = 13)
nextline = Mid$(nextline, 2)
If Len(nextline) > 0 Then
first_char = Asc(Left(nextline, 1))
End If
Wend
End If
If Len(nextline) > 0 Then
Dim last_char As Integer
last_char = Asc(Right(nextline, 1))
While Len(nextline) > 0 And (last_char = 10 Or last_char = 13)
nextline = Mid$(nextline, 1, Len(nextline)-1)
If Len(nextline) > 0 Then
last_char = Asc(Right(nextline, 1))
End If
Wend
End If
'if the line contains a comment only read to the start of the comment
'except if the line contains LotusScript.doc markup
If Left(nextline, 4) <> "'/**" And Left(nextline, 4) <> "' * " And Left(nextline, 4) <> "' */" Then
Dim comment_index As Integer
comment_index = Instr(1, nextline, |'|)
If comment_index >= 1 Then
'there is a comment
nextline = Mid$(nextline, 1, comment_index-1)
End If
End If
'process %INCLUDE files
If Me.pCheckLeft(nextline, 8, "%INCLUDE") Then
includefile_name = Strleft(Strright(nextline , |"| ) , |"|)
If Dir(includefile_name) <> "" Then
'create a new ScriptParser pointing to our include file
Set includefile_filestream = New FileInputStream(includefile_name)
Set includefile_linestream = New LineInputStream(includefile_filestream)
Set includefile_parser = New ScriptParser(includefile_linestream)
'parse into our existing vector
Call includefile_parser.ParseToVector(script_elements)
'reset
Set includefile_parser = Nothing
Set includefile_linestream = Nothing
Set includefile_filestream = Nothing
Else
'could not find include file
Print "LotusScript.doc - Cannot find %INCLUDE file : " + includefile_name
End If
End If
'we only look at lines that doesn't contain the declare-token
If Instr(1, nextline, " Declare ") = 0 Then
'we have a line to parse - look at it
If Me.pCheckLeft(nextline, 4, "'/**") Then
'starting comment
Set comment = New Comment()
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' */") >= 1 Then
'comment is done - if we are NOT processing a class we'll allow and
'set the comment even if it occurs inside the function or sub
If Not element Is Nothing And clazz_element Is Nothing Then
If element Isa "LotusScriptMethod" And element.Comment Is Nothing Then
'this comment should be set for the active ScriptElement
Set element.Comment = comment
Set comment = Nothing
End If
End If
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' *") >= 1 Then
'add part of commment
Call comment.AddCommentPart(Mid$(nextline, 5))
Elseif Right(nextline, 1) = "_" Then
'the line is set to continue on the next line -
'add to any existing continuing line we might
'have before getting next code line
continuing_line = continuing_line + Mid$(nextline, 1, Len(nextline)-1)
Else
'if we have a continuing line it means that this is
'the last part of a continuing line
If continuing_line <> "" Then
nextline = continuing_line + nextline
'reset continuing line
continuing_line = ""
End If
If Me.pCheckLeft(nextline, 4, "Sub ") Or Me.pCheckLeft(nextline, 12, "Private Sub ") Or Me.pCheckLeft(nextline, 11, "Public Sub ") Then
'we found a method definition - create method object
Set element = New LotusScriptMethod(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the sub to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddMethod(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Function ") Or Me.pCheckLeft(nextline, 17, "Private Function ") Or Me.pCheckLeft(nextline, 16, "Public Function ") Then
'we found a function definition - create function object
Set element = New LotusScriptFunction(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the function to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddFunction(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Property ") Or Me.pCheckLeft(nextline, 17, "Private Property ") Or Me.pCheckLeft(nextline, 16, "Public Property ") Then
'we found a property definition - create property object
Set element = New LotusScriptProperty(nextline)
'add comment id there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the property to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddProperty(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 6, "Const ") Or Me.pCheckLeft(nextline, 13, "Public Const ") Or Me.pCheckLeft(nextline, 14, "Private Const ") Then
'we found a const not inside a class
Set element = New LotusScriptConst(nextline)
'if there is a comment add it
Set element.Comment = comment
'clear comment
Set comment = Nothing
'add as script element
Call script_elements.AddElement(element)
Elseif Me.pCheckLeft(nextline, 6, "Class ") Or Me.pCheckLeft(nextline, 14, "Private Class ") Or Me.pCheckLeft(nextline, 13, "Public Class ") Then
'found class declaration - create class object
Set clazz_element = New LotusScriptClass(nextline)
'set the comment if any
Set clazz_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 5, "Type ") Or Me.pCheckLeft(nextline, 13, "Private Type ") Or Me.pCheckLeft(nextline, 12, "Public Type ") Then
'found type declaration - create type object
Set type_element = New LotusScriptType(nextline)
'set the comment if any
Set type_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 9, "End Class]]]]><![CDATA[></code>
<comment />
<member name="pLineIn" visibility="Private">
<datatype idref="LineInputStream" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pLineIn As LineInputStream]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="line_in">
<datatype idref="LineInputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(line_in As LineInputStream)
Set Me.pLineIn = line_in
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="Parse" visibility="Public">
<returnType idref="Vector" />
<code><![CDATA[Public Function Parse() As Vector
'declarations
Dim script_elements As New Vector()
'process the source into the vector
Call ParseToVector(script_elements)
'return
Set Parse = script_elements
End Function]]]]><![CDATA[></code>
<comment />
</function>
<sub name="ParseToVector" visibility="Public">
<params>
<param name="script_elements">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub ParseToVector(script_elements As Vector)
'declarations
Dim string_in As InputStream
Dim line_in As InputStream
Dim rc As Integer
Dim nextline As String
Dim continuing_line As String
Dim comment As Comment
Dim modifier As Integer
Dim clazz_element As LotusScriptClass
Dim type_element As LotusScriptType
Dim element As ScriptElement
Dim inside_rem As Boolean
Dim includefile_name As String
Dim includefile_filestream As FileInputStream
Dim includefile_linestream As LineInputStream
Dim includefile_parser As ScriptParser
'loop the source
While rc = 0
'read next line
rc = Me.pLineIn.ReadStream(nextline)
'is this line the start or end of a %REM section
If Left(nextline, 4) = "%REM" Then
'we are starting a %REM section
inside_rem = True
Elseif Left(nextline, 8) = "%END REM" Or Left(nextline, 7) = "%ENDREM" Then
'we are finishing a %REM section
inside_rem = False
End If
'skip ahead if we are inside a %REM section
If Not inside_rem Then
'make sure the line doesn't start or end with a tab or newline
If Len(nextline) > 0 Then
Dim first_char As Integer
first_char = Asc(Left(nextline, 1))
While Len(nextline) > 0 And (first_char = 9 Or first_char = 10 Or first_char = 13)
nextline = Mid$(nextline, 2)
If Len(nextline) > 0 Then
first_char = Asc(Left(nextline, 1))
End If
Wend
End If
If Len(nextline) > 0 Then
Dim last_char As Integer
last_char = Asc(Right(nextline, 1))
While Len(nextline) > 0 And (last_char = 10 Or last_char = 13)
nextline = Mid$(nextline, 1, Len(nextline)-1)
If Len(nextline) > 0 Then
last_char = Asc(Right(nextline, 1))
End If
Wend
End If
'if the line contains a comment only read to the start of the comment
'except if the line contains LotusScript.doc markup
If Left(nextline, 4) <> "'/**" And Left(nextline, 4) <> "' * " And Left(nextline, 4) <> "' */" Then
Dim comment_index As Integer
comment_index = Instr(1, nextline, |'|)
If comment_index >= 1 Then
'there is a comment
nextline = Mid$(nextline, 1, comment_index-1)
End If
End If
'process %INCLUDE files
If Me.pCheckLeft(nextline, 8, "%INCLUDE") Then
includefile_name = Strleft(Strright(nextline , |"| ) , |"|)
If Dir(includefile_name) <> "" Then
'create a new ScriptParser pointing to our include file
Set includefile_filestream = New FileInputStream(includefile_name)
Set includefile_linestream = New LineInputStream(includefile_filestream)
Set includefile_parser = New ScriptParser(includefile_linestream)
'parse into our existing vector
Call includefile_parser.ParseToVector(script_elements)
'reset
Set includefile_parser = Nothing
Set includefile_linestream = Nothing
Set includefile_filestream = Nothing
Else
'could not find include file
Print "LotusScript.doc - Cannot find %INCLUDE file : " + includefile_name
End If
End If
'we only look at lines that doesn't contain the declare-token
If Instr(1, nextline, " Declare ") = 0 Then
'we have a line to parse - look at it
If Me.pCheckLeft(nextline, 4, "'/**") Then
'starting comment
Set comment = New Comment()
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' */") >= 1 Then
'comment is done - if we are NOT processing a class we'll allow and
'set the comment even if it occurs inside the function or sub
If Not element Is Nothing And clazz_element Is Nothing Then
If element Isa "LotusScriptMethod" And element.Comment Is Nothing Then
'this comment should be set for the active ScriptElement
Set element.Comment = comment
Set comment = Nothing
End If
End If
Elseif Not (comment Is Nothing) And Instr(1, nextline, "' *") >= 1 Then
'add part of commment
Call comment.AddCommentPart(Mid$(nextline, 5))
Elseif Right(nextline, 1) = "_" Then
'the line is set to continue on the next line -
'add to any existing continuing line we might
'have before getting next code line
continuing_line = continuing_line + Mid$(nextline, 1, Len(nextline)-1)
Else
'if we have a continuing line it means that this is
'the last part of a continuing line
If continuing_line <> "" Then
nextline = continuing_line + nextline
'reset continuing line
continuing_line = ""
End If
If Me.pCheckLeft(nextline, 4, "Sub ") Or Me.pCheckLeft(nextline, 12, "Private Sub ") Or Me.pCheckLeft(nextline, 11, "Public Sub ") Then
'we found a method definition - create method object
Set element = New LotusScriptMethod(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the sub to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddMethod(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Function ") Or Me.pCheckLeft(nextline, 17, "Private Function ") Or Me.pCheckLeft(nextline, 16, "Public Function ") Then
'we found a function definition - create function object
Set element = New LotusScriptFunction(nextline)
'add comment if there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the function to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddFunction(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 9, "Property ") Or Me.pCheckLeft(nextline, 17, "Private Property ") Or Me.pCheckLeft(nextline, 16, "Public Property ") Then
'we found a property definition - create property object
Set element = New LotusScriptProperty(nextline)
'add comment id there is one
Set element.Comment = comment
'clear comment
Set comment = Nothing
'if we are currently processing a class add the property to the class
If Not (clazz_element Is Nothing) Then
'add to class
Call clazz_element.AddProperty(element)
Else
'add as a script element
Call script_elements.AddElement(element)
End If
Elseif Me.pCheckLeft(nextline, 6, "Const ") Or Me.pCheckLeft(nextline, 13, "Public Const ") Or Me.pCheckLeft(nextline, 14, "Private Const ") Then
'we found a const not inside a class
Set element = New LotusScriptConst(nextline)
'if there is a comment add it
Set element.Comment = comment
'clear comment
Set comment = Nothing
'add as script element
Call script_elements.AddElement(element)
Elseif Me.pCheckLeft(nextline, 6, "Class ") Or Me.pCheckLeft(nextline, 14, "Private Class ") Or Me.pCheckLeft(nextline, 13, "Public Class ") Then
'found class declaration - create class object
Set clazz_element = New LotusScriptClass(nextline)
'set the comment if any
Set clazz_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 5, "Type ") Or Me.pCheckLeft(nextline, 13, "Private Type ") Or Me.pCheckLeft(nextline, 12, "Public Type ") Then
'found type declaration - create type object
Set type_element = New LotusScriptType(nextline)
'set the comment if any
Set type_element.Comment = comment
'clear comment
Set comment = Nothing
Elseif Me.pCheckLeft(nextline, 9, "End Class") Then
'found end of class declarations - add to list of classes
Call script_elements.AddElement(clazz_element)
'clear variable
Set clazz_element = Nothing
Elseif Me.pCheckLeft(nextline, 8, "End Type") Then
'found end of type declarations - add to list of types
Call script_elements.AddElement(type_element)
'clear variable
Set type_element = Nothing
Elseif Not (type_element Is Nothing) Then
'the line is a member for the active type
If Fulltrim(nextline) <> "" Then
Dim arg As New Argument(nextline)
Call type_element.AddMember(arg)
End If
End If
End If
End If
End If
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="pCheckLeft" visibility="Private">
<params>
<param name="source">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="length">
<datatype idref="Integer" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="compare">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Boolean" />
<code><![CDATA[Private Function pCheckLeft(source As String, length As Integer, compare As String) As Boolean
'make sure the source is at least the length of the length
'parameter
If Len(source) < length Then
'cannot be equal to the compare string since the source
'is shorter
pCheckLeft = False
Else
'length is ok - check
pCheckLeft = (Left(source, length) = compare)
End If
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
This script library holds the classes for parsing LotusScript source code.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: OutputStreamFactory" alias="" language="lotusscript">
<noteinfo>
<unid>C52FC2769A51F32BC1256FDA004C9829</unid>
<noteid>682</noteid>
<created>05-04-2005 15:56:36</created>
<modified>19-10-2005 14:18:21</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>34</sequence>
<addedtofile>05-04-2005 15:59:55</addedtofile>
<lastaccessed>19-10-2005 14:18:21</lastaccessed>
<revised>02-10-2005 12:46:39</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: OutputStream"
Use "CLASS: LsDocConstants"
Public Class OutputStreamFactory
'/**
' * Function to return the OutputStream to write to.
' *
' * @param key The key of the entity to create
' * @return An open ready OutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
End Function
'/**
' * Returns the url to the document with the supplied key.
' *
' * @param key The key
' */
Public Function GetUrl(key As String) As String
GetUrl = key + ".html"
End Function
'/**
' * Method to prepare the factory.
' *
' */
Public Sub Prepare()
End Sub
End Class
Public Class FileOutputStreamFactory As OutputStreamFactory
'declarations
Private pDirectory As String
'/**
' * Constructor.
' *
' * @param directory The directory to create the file in (should end in a directory separator)
' */
Public Sub New(directory As String)
Me.pDirectory = directory
End Sub
'/**
' * @see OutputStreamFactory#GetOutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
'create a FileOutputStream
Dim fo As New FileOutputStream(Me.pDirectory + key, True)
Call fo.Open()
Set GetOutputStream = fo
End Function
'/**
' * @see OutputStreamFactory#Prepare
' */
Public Sub Prepare()
'declarations
Dim file As String
'list the normal files in the directory
file = Dir$(Me.pDirectory, 0)
While file <> ""
Kill Me.pDirectory + file
'get next file
file = Dir$()
Wend
End Sub
End Class
Public Class NotesOutputStreamFactory As OutputStreamFactory
'declarations
Private pDbWrite As NotesDatabase
Private pDoc As NotesDocument
Private pTitle As String
Private pDirectory As String
'/**
' * Constructor.
' *
' * @param db_process The database we are processing and for which the replica id is used as the "directory" (specify Nothing for NotesSession.CurrentDatabase)
' * @param db_write The database we should write to (specify Nothing for NotesSession.CurrentDatabase).
' */
Public Sub New(db_write As NotesDatabase, title As String, directory As String)
Dim session As New NotesSession
If db_write Is Nothing Then
Set Me.pDbWrite = session.CurrentDatabase
Else
Set Me.pDbWrite = db_write
End If
Me.pTitle = title
Me.pDirectory = directory
End Sub
'/**
' * Destructor.
' */
Public Sub Delete()
'save current document if any
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
End Sub
'/**
' * @see OutputStreamFactory#GetOutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
'save document if we have any existing document
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
'create document
Set Me.pDoc = New NotesDocument(Me.pDbWrite)
'set items
Call Me.pDoc.ReplaceItemValue("Form", "HTML")
Call Me.pDoc.ReplaceItemValue("txtKey", key)
Call Me.pDoc.ReplaceItemValue("txtDescription", LSDOC_HTML_HEADER)
Call Me.pDoc.ReplaceItemValue("txtDbTitle", Me.pTitle)
Call Me.pDoc.ReplaceItemValue("txtDirectory", Me.pDirectory)
'create a rich text OutputStream
Dim out As New RichTextOutputStream("HTML", Me.pDoc)
'open outputstream
Call out.Open()
'return
Set GetOutputStream = out
End Function
'/**
' * Returns the url to the document with the supplied key.
' *
' * @param key The key
' */
Public Function GetUrl(key As String) As String
GetUrl = Me.pDirectory + "_" + key + ".html"
End Function
'/**
' * @see OutputStreamFactory#Prepare
' */
Public Sub Prepare()
'declarations
Dim view As NotesView
Dim dc As NotesDocumentCollection
'get view
Set view = Me.pDbWrite.GetView(NOTES_VIEW_BY_DIRECTORY)
Set dc = view.GetAllDocumentsByKey(Me.pDirectory, True)
'remove all directory
Call dc.RemoveAll(True)
End Sub
End Class
Private Sub lsdoc_description
%REM
Holds classes that knows how to produce OutputStreams (to files and/or Notes databases).
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: OutputStream" />
<usereference name="CLASS: LsDocConstants" />
<class name="OutputStreamFactory" visibility="Public">
<code><![CDATA[Public Class OutputStreamFactory
'/**
' * Function to return the OutputStream to write to.
' *
' * @param key The key of the entity to create
' * @return An open ready OutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
End Function
'/**
' * Returns the url to the document with the supplied key.
' *
' * @param key The key
' */
Public Function GetUrl(key As String) As String
GetUrl = key + ".html"
End Function
'/**
' * Method to prepare the factory.
' *
' */
Public Sub Prepare()
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<function name="GetOutputStream" visibility="Public">
<params>
<param name="key">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="OutputStream" />
<code><![CDATA[Public Function GetOutputStream(key As String) As OutputStream
End Function]]]]><![CDATA[></code>
<comment />
</function>
<function name="GetUrl" visibility="Public">
<params>
<param name="key">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="String" />
<code><![CDATA[Public Function GetUrl(key As String) As String
GetUrl = key + ".html"
End Function]]]]><![CDATA[></code>
<comment />
</function>
<sub name="Prepare" visibility="Public">
<code><![CDATA[Public Sub Prepare()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="FileOutputStreamFactory" visibility="Public">
<parentClass>OutputStreamFactory</parentClass>
<hierarchy>
<class>OutputStreamFactory</class>
<class>FileOutputStreamFactory</class>
</hierarchy>
<code><![CDATA[Public Class FileOutputStreamFactory As OutputStreamFactory
'declarations
Private pDirectory As String
'/**
' * Constructor.
' *
' * @param directory The directory to create the file in (should end in a directory separator)
' */
Public Sub New(directory As String)
Me.pDirectory = directory
End Sub
'/**
' * @see OutputStreamFactory#GetOutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
'create a FileOutputStream
Dim fo As New FileOutputStream(Me.pDirectory + key, True)
Call fo.Open()
Set GetOutputStream = fo
End Function
'/**
' * @see OutputStreamFactory#Prepare
' */
Public Sub Prepare()
'declarations
Dim file As String
'list the normal files in the directory
file = Dir$(Me.pDirectory, 0)
While file <> ""
Kill Me.pDirectory + file
'get next file
file = Dir$()
Wend
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pDirectory" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDirectory As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="directory">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(directory As String)
Me.pDirectory = directory
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="GetOutputStream" visibility="Public">
<params>
<param name="key">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="OutputStream" />
<code><![CDATA[Public Function GetOutputStream(key As String) As OutputStream
'create a FileOutputStream
Dim fo As New FileOutputStream(Me.pDirectory + key, True)
Call fo.Open()
Set GetOutputStream = fo
End Function]]]]><![CDATA[></code>
<comment />
</function>
<sub name="Prepare" visibility="Public">
<code><![CDATA[Public Sub Prepare()
'declarations
Dim file As String
'list the normal files in the directory
file = Dir$(Me.pDirectory, 0)
While file <> ""
Kill Me.pDirectory + file
'get next file
file = Dir$()
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="NotesOutputStreamFactory" visibility="Public">
<parentClass>OutputStreamFactory</parentClass>
<hierarchy>
<class>OutputStreamFactory</class>
<class>NotesOutputStreamFactory</class>
</hierarchy>
<code><![CDATA[Public Class NotesOutputStreamFactory As OutputStreamFactory
'declarations
Private pDbWrite As NotesDatabase
Private pDoc As NotesDocument
Private pTitle As String
Private pDirectory As String
'/**
' * Constructor.
' *
' * @param db_process The database we are processing and for which the replica id is used as the "directory" (specify Nothing for NotesSession.CurrentDatabase)
' * @param db_write The database we should write to (specify Nothing for NotesSession.CurrentDatabase).
' */
Public Sub New(db_write As NotesDatabase, title As String, directory As String)
Dim session As New NotesSession
If db_write Is Nothing Then
Set Me.pDbWrite = session.CurrentDatabase
Else
Set Me.pDbWrite = db_write
End If
Me.pTitle = title
Me.pDirectory = directory
End Sub
'/**
' * Destructor.
' */
Public Sub Delete()
'save current document if any
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
End Sub
'/**
' * @see OutputStreamFactory#GetOutputStream
' */
Public Function GetOutputStream(key As String) As OutputStream
'save document if we have any existing document
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
'create document
Set Me.pDoc = New NotesDocument(Me.pDbWrite)
'set items
Call Me.pDoc.ReplaceItemValue("Form", "HTML")
Call Me.pDoc.ReplaceItemValue("txtKey", key)
Call Me.pDoc.ReplaceItemValue("txtDescription", LSDOC_HTML_HEADER)
Call Me.pDoc.ReplaceItemValue("txtDbTitle", Me.pTitle)
Call Me.pDoc.ReplaceItemValue("txtDirectory", Me.pDirectory)
'create a rich text OutputStream
Dim out As New RichTextOutputStream("HTML", Me.pDoc)
'open outputstream
Call out.Open()
'return
Set GetOutputStream = out
End Function
'/**
' * Returns the url to the document with the supplied key.
' *
' * @param key The key
' */
Public Function GetUrl(key As String) As String
GetUrl = Me.pDirectory + "_" + key + ".html"
End Function
'/**
' * @see OutputStreamFactory#Prepare
' */
Public Sub Prepare()
'declarations
Dim view As NotesView
Dim dc As NotesDocumentCollection
'get view
Set view = Me.pDbWrite.GetView(NOTES_VIEW_BY_DIRECTORY)
Set dc = view.GetAllDocumentsByKey(Me.pDirectory, True)
'remove all directory
Call dc.RemoveAll(True)
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pDbWrite" visibility="Private">
<datatype idref="NotesDatabase" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDbWrite As NotesDatabase]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDoc" visibility="Private">
<datatype idref="NotesDocument" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDoc As NotesDocument]]]]><![CDATA[></code>
<comment />
</member>
<member name="pTitle" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pTitle As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDirectory" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDirectory As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="db_write">
<datatype idref="NotesDatabase" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="title">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="directory">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(db_write As NotesDatabase, title As String, directory As String)
Dim session As New NotesSession
If db_write Is Nothing Then
Set Me.pDbWrite = session.CurrentDatabase
Else
Set Me.pDbWrite = db_write
End If
Me.pTitle = title
Me.pDirectory = directory
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Delete" visibility="Public">
<code><![CDATA[Public Sub Delete()
'save current document if any
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="GetOutputStream" visibility="Public">
<params>
<param name="key">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="OutputStream" />
<code><![CDATA[Public Function GetOutputStream(key As String) As OutputStream
'save document if we have any existing document
If Not (Me.pDoc Is Nothing) Then
Call Me.pDoc.Save(True, False)
Set Me.pDoc = Nothing
End If
'create document
Set Me.pDoc = New NotesDocument(Me.pDbWrite)
'set items
Call Me.pDoc.ReplaceItemValue("Form", "HTML")
Call Me.pDoc.ReplaceItemValue("txtKey", key)
Call Me.pDoc.ReplaceItemValue("txtDescription", LSDOC_HTML_HEADER)
Call Me.pDoc.ReplaceItemValue("txtDbTitle", Me.pTitle)
Call Me.pDoc.ReplaceItemValue("txtDirectory", Me.pDirectory)
'create a rich text OutputStream
Dim out As New RichTextOutputStream("HTML", Me.pDoc)
'open outputstream
Call out.Open()
'return
Set GetOutputStream = out
End Function]]]]><![CDATA[></code>
<comment />
</function>
<function name="GetUrl" visibility="Public">
<params>
<param name="key">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="String" />
<code><![CDATA[Public Function GetUrl(key As String) As String
GetUrl = Me.pDirectory + "_" + key + ".html"
End Function]]]]><![CDATA[></code>
<comment />
</function>
<sub name="Prepare" visibility="Public">
<code><![CDATA[Public Sub Prepare()
'declarations
Dim view As NotesView
Dim dc As NotesDocumentCollection
'get view
Set view = Me.pDbWrite.GetView(NOTES_VIEW_BY_DIRECTORY)
Set dc = view.GetAllDocumentsByKey(Me.pDirectory, True)
'remove all directory
Call dc.RemoveAll(True)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Holds classes that knows how to produce OutputStreams (to files and/or Notes databases).
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: Comment" alias="" language="lotusscript">
<noteinfo>
<unid>37CA546701D68A9EC1257027005EB451</unid>
<noteid>152a</noteid>
<created>21-06-2005 19:14:25</created>
<modified>26-10-2005 09:58:11</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>46</sequence>
<addedtofile>21-06-2005 19:14:46</addedtofile>
<lastaccessed>26-10-2005 09:54:53</lastaccessed>
<revised>22-10-2005 16:06:20</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: Collections"
Use "CLASS: OutputStream"
Use "CLASS: LsDocConstants"
Public Class Comment
'declarations
Private pComment As String
Private pParams As Hashtable
'/**
' * Constructor.
' *
' */
Public Sub New()
'create param hashtable
Set Me.pParams = New Hashtable()
End Sub
'/**
' * Add a part of the comment as we encouter it while parsing
' * LotusScript source.
' *
' * @param comment The comment part.
' */
Public Sub AddCommentPart(comment As String)
'declarations
Dim index_at As Integer
Dim index_space As Integer
Dim i As Integer
Dim char_code As Integer
Dim param_name As String
Dim param_text As String
Dim param As Parameter
Dim v As Variant
'parse the comment par to see if the comment contains
'an @-sign (quick way to bail out)
index_at = Instr(1, comment, "@")
If index_at = 0 Then
'comment part doesn't contain any parameter - just add
Me.pComment = Me.pComment + comment
Exit Sub
End If
'get parameter name
For i=index_at To Len(comment)
char_code = Asc(Mid$(comment, i, 1))
If char_code = 32 Or char_code = 9 Then
'reached the end of the param name
param_name = Mid$(comment, index_at, i-index_at)
Exit For
End If
Next
'test parameter name
If Not gFactory.IsValidParameter(param_name) Then
'unknown parameter - just add to comment
Me.pComment = Me.pComment + comment
Exit Sub
End If
'we have a know parameter - add the text before the @-sign to the
'normal comment
If index_at > 1 Then
Me.pComment = Me.pComment + Mid(comment, 1, index_at-1)
End If
'get the parameter text
param_text = Mid(comment, i + 1)
'construct parameter
Set param = gFactory.GetInstance(param_name, param_text)
If Not (param Is Nothing) Then
'get vector for param name
Set v = Me.pParams.Get(param_name)
If v Is Nothing Then
Set v = New Vector()
Call Me.pParams.Put(param_name, v)
End If
'add param to vector
Call v.AddElement(param)
End If
End Sub
'/**
' * Returns the entire comment except @-parameters.
' *
' * @return The comment.
' */
Public Property Get Comment As String
Comment = Me.pComment
End Property
'/**
' * Returns a vector of Parameter-objects with the
' * supplied name.
' *
' * @param param_name The name of the @-parameter to get Parameter objects for.
' * @return Vector of Parameter objects or Nothing if no @-parameters with the supplied name.
' */
Public Function GetParameters(param_name As String) As Vector
'declarations
Dim v As Vector
'get
Set v = Me.pParams.Get(param_name)
'return
Set GetParameters = v
End Function
'/**
' * Returns the first sentence (until the first period or @ which ever
' * comes first or until the end of the comment if no period or @.
' *
' */
Public Property Get FirstSentence As String
'declarations
Dim index_period As Integer
Dim index_at As Integer
'find chars
index_period = Instr(1, Me.pComment, ".")
index_at = Instr(1, Me.pComment, "@")
If (index_period + index_at) = 0 Then
'no period or @ - return everything
FirstSentence = Me.pComment
Elseif (index_period < index_at) Or (index_period > 0 And index_at = 0) Then
'get until period
FirstSentence = Mid(Me.pComment, 1, index_period)
Else
'get until @ (minus 1 since we do not want the @-sign)
FirstSentence = Mid(Me.pComment, 1, index_at-1)
End If
End Property
End Class
Public Class Parameter
'declarations
Private pName As String
Private pText As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String)
Me.pName = param_name
Me.pText = param_text
End Sub
'/**
' * Returns the name of the parameter (error, depends etc.)
' */
Public Property Get ParamName As String
ParamName = Me.pName
End Property
'/**
' * Returns the text of the parameter which is everything after the
' * @-parameter name.
' */
Public Property Get ParamText As String
ParamText = Me.pText
End Property
End Class
Public Class SeeParameter As Parameter
'declarations
Private pMainPart As String
Private pSubPart As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for a # in the text
i = Instr(1, param_text, "#")
If i > 0 Then
'there is a # sign
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no # sign - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub
'/**
' * Returns the main part of the see-parameter.
' */
Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property
'/**
' * Returns the sub part of the see-parameter.
' */
Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property
End Class
Public Class ParamParameter As Parameter
'declarations
Private pMainPart As String
Private pSubPart As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for first space
i = Instr(1, param_text, " ")
If i > 0 Then
'there is a space
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no space - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub
'/**
' * Returns the main part of the parameter.
' */
Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property
'/**
' * Returns the sub part of the parameter.
' */
Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property
End Class
Public Class ParameterFactory
'/**
' * Utility method to test to valid parameter name.
' *
' * @return True if the parameter is valid - False otherwise.
' */
Public Function IsValidParameter(param_name As String) As Boolean
'declarations
IsValidParameter = (param_name = AT_PARAM_PARAM) Or (param_name = AT_PARAM_DEPENDS) Or _
(param_name = AT_PARAM_ERROR) Or (param_name = AT_PARAM_RETURN) Or _
(param_name = AT_PARAM_SEE) Or (param_name = AT_PARAM_VERSION) Or _
(param_name = AT_PARAM_AUTHOR)
End Function
'/**
' * Returns a parameter for the supplied name.
' *
' * @return The constructed parameter object or Nothing if no parameter matches the supplied name.
' */
Public Function GetInstance(param_name As String, param_text As String) As Parameter
'declarations
Dim param As Parameter
'test for valid parameter
If Not Me.IsValidParameter(param_name) Then
Set param = Nothing
Exit Function
End If
'decide which param to create
Select Case param_name
Case Is = AT_PARAM_SEE
'this is a @see parameter
Set param = New SeeParameter(param_name, param_text)
Case Is = AT_PARAM_PARAM
'this is a @param parameter
Set param = New ParamParameter(param_name, param_text)
Case Else
Set param = New Parameter(param_name, param_text)
End Select
'return object
Set GetInstance = param
End Function
End Class
Private Sub lsdoc_description()
%REM
This script library holds the classes for parsing and dealing with
comments as well as the @-parameters.
%END REM
End Sub
'/**
' * Constructs a parameter to use to the lifetime of the script library.
' */
Sub Initialize
'construct a factory
Set gFactory = New ParameterFactory()
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: Collections" />
<usereference name="CLASS: OutputStream" />
<usereference name="CLASS: LsDocConstants" />
<class name="Comment" visibility="Public">
<code><![CDATA[Public Class Comment
'declarations
Private pComment As String
Private pParams As Hashtable
'/**
' * Constructor.
' *
' */
Public Sub New()
'create param hashtable
Set Me.pParams = New Hashtable()
End Sub
'/**
' * Add a part of the comment as we encouter it while parsing
' * LotusScript source.
' *
' * @param comment The comment part.
' */
Public Sub AddCommentPart(comment As String)
'declarations
Dim index_at As Integer
Dim index_space As Integer
Dim i As Integer
Dim char_code As Integer
Dim param_name As String
Dim param_text As String
Dim param As Parameter
Dim v As Variant
'parse the comment par to see if the comment contains
'an @-sign (quick way to bail out)
index_at = Instr(1, comment, "@")
If index_at = 0 Then
'comment part doesn't contain any parameter - just add
Me.pComment = Me.pComment + comment
Exit Sub
End If
'get parameter name
For i=index_at To Len(comment)
char_code = Asc(Mid$(comment, i, 1))
If char_code = 32 Or char_code = 9 Then
'reached the end of the param name
param_name = Mid$(comment, index_at, i-index_at)
Exit For
End If
Next
'test parameter name
If Not gFactory.IsValidParameter(param_name) Then
'unknown parameter - just add to comment
Me.pComment = Me.pComment + comment
Exit Sub
End If
'we have a know parameter - add the text before the @-sign to the
'normal comment
If index_at > 1 Then
Me.pComment = Me.pComment + Mid(comment, 1, index_at-1)
End If
'get the parameter text
param_text = Mid(comment, i + 1)
'construct parameter
Set param = gFactory.GetInstance(param_name, param_text)
If Not (param Is Nothing) Then
'get vector for param name
Set v = Me.pParams.Get(param_name)
If v Is Nothing Then
Set v = New Vector()
Call Me.pParams.Put(param_name, v)
End If
'add param to vector
Call v.AddElement(param)
End If
End Sub
'/**
' * Returns the entire comment except @-parameters.
' *
' * @return The comment.
' */
Public Property Get Comment As String
Comment = Me.pComment
End Property
'/**
' * Returns a vector of Parameter-objects with the
' * supplied name.
' *
' * @param param_name The name of the @-parameter to get Parameter objects for.
' * @return Vector of Parameter objects or Nothing if no @-parameters with the supplied name.
' */
Public Function GetParameters(param_name As String) As Vector
'declarations
Dim v As Vector
'get
Set v = Me.pParams.Get(param_name)
'return
Set GetParameters = v
End Function
'/**
' * Returns the first sentence (until the first period or @ which ever
' * comes first or until the end of the comment if no period or @.
' *
' */
Public Property Get FirstSentence As String
'declarations
Dim index_period As Integer
Dim index_at As Integer
'find chars
index_period = Instr(1, Me.pComment, ".")
index_at = Instr(1, Me.pComment, "@")
If (index_period + index_at) = 0 Then
'no period or @ - return everything
FirstSentence = Me.pComment
Elseif (index_period < index_at) Or (index_period > 0 And index_at = 0) Then
'get until period
FirstSentence = Mid(Me.pComment, 1, index_period)
Else
'get until @ (minus 1 since we do not want the @-sign)
FirstSentence = Mid(Me.pComment, 1, index_at-1)
End If
End Property
End Class]]]]><![CDATA[></code>
<comment />
<member name="pComment" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pComment As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pParams" visibility="Private">
<datatype idref="Hashtable" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pParams As Hashtable]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<code><![CDATA[Public Sub New()
'create param hashtable
Set Me.pParams = New Hashtable()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddCommentPart" visibility="Public">
<params>
<param name="comment">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddCommentPart(comment As String)
'declarations
Dim index_at As Integer
Dim index_space As Integer
Dim i As Integer
Dim char_code As Integer
Dim param_name As String
Dim param_text As String
Dim param As Parameter
Dim v As Variant
'parse the comment par to see if the comment contains
'an @-sign (quick way to bail out)
index_at = Instr(1, comment, "@")
If index_at = 0 Then
'comment part doesn't contain any parameter - just add
Me.pComment = Me.pComment + comment
Exit Sub
End If
'get parameter name
For i=index_at To Len(comment)
char_code = Asc(Mid$(comment, i, 1))
If char_code = 32 Or char_code = 9 Then
'reached the end of the param name
param_name = Mid$(comment, index_at, i-index_at)
Exit For
End If
Next
'test parameter name
If Not gFactory.IsValidParameter(param_name) Then
'unknown parameter - just add to comment
Me.pComment = Me.pComment + comment
Exit Sub
End If
'we have a know parameter - add the text before the @-sign to the
'normal comment
If index_at > 1 Then
Me.pComment = Me.pComment + Mid(comment, 1, index_at-1)
End If
'get the parameter text
param_text = Mid(comment, i + 1)
'construct parameter
Set param = gFactory.GetInstance(param_name, param_text)
If Not (param Is Nothing) Then
'get vector for param name
Set v = Me.pParams.Get(param_name)
If v Is Nothing Then
Set v = New Vector()
Call Me.pParams.Put(param_name, v)
End If
'add param to vector
Call v.AddElement(param)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="Comment" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get Comment As String
Comment = Me.pComment
End Property]]]]><![CDATA[></code>
<comment />
</property>
<function name="GetParameters" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Vector" />
<code><![CDATA[Public Function GetParameters(param_name As String) As Vector
'declarations
Dim v As Vector
'get
Set v = Me.pParams.Get(param_name)
'return
Set GetParameters = v
End Function]]]]><![CDATA[></code>
<comment />
</function>
<property name="FirstSentence" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get FirstSentence As String
'declarations
Dim index_period As Integer
Dim index_at As Integer
'find chars
index_period = Instr(1, Me.pComment, ".")
index_at = Instr(1, Me.pComment, "@")
If (index_period + index_at) = 0 Then
'no period or @ - return everything
FirstSentence = Me.pComment
Elseif (index_period < index_at) Or (index_period > 0 And index_at = 0) Then
'get until period
FirstSentence = Mid(Me.pComment, 1, index_period)
Else
'get until @ (minus 1 since we do not want the @-sign)
FirstSentence = Mid(Me.pComment, 1, index_at-1)
End If
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="Parameter" visibility="Public">
<code><![CDATA[Public Class Parameter
'declarations
Private pName As String
Private pText As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String)
Me.pName = param_name
Me.pText = param_text
End Sub
'/**
' * Returns the name of the parameter (error, depends etc.)
' */
Public Property Get ParamName As String
ParamName = Me.pName
End Property
'/**
' * Returns the text of the parameter which is everything after the
' * @-parameter name.
' */
Public Property Get ParamText As String
ParamText = Me.pText
End Property
End Class]]]]><![CDATA[></code>
<comment />
<member name="pName" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pName As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pText" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pText As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(param_name As String, param_text As String)
Me.pName = param_name
Me.pText = param_text
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ParamName" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get ParamName As String
ParamName = Me.pName
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="ParamText" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get ParamText As String
ParamText = Me.pText
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="SeeParameter" visibility="Public">
<parentClass>Parameter</parentClass>
<hierarchy>
<class>Parameter</class>
<class>SeeParameter</class>
</hierarchy>
<code><![CDATA[Public Class SeeParameter As Parameter
'declarations
Private pMainPart As String
Private pSubPart As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for a # in the text
i = Instr(1, param_text, "#")
If i > 0 Then
'there is a # sign
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no # sign - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub
'/**
' * Returns the main part of the see-parameter.
' */
Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property
'/**
' * Returns the sub part of the see-parameter.
' */
Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property
End Class]]]]><![CDATA[></code>
<comment />
<member name="pMainPart" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pMainPart As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pSubPart" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSubPart As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Parameter">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_name">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for a # in the text
i = Instr(1, param_text, "#")
If i > 0 Then
'there is a # sign
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no # sign - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="MainPart" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="SubPart" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="ParamParameter" visibility="Public">
<parentClass>Parameter</parentClass>
<hierarchy>
<class>Parameter</class>
<class>ParamParameter</class>
</hierarchy>
<code><![CDATA[Public Class ParamParameter As Parameter
'declarations
Private pMainPart As String
Private pSubPart As String
'/**
' * Constructor.
' */
Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for first space
i = Instr(1, param_text, " ")
If i > 0 Then
'there is a space
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no space - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub
'/**
' * Returns the main part of the parameter.
' */
Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property
'/**
' * Returns the sub part of the parameter.
' */
Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property
End Class]]]]><![CDATA[></code>
<comment />
<member name="pMainPart" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pMainPart As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pSubPart" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSubPart As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Parameter">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_name">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(param_name As String, param_text As String), Parameter(param_name, param_text)
'declarations
Dim i As Integer
'look for first space
i = Instr(1, param_text, " ")
If i > 0 Then
'there is a space
Me.pMainPart = Mid$(param_text, 1, i-1)
Me.pSubPart = Mid$(param_text, i+1)
Else
'no space - everything is the "main" part
Me.pMainPart = param_text
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="MainPart" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get MainPart As String
MainPart = Me.pMainPart
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="SubPart" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get SubPart As String
SubPart = Me.pSubPart
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="ParameterFactory" visibility="Public">
<code><![CDATA[Public Class ParameterFactory
'/**
' * Utility method to test to valid parameter name.
' *
' * @return True if the parameter is valid - False otherwise.
' */
Public Function IsValidParameter(param_name As String) As Boolean
'declarations
IsValidParameter = (param_name = AT_PARAM_PARAM) Or (param_name = AT_PARAM_DEPENDS) Or _
(param_name = AT_PARAM_ERROR) Or (param_name = AT_PARAM_RETURN) Or _
(param_name = AT_PARAM_SEE) Or (param_name = AT_PARAM_VERSION) Or _
(param_name = AT_PARAM_AUTHOR)
End Function
'/**
' * Returns a parameter for the supplied name.
' *
' * @return The constructed parameter object or Nothing if no parameter matches the supplied name.
' */
Public Function GetInstance(param_name As String, param_text As String) As Parameter
'declarations
Dim param As Parameter
'test for valid parameter
If Not Me.IsValidParameter(param_name) Then
Set param = Nothing
Exit Function
End If
'decide which param to create
Select Case param_name
Case Is = AT_PARAM_SEE
'this is a @see parameter
Set param = New SeeParameter(param_name, param_text)
Case Is = AT_PARAM_PARAM
'this is a @param parameter
Set param = New ParamParameter(param_name, param_text)
Case Else
Set param = New Parameter(param_name, param_text)
End Select
'return object
Set GetInstance = param
End Function
End Class]]]]><![CDATA[></code>
<comment />
<function name="IsValidParameter" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Boolean" />
<code><![CDATA[Public Function IsValidParameter(param_name As String) As Boolean
'declarations
IsValidParameter = (param_name = AT_PARAM_PARAM) Or (param_name = AT_PARAM_DEPENDS) Or _
(param_name = AT_PARAM_ERROR) Or (param_name = AT_PARAM_RETURN) Or _
(param_name = AT_PARAM_SEE) Or (param_name = AT_PARAM_VERSION) Or _
(param_name = AT_PARAM_AUTHOR)
End Function]]]]><![CDATA[></code>
<comment />
</function>
<function name="GetInstance" visibility="Public">
<params>
<param name="param_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="param_text">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Parameter" />
<code><![CDATA[Public Function GetInstance(param_name As String, param_text As String) As Parameter
'declarations
Dim param As Parameter
'test for valid parameter
If Not Me.IsValidParameter(param_name) Then
Set param = Nothing
Exit Function
End If
'decide which param to create
Select Case param_name
Case Is = AT_PARAM_SEE
'this is a @see parameter
Set param = New SeeParameter(param_name, param_text)
Case Is = AT_PARAM_PARAM
'this is a @param parameter
Set param = New ParamParameter(param_name, param_text)
Case Else
Set param = New Parameter(param_name, param_text)
End Select
'return object
Set GetInstance = param
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description()
%REM
This script library holds the classes for parsing and dealing with
comments as well as the @-parameters.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Initialize" visibility="Private">
<code><![CDATA['/**
' * Constructs a parameter to use to the lifetime of the script library.
' */
Sub Initialize
'construct a factory
Set gFactory = New ParameterFactory()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: ScriptFactory" alias="" language="lotusscript">
<noteinfo>
<unid>4D26E3C7B4173573C1256FD7007B479A</unid>
<noteid>48e</noteid>
<created>03-04-2005 00:26:32</created>
<modified>29-11-2006 14:53:44</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>112</sequence>
<addedtofile>03-04-2005 00:26:54</addedtofile>
<lastaccessed>29-11-2006 13:47:38</lastaccessed>
<revised>11-12-2005 19:42:30</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "AppSLDesign7"
Use "CLASS: Collections"
Use "CLASS: Script"
Use "CLASS: ScriptSource"
Use "CLASS: LSDocConstants"
Public Class ScriptFactory
'declarations
Private pSession As NotesSession
Private pDb As NotesDatabase
Private pForms As Vector
Private pViews As Vector
Private pAgents As Vector
Private pScriptLibs As Vector
Private pPages As Vector
Private pWebservices As Vector
Private pSharedActions As Boolean
'/**
' * Constructor.
' *
' * @param db The database to look in (Nothing to use NotesSession.CurrentDatabase)
' */
Public Sub New(db As NotesDatabase)
'create session
Set Me.pSession = New NotesSession
'store database
If db Is Nothing Then
Set Me.pDb = Me.pSession.CurrentDatabase
Else
Set Me.pDb = db
End If
End Sub
'/**
' * Add the shared actions to the factory.
' *
' */
Public Sub AddSharedActions()
Me.pSharedActions = True
End Sub
'/**
' * Adds a page to the factory.
' *
' * @param elem_name The name of the page
' */
Public Sub AddPage(elem_name As String)
If Me.pPages Is Nothing Then
Set Me.pPages = New Vector()
End If
Call Me.pPages.AddElement(elem_name)
End Sub
'/**
' * Adds a web service to the factory.
' *
' * @param elem_name The name of the web service
' */
Public Sub AddWebservice(elem_name As String)
If Me.pWebservices Is Nothing Then
Set Me.pWebservices = New Vector()
End If
Call Me.pWebservices.AddElement(elem_name)
End Sub
'/**
' * Adds a script library to the factory.
' *
' * @param elem_name The name of the script library
' */
Public Sub AddScriptLibrary(elem_name As String)
If Me.pScriptLibs Is Nothing Then
Set Me.pScriptLibs = New Vector()
End If
Call Me.pScriptLibs.AddElement(elem_name)
End Sub
'/**
' * Adds a form to the factory.
' *
' * @param elem_name The name of the form
' */
Public Sub AddForm(elem_name As String)
If Me.pForms Is Nothing Then
Set Me.pForms = New Vector()
End If
Call Me.pForms.AddElement(elem_name)
End Sub
'/**
' * Adds a view to the factory.
' *
' * @param elem_name The name of the view
' */
Public Sub AddView(elem_name As String)
If Me.pViews Is Nothing Then
Set Me.pViews = New Vector()
End If
Call Me.pViews.AddElement(elem_name)
End Sub
'/**
' * Adds an agent to the factory.
' *
' * @param elem_name The name of the agent
' */
Public Sub AddAgent(elem_name As String)
If Me.pAgents Is Nothing Then
Set Me.pAgents = New Vector()
End If
Call Me.pAgents.AddElement(elem_name)
End Sub
'/**
' * Processes the design elements added.
' *
' * @return A Vector of created Script objects.
' */
Public Function Process() As Vector
Error 9999, "Use a sub-class"
End Function
End Class
Public Class DxlScriptFactory As ScriptFactory
'declarations
Private pNoteCol As NotesNoteCollection
Private pAllWebservices As Boolean
Public Sub New(db As NotesDatabase), ScriptFactory(db)
Me.pAllWebservices = False
End Sub
'/**
' * Adds the actions to the factory.
' *
' */
Public Sub AddSharedActions()
'call super
Call ScriptFactory..AddSharedActions()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectActions = True
End Sub
'/**
' * Adds all the pages to the factory.
' *
' */
Public Sub AddPages()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectPages = True
End Sub
'/**
' * Adds all the web services to the factory.
' *
' */
Public Sub AddWebservices()
Me.pAllWebservices = True
End Sub
'/**
' * Adds all the script libraries to the factory.
' *
' */
Public Sub AddScriptLibraries()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectScriptLibraries = True
End Sub
'/**
' * Adds all the forms to the factory.
' *
' */
Public Sub AddForms()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectForms = True
End Sub
'/**
' * Adds all the views to the factory.
' *
' */
Public Sub AddViews()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectViews = True
End Sub
'/**
' * Adds all the agents to the factory.
' *
' */
Public Sub AddAgents()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectAgents = True
End Sub
'/**
' * Adds the database script to the factory.
' *
' */
Public Sub AddDatabaseScript()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectDatabaseScript = True
End Sub
'/**
' * @see ScriptAgent#AddPage
' */
Public Sub AddPage(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddPages()
'call super
Call ScriptFactory..AddPage(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddScriptLibrary
' */
Public Sub AddScriptLibrary(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddScriptLibraries()
'call super
Call ScriptFactory..AddScriptLibrary(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddForm
' */
Public Sub AddForm(elem_name As String)
'make sure we export the forms to the DXL
Call Me.AddForms()
'call super
Call ScriptFactory..AddForm(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddView
' */
Public Sub AddView(elem_name As String)
'make sure we export the views to the DXL
Call Me.AddViews()
'call super
Call ScriptFactory..AddView(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddAgent
' */
Public Sub AddAgent(elem_name As String)
'make sure we export the agents to the DXL
Call Me.AddAgents()
'call super
Call ScriptFactory..AddAgent(elem_name)
End Sub
'/**
' * @see ScriptFactory#Process
' */
Public Function Process() As Vector
'declarations
Dim scripts As New Vector
Dim doc As NotesDocument
Dim exporter As NotesDXLExporter
Dim dom_parser As NotesDOMParser
Dim xslt_transformer As NotesXSLTransformer
Dim xslt_stream As NotesStream
Dim xml_doc As NotesDOMDocumentNode
Dim script_nodelist As NotesDOMNodeList
Dim code_node As NotesDOMElementNode
Dim script_node As NotesDOMElementNode
Dim i As Integer
Dim script_name As String
Dim script_type As String
Dim event_name As String
Dim script As Script
Dim script_source As ScriptSource
Dim enum As Enumeration
'create stylesheet
Set xslt_stream = Me.pSession.CreateStream()
Call xslt_stream.WriteText({<?xml version="1.0" encoding="UTF-8"?><xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:dxl="http://www.lotus.com/dxl" version="1.0"><xsl:param name="export_forms">#all#</xsl:param><xsl:param name="export_views">#all#</xsl:param><xsl:param name="export_agents">#all#</xsl:param><xsl:param name="export_scriptlibs">#all#</xsl:param>})
Call xslt_stream.WriteText({<xsl:param name="export_databasescript">#all#</xsl:param><xsl:param name="export_pages">#all#</xsl:param><xsl:param name="export_actions">#all#</xsl:param><xsl:template match="/"><scripts><xsl:apply-templates select="/dxl:database/dxl:scriptlibrary"/><xsl:apply-templates select="/dxl:database/dxl:agent"/><xsl:apply-templates select="/dxl:database/dxl:form"/><xsl:apply-templates select="/dxl:database/dxl:view"/><xsl:apply-templates select="/dxl:database/dxl:databasescript"/>})
Call xslt_stream.WriteText({<xsl:apply-templates select="/dxl:database/dxl:page"/><xsl:apply-templates select="/dxl:database/dxl:sharedactions/dxl:action"/></scripts></xsl:template><xsl:template match="//dxl:scriptlibrary | //dxl:agent | //dxl:view | //dxl:form | //dxl:databasescript | //dxl:page | //dxl:sharedactions/dxl:action"><xsl:call-template name="code"><xsl:with-param name="export_source"><xsl:choose><xsl:when test="name() = 'agent'">})
Call xslt_stream.WriteText({<xsl:value-of select="$export_agents"/></xsl:when><xsl:when test="name() = 'view'"><xsl:value-of select="$export_views"/></xsl:when><xsl:when test="name() = 'form'"><xsl:value-of select="$export_forms"/></xsl:when><xsl:when test="name() = 'scriptlibrary'"><xsl:value-of select="$export_scriptlibs"/></xsl:when><xsl:when test="name() = 'databasescript'"><xsl:value-of select="$export_databasescript"/></xsl:when><xsl:when test="name() = 'page'"><xsl:value-of select="$export_pages"/></xsl:when><xsl:when test="name() = 'action'"><xsl:value-of select="$export_actions"/>})
Call xslt_stream.WriteText({</xsl:when></xsl:choose></xsl:with-param></xsl:call-template></xsl:template><xsl:template name="code"><xsl:param name="export_source" /><xsl:if test="child::dxl:code/dxl:lotusscript/text() != ''"><xsl:if test="$export_source = '#all#' or contains($export_source, concat('¤', @name, '¤'))"><xsl:element name="script"><xsl:attribute name="type"><xsl:value-of select="name()"/></xsl:attribute><!-- shared actions use the title-attribute for the name and all other then name-attribute --><xsl:attribute name="name"><xsl:choose><xsl:when test="name() = 'action'"><xsl:value-of select="@title"/></xsl:when><xsl:otherwise><xsl:value-of select="@name"/>})
Call xslt_stream.WriteText({</xsl:otherwise></xsl:choose></xsl:attribute><xsl:for-each select="descendant::dxl:code"><xsl:element name="code"><xsl:attribute name="event"><xsl:value-of select="@event"/></xsl:attribute><xsl:value-of select="child::dxl:lotusscript/text()"/></xsl:element></xsl:for-each></xsl:element></xsl:if></xsl:if></xsl:template></xsl:stylesheet>})
'create transformer
Set xslt_transformer = Me.pSession.CreateXSLTransformer()
'see if the user added design notes - otherwise we get all
If Me.pNoteCol Is Nothing Then
'no design notes selected by user - get all supported design elements
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
Call Me.pNoteCol.SelectAllDesignElements(True)
End If
'build collection
Call Me.pNoteCol.BuildCollection()
'create dom parser
Set dom_parser = Me.pSession.CreateDOMParser()
'if the user only wants certain design elements we set the names
'as parameters to the stylesheet
If Not (Me.pForms Is Nothing) Then
'user wants specific forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "¤" + Me.pForms.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectForms Then
'user wants all forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, XSLT_VALUE_ALL)
Else
'user don't want any forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "")
End If
If Not (Me.pViews Is Nothing) Then
'user wants specific views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "¤" + Me.pViews.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectViews Then
'user wants all views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, XSLT_VALUE_ALL)
Else
'user don't want any views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "")
End If
If Not (Me.pAgents Is Nothing) Then
'user wants specific agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "¤" + Me.pAgents.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectAgents Then
'user wants all agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, XSLT_VALUE_ALL)
Else
'user don't want any agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "")
End If
If Not (Me.pScriptLibs Is Nothing) Then
'user wants specific script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "¤" + Me.pScriptLibs.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectScriptLibraries Then
'user wants all script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, XSLT_VALUE_ALL)
Else
'user don't want any script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "")
End If
If Me.pNoteCol.SelectDatabaseScript Then
'user wants the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, XSLT_VALUE_ALL)
Else
'user don't want the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, "")
End If
If Not (Me.pPages Is Nothing) Then
'user wants specific pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "¤" + Me.pPages.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectPages Then
'user wants all pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, XSLT_VALUE_ALL)
Else
'user don't want any pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "")
End If
If Me.pNoteCol.SelectActions Then
'user wants the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, XSLT_VALUE_ALL)
Else
'user don't want the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, "")
End If
'apply stylesheet
Call xslt_transformer.SetStylesheet(xslt_stream)
Call xslt_transformer.SetOutput(dom_parser)
'export the database piping it to the xslt transformer piping the
'result to the dom parser
Set exporter = Me.pSession.CreateDXLExporter(Me.pNoteCol, xslt_transformer)
Call exporter.Process()
'get the document
Set xml_doc = dom_parser.Document
'get all scripts as a list of nodes
Set script_nodelist = xml_doc.GetElementsByTagName("script")
For i=1 To script_nodelist.NumberOfEntries
Set script_node = script_nodelist.GetItem(i)
'get type attribute
script_name = script_node.GetAttribute("name")
script_type = script_node.GetAttribute("type")
'create ScriptSource object
Set script_source = New ScriptSource(script_type, script_name)
'loop code nodes
Set code_node = script_node.FirstChild()
While Not (code_node Is Nothing)
'get the event name
event_name = code_node.GetAttribute("event")
'make sure there is actually source code
If Not code_node.FirstChild.IsNull Then
'get the event code and add to source object
Call script_source.AddEventCode(event_name, code_node.FirstChild.NodeValue)
End If
'get next
If Not (code_node.NextSibling().IsNull) Then
Set code_node = code_node.NextSibling()
Else
Set code_node = Nothing
End If
Wend
'create script object
Select Case script_type
Case Is = SCRIPT_FORM
Set script = New Form(script_source)
Case Is = SCRIPT_VIEW
Set script = New View(script_source)
Case Is = SCRIPT_LIBRARY
Set script = New ScriptLibrary(script_source)
Case Is = SCRIPT_AGENT
Set script = New Agent(script_source)
Case Is = SCRIPT_DATABASESCRIPT
Set script = New DatabaseScript(script_source)
Case Is = SCRIPT_PAGE
Set script = New Page(script_source)
Case Is = SCRIPT_ACTION
Set script = New SharedAction(script_source)
Case Else
Set script = Nothing
End Select
'avoid unknown types
If Not (script Is Nothing) Then
'parse source
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
End If
Next
'handle web services
If Me.pAllWebservices = True Or Not (Me.pWebservices Is Nothing) Then
'web services are added
If Me.pAllWebservices Then
'add all web services
Set Me.pWebservices = New Vector()
Dim design As New DesignBase(Me.pDb)
Dim webservices As Variant
webservices = design.WebserviceDocuments
Forall de In webservices
If de.GetItemValue("$AssistType")(0) = LOTUSSCRIPT_WEBSERVICE Then
Call Me.pWebservices.AddElement(de.GetItemValue("$TITLE")(0))
End If
End Forall
End If
'loop added specific web services
Set enum = Me.pWebservices.Elements
While enum.HasMoreElements()
Set script_source = New WebserviceScriptSource(Cstr(enum.NextElement()), Me.pDb)
Set script = New Webservice(script_source)
'parse code
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
Wend
End If
'return
Set Process = scripts
End Function
End Class
Private Sub lsdoc_description
%REM
This script library holds a factory class for producing Script objects from LotusScript source.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="AppSLDesign7" />
<usereference name="CLASS: Collections" />
<usereference name="CLASS: Script" />
<usereference name="CLASS: ScriptSource" />
<usereference name="CLASS: LSDocConstants" />
<class name="ScriptFactory" visibility="Public">
<code><![CDATA[Public Class ScriptFactory
'declarations
Private pSession As NotesSession
Private pDb As NotesDatabase
Private pForms As Vector
Private pViews As Vector
Private pAgents As Vector
Private pScriptLibs As Vector
Private pPages As Vector
Private pWebservices As Vector
Private pSharedActions As Boolean
'/**
' * Constructor.
' *
' * @param db The database to look in (Nothing to use NotesSession.CurrentDatabase)
' */
Public Sub New(db As NotesDatabase)
'create session
Set Me.pSession = New NotesSession
'store database
If db Is Nothing Then
Set Me.pDb = Me.pSession.CurrentDatabase
Else
Set Me.pDb = db
End If
End Sub
'/**
' * Add the shared actions to the factory.
' *
' */
Public Sub AddSharedActions()
Me.pSharedActions = True
End Sub
'/**
' * Adds a page to the factory.
' *
' * @param elem_name The name of the page
' */
Public Sub AddPage(elem_name As String)
If Me.pPages Is Nothing Then
Set Me.pPages = New Vector()
End If
Call Me.pPages.AddElement(elem_name)
End Sub
'/**
' * Adds a web service to the factory.
' *
' * @param elem_name The name of the web service
' */
Public Sub AddWebservice(elem_name As String)
If Me.pWebservices Is Nothing Then
Set Me.pWebservices = New Vector()
End If
Call Me.pWebservices.AddElement(elem_name)
End Sub
'/**
' * Adds a script library to the factory.
' *
' * @param elem_name The name of the script library
' */
Public Sub AddScriptLibrary(elem_name As String)
If Me.pScriptLibs Is Nothing Then
Set Me.pScriptLibs = New Vector()
End If
Call Me.pScriptLibs.AddElement(elem_name)
End Sub
'/**
' * Adds a form to the factory.
' *
' * @param elem_name The name of the form
' */
Public Sub AddForm(elem_name As String)
If Me.pForms Is Nothing Then
Set Me.pForms = New Vector()
End If
Call Me.pForms.AddElement(elem_name)
End Sub
'/**
' * Adds a view to the factory.
' *
' * @param elem_name The name of the view
' */
Public Sub AddView(elem_name As String)
If Me.pViews Is Nothing Then
Set Me.pViews = New Vector()
End If
Call Me.pViews.AddElement(elem_name)
End Sub
'/**
' * Adds an agent to the factory.
' *
' * @param elem_name The name of the agent
' */
Public Sub AddAgent(elem_name As String)
If Me.pAgents Is Nothing Then
Set Me.pAgents = New Vector()
End If
Call Me.pAgents.AddElement(elem_name)
End Sub
'/**
' * Processes the design elements added.
' *
' * @return A Vector of created Script objects.
' */
Public Function Process() As Vector
Error 9999, "Use a sub-class"
End Function
End Class]]]]><![CDATA[></code>
<comment />
<member name="pSession" visibility="Private">
<datatype idref="NotesSession" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSession As NotesSession]]]]><![CDATA[></code>
<comment />
</member>
<member name="pDb" visibility="Private">
<datatype idref="NotesDatabase" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pDb As NotesDatabase]]]]><![CDATA[></code>
<comment />
</member>
<member name="pForms" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pForms As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pViews" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pViews As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pAgents" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pAgents As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pScriptLibs" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pScriptLibs As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pPages" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pPages As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pWebservices" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pWebservices As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pSharedActions" visibility="Private">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSharedActions As Boolean]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="db">
<datatype idref="NotesDatabase" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(db As NotesDatabase)
'create session
Set Me.pSession = New NotesSession
'store database
If db Is Nothing Then
Set Me.pDb = Me.pSession.CurrentDatabase
Else
Set Me.pDb = db
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddSharedActions" visibility="Public">
<code><![CDATA[Public Sub AddSharedActions()
Me.pSharedActions = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddPage" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddPage(elem_name As String)
If Me.pPages Is Nothing Then
Set Me.pPages = New Vector()
End If
Call Me.pPages.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddWebservice" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddWebservice(elem_name As String)
If Me.pWebservices Is Nothing Then
Set Me.pWebservices = New Vector()
End If
Call Me.pWebservices.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddScriptLibrary" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddScriptLibrary(elem_name As String)
If Me.pScriptLibs Is Nothing Then
Set Me.pScriptLibs = New Vector()
End If
Call Me.pScriptLibs.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddForm" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddForm(elem_name As String)
If Me.pForms Is Nothing Then
Set Me.pForms = New Vector()
End If
Call Me.pForms.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddView" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddView(elem_name As String)
If Me.pViews Is Nothing Then
Set Me.pViews = New Vector()
End If
Call Me.pViews.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddAgent" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddAgent(elem_name As String)
If Me.pAgents Is Nothing Then
Set Me.pAgents = New Vector()
End If
Call Me.pAgents.AddElement(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="Process" visibility="Public">
<returnType idref="Vector" />
<code><![CDATA[Public Function Process() As Vector
Error 9999, "Use a sub-class"
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<class name="DxlScriptFactory" visibility="Public">
<parentClass>ScriptFactory</parentClass>
<hierarchy>
<class>ScriptFactory</class>
<class>DxlScriptFactory</class>
</hierarchy>
<code><![CDATA[Public Class DxlScriptFactory As ScriptFactory
'declarations
Private pNoteCol As NotesNoteCollection
Private pAllWebservices As Boolean
Public Sub New(db As NotesDatabase), ScriptFactory(db)
Me.pAllWebservices = False
End Sub
'/**
' * Adds the actions to the factory.
' *
' */
Public Sub AddSharedActions()
'call super
Call ScriptFactory..AddSharedActions()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectActions = True
End Sub
'/**
' * Adds all the pages to the factory.
' *
' */
Public Sub AddPages()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectPages = True
End Sub
'/**
' * Adds all the web services to the factory.
' *
' */
Public Sub AddWebservices()
Me.pAllWebservices = True
End Sub
'/**
' * Adds all the script libraries to the factory.
' *
' */
Public Sub AddScriptLibraries()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectScriptLibraries = True
End Sub
'/**
' * Adds all the forms to the factory.
' *
' */
Public Sub AddForms()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectForms = True
End Sub
'/**
' * Adds all the views to the factory.
' *
' */
Public Sub AddViews()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectViews = True
End Sub
'/**
' * Adds all the agents to the factory.
' *
' */
Public Sub AddAgents()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectAgents = True
End Sub
'/**
' * Adds the database script to the factory.
' *
' */
Public Sub AddDatabaseScript()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectDatabaseScript = True
End Sub
'/**
' * @see ScriptAgent#AddPage
' */
Public Sub AddPage(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddPages()
'call super
Call ScriptFactory..AddPage(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddScriptLibrary
' */
Public Sub AddScriptLibrary(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddScriptLibraries()
'call super
Call ScriptFactory..AddScriptLibrary(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddForm
' */
Public Sub AddForm(elem_name As String)
'make sure we export the forms to the DXL
Call Me.AddForms()
'call super
Call ScriptFactory..AddForm(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddView
' */
Public Sub AddView(elem_name As String)
'make sure we export the views to the DXL
Call Me.AddViews()
'call super
Call ScriptFactory..AddView(elem_name)
End Sub
'/**
' * @see ScriptAgent#AddAgent
' */
Public Sub AddAgent(elem_name As String)
'make sure we export the agents to the DXL
Call Me.AddAgents()
'call super
Call ScriptFactory..AddAgent(elem_name)
End Sub
'/**
' * @see ScriptFactory#Process
' */
Public Function Process() As Vector
'declarations
Dim scripts As New Vector
Dim doc As NotesDocument
Dim exporter As NotesDXLExporter
Dim dom_parser As NotesDOMParser
Dim xslt_transformer As NotesXSLTransformer
Dim xslt_stream As NotesStream
Dim xml_doc As NotesDOMDocumentNode
Dim script_nodelist As NotesDOMNodeList
Dim code_node As NotesDOMElementNode
Dim script_node As NotesDOMElementNode
Dim i As Integer
Dim script_name As String
Dim script_type As String
Dim event_name As String
Dim script As Script
Dim script_source As ScriptSource
Dim enum As Enumeration
'create stylesheet
Set xslt_stream = Me.pSession.CreateStream()
Call xslt_stream.WriteText({<?xml version="1.0" encoding="UTF-8"?><xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:dxl="http://www.lotus.com/dxl" version="1.0"><xsl:param name="export_forms">#all#</xsl:param><xsl:param name="export_views">#all#</xsl:param><xsl:param name="export_agents">#all#</xsl:param><xsl:param name="export_scriptlibs">#all#</xsl:param>})
Call xslt_stream.WriteText({<xsl:param name="export_databasescript">#all#</xsl:param><xsl:param name="export_pages">#all#</xsl:param><xsl:param name="export_actions">#all#</xsl:param><xsl:template match="/"><scripts><xsl:apply-templates select="/dxl:database/dxl:scriptlibrary"/><xsl:apply-templates select="/dxl:database/dxl:agent"/><xsl:apply-templates select="/dxl:database/dxl:form"/><xsl:apply-templates select="/dxl:database/dxl:view"/><xsl:apply-templates select="/dxl:database/dxl:databasescript"/>})
Call xslt_stream.WriteText({<xsl:apply-templates select="/dxl:database/dxl:page"/><xsl:apply-templates select="/dxl:database/dxl:sharedactions/dxl:action"/></scripts></xsl:template><xsl:template match="//dxl:scriptlibrary | //dxl:agent | //dxl:view | //dxl:form | //dxl:databasescript | //dxl:page | //dxl:sharedactions/dxl:action"><xsl:call-template name="code"><xsl:with-param name="export_source"><xsl:choose><xsl:when test="name() = 'agent'">})
Call xslt_stream.WriteText({<xsl:value-of select="$export_agents"/></xsl:when><xsl:when test="name() = 'view'"><xsl:value-of select="$export_views"/></xsl:when><xsl:when test="name() = 'form'"><xsl:value-of select="$export_forms"/></xsl:when><xsl:when test="name() = 'scriptlibrary'"><xsl:value-of select="$export_scriptlibs"/></xsl:when><xsl:when test="name() = 'databasescript'"><xsl:value-of select="$export_databasescript"/></xsl:when><xsl:when test="name() = 'page'"><xsl:value-of select="$export_pages"/></xsl:when><xsl:when test="name() = 'action'"><xsl:value-of select="$export_actions"/>})
Call xslt_stream.WriteText({</xsl:when></xsl:choose></xsl:with-param></xsl:call-template></xsl:template><xsl:template name="code"><xsl:param name="export_source" /><xsl:if test="child::dxl:code/dxl:lotusscript/text() != ''"><xsl:if test="$export_source = '#all#' or contains($export_source, concat('¤', @name, '¤'))"><xsl:element name="script"><xsl:attribute name="type"><xsl:value-of select="name()"/></xsl:attribute><!-- shared actions use the title-attribute for the name and all other then name-attribute --><xsl:attribute name="name"><xsl:choose><xsl:when test="name() = 'action'"><xsl:value-of select="@title"/></xsl:when><xsl:otherwise><xsl:value-of select="@name"/>})
Call xslt_stream.WriteText({</xsl:otherwise></xsl:choose></xsl:attribute><xsl:for-each select="descendant::dxl:code"><xsl:element name="code"><xsl:attribute name="event"><xsl:value-of select="@event"/></xsl:attribute><xsl:value-of select="child::dxl:lotusscript/text()"/></xsl:element></xsl:for-each></xsl:element></xsl:if></xsl:if></xsl:template></xsl:stylesheet>})
'create transformer
Set xslt_transformer = Me.pSession.CreateXSLTransformer()
'see if the user added design notes - otherwise we get all
If Me.pNoteCol Is Nothing Then
'no design notes selected by user - get all supported design elements
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
Call Me.pNoteCol.SelectAllDesignElements(True)
End If
'build collection
Call Me.pNoteCol.BuildCollection()
'create dom parser
Set dom_parser = Me.pSession.CreateDOMParser()
'if the user only wants certain design elements we set the names
'as parameters to the stylesheet
If Not (Me.pForms Is Nothing) Then
'user wants specific forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "¤" + Me.pForms.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectForms Then
'user wants all forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, XSLT_VALUE_ALL)
Else
'user don't want any forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "")
End If
If Not (Me.pViews Is Nothing) Then
'user wants specific views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "¤" + Me.pViews.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectViews Then
'user wants all views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, XSLT_VALUE_ALL)
Else
'user don't want any views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "")
End If
If Not (Me.pAgents Is Nothing) Then
'user wants specific agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "¤" + Me.pAgents.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectAgents Then
'user wants all agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, XSLT_VALUE_ALL)
Else
'user don't want any agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "")
End If
If Not (Me.pScriptLibs Is Nothing) Then
'user wants specific script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "¤" + Me.pScriptLibs.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectScriptLibraries Then
'user wants all script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, XSLT_VALUE_ALL)
Else
'user don't want any script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "")
End If
If Me.pNoteCol.SelectDatabaseScript Then
'user wants the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, XSLT_VALUE_ALL)
Else
'user don't want the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, "")
End If
If Not (Me.pPages Is Nothing) Then
'user wants specific pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "¤" + Me.pPages.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectPages Then
'user wants all pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, XSLT_VALUE_ALL)
Else
'user don't want any pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "")
End If
If Me.pNoteCol.SelectActions Then
'user wants the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, XSLT_VALUE_ALL)
Else
'user don't want the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, "")
End If
'apply stylesheet
Call xslt_transformer.SetStylesheet(xslt_stream)
Call xslt_transformer.SetOutput(dom_parser)
'export the database piping it to the xslt transformer piping the
'result to the dom parser
Set exporter = Me.pSession.CreateDXLExporter(Me.pNoteCol, xslt_transformer)
Call exporter.Process()
'get the document
Set xml_doc = dom_parser.Document
'get all scripts as a list of nodes
Set script_nodelist = xml_doc.GetElementsByTagName("script")
For i=1 To script_nodelist.NumberOfEntries
Set script_node = script_nodelist.GetItem(i)
'get type attribute
script_name = script_node.GetAttribute("name")
script_type = script_node.GetAttribute("type")
'create ScriptSource object
Set script_source = New ScriptSource(script_type, script_name)
'loop code nodes
Set code_node = script_node.FirstChild()
While Not (code_node Is Nothing)
'get the event name
event_name = code_node.GetAttribute("event")
'make sure there is actually source code
If Not code_node.FirstChild.IsNull Then
'get the event code and add to source object
Call script_source.AddEventCode(event_name, code_node.FirstChild.NodeValue)
End If
'get next
If Not (code_node.NextSibling().IsNull) Then
Set code_node = code_node.NextSibling()
Else
Set code_node = Nothing
End If
Wend
'create script object
Select Case script_type
Case Is = SCRIPT_FORM
Set script = New Form(script_source)
Case Is = SCRIPT_VIEW
Set script = New View(script_source)
Case Is = SCRIPT_LIBRARY
Set script = New ScriptLibrary(script_source)
Case Is = SCRIPT_AGENT
Set script = New Agent(script_source)
Case Is = SCRIPT_DATABASESCRIPT
Set script = New DatabaseScript(script_source)
Case Is = SCRIPT_PAGE
Set script = New Page(script_source)
Case Is = SCRIPT_ACTION
Set script = New SharedAction(script_source)
Case Else
Set script = Nothing
End Select
'avoid unknown types
If Not (script Is Nothing) Then
'parse source
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
End If
Next
'handle web services
If Me.pAllWebservices = True Or Not (Me.pWebservices Is Nothing) Then
'web services are added
If Me.pAllWebservices Then
'add all web services
Set Me.pWebservices = New Vector()
Dim design As New DesignBase(Me.pDb)
Dim webservices As Variant
webservices = design.WebserviceDocuments
Forall de In webservices
If de.GetItemValue("$AssistType")(0) = LOTUSSCRIPT_WEBSERVICE Then
Call Me.pWebservices.AddElement(de.GetItemValue("$TITLE")(0))
End If
End Forall
End If
'loop added specific web services
Set enum = Me.pWebservices.Elements
While enum.HasMoreElements()
Set script_source = New WebserviceScriptSource(Cstr(enum.NextElement()), Me.pDb)
Set script = New Webservice(script_source)
'parse code
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
Wend
End If
'return
Set Process = scripts
End Function
End Class]]]]><![CDATA[></code>
<comment />
<member name="pNoteCol" visibility="Private">
<datatype idref="NotesNoteCollection" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pNoteCol As NotesNoteCollection]]]]><![CDATA[></code>
<comment />
</member>
<member name="pAllWebservices" visibility="Private">
<datatype idref="Boolean" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pAllWebservices As Boolean]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="db">
<datatype idref="NotesDatabase" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="ScriptFactory">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="db">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(db As NotesDatabase), ScriptFactory(db)
Me.pAllWebservices = False
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddSharedActions" visibility="Public">
<code><![CDATA[Public Sub AddSharedActions()
'call super
Call ScriptFactory..AddSharedActions()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectActions = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddPages" visibility="Public">
<code><![CDATA[Public Sub AddPages()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectPages = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddWebservices" visibility="Public">
<code><![CDATA[Public Sub AddWebservices()
Me.pAllWebservices = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddScriptLibraries" visibility="Public">
<code><![CDATA[Public Sub AddScriptLibraries()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectScriptLibraries = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddForms" visibility="Public">
<code><![CDATA[Public Sub AddForms()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectForms = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddViews" visibility="Public">
<code><![CDATA[Public Sub AddViews()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectViews = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddAgents" visibility="Public">
<code><![CDATA[Public Sub AddAgents()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectAgents = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddDatabaseScript" visibility="Public">
<code><![CDATA[Public Sub AddDatabaseScript()
If Me.pNoteCol Is Nothing Then
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
End If
Me.pNoteCol.SelectDatabaseScript = True
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddPage" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddPage(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddPages()
'call super
Call ScriptFactory..AddPage(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddScriptLibrary" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddScriptLibrary(elem_name As String)
'make sure we export the script libs to the DXL
Call Me.AddScriptLibraries()
'call super
Call ScriptFactory..AddScriptLibrary(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddForm" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddForm(elem_name As String)
'make sure we export the forms to the DXL
Call Me.AddForms()
'call super
Call ScriptFactory..AddForm(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddView" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddView(elem_name As String)
'make sure we export the views to the DXL
Call Me.AddViews()
'call super
Call ScriptFactory..AddView(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddAgent" visibility="Public">
<params>
<param name="elem_name">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddAgent(elem_name As String)
'make sure we export the agents to the DXL
Call Me.AddAgents()
'call super
Call ScriptFactory..AddAgent(elem_name)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="Process" visibility="Public">
<returnType idref="Vector" />
<code><![CDATA[Public Function Process() As Vector
'declarations
Dim scripts As New Vector
Dim doc As NotesDocument
Dim exporter As NotesDXLExporter
Dim dom_parser As NotesDOMParser
Dim xslt_transformer As NotesXSLTransformer
Dim xslt_stream As NotesStream
Dim xml_doc As NotesDOMDocumentNode
Dim script_nodelist As NotesDOMNodeList
Dim code_node As NotesDOMElementNode
Dim script_node As NotesDOMElementNode
Dim i As Integer
Dim script_name As String
Dim script_type As String
Dim event_name As String
Dim script As Script
Dim script_source As ScriptSource
Dim enum As Enumeration
'create stylesheet
Set xslt_stream = Me.pSession.CreateStream()
Call xslt_stream.WriteText({<?xml version="1.0" encoding="UTF-8"?><xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:dxl="http://www.lotus.com/dxl" version="1.0"><xsl:param name="export_forms">#all#</xsl:param><xsl:param name="export_views">#all#</xsl:param><xsl:param name="export_agents">#all#</xsl:param><xsl:param name="export_scriptlibs">#all#</xsl:param>})
Call xslt_stream.WriteText({<xsl:param name="export_databasescript">#all#</xsl:param><xsl:param name="export_pages">#all#</xsl:param><xsl:param name="export_actions">#all#</xsl:param><xsl:template match="/"><scripts><xsl:apply-templates select="/dxl:database/dxl:scriptlibrary"/><xsl:apply-templates select="/dxl:database/dxl:agent"/><xsl:apply-templates select="/dxl:database/dxl:form"/><xsl:apply-templates select="/dxl:database/dxl:view"/><xsl:apply-templates select="/dxl:database/dxl:databasescript"/>})
Call xslt_stream.WriteText({<xsl:apply-templates select="/dxl:database/dxl:page"/><xsl:apply-templates select="/dxl:database/dxl:sharedactions/dxl:action"/></scripts></xsl:template><xsl:template match="//dxl:scriptlibrary | //dxl:agent | //dxl:view | //dxl:form | //dxl:databasescript | //dxl:page | //dxl:sharedactions/dxl:action"><xsl:call-template name="code"><xsl:with-param name="export_source"><xsl:choose><xsl:when test="name() = 'agent'">})
Call xslt_stream.WriteText({<xsl:value-of select="$export_agents"/></xsl:when><xsl:when test="name() = 'view'"><xsl:value-of select="$export_views"/></xsl:when><xsl:when test="name() = 'form'"><xsl:value-of select="$export_forms"/></xsl:when><xsl:when test="name() = 'scriptlibrary'"><xsl:value-of select="$export_scriptlibs"/></xsl:when><xsl:when test="name() = 'databasescript'"><xsl:value-of select="$export_databasescript"/></xsl:when><xsl:when test="name() = 'page'"><xsl:value-of select="$export_pages"/></xsl:when><xsl:when test="name() = 'action'"><xsl:value-of select="$export_actions"/>})
Call xslt_stream.WriteText({</xsl:when></xsl:choose></xsl:with-param></xsl:call-template></xsl:template><xsl:template name="code"><xsl:param name="export_source" /><xsl:if test="child::dxl:code/dxl:lotusscript/text() != ''"><xsl:if test="$export_source = '#all#' or contains($export_source, concat('¤', @name, '¤'))"><xsl:element name="script"><xsl:attribute name="type"><xsl:value-of select="name()"/></xsl:attribute><!-- shared actions use the title-attribute for the name and all other then name-attribute --><xsl:attribute name="name"><xsl:choose><xsl:when test="name() = 'action'"><xsl:value-of select="@title"/></xsl:when><xsl:otherwise><xsl:value-of select="@name"/>})
Call xslt_stream.WriteText({</xsl:otherwise></xsl:choose></xsl:attribute><xsl:for-each select="descendant::dxl:code"><xsl:element name="code"><xsl:attribute name="event"><xsl:value-of select="@event"/></xsl:attribute><xsl:value-of select="child::dxl:lotusscript/text()"/></xsl:element></xsl:for-each></xsl:element></xsl:if></xsl:if></xsl:template></xsl:stylesheet>})
'create transformer
Set xslt_transformer = Me.pSession.CreateXSLTransformer()
'see if the user added design notes - otherwise we get all
If Me.pNoteCol Is Nothing Then
'no design notes selected by user - get all supported design elements
Set Me.pNoteCol = Me.pDb.CreateNoteCollection(False)
Call Me.pNoteCol.SelectAllDesignElements(True)
End If
'build collection
Call Me.pNoteCol.BuildCollection()
'create dom parser
Set dom_parser = Me.pSession.CreateDOMParser()
'if the user only wants certain design elements we set the names
'as parameters to the stylesheet
If Not (Me.pForms Is Nothing) Then
'user wants specific forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "¤" + Me.pForms.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectForms Then
'user wants all forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, XSLT_VALUE_ALL)
Else
'user don't want any forms
Call xslt_transformer.AddParameter(XSLT_PARAM_FORMS, "")
End If
If Not (Me.pViews Is Nothing) Then
'user wants specific views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "¤" + Me.pViews.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectViews Then
'user wants all views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, XSLT_VALUE_ALL)
Else
'user don't want any views
Call xslt_transformer.AddParameter(XSLT_PARAM_VIEWS, "")
End If
If Not (Me.pAgents Is Nothing) Then
'user wants specific agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "¤" + Me.pAgents.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectAgents Then
'user wants all agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, XSLT_VALUE_ALL)
Else
'user don't want any agents
Call xslt_transformer.AddParameter(XSLT_PARAM_AGENTS, "")
End If
If Not (Me.pScriptLibs Is Nothing) Then
'user wants specific script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "¤" + Me.pScriptLibs.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectScriptLibraries Then
'user wants all script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, XSLT_VALUE_ALL)
Else
'user don't want any script libs
Call xslt_transformer.AddParameter(XSLT_PARAM_SCRIPTLIBS, "")
End If
If Me.pNoteCol.SelectDatabaseScript Then
'user wants the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, XSLT_VALUE_ALL)
Else
'user don't want the database script
Call xslt_transformer.AddParameter(XSLT_PARAM_DATABASESCRIPT, "")
End If
If Not (Me.pPages Is Nothing) Then
'user wants specific pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "¤" + Me.pPages.Implode("¤") + "¤")
Elseif Me.pNoteCol.SelectPages Then
'user wants all pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, XSLT_VALUE_ALL)
Else
'user don't want any pages
Call xslt_transformer.AddParameter(XSLT_PARAM_PAGES, "")
End If
If Me.pNoteCol.SelectActions Then
'user wants the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, XSLT_VALUE_ALL)
Else
'user don't want the shared actions
Call xslt_transformer.AddParameter(XSLT_PARAM_ACTIONS, "")
End If
'apply stylesheet
Call xslt_transformer.SetStylesheet(xslt_stream)
Call xslt_transformer.SetOutput(dom_parser)
'export the database piping it to the xslt transformer piping the
'result to the dom parser
Set exporter = Me.pSession.CreateDXLExporter(Me.pNoteCol, xslt_transformer)
Call exporter.Process()
'get the document
Set xml_doc = dom_parser.Document
'get all scripts as a list of nodes
Set script_nodelist = xml_doc.GetElementsByTagName("script")
For i=1 To script_nodelist.NumberOfEntries
Set script_node = script_nodelist.GetItem(i)
'get type attribute
script_name = script_node.GetAttribute("name")
script_type = script_node.GetAttribute("type")
'create ScriptSource object
Set script_source = New ScriptSource(script_type, script_name)
'loop code nodes
Set code_node = script_node.FirstChild()
While Not (code_node Is Nothing)
'get the event name
event_name = code_node.GetAttribute("event")
'make sure there is actually source code
If Not code_node.FirstChild.IsNull Then
'get the event code and add to source object
Call script_source.AddEventCode(event_name, code_node.FirstChild.NodeValue)
End If
'get next
If Not (code_node.NextSibling().IsNull) Then
Set code_node = code_node.NextSibling()
Else
Set code_node = Nothing
End If
Wend
'create script object
Select Case script_type
Case Is = SCRIPT_FORM
Set script = New Form(script_source)
Case Is = SCRIPT_VIEW
Set script = New View(script_source)
Case Is = SCRIPT_LIBRARY
Set script = New ScriptLibrary(script_source)
Case Is = SCRIPT_AGENT
Set script = New Agent(script_source)
Case Is = SCRIPT_DATABASESCRIPT
Set script = New DatabaseScript(script_source)
Case Is = SCRIPT_PAGE
Set script = New Page(script_source)
Case Is = SCRIPT_ACTION
Set script = New SharedAction(script_source)
Case Else
Set script = Nothing
End Select
'avoid unknown types
If Not (script Is Nothing) Then
'parse source
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
End If
Next
'handle web services
If Me.pAllWebservices = True Or Not (Me.pWebservices Is Nothing) Then
'web services are added
If Me.pAllWebservices Then
'add all web services
Set Me.pWebservices = New Vector()
Dim design As New DesignBase(Me.pDb)
Dim webservices As Variant
webservices = design.WebserviceDocuments
Forall de In webservices
If de.GetItemValue("$AssistType")(0) = LOTUSSCRIPT_WEBSERVICE Then
Call Me.pWebservices.AddElement(de.GetItemValue("$TITLE")(0))
End If
End Forall
End If
'loop added specific web services
Set enum = Me.pWebservices.Elements
While enum.HasMoreElements()
Set script_source = New WebserviceScriptSource(Cstr(enum.NextElement()), Me.pDb)
Set script = New Webservice(script_source)
'parse code
Call script.Parse()
'add to vector
Call scripts.AddElement(script)
Wend
End If
'return
Set Process = scripts
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
This script library holds a factory class for producing Script objects from LotusScript source.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: InputStream" alias="" language="lotusscript">
<noteinfo>
<unid>58AA43B864F3D322C1256FD70061821C</unid>
<noteid>3ae</noteid>
<created>02-04-2005 19:45:03</created>
<modified>26-10-2005 09:58:10</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>69</sequence>
<addedtofile>02-04-2005 19:47:19</addedtofile>
<lastaccessed>26-10-2005 09:54:49</lastaccessed>
<revised>24-10-2005 23:05:59</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Public Class InputStream
'declarations
Private pStream As NotesStream
'/**
' * Constructor.
' *
' * @param stream The NotesStream to wrap.
' */
Public Sub New(stream As NotesStream)
'store reference
Set Me.pStream = stream
End Sub
'/**
' * Destructor that makes sure the underlying stream is closed
' * when the object goes out of scope.
' *
' */
Public Sub Delete()
If Not (Me.pStream Is Nothing) Then
Call Me.Close()
End If
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'check for nothing
If Me.pStream Is Nothing Then
Error 9999, "The supplied stream may not be Nothing"
End If
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
Set Me.pStream = Nothing
End Sub
'/**
' * Function that reads one byte from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pStream Is Nothing Then
Error 9999, "We cannot read from a closed stream."
Else
If Me.pStream.IsEOS Then
ReadStream = 1
Else
Dim b As Variant
b = Me.pStream.Read(1)
buffer = b(0)
End If
End If
End Function
End Class
Public Class StringInputStream As InputStream
'declarations
Private pSource As String
Private pPosition As Long
'/**
' * Constructor.
' *
' * @param source The String source.
' */
Public Sub New(source As String), InputStream(Nothing)
If Len(source) = 0 Then
Error 9999, "The string may not be empty."
End If
Me.pSource = source
Me.pPosition = 1
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'do nothing
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
'reset position to indicate we are closed
Me.pPosition = 0
End Sub
'/**
' * Function that reads one byte from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pPosition = 0 Then
Error 9999, "We cannot read from a closed stream."
Else
'make sure we wont read past the end
If Me.pPosition > Len(Me.pSource) Then
ReadStream = 1
Else
'get next character
Dim nextchar As String
nextchar = Mid$(Me.pSource, Me.pPosition, 1)
'increment position
Me.pPosition = Me.pPosition + 1
'return
buffer = nextchar
'set return code
ReadStream = 0
End If
End If
End Function
End Class
Public Class FileInputStream As InputStream
'declarations
Private pFilename As String
'/**
' * Constructor.
' *
' * @param filename The filename of the file to read
' */
Public Sub New(filename As String), InputStream(Nothing)
Me.pFilename = filename
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'create session
Dim session As New NotesSession
'create stream
Set Me.pStream = session.CreateStream()
'open the stream
Call Me.pStream.Open(Me.pFilename, "UTF-8")
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
'close the stream
Call Me.pStream.Close()
'clear reference
Set Me.pStream = Nothing
End Sub
End Class
Public Class LineInputStream As InputStream
'declarations
Private pIn As InputStream
Private pLineCount As Long
'/**
' * Constructor.
' *
' * @param filename The filename of the file to read
' */
Public Sub New(i As InputStream), InputStream(Nothing)
'store reference
Set Me.pIn = i
'open the stream
Call Me.pIn.Open()
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'do nothing
End Sub
'/**
' * Function that reads the next line from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'declarations
Dim nextchar As String
Dim nextcode As Long
Dim rc As Integer
'set up error handler
On Error Goto catch
'reset buffer
buffer = ""
'read until we find a line separator
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
While rc = 0 And nextcode <> 10
'append to buffer converting to a character
buffer = buffer + Uchr(nextcode)
'get next character
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
Wend
'remove last character if code 13 or 10
If Len(buffer) > 0 Then
For rc=Len(buffer) To 1 Step -1
nextchar = Mid$(buffer, rc, 1)
If Uni(nextchar) = 13 Or Uni(nextchar) = 10 Then
buffer = Mid$(buffer, 1, rc-1)
End If
Next
End If
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return code
ReadStream = rc
'graceful exit
Exit Function
catch:
'set return code
ReadStream = 1
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return what we have
Resume finally
finally:
End Function
'/**
' * Returns the current line number.
' */
Public Property Get LineCount As Long
LineCount = Me.pLineCount
End Property
End Class
Private Sub lsdoc_description
%REM
Abstraction for reading from different sources.
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<class name="InputStream" visibility="Public">
<code><![CDATA[Public Class InputStream
'declarations
Private pStream As NotesStream
'/**
' * Constructor.
' *
' * @param stream The NotesStream to wrap.
' */
Public Sub New(stream As NotesStream)
'store reference
Set Me.pStream = stream
End Sub
'/**
' * Destructor that makes sure the underlying stream is closed
' * when the object goes out of scope.
' *
' */
Public Sub Delete()
If Not (Me.pStream Is Nothing) Then
Call Me.Close()
End If
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'check for nothing
If Me.pStream Is Nothing Then
Error 9999, "The supplied stream may not be Nothing"
End If
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
Set Me.pStream = Nothing
End Sub
'/**
' * Function that reads one byte from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pStream Is Nothing Then
Error 9999, "We cannot read from a closed stream."
Else
If Me.pStream.IsEOS Then
ReadStream = 1
Else
Dim b As Variant
b = Me.pStream.Read(1)
buffer = b(0)
End If
End If
End Function
End Class]]]]><![CDATA[></code>
<comment />
<member name="pStream" visibility="Private">
<datatype idref="NotesStream" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pStream As NotesStream]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="stream">
<datatype idref="NotesStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(stream As NotesStream)
'store reference
Set Me.pStream = stream
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Delete" visibility="Public">
<code><![CDATA[Public Sub Delete()
If Not (Me.pStream Is Nothing) Then
Call Me.Close()
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'check for nothing
If Me.pStream Is Nothing Then
Error 9999, "The supplied stream may not be Nothing"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Close" visibility="Public">
<code><![CDATA[Public Sub Close()
Set Me.pStream = Nothing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="ReadStream" visibility="Public">
<params>
<param name="buffer">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Integer" />
<code><![CDATA[Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pStream Is Nothing Then
Error 9999, "We cannot read from a closed stream."
Else
If Me.pStream.IsEOS Then
ReadStream = 1
Else
Dim b As Variant
b = Me.pStream.Read(1)
buffer = b(0)
End If
End If
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<class name="StringInputStream" visibility="Public">
<parentClass>InputStream</parentClass>
<hierarchy>
<class>InputStream</class>
<class>StringInputStream</class>
</hierarchy>
<code><![CDATA[Public Class StringInputStream As InputStream
'declarations
Private pSource As String
Private pPosition As Long
'/**
' * Constructor.
' *
' * @param source The String source.
' */
Public Sub New(source As String), InputStream(Nothing)
If Len(source) = 0 Then
Error 9999, "The string may not be empty."
End If
Me.pSource = source
Me.pPosition = 1
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'do nothing
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
'reset position to indicate we are closed
Me.pPosition = 0
End Sub
'/**
' * Function that reads one byte from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pPosition = 0 Then
Error 9999, "We cannot read from a closed stream."
Else
'make sure we wont read past the end
If Me.pPosition > Len(Me.pSource) Then
ReadStream = 1
Else
'get next character
Dim nextchar As String
nextchar = Mid$(Me.pSource, Me.pPosition, 1)
'increment position
Me.pPosition = Me.pPosition + 1
'return
buffer = nextchar
'set return code
ReadStream = 0
End If
End If
End Function
End Class]]]]><![CDATA[></code>
<comment />
<member name="pSource" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSource As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pPosition" visibility="Private">
<datatype idref="Long" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pPosition As Long]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="InputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Nothing">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As String), InputStream(Nothing)
If Len(source) = 0 Then
Error 9999, "The string may not be empty."
End If
Me.pSource = source
Me.pPosition = 1
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'do nothing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Close" visibility="Public">
<code><![CDATA[Public Sub Close()
'reset position to indicate we are closed
Me.pPosition = 0
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="ReadStream" visibility="Public">
<params>
<param name="buffer">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Integer" />
<code><![CDATA[Public Function ReadStream(buffer As String) As Integer
'clear buffer
buffer = ""
If Me.pPosition = 0 Then
Error 9999, "We cannot read from a closed stream."
Else
'make sure we wont read past the end
If Me.pPosition > Len(Me.pSource) Then
ReadStream = 1
Else
'get next character
Dim nextchar As String
nextchar = Mid$(Me.pSource, Me.pPosition, 1)
'increment position
Me.pPosition = Me.pPosition + 1
'return
buffer = nextchar
'set return code
ReadStream = 0
End If
End If
End Function]]]]><![CDATA[></code>
<comment />
</function>
</class>
<class name="FileInputStream" visibility="Public">
<parentClass>InputStream</parentClass>
<hierarchy>
<class>InputStream</class>
<class>FileInputStream</class>
</hierarchy>
<code><![CDATA[Public Class FileInputStream As InputStream
'declarations
Private pFilename As String
'/**
' * Constructor.
' *
' * @param filename The filename of the file to read
' */
Public Sub New(filename As String), InputStream(Nothing)
Me.pFilename = filename
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'create session
Dim session As New NotesSession
'create stream
Set Me.pStream = session.CreateStream()
'open the stream
Call Me.pStream.Open(Me.pFilename, "UTF-8")
End Sub
'/**
' * Method to close the underlying stream.
' */
Public Sub Close()
'close the stream
Call Me.pStream.Close()
'clear reference
Set Me.pStream = Nothing
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pFilename" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pFilename As String]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="filename">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="InputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Nothing">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(filename As String), InputStream(Nothing)
Me.pFilename = filename
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'create session
Dim session As New NotesSession
'create stream
Set Me.pStream = session.CreateStream()
'open the stream
Call Me.pStream.Open(Me.pFilename, "UTF-8")
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Close" visibility="Public">
<code><![CDATA[Public Sub Close()
'close the stream
Call Me.pStream.Close()
'clear reference
Set Me.pStream = Nothing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="LineInputStream" visibility="Public">
<parentClass>InputStream</parentClass>
<hierarchy>
<class>InputStream</class>
<class>LineInputStream</class>
</hierarchy>
<code><![CDATA[Public Class LineInputStream As InputStream
'declarations
Private pIn As InputStream
Private pLineCount As Long
'/**
' * Constructor.
' *
' * @param filename The filename of the file to read
' */
Public Sub New(i As InputStream), InputStream(Nothing)
'store reference
Set Me.pIn = i
'open the stream
Call Me.pIn.Open()
End Sub
'/**
' * Method to open the underlying stream for reading.
' *
' */
Public Sub Open()
'do nothing
End Sub
'/**
' * Function that reads the next line from the stream.
' *
' * @param buffer The buffer to write to
' * @return Return code (0 if there is more data, 1 if we are done)
' */
Public Function ReadStream(buffer As String) As Integer
'declarations
Dim nextchar As String
Dim nextcode As Long
Dim rc As Integer
'set up error handler
On Error Goto catch
'reset buffer
buffer = ""
'read until we find a line separator
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
While rc = 0 And nextcode <> 10
'append to buffer converting to a character
buffer = buffer + Uchr(nextcode)
'get next character
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
Wend
'remove last character if code 13 or 10
If Len(buffer) > 0 Then
For rc=Len(buffer) To 1 Step -1
nextchar = Mid$(buffer, rc, 1)
If Uni(nextchar) = 13 Or Uni(nextchar) = 10 Then
buffer = Mid$(buffer, 1, rc-1)
End If
Next
End If
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return code
ReadStream = rc
'graceful exit
Exit Function
catch:
'set return code
ReadStream = 1
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return what we have
Resume finally
finally:
End Function
'/**
' * Returns the current line number.
' */
Public Property Get LineCount As Long
LineCount = Me.pLineCount
End Property
End Class]]]]><![CDATA[></code>
<comment />
<member name="pIn" visibility="Private">
<datatype idref="InputStream" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pIn As InputStream]]]]><![CDATA[></code>
<comment />
</member>
<member name="pLineCount" visibility="Private">
<datatype idref="Long" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pLineCount As Long]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="i">
<datatype idref="InputStream" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="InputStream">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Nothing">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(i As InputStream), InputStream(Nothing)
'store reference
Set Me.pIn = i
'open the stream
Call Me.pIn.Open()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="Open" visibility="Public">
<code><![CDATA[Public Sub Open()
'do nothing
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="ReadStream" visibility="Public">
<params>
<param name="buffer">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<returnType idref="Integer" />
<code><![CDATA[Public Function ReadStream(buffer As String) As Integer
'declarations
Dim nextchar As String
Dim nextcode As Long
Dim rc As Integer
'set up error handler
On Error Goto catch
'reset buffer
buffer = ""
'read until we find a line separator
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
While rc = 0 And nextcode <> 10
'append to buffer converting to a character
buffer = buffer + Uchr(nextcode)
'get next character
rc = Me.pIn.ReadStream(nextchar)
If Me.pIn Isa "StringInputStream" Then
nextcode = Uni(nextchar)
Else
nextcode = Clng(nextchar)
End If
Wend
'remove last character if code 13 or 10
If Len(buffer) > 0 Then
For rc=Len(buffer) To 1 Step -1
nextchar = Mid$(buffer, rc, 1)
If Uni(nextchar) = 13 Or Uni(nextchar) = 10 Then
buffer = Mid$(buffer, 1, rc-1)
End If
Next
End If
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return code
ReadStream = rc
'graceful exit
Exit Function
catch:
'set return code
ReadStream = 1
'increment line count
Me.pLineCount = Me.pLineCount + 1
'return what we have
Resume finally
finally:
End Function]]]]><![CDATA[></code>
<comment />
</function>
<property name="LineCount" visibility="Public" setter="false">
<datatype idref="Long" />
<code><![CDATA[Public Property Get LineCount As Long
LineCount = Me.pLineCount
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Abstraction for reading from different sources.
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
<scriptlibrary name="CLASS: Script" alias="" language="lotusscript">
<noteinfo>
<unid>630E49C17923187EC1256FD7005BD9C2</unid>
<noteid>39e</noteid>
<created>02-04-2005 18:43:15</created>
<modified>29-11-2006 14:53:44</modified>
<signedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</signedby>
<sequence>122</sequence>
<addedtofile>02-04-2005 19:02:11</addedtofile>
<lastaccessed>29-11-2006 13:47:38</lastaccessed>
<revised>11-12-2005 19:36:26</revised>
<updatedby>CN=Mikkel Heisterberg/OU=Partnere/O=It-Inspiration</updatedby>
</noteinfo>
<code><![CDATA[Use "CLASS: LSDocConstants"
Use "CLASS: ScriptElement"
Use "CLASS: Collections"
Use "CLASS: ScriptParser"
Use "CLASS: InputStream"
Use "CLASS: ScriptSource"
Public Class Script
'declarations
Private pSource As String
Private pName As String
Private pAlias As String
Private pElements As Vector
Private pComment As Comment
'/**
' * Constructor.
' *
' * @param source The source of the source code (either a NotesDocument or a ScriptSource object)
' */
Public Sub New(source As Variant)
'which type was passed
If Typename(source) = "NOTESDOCUMENT" Then
'we received a NotesDocument object - store the name
Me.pName = source.GetItemValue("$TITLE")(0)
'if the title is multi value we have an alias
If Ubound(source.GetItemValue("$TITLE")) > 0 Then
'alias specified as multi-value field
Me.pAlias = source.GetItemValue("$TITLE")(1)
Else
'check name for pipe character
Dim index As Integer
index = Instr(1, Me.pName, "|")
If index > 1 Then
Me.pAlias = Mid$(Me.pName, index+1)
Me.pName = Mid$(Me.pName, 1, index-1)
End If
End If
Elseif source Isa "ScriptSource" Then
'we received a ScriptSource object
Me.pName = source.SourceName
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
'create vector to hold script elements
Set Me.pElements = New SortedVector()
End Sub
'/**
' * Adds a ScriptElement for this Script.
' *
' * @param se The ScriptElement to add.
' */
Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
'add to all elements holder
Call Me.pElements.AddElement(se)
End If
End Sub
'/**
' * Returns the ScriptElement objects for the Script object.
' *
' * @return Vector of ScriptElement objects (never nothing)
' */
Public Function GetScriptElements() As Vector
Set GetScriptElements = Me.pElements
End Function
'/**
' * Returns the name of the script.
' */
Public Property Get ScriptName As String
ScriptName = Me.pName
End Property
'/**
' * Returns the alias of the script (if any).
' */
Public Property Get ScriptAlias As String
ScriptAlias = Me.pAlias
End Property
'/**
' * Returns the type of script.
' */
Public Property Get ScriptType As Integer
Error 123, "Should not be called directly - use a sub-class."
End Property
'/**
' * Returns the comment (if any).
' */
Public Property Get Comment As Comment
Set Comment = Me.pComment
End Property
'/**
' * Parses the added source and create ScriptElements objects.
' */
Public Sub Parse()
'declarations
Dim v As Vector
Dim enum As Enumeration
Dim script_elem As Variant
'only parse if there is any data
If Len(Me.pSource) = 0 Then
Exit Sub
End If
'create a LineInputStream and a Parser
Dim string_in As New StringInputStream(Me.pSource)
Dim line_in As New LineInputStream(string_in)
Dim parser As New ScriptParser(line_in)
'parse
Set v = parser.Parse()
'add script elements to our selves
Set enum = v.Elements
While enum.HasMoreElements
Set script_elem = enum.NextElement()
Call Me.AddScriptElement(script_elem)
Wend
End Sub
'/**
' * Handles parsing the script comment it any.
' *
' * @param source The script source we use
' */
Private Sub pHandleScriptComment(source As Variant)
'declarations
Dim comment As String
Dim buffer As String
Dim rc As Integer
Dim index As Long
'get the code for the script comment (if any)
comment = source.GetEventCode(EVENT_DESCRIPTION)
If comment <> "" Then
'there is a script comment - we need to ignore the
'first and last line since it is REM statements
Dim string_in As New StringInputStream(comment)
Dim line_in As New LineInputStream(string_in)
'create comment
Set Me.pComment = New Comment()
'loop comment
rc = line_in.ReadStream(buffer)
While rc = 0
index = Instr(1, buffer, "%REM")
index = index + Instr(1, buffer, "%END REM")
index = index + Instr(1, buffer, EVENT_DESCRIPTION)
index = index + Instr(1, buffer, "End Sub")
If index < 1 Then
Call Me.pComment.AddCommentPart(buffer)
End If
'read next line
rc = line_in.ReadStream(buffer)
Wend
End If
End Sub
End Class
Public Class ScriptLibrary As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript library
If Not source.HasItem("$ScriptLib") Then
Error 123, "The passed document is not a LotusScript script library."
End If
'get the source for the ScriptLibrary
Me.pSource = source.GetItemValue("$ScriptLib")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_LIBRARY
End Property
End Class
Public Class IgnoringScript As Script
'/**
' * @see Script#New
' */
Public Sub New(source As Variant), Script(source)
End Sub
'/**
' * Ignores the method called "BindEvents".
' *
' * @see Script#AddScriptElement
' */
Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
If se.ElementName <> "BindEvents" Then
Call Me.pElements.AddElement(se)
End If
End If
End Sub
End Class
Public Class Form As IgnoringScript
'/**
' * Constructor.
' */
Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript form
If Not source.HasItem("$Fields") Then
Error 123, "The passed document is not a LotusScript form."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$$FormScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_FORM
End Property
End Class
Public Class View As IgnoringScript
'/**
' * Constructor.
' */
Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript view
If Not source.HasItem("$ViewScript") Then
Error 123, "The passed document is not a LotusScript view."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$ViewScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_VIEW
End Property
End Class
Public Class Agent As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript agent
If Not source.HasItem("$AssistAction") Then
Error 123, "The passed document is not a LotusScript agent."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$AssistAction")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_AGENT
End Property
End Class
Public Class DatabaseScript As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
Me.pName = "Database script"
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_DBSCRIPT
End Property
End Class
Public Class Page As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_PAGE
End Property
End Class
Public Class SharedAction As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_ACTION
End Property
End Class
Public Class Webservice As Script
'/**
' *
' *
' * @error 9999 Raised if the supplied argument isn't a NotesDocument or if the webservice isn't in LotusScript
' */
Public Sub New(source As Variant), Script(source)
'declarations
Dim ss As ScriptSource
'make sure the supplied argument is a document and that it is a
'LotusScript webservice
If Typename(source) = "NOTESDOCUMENT" Then
If source.GetItemValue("$AssistType")(0) <> LOTUSSCRIPT_WEBSERVICE Then
'this is not a LotusScript webservice
Error 9999, "The supplied webservice is not in LotusScript"
Else
'convert to WebserviceScriptSource
Set ss = New WebserviceScriptSource(source.GetItemValue("$TITLE")(0), source.ParentDatabase)
Me.pName = ss.SourceName
End If
Elseif source Isa "ScriptSource" Then
Set ss = source
Else
Error 9999, "The supplied argument isn't a NotesDocument"
End If
'store code
Me.pSource = ss.GetCode()
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_WEBSERVICE
End Property
End Class
Private Sub lsdoc_description
%REM
Script library holding classes representing the different design elements (forms, agents etc.).
%END REM
End Sub]]]]><![CDATA[></code>
<parsedCode>
<usereference name="CLASS: LSDocConstants" />
<usereference name="CLASS: ScriptElement" />
<usereference name="CLASS: Collections" />
<usereference name="CLASS: ScriptParser" />
<usereference name="CLASS: InputStream" />
<usereference name="CLASS: ScriptSource" />
<class name="Script" visibility="Public">
<code><![CDATA[Public Class Script
'declarations
Private pSource As String
Private pName As String
Private pAlias As String
Private pElements As Vector
Private pComment As Comment
'/**
' * Constructor.
' *
' * @param source The source of the source code (either a NotesDocument or a ScriptSource object)
' */
Public Sub New(source As Variant)
'which type was passed
If Typename(source) = "NOTESDOCUMENT" Then
'we received a NotesDocument object - store the name
Me.pName = source.GetItemValue("$TITLE")(0)
'if the title is multi value we have an alias
If Ubound(source.GetItemValue("$TITLE")) > 0 Then
'alias specified as multi-value field
Me.pAlias = source.GetItemValue("$TITLE")(1)
Else
'check name for pipe character
Dim index As Integer
index = Instr(1, Me.pName, "|")
If index > 1 Then
Me.pAlias = Mid$(Me.pName, index+1)
Me.pName = Mid$(Me.pName, 1, index-1)
End If
End If
Elseif source Isa "ScriptSource" Then
'we received a ScriptSource object
Me.pName = source.SourceName
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
'create vector to hold script elements
Set Me.pElements = New SortedVector()
End Sub
'/**
' * Adds a ScriptElement for this Script.
' *
' * @param se The ScriptElement to add.
' */
Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
'add to all elements holder
Call Me.pElements.AddElement(se)
End If
End Sub
'/**
' * Returns the ScriptElement objects for the Script object.
' *
' * @return Vector of ScriptElement objects (never nothing)
' */
Public Function GetScriptElements() As Vector
Set GetScriptElements = Me.pElements
End Function
'/**
' * Returns the name of the script.
' */
Public Property Get ScriptName As String
ScriptName = Me.pName
End Property
'/**
' * Returns the alias of the script (if any).
' */
Public Property Get ScriptAlias As String
ScriptAlias = Me.pAlias
End Property
'/**
' * Returns the type of script.
' */
Public Property Get ScriptType As Integer
Error 123, "Should not be called directly - use a sub-class."
End Property
'/**
' * Returns the comment (if any).
' */
Public Property Get Comment As Comment
Set Comment = Me.pComment
End Property
'/**
' * Parses the added source and create ScriptElements objects.
' */
Public Sub Parse()
'declarations
Dim v As Vector
Dim enum As Enumeration
Dim script_elem As Variant
'only parse if there is any data
If Len(Me.pSource) = 0 Then
Exit Sub
End If
'create a LineInputStream and a Parser
Dim string_in As New StringInputStream(Me.pSource)
Dim line_in As New LineInputStream(string_in)
Dim parser As New ScriptParser(line_in)
'parse
Set v = parser.Parse()
'add script elements to our selves
Set enum = v.Elements
While enum.HasMoreElements
Set script_elem = enum.NextElement()
Call Me.AddScriptElement(script_elem)
Wend
End Sub
'/**
' * Handles parsing the script comment it any.
' *
' * @param source The script source we use
' */
Private Sub pHandleScriptComment(source As Variant)
'declarations
Dim comment As String
Dim buffer As String
Dim rc As Integer
Dim index As Long
'get the code for the script comment (if any)
comment = source.GetEventCode(EVENT_DESCRIPTION)
If comment <> "" Then
'there is a script comment - we need to ignore the
'first and last line since it is REM statements
Dim string_in As New StringInputStream(comment)
Dim line_in As New LineInputStream(string_in)
'create comment
Set Me.pComment = New Comment()
'loop comment
rc = line_in.ReadStream(buffer)
While rc = 0
index = Instr(1, buffer, "%REM")
index = index + Instr(1, buffer, "%END REM")
index = index + Instr(1, buffer, EVENT_DESCRIPTION)
index = index + Instr(1, buffer, "End Sub")
If index < 1 Then
Call Me.pComment.AddCommentPart(buffer)
End If
'read next line
rc = line_in.ReadStream(buffer)
Wend
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<member name="pSource" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pSource As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pName" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pName As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pAlias" visibility="Private">
<datatype idref="String" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pAlias As String]]]]><![CDATA[></code>
<comment />
</member>
<member name="pElements" visibility="Private">
<datatype idref="Vector" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pElements As Vector]]]]><![CDATA[></code>
<comment />
</member>
<member name="pComment" visibility="Private">
<datatype idref="Comment" />
<isList>false</isList>
<isArray>false</isArray>
<code><![CDATA[Private pComment As Comment]]]]><![CDATA[></code>
<comment />
</member>
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant)
'which type was passed
If Typename(source) = "NOTESDOCUMENT" Then
'we received a NotesDocument object - store the name
Me.pName = source.GetItemValue("$TITLE")(0)
'if the title is multi value we have an alias
If Ubound(source.GetItemValue("$TITLE")) > 0 Then
'alias specified as multi-value field
Me.pAlias = source.GetItemValue("$TITLE")(1)
Else
'check name for pipe character
Dim index As Integer
index = Instr(1, Me.pName, "|")
If index > 1 Then
Me.pAlias = Mid$(Me.pName, index+1)
Me.pName = Mid$(Me.pName, 1, index-1)
End If
End If
Elseif source Isa "ScriptSource" Then
'we received a ScriptSource object
Me.pName = source.SourceName
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
'create vector to hold script elements
Set Me.pElements = New SortedVector()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddScriptElement" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
'add to all elements holder
Call Me.pElements.AddElement(se)
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<function name="GetScriptElements" visibility="Public">
<returnType idref="Vector" />
<code><![CDATA[Public Function GetScriptElements() As Vector
Set GetScriptElements = Me.pElements
End Function]]]]><![CDATA[></code>
<comment />
</function>
<property name="ScriptName" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get ScriptName As String
ScriptName = Me.pName
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="ScriptAlias" visibility="Public" setter="false">
<datatype idref="String" />
<code><![CDATA[Public Property Get ScriptAlias As String
ScriptAlias = Me.pAlias
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
Error 123, "Should not be called directly - use a sub-class."
End Property]]]]><![CDATA[></code>
<comment />
</property>
<property name="Comment" visibility="Public" setter="false">
<datatype idref="Comment" />
<code><![CDATA[Public Property Get Comment As Comment
Set Comment = Me.pComment
End Property]]]]><![CDATA[></code>
<comment />
</property>
<sub name="Parse" visibility="Public">
<code><![CDATA[Public Sub Parse()
'declarations
Dim v As Vector
Dim enum As Enumeration
Dim script_elem As Variant
'only parse if there is any data
If Len(Me.pSource) = 0 Then
Exit Sub
End If
'create a LineInputStream and a Parser
Dim string_in As New StringInputStream(Me.pSource)
Dim line_in As New LineInputStream(string_in)
Dim parser As New ScriptParser(line_in)
'parse
Set v = parser.Parse()
'add script elements to our selves
Set enum = v.Elements
While enum.HasMoreElements
Set script_elem = enum.NextElement()
Call Me.AddScriptElement(script_elem)
Wend
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="pHandleScriptComment" visibility="Private">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Private Sub pHandleScriptComment(source As Variant)
'declarations
Dim comment As String
Dim buffer As String
Dim rc As Integer
Dim index As Long
'get the code for the script comment (if any)
comment = source.GetEventCode(EVENT_DESCRIPTION)
If comment <> "" Then
'there is a script comment - we need to ignore the
'first and last line since it is REM statements
Dim string_in As New StringInputStream(comment)
Dim line_in As New LineInputStream(string_in)
'create comment
Set Me.pComment = New Comment()
'loop comment
rc = line_in.ReadStream(buffer)
While rc = 0
index = Instr(1, buffer, "%REM")
index = index + Instr(1, buffer, "%END REM")
index = index + Instr(1, buffer, EVENT_DESCRIPTION)
index = index + Instr(1, buffer, "End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="ScriptLibrary" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>ScriptLibrary</class>
</hierarchy>
<code><![CDATA[Public Class ScriptLibrary As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript library
If Not source.HasItem("$ScriptLib") Then
Error 123, "The passed document is not a LotusScript script library."
End If
'get the source for the ScriptLibrary
Me.pSource = source.GetItemValue("$ScriptLib")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_LIBRARY
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript library
If Not source.HasItem("$ScriptLib") Then
Error 123, "The passed document is not a LotusScript script library."
End If
'get the source for the ScriptLibrary
Me.pSource = source.GetItemValue("$ScriptLib")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_LIBRARY
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="IgnoringScript" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>IgnoringScript</class>
</hierarchy>
<code><![CDATA[Public Class IgnoringScript As Script
'/**
' * @see Script#New
' */
Public Sub New(source As Variant), Script(source)
End Sub
'/**
' * Ignores the method called "BindEvents".
' *
' * @see Script#AddScriptElement
' */
Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
If se.ElementName <> "BindEvents" Then
Call Me.pElements.AddElement(se)
End If
End If
End Sub
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<sub name="AddScriptElement" visibility="Public">
<params>
<param name="se">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub AddScriptElement(se As Variant)
If se Isa "SCRIPTELEMENT" Then
If se.ElementName <> "BindEvents" Then
Call Me.pElements.AddElement(se)
End If
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</class>
<class name="Form" visibility="Public">
<parentClass>IgnoringScript</parentClass>
<hierarchy>
<class>Script</class>
<class>IgnoringScript</class>
<class>Form</class>
</hierarchy>
<code><![CDATA[Public Class Form As IgnoringScript
'/**
' * Constructor.
' */
Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript form
If Not source.HasItem("$Fields") Then
Error 123, "The passed document is not a LotusScript form."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$$FormScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_FORM
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="IgnoringScript">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript form
If Not source.HasItem("$Fields") Then
Error 123, "The passed document is not a LotusScript form."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$$FormScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_FORM
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="View" visibility="Public">
<parentClass>IgnoringScript</parentClass>
<hierarchy>
<class>Script</class>
<class>IgnoringScript</class>
<class>View</class>
</hierarchy>
<code><![CDATA[Public Class View As IgnoringScript
'/**
' * Constructor.
' */
Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript view
If Not source.HasItem("$ViewScript") Then
Error 123, "The passed document is not a LotusScript view."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$ViewScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_VIEW
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="IgnoringScript">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), IgnoringScript(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript view
If Not source.HasItem("$ViewScript") Then
Error 123, "The passed document is not a LotusScript view."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$ViewScript")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_VIEW
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="Agent" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>Agent</class>
</hierarchy>
<code><![CDATA[Public Class Agent As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript agent
If Not source.HasItem("$AssistAction") Then
Error 123, "The passed document is not a LotusScript agent."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$AssistAction")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_AGENT
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
If Typename(source) = "NOTESDOCUMENT" Then
'make sure this is a LotusScript agent
If Not source.HasItem("$AssistAction") Then
Error 123, "The passed document is not a LotusScript agent."
End If
'get the source for the form
Me.pSource = source.GetItemValue("$AssistAction")(0)
Elseif Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a NotesDocument or a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_AGENT
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="DatabaseScript" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>DatabaseScript</class>
</hierarchy>
<code><![CDATA[Public Class DatabaseScript As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
Me.pName = "Database script"
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_DBSCRIPT
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
Me.pName = "Database script"
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_DBSCRIPT
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="Page" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>Page</class>
</hierarchy>
<code><![CDATA[Public Class Page As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_PAGE
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_PAGE
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="SharedAction" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>SharedAction</class>
</hierarchy>
<code><![CDATA[Public Class SharedAction As Script
'/**
' * Constructor.
' */
Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_ACTION
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
If Typename(source) = "SCRIPTSOURCE" Then
'we received a ScriptSource object
Me.pSource = source.GetCode()
'handle script comment if any
Call Me.pHandleScriptComment(source)
Else
'invalid type supplied
Error 9999, "Invalid source type supplied (supply a ScriptSource object)"
End If
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_ACTION
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<class name="Webservice" visibility="Public">
<parentClass>Script</parentClass>
<hierarchy>
<class>Script</class>
<class>Webservice</class>
</hierarchy>
<code><![CDATA[Public Class Webservice As Script
'/**
' *
' *
' * @error 9999 Raised if the supplied argument isn't a NotesDocument or if the webservice isn't in LotusScript
' */
Public Sub New(source As Variant), Script(source)
'declarations
Dim ss As ScriptSource
'make sure the supplied argument is a document and that it is a
'LotusScript webservice
If Typename(source) = "NOTESDOCUMENT" Then
If source.GetItemValue("$AssistType")(0) <> LOTUSSCRIPT_WEBSERVICE Then
'this is not a LotusScript webservice
Error 9999, "The supplied webservice is not in LotusScript"
Else
'convert to WebserviceScriptSource
Set ss = New WebserviceScriptSource(source.GetItemValue("$TITLE")(0), source.ParentDatabase)
Me.pName = ss.SourceName
End If
Elseif source Isa "ScriptSource" Then
Set ss = source
Else
Error 9999, "The supplied argument isn't a NotesDocument"
End If
'store code
Me.pSource = ss.GetCode()
End Sub
'/**
' * Override parent to return correct type.
' */
Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_WEBSERVICE
End Property
End Class]]]]><![CDATA[></code>
<comment />
<sub name="New" visibility="Public">
<params>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="Script">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
<param name="source">
<datatype idref="Variant" />
<isList>false</isList>
<isArray>false</isArray>
<isByval>false</isByval>
</param>
</params>
<code><![CDATA[Public Sub New(source As Variant), Script(source)
'declarations
Dim ss As ScriptSource
'make sure the supplied argument is a document and that it is a
'LotusScript webservice
If Typename(source) = "NOTESDOCUMENT" Then
If source.GetItemValue("$AssistType")(0) <> LOTUSSCRIPT_WEBSERVICE Then
'this is not a LotusScript webservice
Error 9999, "The supplied webservice is not in LotusScript"
Else
'convert to WebserviceScriptSource
Set ss = New WebserviceScriptSource(source.GetItemValue("$TITLE")(0), source.ParentDatabase)
Me.pName = ss.SourceName
End If
Elseif source Isa "ScriptSource" Then
Set ss = source
Else
Error 9999, "The supplied argument isn't a NotesDocument"
End If
'store code
Me.pSource = ss.GetCode()
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
<property name="ScriptType" visibility="Public" setter="false">
<datatype idref="Integer" />
<code><![CDATA[Public Property Get ScriptType As Integer
ScriptType = SCRIPTTYPE_WEBSERVICE
End Property]]]]><![CDATA[></code>
<comment />
</property>
</class>
<sub name="lsdoc_description" visibility="Private">
<code><![CDATA[Private Sub lsdoc_description
%REM
Script library holding classes representing the different design elements (forms, agents etc.).
%END REM
End Sub]]]]><![CDATA[></code>
<comment />
</sub>
</parsedCode>
</scriptlibrary>
</scriptlibraries>
</lsdoc:database>
]]>