'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' InterestingThread - John Robbins (c) 2009 - john@wintellect.com
' A set of macros that make debugging multithreaded programs easier.
'
' Version 1.0 - July 11, 2009
'   - Initial version. 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports System.Diagnostics
Imports System.Text
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Public Module InterestingThread
    ' The caption for all message boxes.
    Private Const captionTitle As String = _
                                        "Wintellect Interesting Thread Macros"
    ' The Filter set on breakpoints.
    Private Const k_THREADFILTER As String = "ThreadName == InterestingThread"
    ' For all breakpoints, sets the Filter to "ThreadName == InterestingThread"
    Public Sub SetAllBreakpointsToInterestingThreadFilter()
        Dim currBP As EnvDTE80.Breakpoint2
        For Each currBP In DTE.Debugger.Breakpoints
            ' Only set the filter if it's empty.
            If (String.IsNullOrEmpty(currBP.FilterBy) = True) Then
                currBP.FilterBy = k_THREADFILTER
            End If
        Next
    End Sub
    ' For all breakpoints, clears the Filter if it's set to 
    ' "ThreadName == InterestingThread"
    Public Sub ClearAllBreakpointInterestingThreadFilters()
        Dim currBP As EnvDTE80.Breakpoint2
        For Each currBP In DTE.Debugger.Breakpoints
            If (String.Compare(currBP.FilterBy, k_THREADFILTER) = 0) Then
                currBP.FilterBy = String.Empty
            End If
        Next
    End Sub
    ' Sets a breakpoint on the current source code line with the Filter set
    ' to "ThreadName == InterestingThread"
    Public Sub SetInterestingThreadBreakpoint()
        ' There has to be a document open for things to work.
        Dim currDoc As Document = GetCurrentDocument()
        If (currDoc Is Nothing) Then
            Exit Sub
        End If
        ' Get the cursor location. I'll make my setter behave the same
        ' way as when you have a selection and press F9, which will
        ' set a breakpoint on the top part of the selection. However,
        ' unlike F9 breakpoints, I won't clear the selection after
        ' setting the breakpoint.
        Dim txtSel As TextSelection = currDoc.Selection
        Dim point As VirtualPoint = txtSel.TopPoint
        Try
            Dim bps As EnvDTE.Breakpoints = DTE.Debugger.Breakpoints.Add( _
                                                File:=currDoc.FullName, _
                                                Line:=point.Line, _
                                                Column:=point.DisplayColumn)
            ' There's no way to set the filter property when adding a 
            ' breakpoint so you have to do it after the file and line 
            ' breakpoint is set.
            Dim newBP As EnvDTE80.Breakpoint2
            For Each newBP In bps
                newBP.FilterBy = k_THREADFILTER
            Next
        Catch ex As COMException
            ErrorMessage(ex.Message)
        End Try
    End Sub
    Private Function GetCurrentDocument() As Document
        ' Check to see if a project or solution is open.  If not, you
        ' can't get at the code model for the file.
        Dim projs As System.Array = CType(DTE.ActiveSolutionProjects, Array)
        If (projs.Length = 0) Then
            ErrorMessage("You must have a project open.")
            GetCurrentDocument = Nothing
            Exit Function
        End If
        ' Getting the active document is a little odd.  
        ' DTE.ActiveDocument will return the active code document, but
        ' it might not be the real ACTIVE window.  It's quite 
        ' disconcerting to see macros working on a document when you're
        ' looking at the Start Page.  Anyway, I'll ensure the active 
        ' document is really the active window.
        Dim currWin As Window = DTE.ActiveWindow
        Dim currWinDoc As Document = currWin.Document
        Dim currDoc As Document = DTE.ActiveDocument
        ' Gotta play the game to keep from null ref exceptions in the 
        ' real active doc check below.
        Dim winDocName As String = String.Empty
        If Not (currWinDoc Is Nothing) Then
            winDocName = currWinDoc.Name
        End If
        Dim docName As String = "x"
        If Not (currDoc Is Nothing) Then
            docName = currDoc.Name
        End If
        If ((currWinDoc Is Nothing) And _
            (winDocName <> docName)) Then
            ErrorMessage("The active cursor is not in a code document.")
            GetCurrentDocument = Nothing
            Exit Function
        End If
        ' While I might have a document, I still need to check this is
        ' one I can get a code model from.
        Dim fileMod As FileCodeModel = _
                                   currDoc.ProjectItem.FileCodeModel
        If (fileMod Is Nothing) Then
            ErrorMessage("Unable to get code model from document.")
            GetCurrentDocument = Nothing
            Exit Function
        End If
        GetCurrentDocument = currDoc
    End Function
    Private Sub ErrorMessage(ByVal text As String)
        MessageBox.Show(New MainWindow(), _
                        text, _
                        captionTitle, _
                        MessageBoxButtons.OK, _
                        MessageBoxIcon.Error)
    End Sub
    ' A helper class so I can parent message boxes correctly on the IDE.
    Class MainWindow
        Implements IWin32Window
        Public ReadOnly Property Handle() _
                            As System.IntPtr Implements IWin32Window.Handle
            Get
                ' The HWnd property is undocumented.
                Dim ret As IntPtr = DTE.MainWindow.HWnd
                Return (ret)
            End Get
        End Property
    End Class
End Module