<%
'Markup class by Gunnar Liljas
'Copyright 2001
'v0.2

'Instructions:
'
'Include the Classes wherever markup code is to be parsed
'Define the tags used by using the supplied methods
'
'Properties:
'
'object.URLify (boolean)
'
'If URLify is set to true, all URLs in the text is automatically turned into HTML links.
'Default is false
'
'
'object.Target (string)
'
'Sets the link target for the created links.
'Default is "_blank"
'
'
'object.AllowHTML (boolean)
'
'If AllowHTML is set to true, regular HTML is allowed in the text, otherwise it's encoded.
'Default is false.
'
'
'Methods:
'
'object.AddQuickTag(StartTag,EndTag,StartReplacement,EndReplacement,ParseContents)
'
'Adds a QuickTag, which is a tag where the start end end tags are just replaced with something else
'Starttag - the starting tag (string)
'EndTag - the ending tag (string)
'StartReplacement - what to replace the StartTag with (string)
'EndReplacement - what to replace the EndTag with (string)
'ParseContents - sets whether the text between the tags should be parsed (boolean)
'
'
'object.AddSingleTag(TagName,Replacement)
'
'Adds a SingleTag, which is a tag with no closing tag, eg. [hr]
'Tagname - the tag
'Replacement - the replacing text
'
'
'object.AddTag(TagName,Replacement,ParseContents)
'
'Adds a standard tag, which is a tag where the contents between the tags
'can be placed within the replacement in any fashion
'TagName - the tag
'Replacement - what to replace with. The contents are placed
' where the ##contents## placeholders are placed
'
'
'object.AddTag(TagName,Replacement,ParseContents)
'
'Adds a standard attributed tag, which is a tag where the contents between the tags
'can be placed within the replacement in any fashion, and an attribute can be given, also placed
'at any position
'TagName - the tag
'Replacement - what to replace with. The contents are placed
' where the ##contents## placeholders are placed.
' The attributes are placed where the ##attr##
' placeholders are placed.
'
'
'ParsedText = object.Parse(TextToParse)
'
'Parses the text according to the added tag set.
'
'
'ParsedText = object.ParseURLs(TextToParse,LinkTarget)
'
'Creates HTML links of URLs, with the supplied target
'
'ParsedText = object.RegExpEncode(TextToParse)
'
'Encodes text for safe inclusion in RegExp patterns
'
'


Class EMarkupParser

Private m_colTags
Private m_objRxp
Private m_strTagLIst
Private m_blnURLify
Private m_blnAllowHTML
Private m_strTarget

Public Property Let URLify(DoURLify)
m_blnURLify=DoURLify
End Property

Public Property Let AllowHTML(DoAllowHTML)
m_blnAllowHTML=DoAllowHTML
End Property

Public Property Let Target(LinkTarget)
m_strTarget=LinkTarget
End Property

Private Sub AddToList(TagName)
m_strTagLIst=m_strTagLIst & "|" & TagName
End Sub

Private Property Get TagList
If len(m_strTagLIst)>1 Then
TagLIst=mid(m_strTagLIst,2)
Else
TagLIst=""
End If
End Property

Public Sub AddTag(TagName,Replacement,ParseContents)
Dim s_objTag
Set s_objTag=new ETag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Sub AddAttrTag(TagName,Replacement,ParseContents)
Dim s_objTag
Set s_objTag=new EAttrTag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Sub AddSingleTag(TagName,Replacement)
Dim s_objTag
Set s_objTag=new ESingleTag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
End Sub

Public Sub AddQuickTag(StartTag,EndTag,StartReplacement,EndReplacement,ParseContents)
Dim s_objTag
Set s_objTag=new EQuickTag
Set s_objTag.Parser=Me
s_objTag.StartTag=StartTag
s_objTag.EndTag=EndTag
s_objTag.StartReplacement=StartReplacement
s_objTag.EndReplacement=EndReplacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Function Parse(TextToParse)
dim f_strText,f_strTag
f_strText=TextToParse
f_strText=Replace(f_strText,"##",chr(1))
If Not m_blnAllowHTML Then
f_strText=Replace(f_strText,"<","&lt;")
f_strText=Replace(f_strText,">","&gt;")
End If
m_objRxp.Pattern="(\[(" & TagLIst & ")(=[^\]]*?)?\])(.*?)(\[/\2\])"
For Each f_objMatch in m_objRxp.Execute(f_strText)
f_strText=Replace(f_strText,f_objMatch.Value,f_objMatch.Submatches(0) & Replace(f_objMatch.Submatches(3),"[",chr(0)) & f_objMatch.Submatches(4))
Next
For Each f_objTag in m_colTags
f_strText=m_colTags(f_objTag).Parse(f_strText,m_objRxp)
Next
If m_blnURLIfy Then
f_strText=ParseURLs(Replace(Replace(f_strText,chr(0),"["),chr(1),"##"),m_strTarget)
Else
f_strText=Replace(Replace(f_strText,chr(0),"["),chr(1),"##")
End If

Parse=Replace(f_strText,vbcrlf,"<BR>" & vbcrlf)
End Function

Public Function ParseURLs(TextToParse,LinkTarget)
dim f_strText
f_strText=TextToParse
m_objRxp.Pattern="(^|[^""])(http://|https://|ftp://|mailto:|file://|telnet://|gopher://)([\w/#~:.,?+=&%@!\-]*?)([\s.:?\-]*[^\w/#~:.,?+=&%@!\-]|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a target=""" & LinkTarget & """ href=""$2$3"">$2$3</a>$4")
m_objRxp.Pattern="(^|[^\w/>])(www\.[\w/#~:.,?+=&%@!\-]*?)([\s.:?\-]*[^\w/#~:.,?+=&%@!\-]|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a target=""" & LinkTarget & """ href=""http://$2"">$2</a>$3")
'objRxp.Pattern = "(\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+)"
m_objRxp.Pattern="(^|[^:>\w])([\w\.]*@[\w\.\-]*\.\w{2,3})(\b|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a href=""mailto:$2"">$2</a>")
ParseURLs=f_strText
End Function

Public Function RegExpEncode(TextToParse)
m_objRxp.Pattern="([\\\^\$\*\+\?\.\(\)\|\{\}\[\]])"
RegExpEncode=m_objRxp.Replace(TextToParse,"\$1")
End Function

Private Sub Class_Initialize
Set m_colTags=Server.CreateObject("Scripting.Dictionary")
Set m_objRxp=New RegExp
m_objRxp.Global=True
m_objRxp.IgnoreCase=True
m_objRxp.Multiline=True
m_strTarget="_blank"
m_blnAllowHTML=false
m_blnURLify=true
End Sub

End Class

Class ETag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
Dim f_strPattern
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
f_strPattern=Replace(Replacement,"##contents##","$1")
objRxp.Pattern="\[" & c_strTag & "\]((.|\s)*?)\[/" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,f_strPattern)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class EAttrTag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
Dim m_strPattern
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
m_strPattern=Replace(Replace(Replacement,"##contents##","$2"),"##attr##","$1")
objRxp.Multiline=true
objRxp.Pattern="\[" & c_strTag & "=([^\]]*?)\]((.|\s)*?)\[/" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,m_strPattern)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class ESingleTag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
objRxp.Pattern="\[" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,Replacement)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class EQuickTag
Public StartTag
Public EndTag
Public StartReplacement
Public EndReplacement
Public Parser
Private c_strStartTag
Private c_strEndTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
If Parser Is Nothing Then
c_strStartTag=StartTag
c_strEndTag=EndTag
Else
c_strStartTag=Parser.RegExpEncode(StartTag)
c_strEndTag=Parser.RegExpEncode(EndTag)
End If
objRxp.Pattern="\[" & c_strStartTag & "\]((.|\s)*?)\[/" & c_strEndTag & "\]"
Parse=objRxp.Replace(TextToParse,StartReplacement & "$1" & EndReplacement)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class


Set wfParser=New EMarkupParser
With wfParser

.URLIfy=true
.Target="_blank"

.AddQuickTag "b","b","<b>","</b>",true
.AddQuickTag "i","i","<i>","</i>",true

.AddTag "img","<img src=""##contents##"">",false
.AddAttrTag "img","<img alt=""##attr##"" src=""##contents##"">",false

.AddTag "email","<a href=""mailto:##contents##"">##contents##</a>",false

.AddAttrTag "mailto","<a href=""mailto:##attr##"">##contents##</a>",false

.AddTag "url","<a target=""_blank"" href=""##contents##"">##contents##</a>",false
.AddAttrTag "url","<a target=""_blank"" href=""##attr##"">##contents##</a>",false


.AddQuickTag "list","list","<ul type=""square"">","</ul>",true
.AddQuickTag "list=A","list","<ol type=""A"">","</ol>",true
.AddQuickTag "list=1","list","<ol type=""1"">","</ol>",true

.AddQuickTag "red","red","<font style=""color: red"">","</font>",true
.AddQuickTag "blue","blue","<font style=""color: blue"">","</font>",true


.AddSingleTag "*","<li>"
.AddQuickTag "kod","kod","<P><font size=""1"" face=""Verdana, Arial, Helvetica, sans-serif"">Kod:</font><HR><font size=""1"" face=""Verdana, Arial, Helvetica, sans-serif"" color=""#660000"">","<BR></font><HR>",true

.AddQuickTag "perl","perl","<BLOCKQUOTE><font size=""1"" face=""Verdana, Arial, Helvetica, sans-serif"">kod:</font><HR><code><pre><BR>","</pre></code><HR></BLOCKQUOTE>",true
.AddQuickTag "citat","citat","<font face=""Verdana, Arial, Helvetica, sans-serif"" size=""1"">Citat:</font><hr size=""1""><font face=""Verdana, Arial, Helvetica, sans-serif"" size=""2"" color=""#006666""> ","<BR><BR></font><hr size=""1"">",true

End With

response.write wfParser.Parse(Texten)

%>