'#Language "WWB-COM"

' Create an integer custom property on the selected topic
' If it already exists, increment it

Option Explicit

Const T_URI = "http://mindmanager.com/macros/properties/integer" ' just a unique string, not a real URL
Const T_Name = "Points"

Sub Main
	Dim m_Topic As Topic

	Set m_Topic = ActiveDocument.Selection.PrimaryTopic
	If Not (m_Topic Is Nothing) Then
		'Dim i_Value As Integer
		'If Not TopicGetIntegerProperty(m_Topic, T_URI, T_Name, i_Value) Then ' does not exist, assert
		'	TopicAssertIntegerProperty(m_Topic, T_URI, T_Name, 0)
		'Else ' increment
		'	TopicSetIntegerProperty(m_Topic, T_URI, T_Name, i_Value + 1)
		'End If

		Dim s_Value As String
		If Not TopicGetListProperty(m_Topic, T_URI, T_Name, s_Value) Then ' does not exist, assert
			TopicAssertListProperty(m_Topic, T_URI, T_Name, "1 point, 2 points")
		Else ' add a list option
			Dim m_Property As CustomProperty
			If TopicFindProperty(m_Topic, T_URI, T_Name, m_Property) Then
				If m_Property.CustomPropertyFormat.FormatType = mmCustomPropertyFormatTypeList Then
					m_Property.CustomPropertyFormat.AddListOption(CStr(m_Property.CustomPropertyFormat.GetListOptionCount + 1) & " points")
				End If
			End If
		End If

	End If

End Sub

Function TopicAssertIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal i_Value As Integer) As CustomProperty
	' Assert an integer property on a topic and return the  custom property
	' If the topic already has a different data contain type, return nothing

	Set TopicAssertIntegerProperty = Nothing
	If Not TopicFindProperty(m_Topic, s_URI, s_Name, TopicAssertIntegerProperty) Then ' not found, create
		If  m_Topic.DataContainer.DataContainerType = mmDataContainerTypeNone Then
			m_Topic.DataContainer.InsertCustomProperties
		End If
		If m_Topic.DataContainer.DataContainerType = mmDataContainerTypeCustomProperties Then
			Set TopicAssertIntegerProperty = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.AddCustomProperty(s_URI, s_Name, mmCustomPropertyFormatTypeInteger)
		End If
	End If
	If Not (TopicAssertIntegerProperty Is Nothing) Then ' we have a property
		TopicAssertIntegerProperty.Value = i_Value ' assert value
	End If

End Function

Function TopicAssertListProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal s_List As String) As CustomProperty
	' Assert a list property on a topic and return the  custom property
	' If the topic already has a different data contain type, return nothing

	Set TopicAssertListProperty = Nothing
	If Not TopicFindProperty(m_Topic, s_URI, s_Name, TopicAssertListProperty) Then ' not found, create
		If  m_Topic.DataContainer.DataContainerType = mmDataContainerTypeNone Then
			m_Topic.DataContainer.InsertCustomProperties
		End If
		If m_Topic.DataContainer.DataContainerType = mmDataContainerTypeCustomProperties Then
			Set TopicAssertListProperty = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.AddCustomProperty(s_URI, s_Name,  mmCustomPropertyFormatTypeList)
		End If
	End If
	If Not (TopicAssertListProperty Is Nothing) Then ' we have a property
		Dim s_ListItems() As String
		Dim i_1 As Integer
		s_ListItems = Split(s_List, ",")
		For i_1 = LBound(s_ListItems) To UBound(s_ListItems)
			TopicAssertListProperty.CustomPropertyFormat.AddListOption(Trim(s_ListItems(i_1)))
		Next
		TopicAssertListProperty.Value = Trim(s_ListItems(LBound(s_ListItems))) ' value is first item
	End If

End Function

Function TopicGetIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByRef i_Value As Integer) As Boolean
	' Read the value of an integer property
	Dim m_Property As CustomProperty

	TopicGetIntegerProperty = False
	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType =  mmCustomPropertyFormatTypeInteger Then
			If m_Property.HasValue Then
				i_Value = m_Property.Value
				TopicGetIntegerProperty = True
			End If
		End If
	End If

End Function

Function TopicGetListProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByRef s_Value As String) As Boolean
	' Read the value of a list property
	Dim m_Property As CustomProperty

	TopicGetListProperty = False
	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType =   mmCustomPropertyFormatTypeList Then
			If m_Property.HasValue Then
				s_Value = m_Property.Value
				TopicGetListProperty = True
			End If
		End If
	End If

End Function

Sub TopicSetIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal i_Value As Integer)
	' Write a value to an integer property
	Dim m_Property As CustomProperty

	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType = mmCustomPropertyFormatTypeInteger Then
			m_Property.Value = i_Value
		End If
	End If

End Sub

Sub TopicSetListProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal s_Value As String)
	' Write a value to a list property
	Dim m_Property As CustomProperty

	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType =  mmCustomPropertyFormatTypeList Then
			m_Property.Value = s_Value
		End If
	End If

End Sub

Function TopicFindProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByRef m_Property As CustomProperty) As Boolean
	' Find a property by either matching URI or name if given
	' Match by name is used if the match by URI fails. The name is not case-sensitive and ignores spaces.
	Dim i_1 As Integer

	Set m_Property = Nothing
	TopicFindProperty = False
	If m_Topic.DataContainer.DataContainerType = mmDataContainerTypeCustomProperties Then
		If Len(s_URI) > 0 Then
			For i_1 = 1 To m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Count
				If m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1).Uri = s_URI Then
					Set m_Property = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1)
					TopicFindProperty = True
					Exit For
				End If
			Next
		End If
		If (m_Property Is Nothing) And (Len(s_Name) > 0) Then
			s_Name = UCase(Trim(s_Name))
			For i_1 = 1 To m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Count
				If UCase(Trim(m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1).CustomPropertyName)) = s_Name Then
					Set m_Property = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1)
					TopicFindProperty = True
					Exit For
				End If
			Next
		End If
	End If

End Function