'Attribute VB_Name = "WordRadio"
' Copyright (c) 2002 Simon Fell
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of
' this software and associated documentation files (the "Software"), to deal in
' the Software without restriction, including without limitation the rights to
' use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
' of the Software, and to permit persons to whom the Software is furnished to do
' so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
' INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
' PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
' HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
' SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
' **********************************************************************************
' Radio Blogging Macros for Word, Powered by PocketSOAP.
' see http://www.pocketsoap.com/weblog/stories/2002/04/11/radioBloggingFromWord.html
' for the latest version
' **********************************************************************************
' 04/13/02  OHS modified macro to work in Mac Word with accompaning AppleScript
'               removed functions relating to pocketsoap since they don't apply
'               to the mac
' 04/12/02  SZF added comments, fix for proxy in getTransport
'               selection is now returned to its original state
'               bold & italic formatting are now carried over
' 04/11/02  SZF Original Release
' **********************************************************************************

' helper function, generates a simple HTML rendering of the current
' doc, expanding links.

Public Function getCurrentDocAsSimpleHtml() As String
    ' save the current selection, so we can put it back later
    Dim ss As Long, se As Long
    ss = Selection.Start
    se = Selection.End
    
    ' expand the selection to the whole of the current doc
    While (Selection.MoveStart(wdParagraph, -1) <> 0)
    Wend
    While (Selection.MoveEnd(wdParagraph, 1) <> 0)
    Wend
    
    ' build a HTML formated version, with the links expanded
    Dim strText As String
    Dim w As Range, strUrl As String, bItalics As Boolean, bBold As Boolean
    For Each w In Selection.Characters
        If w.Hyperlinks.Count > 0 Then
            If strUrl <> w.Hyperlinks(1).Address Then
                strText = strText + "<a href=""" + w.Hyperlinks(1).Address + """>"
                strUrl = w.Hyperlinks(1).Address
            End If
        End If
        If Len(strUrl) > 0 And w.Hyperlinks.Count = 0 Then
            strText = strText + "</a>"
            strUrl = ""
        End If
        If w.Bold And Not bBold Then
            strText = strText + "<b>"
            bBold = True
        ElseIf Not w.Bold And bBold Then
            strText = strText + "</b>"
            bBold = False
        End If
        If w.Italic And Not bItalic Then
            strText = strText + "<i>"
            bItalic = True
        ElseIf Not w.Italic And bItalic Then
            strText = strText + "</i>"
            bItalic = False
        End If
        strText = strText + encode(w)
    Next
    getCurrentDocAsSimpleHtml = strText
    
    ' this is omar's code. Basically I copy the string to the clipboard so that
    ' I can get it from AppleScript.
    Set MyClipboard = New DataObject
    MyClipboard.SetText strText
    MyClipboard.PutInClipboard

    Selection.Start = ss
    Selection.End = se
End Function

' simple HTML entity encoder
Private Function encode(ByVal s As String) As String
    If s = "&" Then
        encode = "&amp;"
    ElseIf s = "<" Then
        encode = "&lt;"
    ElseIf s = ">" Then
        encode = "&gt;"
    Else
        encode = s
    End If
End Function