Tricks of the Windows Gam…ming Gurus (2nd Edition)/Disc2.iso/common/msdev98/macros/sample.dsm

Text File | 1998-05-05 | 24.5 KB | 767 lines

'------------------------------------------------------------------------------
'FILE DESCRIPTION: SAMPLE.DSM is a collection of sample editor macros.
'------------------------------------------------------------------------------

'This routine has many uses if you are trying to determine the type of source
'    file.
'Return value:  0 Unknown file type
'               1 C-related file, this includes .c, .cpp, .cxx, .h, .hpp, .hxx
'               2 Java-related file, this includes .jav, .java
'               3 ODL-style file, .odl, .idl
'               4 Resource file, .rc, .rc2
'               5 HTML-style file, this includes .html, and .htm
'               6 VBS-style file, .dsm
'               7 Def-style file, .def
'USE: Pass this function the document that you wish to get information for.
Function FileType (ByVal doc)
    ext = doc.Name
    FileType = 0
    pos = Instr(ext, ".")
    if pos > 0 then
        Do While pos <> 1
            ext = Mid(ext, pos, Len(ext) - pos + 1)
            pos = Instr(ext, ".")
        Loop
        ext = LCase(ext)
    end if
    If ext = ".rc" Or ext = ".rc2" Then
        FileType = 4
    ElseIf doc.Language = dsCPP Then
        FileType = 1
    ElseIf doc.Language = dsJava Then
        FileType = 2
    ElseIf doc.Language = dsIDL Then
        FileType = 3
    ElseIf doc.Language = dsHTML_IE3 Or doc.Language = dsHTML_RFC1866 Then
        FileType = 5
    ElseIf doc.Language = dsVBSMacro Then '
        FileType = 6
    ElseIf ext = ".def" Then
        FileType = 7
    Else
        FileType = 0
    End If
End Function


'This routine has many uses if you are trying to determine if an identifier
'  is a valid C identifier.
'  These identifiers do not include qualification syntax, for example:
'  foo.bar is not valid
'  foo is valid
'Parameters:    String to test for a valid C identifier.
'Return value:  True: passed parameter is a valid C identifier.
'               False: passed parameter is not a valid C identifier.
Function ValidId(Id)
    ValidId = True

    'Don't permit an empty string
    ' (how can you identify nothing with something?)
    if Id = "" then
      ValidID = False
      Exit Function
    End If

    For i = 1 To Len(Id)
      if Mid(Id, i, 1) < "a" Or Mid(Id, i, 1) > "z" Then
        if Mid(Id, i, 1) < "A" Or Mid(Id, i, 1) > "Z" Then
            if Mid(Id, i, 1) < "0" Or Mid(Id, i, 1) > "9" Then
                if Mid(Id, i, 1) <> "_" Then
                    ValidId = False
                End if
            End If
        End If
      End If
    Next
    If IsNumeric(Left(Id, 1)) = True Then
        ValidId = False
    End If
End Function


Dim ParamArr ()  ' Dynamic array to store function arguments.

Sub AddFunctionDescription ( )
'DESCRIPTION: Creates a comment block for the currently selected C/C++ function prototype

    'Throughout this file, ActiveDocument.Selection is used in place
    'of ActiveDocument.Selection.Text.  The two are equivalent, and can
    'be used interchangeably. The reason for the equivalence is that
    'Text is regarded as the default property to use. All uses of
    'ActiveDocument.Selection without any other property default to the Text
    'property.
    if ActiveDocument.Language = dsCPP Then
        Header = StripTabs(Trim(ActiveDocument.Selection))

        'Get the function return type.
        if Header <> "" then
            Reti = InStr(Header, " ")
            Loc = InStr(Header, "(")
            if Reti < Loc Then
              RetTp = Left(Header, Reti)
              Header = Right(Header, Len(Header) - Reti)
            End If

            'Get the function name.
            Loc = InStr(Header, "(") - 1
            Loc2 = InStr(Header, ")")
            if Loc > 0 And Loc2 > 0 then 'make sure there is a '(' and a ')'
                fcName = Left(Header, Loc)
                Header = Right(Header, Len(Header) - Len(fcName))

                'Do we have storage type on the return type?
                Trim (fcName)
                If InStr(fcName," ") <> 0 Then
                    retTp = retTp + Left(fcName,InStr (fcName," "))
                    fcName = Right(fcName, Len(fcName) - InStr(fcName," "))
                End If

                'Get the function parameters.
                iPrm = 0
                iPrmA = 0
                prms = Header

                'Count the number of parameters.
                Do While InStr(prms, ",") <> 0
                    iPrm = iPrm + 1
                    prms = Right(prms, Len(prms) - InStr(prms, ","))
                Loop

                'Store the parameter list in the array.
                If iPrm > 0 Then  ' If multiple params.
                    iPrm = iPrm + 1
                    iPrmA = iPrm
                    Redim ParamArr(iPrm)
                    Do While InStr(header, ",") <> 0
                        ParamArr(iPrm) = Left(Header, InStr (Header, ",") - 1)
                        'Remove brace from first parameter.
                        If InStr(ParamArr(iPrm), " (") <> 0 Then
                            ParamArr(iPrm) = Right(ParamArr(iPrm), _
                                    Len(ParamArr(iPrm))-InStr(ParamArr(iPrm)," ("))
                            Trim(ParamArr(iPrm))
                        End If
                        Header = Right(Header, Len(Header) - InStr(Header,","))
                        iPrm = iPrm - 1
                        Loop
                    ParamArr(iPrm) = Header
                    'Remove trailing brace from last parameter.
                    If InStr(ParamArr(iPrm), ")") <> 0 Then
                        ParamArr(iPrm) = Left(ParamArr(iPrm), _
                                InStr(ParamArr(iPrm), ")") - 1)
                        Trim(ParamArr(iPrm))
                    End If
                Else 'Possibly one param.
                    Redim ParamArr(1)
                    Header = Right(Header, Len(Header) - 1) ' Strip the first brace.
                    Trim(Header)
                    ParamArr(1) = StripTabs(Header)
                    If InStr(ParamArr(1), ")") <> 1 Then
                        ParamArr(1) = Left(ParamArr(1), InStr(ParamArr(1), ")") - 1)
                        Trim(ParamArr(1))
                        iPrmA = 1
                    End If
                End If

                'Position the cursor one line above the selected text.
                ActiveDocument.Selection.LineUp
                ActiveDocument.Selection.LineDown
                ActiveDocument.Selection.StartOfLine
                ActiveDocument.Selection = vbLf

                Descr = "// Function name    : " + fcName + _
                        vbLf + "// Description        : " + _
                        vbLf +  "// Return type        : " + RetTp + vbLf

                'Print the parameter list.
                Last = iPrmA
                Do While iPrmA <> 0
                    'Remove a line feed from any of the arguments.
                    If InStr(ParamArr(iPrmA), vbLf) <> 0 Then
                        ParamArr(iPrmA) = Right(ParamArr(iPrmA), _
                                (Len(ParamArr(iPrmA)) - _
                                InStr(ParamArr(iPrmA), vbLf)))
                        Trim(ParamArr(iPrmA))
                    End If
                    ParamArr(iPrmA) = StripTabs(ParamArr(iPrmA))
                    'If there are 2+ parameters, the first parameter will
                    'have a '(' prepended to it, remove it here:
                    if iPrmA = Last AND Last <> 1 then
                      ParamArr(iPrmA) = Right(ParamArr(iPrmA), _
                            Len(ParamArr(iPrmA)) - 1)
                    End If
                    Descr = Descr + "// Argument         : " + _
                            ParamArr(iPrmA) + vbLf
                    iPrmA = iPrmA - 1
                Loop
                ActiveDocument.Selection = Descr
            Else
                MsgBox("It is possible that the function you are trying to"+_
                        " work with has a syntax error.")
            End if
        End If
    Else
        MsgBox("You need to have an active C/C++ document open"+ _
                vbLF+"with the function prototype selected.")
    End If
End Sub

'Strips the leading tab spaces.
Function StripTabs (ByVal MyStr)
    Do While InStr(MyStr, vbTab) <> 0
        MyStr = Right(MyStr, Len(MyStr) - InStr(MyStr, vbTab))
    Loop
    StripTabs = Trim(MyStr)
End Function

Sub ToggleCommentStyle ( )
'DESCRIPTION: Toggles between comment styles /* and //.

    TmpBlock = ""
    CmtBlock = ActiveDocument.Selection
    TypeOfFile = FileType(ActiveDocument)
    If TypeOfFile > 0 And TypeOfFile < 5 Then   'C/C++ style comment.
        'Get the first two characters of the comment block.
        Trim(CmtBlock)
        If Instr(CmtBlock,"//") <> 0 Then
            Do While Instr (CmtBlock,"//") <> 0
                TmpBlock = TmpBlock + Left (CmtBlock, Instr (CmtBlock,"//") - 1)
                CmtBlock = Right(CmtBlock, (Len(CmtBlock) - (Instr(CmtBlock,_
                        "//") + 1)))
            Loop
            CmtBlock = "/*" + TmpBlock + CmtBlock + "*/"
        ElseIf Instr(CmtBlock, "/*") <> 0 Then
            CmtBlock = Right(CmtBlock, Len(CmtBlock) - (Instr(CmtBlock,"/*")_
                    + 1))
            Do While Instr (CmtBlock, vbLf) <> 0
                TmpBlock = TmpBlock + Left (CmtBlock, Instr(CmtBlock, vbLf))_
                        + "//"
                CmtBlock = Right(CmtBlock, (Len(CmtBlock) - (Instr(CmtBlock,_
                        vbLf))))
            Loop
            CmtBlock = "//" + TmpBlock + Trim(CmtBlock)
            CmtBlock = Left(CmtBlock, Instr(CmtBlock,"*/")-1)
        End If
        ActiveDocument.Selection.Delete
        ActiveDocument.Selection = CmtBlock
    Else
        MsgBox "This macro does not work on this type of file."
    End If

End Sub



Sub AddRevisionMarks ( )
'DESCRIPTION: Adds comments to a file that describe the changes made.

    'This routine adds a new comment block to the top of a file, where the
    ' programmer can place revision marks to describe the changes made to the file.
    'The rules this routine uses are as follows:
    ' 1) Start at the top of the file.
    ' 2) Scan through each line; if the current line starts with a comment,
    '      advance to the next line..
    ' 3) If we are currently in a group comment block, keep advancing until
    '     the end of the block is found.
    ' 4) If we are in a line item comment (e.g.: //, ', rem, etc), keep advancing
    '     until a line that does not start with a comment is found.
    '     By 'start with a comment', it is meant a line, where after
    '     stripping off spaces and tabs from the beginning, the first set of
    '     characters is not a comment delimiter.
    ' 5) Insert a blank line; this allows the next invocation of this macro
    '     to place the newer revision mark before all others.
    ' 6) Insert the revision block.

    'Change this to the programmer's name for a default.
    DefaultUserName = "..."

    'Because the user may not have closed a comment (e.g. a /* without a */),
    ' try to protect ourselves from an infinite loop...
    BreakAfter = 10 'Max number of lines to look at scan before aborting
    CurrentCount = 1

    BeginComment = "" 'The token for the specified language for the beginning
                        ' of a comment.
    EndComment = ""   'Same, except for the end of a comment.
    EveryLine = ""    'Does the comment mark need to be placed on every line
                        ' (VBS, DEF types)?

    'First, make sure the active document is a text window
    ' (Not really necessary, but good practice).
    If ActiveDocument.Type = "Text" Then
        TypeOfFile = FileType(ActiveDocument)

        'Set ourselves at the very top of the document.
        'This also clears any selection made.
        ActiveDocument.Selection.StartOfDocument
        ActiveDocument.Selection.SelectLine
        CurrText = ActiveDocument.Selection
        CurrText = LTrim(CurrText)

        'All of the following do relatively the same thing,
        ' except they look for different comment types.
        If TypeOfFile > 0 And TypeOfFile < 5 Then       'C/C++ family of code
            ContSearch = True
            BeginComment = "/*"
            EndComment = "*/"
            EveryLine = " "

            'In C/C++ style code, we need to look for a //;
            '  if not found, then look for a /*.
            Do
                ActiveDocument.Selection = CurrText
                If InStr(CurrText, "//") = 1 Then   'is a "//" available?
                    ActiveDocument.Selection.SelectLine
                    CurrText = LTrim(ActiveDocument.Selection) 'Remove whitespace.
                    ContSearch = False   ' Looking at // style comments,
                                            'don't look for a /* style.
                Else
                    Exit Do
                End If
            Loop

            If ContSearch = False Then
                ActiveDocument.Selection.LineUp
            End If

            'When the method ActiveDocument.Selection.SelectLine is called,
            '  it is the same as when you click the mouse in the margin; it
            '  selects the whole line, including the carriage return.
            '  Because of this, the cursor comes down to the next line, which
            '  can really confuse this algorithm. So in a number of places,
            '  you will see a grouping of LineUp/LineDown commands. By executing
            '  these commands, the cursor is moved down, which clears the current
            '  selection (including getting us past the carriage return),
            '  then moves us back up, thus putting us on the same line. This
            '  removesthe danger of skipping a line (which is what will
            '  happen without the LineUp/LineDown combination).
            If ContSearch = True Then
                ActiveDocument.Selection.StartOfDocument
                'Prime the loop with the first line.
                ActiveDocument.Selection.SelectLine
                CurrText = ActiveDocument.Selection
                ActiveDocument.Selection.LineDown
                ActiveDocument.Selection.LineUp
                'Remove leading whitespace.
                CurrText = LTrim(CurrText)
                'Does line start with a /*?
                If InStr(CurrText,"/*") = 1 Then
                    while (InStr(CurrText, "*/") = 0) And _
                          (BreakAfter > CurrentCount)
                        ActiveDocument.Selection.SelectLine
                        CurrText = ActiveDocument.Selection
                        CurrText = LTrim(CurrText)
                        ActiveDocument.Selection.LineDown
                        ActiveDocument.Selection.LineUp
                        CurrentCount = CurrentCount + 1
                    wend
                    If (BreakAfter > CurrentCount) Then
                        'Exit the loop because the search has gone on for an
                        '  unreasonable number of lines.
                        MsgBox "Could not find a closing comment mark"
                    End If
                End If
            End If

        'The code for these is really just a copy of that from the
        '  C/C++ section...

        ElseIf TypeOfFile = 5 Then                      'HTML code
            BeginComment = "<!--"
            EndComment = "-->"
            EveryLine = "    "
            If InStr(CurrText,"<!--") = 1 Then
                If InStr(CurrText,"-->") <> 0 Then
                    ActiveDocument.Selection.LineDown
                Else
                    Do
                        ActiveDocument.Selection.SelectLine
                        CurrText = ActiveDocument.Selection
                        CurrText = Left(CurrText, Len(CurrText) - 2)
                        ActiveDocument.Selection = CurrText + vbLf
                        If InStr(CurrText, "-->") Then
                            Exit Do
                        End If
                    Loop
                End If
            End If

        ElseIf TypeOfFile = 6 Then                      'VBS code
            BeginComment = "'"
            EndComment = "'"
            EveryLine = "'"
            Do
                ActiveDocument.Selection = CurrText
                If InStr(CurrText, "'") = 1 Or _
                   InStr(LCase(CurrText), "Rem") = 1 Then
                    ActiveDocument.Selection.SelectLine
                    CurrText = LTrim(ActiveDocument.Selection)
                    ContSearch = False
                Else
                    Exit Do
                End If
            Loop
            If ContSearch = False Then
                ActiveDocument.Selection.LineUp
            End If

        ElseIf TypeOfFile = 7 Then                      'DEF code
            BeginComment = ";"
            EndComment = ""
            EveryLine = ";"
            Do
                ActiveDocument.Selection = CurrText
                If InStr(CurrText, ";") = 1 Then
                    ActiveDocument.Selection.SelectLine
                    CurrText = LTrim(ActiveDocument.Selection)
                    ContSearch = False
                Else
                    Exit Do
                End If
            Loop
            If ContSearch = False Then
                ActiveDocument.Selection.LineUp
            End If
        End If

        If TypeOfFile = 0 Then                          'Unknown type of code.
            MsgBox("Unable to add revision marks. Unrecgonized file type")
        ElseIf (CurrentCount < BreakAfter) Then
            'The BeginComment, EveryLine, and EndComment were set as
            ' avoid duplicating this section...
            ' just insert the generalized block, with the comment markers.
            ActiveDocument.Selection.StartOfLine(True)
            'This is added with one assignment statement, which enables the user
            ' to hit undo once, and remove the entire change.
            ActiveDocument.Selection = vbLf + _
            BeginComment + "***********************************" + vbLf + _
            EveryLine    + " REVISION LOG ENTRY" + vbLf + _
            EveryLine    + " Revision By: " + DefaultUserName + vbLf + _
            EveryLine    + " Revised on " + CStr(Now) + vbLf + _
            EveryLine    + " Comments: ..." + vbLf + _
            EveryLine    + "***********************************" + _
            EndComment + vbLf + vbLf
        End If
    End If
End Sub


Sub CloseExceptActive ()
'DESCRIPTION: Closes all editor windows except the current one.

    'Windows.Item(1) is always the currently active window. So to close all
    ' the windows except the active one, keep looping until there is no
    ' longer a Windows.Item(2).
    do while Windows.Count > 1
        Windows.Item(2).Close(dsSaveChangesPrompt)
    Loop
End Sub


Sub CommentOut ()
'DESCRIPTION: Comments out a selected block of text.
    Dim win
    set win = ActiveWindow
    if win.type <> "Text" Then
      MsgBox "This macro can only be run when a text editor window is active."
    else
        TypeOfFile = FileType(ActiveDocument)
        If TypeOfFile > 0 And TypeOfFile < 5 Then    'C & Java use the same
                                                        'style of comments.
            ActiveDocument.Selection = "/*" + ActiveDocument.Selection + "*/"
        ElseIf TypeOfFile = 5 Then
            ActiveDocument.Selection = "<!-- " + ActiveDocument.Selection + " -->"
        ElseIf TypeOfFile = 6 Or TypeOfFile = 7 Then
            'There is no group comment like there is in the other file types,
            'so we need to iterate through each line, and prepend a ' to the line.
            'Also, because VBS/DEF does not have a 'end the comment at this
            'particular column' delimiter, entire lines of code must be
            'commented out, not sections.
            If TypeOfFile = 6 Then
                CommentType = " ' "
            Else
                CommentType = " ; "
            End If

            StartLine = ActiveDocument.Selection.TopLine
            EndLine = ActiveDocument.Selection.BottomLine
            If EndLine < StartLine Then
                Temp = StartLine
                StartLine = EndLine
                EndLine = Temp
            End If

            If EndLine = StartLine Then
                ActiveDocument.Selection = CommentType + ActiveDocument.Selection

            Else
                For i = StartLine To EndLine
                    ActiveDocument.Selection.GoToLine i
                    ActiveDocument.Selection.SelectLine
                    ActiveDocument.Selection = CommentType + _
                        ActiveDocument.Selection
                Next
            End If
        Else
            MsgBox("Unable to comment out the highlighted text" + vbLf + _
                    "because the file type was unrecognized." + vbLf + _
                    "If the file has not yet been saved, " + vbLf + _
                    "please save it and try again.")
        End If
    End If
End Sub


Sub MultiplePaste ()
'DESCRIPTION: Performs a paste of what is on the clipboard a multiple number of times.

    NumPastes = InputBox("Number of pastes to make", "Multiple Paste Macro",_
                         "1")
    For i = 1 To CInt(NumPastes)
        ActiveDocument.Selection.Paste
        'Because the selection remains active, the following two lines
        'clear the selection, while keeping the cursor in the same place.
        ActiveDocument.Selection.LineUp
        ActiveDocument.Selection.LineDown
        ActiveDocument.Selection = vbLf
    Next
End Sub


Sub PrintAllOpenDocuments ()
'DESCRIPTION: Prints all open, active documents.

    'Small, quick macro, but it can be usefull.
    for each doc in Application.Documents
        Doc.PrintOut
    next
End Sub


Sub PoundDefOut (ifndef)
    If ifndef = true Then
        PoundType = "#ifndef "
    Else
        PoundType = "#ifdef "
    End If

    If FileType(ActiveDocument) <> 1 Then
        MsgBox ("This macro only works on" + vbLf + _
                ".c, .cpp, .cxx, .h, .hpp, or .hxx files")
    Else
        ControlVarName = InputBox("What should the control variable be?" + _
            vbLf + vbLf + "Example: #ifdef ControlVariable", PoundType + _
            " out a section of code")
        OK = True
        If ValidId (ControlVarName) = False Then
            Ok = False
            MsgBox("""" + ControlVarName + """" + _
                " is not a valid C identifier." + _
                vbLf + "please re-run the macro with a valid C identifier")
        End If


        Sel = ActiveDocument.Selection
        For i = 1 To Len(Sel) - 1
            If Mid(Sel, i, 1) = vbLf Then
                Sel = Left(Sel,i) + vbTab + Right(Sel, Len(Sel)-i)
            End If
        Next
        If ControlVarName <> "" And Ok = True Then
            Sel = vbLf + PoundType + ControlVarName + vbLf + vbTab + Sel + _
                vbLf+ "#endif //" + ControlVarName
            If Right(Sel,1) <> vbLf Then
                Sel = Sel + vbLf
            End If
            ActiveDocument.Selection = Sel
        End If
    End If
End Sub

'The next two macros are exactly the same, except one uses ifndef and the
'  other ifdef. We recycle the same code and just use a different
'  preprocessor directive.
Sub ifdefOut ()
'DESCRIPTION: #ifdef / #endif out a section of code.

    PoundDefOut (False)
End Sub

Sub ifndefOut ()
'DESCRIPTION: #ifndef / #endif out a section of code.

    PoundDefOut (True)
End Sub

'Allows the user to make sure the current header file is included only once.
' There are two ways to do this, using the #pragma once directive or
' surrounding the entire file in a #ifndef/#endif structure. The first way
' is much cleaner, but it is VC++ specific, and therefore not portable. If
' you plan on compiling your code with other compilers, use the
' #ifndef/#endif method, otherwise, the #pragma once option is preferrable.
Sub OneTimeInclude ()
'DESCRIPTION: Adds code to the current header file so it is included only once per c/cpp file.

    ext = ActiveDocument.Name
    If ext = "" Then
        If MsgBox("The file you are working with does not have a file extension." + _
                vbLF + "Are you sure this is a C/C++ header file?", 4) = vbCancel Then
            Exit Sub
        End If
        ext = "nofilenamegiven.h"
    End If
    DocName = UCase(ext)
    pos = Instr(ext, ".")
    Do While pos <> 1
        ext = Mid(ext, pos, (Len(ext) - pos + 1))
        pos = Instr(ext, ".")
    Loop
    ext = LCase(ext)
    pos = Instr(DocName, ".")
    If ext = ".h" Or ext = ".hpp" Then
        'Warn user that this will not work with a compiler other than VC++.
        If MsgBox("This macro uses the Visual C++ dependant #pragma once" + _
                vbLf + "Is the source to be portable across compilers?", 4) _
                = 6 Then
            ActiveDocument.Selection.StartOfDocument (False)
            Examp = "__" + Left(DocName, pos - 1) + "_" + _
                UCase(Right(ext, len(ext) - 1)) + "__"
            ControlVarName = InputBox("What should the control variable be?" _
                + vbLf + vbLf + "Example: #ifdef " + _
                Examp, "One time header include protection", Examp)
            If ValidId (ControlVarName) = True Then
                ActiveDocument.Selection = "#ifndef " + ControlVarName + _
                    vbLf + "#define " + ControlVarName + vbLf
                ActiveDocument.Selection.EndOfDocument(False)
                ActiveDocument.Selection = vbLf + "#endif //" + _
                    ControlVarName
            Else
                MsgBox(ControlVarName + " is not a valid c identifier." + _
                vbLf + "please re-run the macro with a valid C identifier")
            End If
        Else
            ActiveDocument.Selection.StartOfDocument(False)
            ActiveDocument.Selection = "#pragma once" + vbLf + vbLf
        End If
    Else
        MsgBox("This macro can only be run on .h or .hpp files")
    End If
End Sub



'Auto completion macro
Dim previousSelection
Dim completionWords
Dim completionWordsIndex

Sub AddToCompletionWords (word)
    ' If the word is already there, abort
    if InStr(1, completionWords, " " & word & " ", 1) <> 0 Then
        Exit Sub
    End If

    completionWords = completionWords & word & " "
End Sub

Function ExtractNextCompletionWord()
    ExtractNextCompletionWord = ""

    ' If no words yet, go away
    if Len(completionWords) <= 1 Then
        Exit Function
    End If

    ' Wrap to beginning if necessary
    if completionWordsIndex > Len(completionWords) Then
        completionWordsIndex = 2
    End If

    ' Find next <space>
    Dim newIndex
    newIndex = InStr (completionWordsIndex, completionWords, " ", 0)
    if newIndex = 0 Then
        Exit Function
    End If

    ExtractNextCompletionWord = Mid(completionWords, completionWordsIndex, _
        newIndex-completionWordsIndex)
    completionWordsIndex = newIndex+1        'Skip over <space>
End Function

Sub FillCompletionWords (word)
    ' Find all words in this file which match word, and
    '  add them, space separated, into completionWords
    previousSelection = word
    completionWords = " "
    completionWordsIndex = 2
    dim sel
    set sel = ActiveDocument.Selection

    Dim searchString
    searchString = "\{^\![^a-zA-Z0-9]\}" & word
    Dim firstTime
    firstTime = True
    Dim firstLine, firstCol
    Do while sel.FindText (searchString, dsMatchBackward + dsMatchRegExp)
        if firstTime Then
            firstLine = sel.TopLine
            firstCol = sel.CurrentColumn
            firstTime = False
        ElseIf firstLine = sel.TopLine And firstCol = sel.CurrentColumn Then
            Exit Do        ' Jump out of loop before repeat
        End If
        sel.WordRight
        sel.WordLeft dsExtend
        AddToCompletionWords Trim(sel.text)
        sel.Cancel
    Loop
End Sub

Function SuggestNextCompletionWord()
    SuggestNextCompletionWord = True
    Dim word
    word = ExtractNextCompletionWord()
    if word <> "" then
        ActiveDocument.Selection = word
        previousSelection = word
    end if
End Function

Sub AutoCompleteFromFile()
'DESCRIPTION: Looks through the active file, searching for the rest of the word that you began to type.
    Dim doc
    set doc = ActiveDocument

    ' Be sure active document is a text document
    if doc Is Nothing Then
        Exit Sub
    elseif doc.Type <> "Text" Then
        Exit Sub
    End If

    ' Get word to be completed
    Dim sel
    set sel = doc.Selection
    sel.Cancel
    dim origLine, origCol
    origLine = sel.TopLine
    origCol = sel.CurrentColumn
    sel.WordLeft dsExtend

    'If the cursor is sitting just to the right of a space, an infinite loop
    'results. This bit of code protects from that:
    if Right(sel, 1) = " " then
        sel.CharRight
        Exit Sub
    end If

    if sel <> previousSelection Or completionWords = "" Then
        FillCompletionWords sel
        sel.MoveTo origLine, origCol
        sel.WordLeft dsExtend
    End If

    SuggestNextCompletionWord

End Sub