scheib.vb

Imports EnvDTE
Imports System
Imports System.Diagnostics
Imports System.Windows.Forms
Imports System.Collections.Generic

'------------------------------------------------------------------------------
'FILE DESCRIPTION: scheib.vb Vincent Scheib's macros
'------------------------------------------------------------------------------

Public Module scheib

    '_______________________________________________________________________________
    Sub InsertCommentBars()
        'DESCRIPTION: Creates a comment block 
        Dim Descr As String

        Descr = "//---------------------------------------------------------------------------" + vbLf

        ActiveDocument.Selection().text = Descr
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentPrefix(ByVal StrPrefix)
        'DESCRIPTION: Inserts this text at the cursor, or if there is a selection, prefixes lines with it.
        'By Vincent Scheib

        Dim win
        win = ActiveWindow
        If win.Kind <> "Document" Then
            MsgBox("This macro can only be run when a text editor window is active.")
        Else

            If Len(ActiveDocument.Selection().text) = 0 Then
                'Insert the text here
                ActiveDocument.Selection().text = StrPrefix

            Else
                'Prefix lines with text

                Dim StartLine = ActiveDocument.Selection.TopPoint.Line
                Dim EndLine = ActiveDocument.Selection.BottomPoint.Line

                Dim i
                For i = StartLine To EndLine
                    ActiveDocument.Selection.GoToLine(i)

                    ActiveDocument.Selection().text = StrPrefix + ActiveDocument.Selection().text
                Next

            End If
        End If
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentVES()
        InsertCommentPrefix("//VES: ")
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentX()
        InsertCommentPrefix("//VES:X ")
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentBang()
        InsertCommentPrefix("//VES:! ")
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentDebug()
        InsertCommentPrefix("//VES:DEBUG ")
    End Sub

    '_______________________________________________________________________________
    Sub InsertCommentTodo()
        InsertCommentPrefix("//TODO vscheib ")
    End Sub

    '_______________________________________________________________________________
    Sub InsertDate()
        Dim ThisMonth As String
        Dim ThisDate As String

        Select Case Month(Now())
            Case 1 : ThisMonth = "January"
            Case 2 : ThisMonth = "February"
            Case 3 : ThisMonth = "March"
            Case 4 : ThisMonth = "April"
            Case 5 : ThisMonth = "May"
            Case 6 : ThisMonth = "June"
            Case 7 : ThisMonth = "July"
            Case 8 : ThisMonth = "August"
            Case 9 : ThisMonth = "September"
            Case 10 : ThisMonth = "October"
            Case 11 : ThisMonth = "November"
            Case 12 : ThisMonth = "December"
        End Select

        ThisDate = ThisMonth + " " & Microsoft.VisualBasic.DateAndTime.Day(Now) & " " & Year(Now())

        ActiveDocument.Selection().text = ThisDate
    End Sub

    '_______________________________________________________________________________
    Sub FindActiveFileInSolution()
        'DESCRIPTION: Highlights the currently active document in the solution explorer (toggles file tracking on then off)
        'Get a reference to the Command window.
        Dim win As EnvDTE.Window = DTE.Windows.Item(EnvDTE.Constants.vsWindowKindCommandWindow)
        Dim CW As EnvDTE.CommandWindow = win.Object
        Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar

        Try
            'Input a command into the Command window and execute it.
            CW.SendInput("View.TrackActivityinSolutionExplorer true", True)
            CW.SendInput("View.TrackActivityinSolutionExplorer false", True)
            TheStatusBar.Text = "Found."
        Catch
            TheStatusBar.Text = "Failed. Check that a document active and selected..."
            TheStatusBar.Highlight(True)
        End Try
    End Sub

    '_______________________________________________________________________________
    'Sub FindNextLongLine(ByVal bStartAtTop As Boolean = False)
    Sub FindNextLongLine(Optional ByVal bStartAtTop As Boolean = False)
        'DESCRIPTION: Finds next line down from cursor that is too long.
        'By Vincent Scheib

        'CONFIGURE: set the maximum line length
        Dim iMaxLength = 79

        Dim win
        win = ActiveWindow
        If win.Kind <> "Document" Then
            MsgBox("This macro can only be run when a text editor window is active.")
        Else

            ' Setup status bar
            Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar

            Dim StartLine = ActiveDocument.Selection.TopPoint.Line


            Dim iLine
            If bStartAtTop Then
                iLine = 1
            Else
                iLine = StartLine
            End If

            Do
                Try ' Try moving to next line
                    ActiveDocument.Selection.GoToLine(iLine)
                Catch
                    ' We have reached end of document
                    ActiveDocument.Selection.GoToLine(StartLine)
                    TheStatusBar.Text = "Did not find a line too long."
                    TheStatusBar.Highlight(True)
                    Exit Do
                End Try

                Dim length = ActiveDocument.Selection.TopPoint.LineLength
                If (length > iMaxLength) Then
                    ActiveDocument.Selection.SelectLine()
                    TheStatusBar.Text = "Line " + iLine.ToString() + " length: " + length.ToString()
                    Exit Do
                End If

                iLine = iLine + 1
            Loop
        End If
    End Sub

    '_______________________________________________________________________________
    Sub FindFirstLongLine()
        'DESCRIPTION: Finds first line in a document that is too long.
        'By Vincent Scheib

        FindNextLongLine(True)
    End Sub

    '_______________________________________________________________________________
    Sub ShowDebugWindows()
        'DESCRIPTION: Opens commonly used debug windows
        DTE.ExecuteCommand("Debug.Watch")
        DTE.ExecuteCommand("Debug.Locals")
        DTE.ExecuteCommand("Debug.Autos")
        DTE.ExecuteCommand("Debug.Threads")
        DTE.ExecuteCommand("View.Output")
    End Sub

    '_______________________________________________________________________________
    Dim ClipboardString As String
    Sub CopyFilenameToClipboard()
        'DESCRIPTION: Copies the selected solution item or active file's pathname to the windows clipboard
        'By Vincent Scheib

        Dim names As List(Of String) = GetSelectedSolutionItemFilenames()
        If (names.Count >= 1) Then
            ClipboardString = names(0)
        Else
            ClipboardString = ActiveDocument.FullName
        End If

        Dim ClipBoardThread As System.Threading.Thread = New System.Threading.Thread(AddressOf _CopyToClipboard_ThreadProcedure)
        With ClipBoardThread
            .ApartmentState = System.Threading.ApartmentState.STA
            .IsBackground = True
            .Start()
            '-- Wait for copy to happen
            .Join()
        End With
        ClipBoardThread = Nothing

        ' Setup status bar
        Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
        TheStatusBar.Text = "Copied active document filename to clipboard."
        TheStatusBar.Highlight(True)
    End Sub
    Sub _CopyToClipboard_ThreadProcedure()
        System.Windows.Forms.Clipboard.SetDataObject(ClipboardString, True)
    End Sub

    Sub P4add()
        'DESCRIPTION: Adds active document or selected solution items to perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4 add """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
        Next
    End Sub

    Sub P4revert()
        'DESCRIPTION: Reverts active document or selected solution items in perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4 revert """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
        Next
    End Sub

    Sub P4delete()
        'DESCRIPTION: Deletes active document or selected solution items in perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4 delete """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
        Next
    End Sub

    Sub P4edit()
        'DESCRIPTION: Opens active document or selected solution items for edit in perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4 edit """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
        Next
    End Sub

    Sub P4diff()
        'DESCRIPTION: Diffs active document or selected solution items in perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4 diff """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
        Next
    End Sub

    Sub P4history()
        'DESCRIPTION: Displays history of active document or selected solution items in perforce
        For Each name As String In GetSelectedSolutionItemFilenames()
            Shell("cmd /c (p4win -H """ + name + """ )", AppWinStyle.NormalFocus)
            ' pause not performed on this command because it will never return useful error text.
        Next
    End Sub

    Function GetSelectedSolutionItemFilenames() As List(Of String)
        Dim names As List(Of String) = New List(Of String)
        For Each selectedItem As EnvDTE.SelectedItem In DTE.SelectedItems
            Dim Found = False
            Try ' to get project filename
                If Not names.Contains(selectedItem.Project.FullName) Then
                    names.Add(selectedItem.Project.FullName)
                End If
                Found = True
            Catch
                Try ' to get project items filenames
                    For i As Short = 1 To selectedItem.ProjectItem.FileCount()
                        If (selectedItem.ProjectItem.FileNames(i).Length > 0) Then
                            If Not names.Contains(selectedItem.ProjectItem.FileNames(i)) Then
                                names.Add(selectedItem.ProjectItem.FileNames(i))
                            End If
                            Found = True
                        End If
                    Next i
                Catch
                End Try
            End Try
            If Not Found Then
                ' Determine if solution is selected and get filename.
                If DTE.Solution.FullName.Contains(selectedItem.Name + ".sln") Then
                    If Not names.Contains(DTE.Solution.FullName) Then
                        names.Add(DTE.Solution.FullName)
                    End If
                End If
            End If
        Next
        If names.Count = 0 Then
            MsgBox("No active document or selcted items. Try turning on the following option:" + vbLf + vbLf + "Tools->Options->Environment->Documents->Show Miscelaneous Files in Solution Explorer")
        End If
        Return names
    End Function


    '_______________________________________________________________________________
    Sub HeaderFlip()
        'DESCRIPTION: Flips between .h .cpp ... files
        'By Vincent Scheib

        'Searches open documents, the solution file list, and files on disk

        'CONFIGURE: add extensions to flip between here, in the order to flip
        Dim extensions() As String
        Dim extensionsCpp() As String = {".h", ".inc", ".inl", ".hpp", ".cpp"}
        Dim extensionsCs() As String = {".designer.cs", ".cs", ".resx"} ' prefer longer extention match

        ' Setup status bar
        Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
        TheStatusBar.Text = "Searching for a header flip..."

        Dim numExtensionsCpp = extensionsCpp.GetLength(0)
        Dim numExtensionsCs = extensionsCs.GetLength(0)

        Dim activeDoc = ActiveDocument.Name
        Dim activePath = ActiveDocument.Path

        ' Determine current extension
        Dim indexForActiveFileExtension As Integer = -1

        ' Check Cpp
        For I As Integer = 0 To numExtensionsCpp - 1
            Dim extension = extensionsCpp(I)
            If InStr(activeDoc, extensionsCpp(I)) Then
                indexForActiveFileExtension = I
                extensions = extensionsCpp
                Exit For
            End If
        Next

        ' Check Cs
        For I As Integer = 0 To numExtensionsCs - 1
            Dim extension = extensionsCs(I)
            If InStr(activeDoc, extensionsCs(I)) Then
                indexForActiveFileExtension = I
                extensions = extensionsCs
                Exit For
            End If
        Next

        ' Check for error
        If indexForActiveFileExtension = -1 Then
            TheStatusBar.Text = "Could not header flip: don't recognize active file's extension."
            TheStatusBar.Highlight(True)
            Return
        End If

        Dim numExtensions = extensions.GetLength(0)
        Dim numExtensionsToTry = numExtensions - 1
        Dim switchToDocs(numExtensionsToTry - 1) As String

        ' Populate list of filenames to switch to
        Dim activeDocExtLen = Len(extensions(indexForActiveFileExtension))
        Dim activeDocBase = Left(activeDoc, Len(activeDoc) - activeDocExtLen)
        For I As Integer = 0 To numExtensionsToTry - 1
            Dim extension = extensions((indexForActiveFileExtension + I + 1) Mod numExtensions)
            switchToDocs(I) = activeDocBase + extension
        Next

        ' Try the files:
        For Each switchToDoc As String In switchToDocs

            ' Try to switch to already open file (with full path name match)
            If (TrySwitchTo_OpenFile_FullName(activePath + switchToDoc)) Then
                TheStatusBar.Text = ""
                Return
                ' Try to open file from projects (with full path name match)
            ElseIf (TrySwitchTo_ProjectFile(activePath + switchToDoc)) Then
                TheStatusBar.Text = ""
                Return
                ' Try to open file from disk from same path
            ElseIf (TryOpen(activePath + switchToDoc)) Then
                TheStatusBar.Text = ""
                Return
                ' Try to open file from projects (any path)
            ElseIf (TrySwitchTo_ProjectFile(switchToDoc)) Then
                TheStatusBar.Text = ""
                Return
                ' Try to switch to already open file (any path)
            ElseIf (TrySwitchTo_OpenFile_Name(switchToDoc)) Then
                TheStatusBar.Text = ""
                Return
            End If
        Next

        TheStatusBar.Text = "Failed to find any file to flip to."
        TheStatusBar.Highlight(True)
    End Sub







    Sub SelectDependentProjects()
        'DESCRIPTION: Step 1 of 2 for setting dependencies on projects 
        DependsHelp.SelectedProjects = GetSelectedProjects()
        Dim OutputString As String
        OutputString = DependsHelp.SelectedProjects.Count.ToString
        OutputString += " Selected Projects:" + vbLf
        OutputString += GetStringOfEachProject(DependsHelp.SelectedProjects)
        MsgBox(OutputString)
    End Sub

    Sub SelectDependeeProjects_AssignDependencies()
        'DESCRIPTION: Step 2 of 2 for setting dependencies on projects 
        If DependsHelp.SelectedProjects Is Nothing Then
            MsgBox("You must first select projects to have dependencies set on, with SelectDependentProjects macro")
            Return
        End If

        Dim DependentProjs As List(Of EnvDTE.Project) = DependsHelp.SelectedProjects
        Dim DependeeProjs As List(Of EnvDTE.Project) = GetSelectedProjects()

        Dim OutputString As String
        OutputString = "Are you sure you want to set" + vbLf + vbLf
        OutputString += DependentProjs.Count.ToString + " Projects:" + vbLf
        OutputString += GetStringOfEachProject(DependentProjs) + vbLf + vbLf

        OutputString += "As dependent upon" + vbLf + vbLf
        OutputString += DependeeProjs.Count.ToString + " Projects:" + vbLf
        OutputString += GetStringOfEachProject(DependeeProjs) + vbLf + vbLf

        If MsgBox(OutputString, MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then
            Return
        End If

        For Each Dependent As EnvDTE.Project In DependentProjs
            For Each Dependee As EnvDTE.Project In DependeeProjs
                Try
                    DTE.Solution.SolutionBuild.BuildDependencies.Item(Dependent).AddProject(Dependee.UniqueName)
                Catch ex As System.Exception
                    Dim Result As Microsoft.VisualBasic.MsgBoxResult
                    Result = MsgBox("Failed to add dependency: " + vbLf _
                    + "Dependent: " + Dependent.Name + vbLf _
                    + "on" + vbLf _
                    + "Dependee: " + Dependee.Name + vbLf + vbLf _
                    + "Error is:" + vbLf + ex.Message + vbLf + vbLf _
                    + "CONTINUE????", MsgBoxStyle.YesNo)
                    If Result = MsgBoxResult.No Then
                        Return
                    End If
                End Try
            Next
        Next
        MsgBox("Done.")
    End Sub

End Module


Module HeaderFlipHelp
    'DESCRIPTION: Helper functions for HeaderFlip
    'By Vincent Scheib

    '_______________________________________________________________________________
    Function TrySwitchTo_OpenFile_FullName(ByVal filename As String) As Boolean
        For Each tryDocument As Document In DTE.Documents
            Try
                If tryDocument.FullName = filename Then
                    tryDocument.Activate()
                    Return True
                End If
            Catch
            End Try
        Next
        Return False
    End Function

    '_______________________________________________________________________________
    Function TrySwitchTo_OpenFile_Name(ByVal filename As String) As Boolean
        For Each tryDocument As Document In DTE.Documents
            Try
                If tryDocument.Name = filename Then
                    tryDocument.Activate()
                    Return True
                End If
            Catch
            End Try
        Next
        Return False
    End Function

    '_______________________________________________________________________________
    Function TrySwitchTo_ProjectFile(ByVal filename As String) As Boolean
        Try
            Dim item As ProjectItem = DTE.Solution.FindProjectItem(filename)
            item.Open()
            item.Document.Activate()
            Return True
        Catch
        End Try
        Return False
    End Function
    '_______________________________________________________________________________
    Function TryOpen(ByVal filename As String) As Boolean
        Try
            DTE.Documents.Open(filename, "Text")
            Return True
        Catch
            Try
                DTE.ItemOperations.OpenFile(filename)
                Return True
            Catch
            End Try
        End Try
        Return False
    End Function
End Module

Public Module DependsHelp
    Public SelectedProjects As List(Of EnvDTE.Project)

    Function GetSelectedProjects() As List(Of EnvDTE.Project)
        Dim projs As List(Of EnvDTE.Project) = New List(Of EnvDTE.Project)
        For Each selectedItem As EnvDTE.SelectedItem In DTE.SelectedItems
            Try ' to get projects
                If Not selectedItem.Project Is Nothing Then
                    If Not projs.Contains(selectedItem.Project) Then
                        projs.Add(selectedItem.Project)
                    End If
                End If
            Catch
            End Try
        Next
        Return projs
    End Function

    Function GetStringOfEachProject(ByVal ProjectsList As List(Of EnvDTE.Project)) As String
        Dim OutputString As String = ""
        For Each proj As EnvDTE.Project In ProjectsList
            If OutputString.Length > 0 Then ' add new line
                OutputString += vbLf
            End If
            OutputString += "  " + proj.Name
        Next
        Return OutputString
    End Function
End Module