Sub XE_Toggle()

' Set of macros by Steven Marzuola - written November 2005
' mentioned: http://groups.yahoo.com/group/dejavu-l/message/63998
'
' Converts the text in Word index entries to regular text, to make it
' visible to programs such as DVX which does not read the text in XE fields
'
' These delimiter strings will appear before and after the text
' extracted from each XE field, to indicate this to the translator.
' if desired, they can be changed (at three different places).

Dim XE_Delims(2) As String
XE_Delims(1) = "XE__XE"
XE_Delims(2) = "EX__EX"

If XE_Query(XE_Delims) Then
    XE_Replace
Else
    XE_Expose
End If

End Sub

Sub XE_Expose()
    Dim XE_Delims(2) As String
    XE_Delims(1) = "XE__XE"
    XE_Delims(2) = "EX__EX"
    MsgBox ("Exposing text in XE fields for translation")
    XE_Expose_Args (XE_Delims)
End Sub


Sub XE_Replace()
    Dim XE_Delims(2) As String
    XE_Delims(1) = "XE__XE"
    XE_Delims(2) = "EX__EX"
    MsgBox ("Restoring translated text to XE fields")
    XE_Replace_Args (XE_Delims)
End Sub


Sub XE_Expose_Args(XE_Delims)

' For each XE field in the document
'   extract the text from the field
'   add new test after the XE field, with extracted text
'   marked with initial and final delimiter strings

Dim myEntry, myText, QuoteLoc1, QuoteLoc2, myFound

    myFound = True

    Selection.HomeKey Unit:=wdStory
    ActiveWindow.ActivePane.View.ShowAll = True
    
    While myFound
    
        With Selection.Find
            .Text = "^d": .Replacement.Text = ""
            .Forward = True: .Wrap = wdFindStop: .Format = False
            .MatchCase = True: .MatchWholeWord = False: .MatchWildcards = False
            .MatchSoundsLike = False: .MatchAllWordForms = False
            .Execute
            myFound = .Found
        End With

        If myFound Then
            If Selection.Fields(1).Type = wdFieldIndexEntry Then
                myEntry = Selection.Fields(1)
                myText = Trim(myEntry.Text)
                QuoteLoc1 = InStr(myText, Chr(34))
                QuoteLoc2 = InStrRev(myText, Chr(34))
                myText = " " & XE_Delims(1) & " " & _
                    Mid(myText, QuoteLoc1 + 1, QuoteLoc2 - QuoteLoc1 - 1) _
                    & " " & XE_Delims(2) & " "
                Selection.Start = Selection.End
                Selection.End = Selection.Start
                Selection.TypeText Text:=myText
            End If
        End If
    Wend
End Sub

Function XE_Query(XE_Delims) As Boolean

' This function checks whethere the current document contains any
' instances of the string defined as the first delimiter.

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = XE_Delims(1)
        .Replacement.Text = ""
        .Forward = True: .Wrap = wdFindStop: .Format = False:
        .MatchCase = True: .MatchWholeWord = True: .MatchWildcards = False
        .MatchSoundsLike = False: .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
    XE_Query = Selection.Find.Found
        
End Function

Sub XE_Replace_Args(XE_Delims)

' Searches for each pair of XE text delimiters in the current document
' For each one, deletes the delimiters, and replaces the text in the
' previous XE field with the text found between the delimiters.

Dim myText, myEntry, QuoteLoc1, QuoteLoc2

    ActiveWindow.ActivePane.View.ShowAll = True
    
    myText = XE_GetNextText(XE_Delims)
    
    While Len(myText) > 0
        XE_Replace_Args_in_field (myText)
        myText = XE_GetNextText(XE_Delims)
    Wend
        
End Sub

Sub XE_Replace_Args_in_field(myText As String)

' is called only if the current Selection includes an XE field
' replaces the text inside the XE field with myText

Dim myEntry, QuoteLoc1, QuoteLoc2, thisField, thisFieldText

    If Selection.Fields(1).Type = wdFieldIndexEntry Then
        thisField = Selection.Fields(1)
        thisFieldText = thisField.Text
        QuoteLoc1 = InStr(thisFieldText, Chr(34))
        QuoteLoc2 = InStrRev(thisFieldText, Chr(34))
        thisFieldText = Left(thisFieldText, QuoteLoc1) & _
            myText & Mid(thisFieldText, QuoteLoc2)
        Selection.Fields(1).Code.Text = thisFieldText
    End If

End Sub

Function XE_GetNextText(XE_Delims)

' Searches for the first pair of XE_Delims (XE text delimiter strings)
' in the document. If the document does not contain any delimiter
' strings, returns an empty string.  Otherwise, locates and returns
' the text contained within the pair of delimiters
' Deletes the delimiters, plus the surrounding spaces
' Searches up (backward) in the document for the previous field,
' which should be an XE field.

Dim myStart, myText, LocOne, LocTwo

    Selection.HomeKey Unit:=wdStory
    
    With Selection.Find
        .ClearFormatting
        .Text = "XE__XE": .Replacement.Text = "": .Forward = True
        .Wrap = wdFindStop: .Format = False: .MatchCase = True
        .MatchWholeWord = False: .MatchWildcards = False
        .MatchSoundsLike = False: .MatchAllWordForms = False
        .Execute
        If Not .Found Then
            myText = ""
        Else
            myStart = Selection.Start - 1
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            .Text = "EX__EX":
            .Execute
            Selection.End = Selection.End + 1
            Selection.Start = myStart
            myText = Selection.Text
            Selection.Delete
        End If
    End With
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "^d": .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
    End With
    
    If myText = "" Then
        XE_GetNextText = ""
    Else
        LocOne = InStr(myText, XE_Delims(1)) + Len(XE_Delims(1))
        LocTwo = InStr(myText, XE_Delims(2))
        XE_GetNextText = Mid(myText, LocOne + 1, LocTwo - LocOne - 2)
    End If
    
End Function