' Original code and adaptations of ideas from other sources
' by Mel Shaline
' V05.05.15.05 Creates contiguous CSharp comment blocks for documentation purposes
' V05.03.29.09 Changed CSharp function header spacing (col 29)
' V04.11.08.18 Fixed VB.Net function formating for Handles subs
' V04.11.08.11 CS function headers with doc comments - work in progress
' V03.12.17.13 (YY.MM.DD.HH)\
' V03.12.17.13 Close all the open Tool windows
' V03.12.01.12 modified macPropertiesConvert to handle C Sharp code
' V03.11.17.04 conditionalizes region code for CS and VB
' V03.11.15.05 modified region code for CS, label header for CS
' V03.10.20.07 bug in measure line
' V03.08.20.14 added a ";" after trace statement in HtoCPP function
' V03.08.18.06 Header formating for CSharp
'---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----
' Beauty and source code formatting are items that are very much in the eye of the
' beholder. My selection of what is beauty in source code structure is motivated as a
' consequence of wanting to incorporate the following ideals:
' 1. The code should be written in a style that is easy for someone else to understand.
' 2. If possible an individual line should be capable of conveying on it own its
' functionality, impact and required arguments and type.
' 3. Consistent function, object, and variable naming conventions should be employed.
'
' Naming conventions used throughout this code.
' Hungarian prefixes are used for instantiation of all objects. Standard Hungarian naming
' lists can be found many places like FMS, and PaulSheriff and I conform to the majority
' of those. There are a few variations.
' For Booleans I use the prefix "yn". This prefix came from my early Access days and it
' cannot be confused with "b" that could be a byte or Boolean, and "f" that could be a
' flag of floating point. There is no other interpretation on "yn".
' For Floating points I use "sfp" for singles and "dfp" for doubles
'
' Before .Net all my Hungarian prefixes where two or three characters in length but with
' the profusion of objects in .Net I occasionally had to increase that to four letters.
'
' After the object data type prefix the naming of the object is typically
' "NounAdjectiveVerb". This syntax amongst other things results in sorts of functions
' by the objects on which they have an impact. It can however change some things we may
' have gotten used to, i.e.
' "GetNewObject" becomes "ObjectNewGet_obj"
' When a function returns a data type I postfix that data type to the function name. This
' results in immediately knowing the specific data type returned.
'
' NOTE: An excellant tool to do your Regex syntax testing is "Expresso" found at
' http://www12.brinkster.com/ultrapico/Expresso.htm
' The C/C++ formating section takes the Microsoft .NET Regular Expression Engine out for
' a major spin.
Imports EnvDTE
Imports System.Diagnostics
Imports System.Text.RegularExpressions
Imports System.Text ' for StringBuilder
Imports System.Exception ' for our try, catch(exception) blocks
Module Mels
Enum E_LANG_TYPE
UNKNOWN
CPP
CS
VB
IDL
RC
XML
VBMAC
DEF
TEXT
End Enum
Enum E_HDR_TYPE
NONE
FULL
PARTIAL
End Enum
Enum E_MODE
DOC
SELECTION
End Enum
Enum E_XML_TYPE
NONE
COMMENT
END_ELEMENT
SINGLE_ELEMENT
START_ELEMENT
START_XML
End Enum
Enum E_ERROR
NOT_CPP
NO_DOC_ACTIVE
NO_SELECTION
NO_XML
NOT_VB
OUT_OF_MEMORY
UNKNOWN
NOT_TYPE
End Enum
'Const XML_LANG As String = "HTML/XML"
'Const CPP_LANG As String = "C/C++"
Const REGX_OPTS_IGCASE_EXPCAP As RegexOptions = RegexOptions.IgnoreCase _
Or RegexOptions.ExplicitCapture
Const STR_VB_COMMENT As String = "'"
Const STR_CPP_COMMENT As String = "//"
Const STR_CS_COMMENT As String = "//"
Const STR_EMPTY As String = ""
Const STR_DIVIDER As String = "------------------------------------------------------------------"
Const STR_COPYRIGHT As String = "{0} Copyright (C) {1} Internation Gaming Corp{3}{0} All rights reserved.{3}{0}{3}{0} THIS CODE AND INFORMATION IS PROVIDED ""AS IS"" WITHOUT WARRANTY OF ANY KIND, EITHER{3}{0} EXPRESSED OR IMPLIED....{3}"
' Module global File TYpe Variables
Private m_strExtension As String
Private m_strComment As String
Private m_strEditor As String
'-------------------- F i l e T y p e _ e n u m --------------------
' Determines the type of the active document
' Helper function that sets up all the file type parameters
'-------------------------------------------------------------------
Private Function FileType_enum( _
ByVal doc As Document) _
As E_LANG_TYPE
Dim strExt As String
Dim s32IX As Integer
FileType_enum = E_LANG_TYPE.UNKNOWN
m_strExtension = STR_EMPTY
m_strComment = STR_EMPTY
m_strEditor = STR_EMPTY
' If (doc Is Nothing) Then Exit Function
strExt = doc.Name
s32IX = InStrRev(strExt, ".") ' Get the right most one
If (s32IX < 1) Then Exit Function
m_strEditor = doc.Language
'We could probably use the Language as out principal type indicator
' but we will use the select statement to make sure the only file
' types we operate on are the ones we have tested against
m_strExtension = LCase(Right(strExt, Len(strExt) - s32IX))
Select Case m_strExtension
Case "h", "cpp", "c"
'doc.Language = EnvDTE.Constants.dsCPP
FileType_enum = E_LANG_TYPE.CPP
m_strComment = STR_CPP_COMMENT
Case "jav", "java"
'doc.Language = EnvDTE.Constants.dsJava
FileType_enum = E_LANG_TYPE.CPP
m_strComment = STR_CPP_COMMENT
Case "cs"
FileType_enum = E_LANG_TYPE.CS
m_strComment = STR_CS_COMMENT
Case "vb", "frm", "cls"
FileType_enum = E_LANG_TYPE.VB
m_strComment = STR_VB_COMMENT
Case "odl", "idl"
'doc.Language = EnvDTE.Constants.dsIDL
FileType_enum = E_LANG_TYPE.IDL
Case "rc", "rc2"
FileType_enum = E_LANG_TYPE.RC
Case "htm", "html", "xml"
'doc.Language = EnvDTE.Constants.dsHTML_IE3
'doc.Language = EnvDTE.Constants.dsHTML_RFC1866
FileType_enum = E_LANG_TYPE.XML
'Case "cs"
' 'EnvDTE.Constants.dsVBSMacro
' FileType_enum = LANG_VBMAC
Case "def"
FileType_enum = E_LANG_TYPE.DEF
Case "txt"
FileType_enum = E_LANG_TYPE.TEXT
Case Else
FileType_enum = E_LANG_TYPE.UNKNOWN
End Select
End Function
'----------------- m a c H F u n c D e f T o C P P -----------------
' This macro uses the function definition in a .h file and formats
' it and places it in its companion CPP file.
' What we do is select the whole definition line, then parse it,
' then add the class, ship it to the .cpp file and then call
' the formating procedure to do its work
'-------------------------------------------------------------------
Sub macHFuncDefToCPP()
Dim doc As Document
Dim s32IX As Integer
Dim sbld As StringBuilder
Dim tsel As TextSelection
Dim strArgs As String
Dim strClass As String
Dim strFunc As String
Dim strLine As String
Dim strReturn As String
Dim strFile As String
Dim s32Space As Integer
Dim s32LParen As Integer
Dim strPathFile As String
Dim strPlusPlus As String
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
If (m_strExtension <> "h") Then
MsgBox("You need to have an active C/C++ header document (.h) open" + _
vbLf + "with the function prototype selected.")
Exit Sub
End If
tsel = doc.Selection
tsel.SelectLine() ' Make sure the whole line is selected
strLine = LineForParsingWash_str(tsel.Text) ' all white space is single space
If (strLine.Length = 0) Then
MsgBox("No content in the selected line")
Exit Sub
End If
'we have data, work with the line, first peel of the return type
s32Space = InStr(strLine, " ")
If (s32Space < 1) Then
strReturn = ""
Else
strReturn = Left(strLine, s32Space - 1)
End If
s32LParen = InStr(strLine, "(")
If (s32LParen < 1) Then ' bad systax of prototype
MsgBox("Bad function definition syntax")
Exit Sub
Else
strArgs = Right(strLine, Len(strLine) - (s32LParen - 1))
s32IX = InStr(strArgs, ";")
If (s32IX > 0) Then
strArgs = Left(strArgs, s32IX - 1)
End If
End If
' extract the function name out of the function definition line
strFunc = Mid(strLine, s32Space + 1, s32LParen - (s32Space + 1))
strFunc = Trim(strFunc)
'Now we want to find the "class " defintion in the file and put it
' in the line that will be the cpp def
If (tsel.FindText("class ", vsFindOptions.vsFindOptionsBackwards)) Then
tsel.CharRight()
tsel.WordRight(True)
strClass = Trim(tsel.Text)
tsel.SelectLine()
strPlusPlus = tsel.Text
strPlusPlus = "::"
Else ' class not there, must be regular C
strClass = ""
strPlusPlus = ""
End If
sbld = New StringBuilder(200)
sbld.AppendFormat("{0} {1}{2}{3}{4}{5}" _
& "{{" & "{5}" _
& " TRACE0( ""{1}{2}{3}\n"" );{5}" _
& "{5}" _
& "}} /* End of {3} */{5}", _
strReturn, _
strClass, _
strPlusPlus, _
strFunc, _
strArgs, _
vbLf)
strFile = doc.Name
s32IX = InStrRev(strFile, ".") ' Get the right most one
strFile = Left(strFile, s32IX - 1)
If (strClass <> "") Then
strPathFile = doc.Path & strFile & ".cpp"
Else
strPathFile = doc.Path & strFile & ".c"
End If
DTE.ItemOperations.OpenFile(strPathFile) ' its now the activeDocument
tsel = DTE.ActiveDocument.Selection
tsel.EndOfDocument()
tsel.Text = sbld.ToString()
tsel.LineUp(False, 5) 'want to be sitting on the function line
tsel.CharRight(False, 5)
FunctionDefDivide(E_HDR_TYPE.FULL) 'give it a full header
End Sub
'----------------- m a c C o m p a n i o n O p e n -----------------
'-------------------------------------------------------------------
Public Sub macCompanionOpen()
Dim strPathFile As String
Dim doc As Document
Dim s32IX As Integer
Dim ynIsHOrCpp As Boolean
Dim win As EnvDTE.Window
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
ynIsHOrCpp = False
strPathFile = doc.FullName()
s32IX = InStrRev(strPathFile, ".cpp")
If (s32IX > 0) Then
strPathFile = Left(strPathFile, Len(strPathFile) - 3) + "h"
ynIsHOrCpp = True
Else
s32IX = InStrRev(strPathFile, ".h")
If (s32IX > 0) Then
strPathFile = Left(strPathFile, Len(strPathFile) - 1) + "cpp"
ynIsHOrCpp = True
End If
End If
If ynIsHOrCpp = True Then
win = DTE.ItemOperations.OpenFile(strPathFile)
win.Activate()
End If
End Sub
'------------- m a c M e a s u r e L i n e I n s e r t -------------
' Maximum line length before VS7 print wraps
'-------------------------------------------------------------------
Public Sub macMeasureLineInsert()
Dim doc As Document
Dim strExt As String
Dim s32IX As Integer
Dim tsel As TextSelection
Dim strText As String
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.UNKNOWN) Then Exit Sub
If (eType = E_LANG_TYPE.VB) Then
m_strComment = m_strComment & "-"
End If
tsel = doc.Selection
tsel.StartOfLine()
strText = m_strComment & _
"--+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----" & _
vbCrLf
tsel.Text = strText ' put our new block back
End Sub
'------ m a c F u n c t i o n F o r m a t F u l l H e a d e r ------
'-------------------------------------------------------------------
Sub macFunctionFormatFullHeader()
'DESCRIPTION: Creates a Full Function Header and split arguments from a any selection on the definition line
FunctionDefDivide(E_HDR_TYPE.FULL)
End Sub
'----- m a c F u n c t i o n F o r m a t L a b e l H e a d e r -----
'-------------------------------------------------------------------
Sub macFunctionFormatLabelHeader()
'DESCRIPTION: Creates and Label Function Header and split arguments from a any selection on the definition line
FunctionDefDivide(E_HDR_TYPE.PARTIAL)
End Sub
'-------- m a c F u n c t i o n F o r m a t N o H e a d e r --------
'-------------------------------------------------------------------
Sub macFunctionFormatNoHeader()
'DESCRIPTION: Makes multiple argument lines out of a function definition
FunctionDefDivide(E_HDR_TYPE.NONE)
End Sub
'---------------- F u n c t i o n D e f D i v i d e ----------------
' This macro divides a function definition into its constitute parts
' and reformats them into multiple lines, 1 line for each argument
'-------------------------------------------------------------------
Private Sub FunctionDefDivide( _
ByVal eHdr As E_HDR_TYPE)
Dim doc As Document
Dim strExt As String
Dim s32IX As Integer
Dim s32IY As Integer
Dim tsel As TextSelection
Dim sbldNew As StringBuilder
Dim s32TopLine As Integer
Dim astrArgs() As String ' Dynamic array to store function arguments.
Dim strArg As String
Dim strArgs As String
Dim strClass As String
Dim strDType As String
Dim strFunc As String
Dim strLastChar As String
Dim strComment As String ' CPP and CS can have comments on the line
Dim strLine As String
Dim strReturn As String
Dim strSpaces As String
Dim s32ArgCnt As Integer
Dim s32Class As Integer
Dim s32Comma As Integer
Dim s32LParen As Integer
Dim s32RParen As Integer
Dim s32Space As Integer
Dim strLineBegin As String
Dim sbld As StringBuilder
Dim s32IndentStyle As Integer
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP _
And eType <> E_LANG_TYPE.CS _
And eType <> E_LANG_TYPE.VB) Then
ErrorShow(E_ERROR.NOT_TYPE)
Exit Sub
End If
sbld = New StringBuilder(600)
tsel = CType(DTE.ActiveDocument.Selection(), EnvDTE.TextSelection)
tsel.SelectLine()
strLine = tsel.Text
'Application.PrintToOutputWindow "strLine =" & strLine
' we are gonna break up our input line into its parts
strLine = LineForParsingWash_str(strLine)
If (strLine.Length = 0) Then Exit Sub
'we have a line of data to work on
If (eType = E_LANG_TYPE.VB) Then ' Vb code to do
' Public/Private Function/Sub FunctName(arg1 as type, arg2 as type)
s32Class = InStr(strLine, "Sub")
If (s32Class > 0) Then ' its a Sub
s32IX = s32Class + 2
strClass = Left(strLine, s32IX)
strLine = Right(strLine, Len(strLine) - s32IX)
Else 'it could be a function
s32Class = InStr(strLine, "Function")
If (s32Class > 0) Then ' its a Function
s32IX = s32Class + 7
strClass = Left(strLine, s32IX)
strLine = Right(strLine, Len(strLine) - s32IX)
Else 'incorrectly formatted line
strClass = ""
End If
End If
s32LParen = InStr(strLine, "(")
If s32LParen > 0 Then
strFunc = Left(strLine, s32LParen - 1)
strFunc = Trim(strFunc)
strLine = Right(strLine, Len(strLine) - s32LParen)
End If 's32LParen > 0
s32RParen = InStr(strLine, ")")
If (s32RParen > 0) Then
' the return data type, if any is after the ")"
' we will replace the terminating ")" with a comma for arg parsing
strReturn = Trim(Right(strLine, Len(strLine) - s32RParen))
If (strReturn <> "") Then
s32IX = InStr(strReturn, "As ")
If (s32IX > 0) Then 'a function returning a type
strReturn = Right(strReturn, Len(strReturn) - 3)
If (InStr(strReturn, vbCr)) Then
strReturn = Left(strReturn, Len(strReturn) - 2)
End If
strReturn = "As " & strReturn
Else
s32IX = InStr(strReturn, "Handles ")
If (s32IX > 0) Then
strReturn = Right(strReturn, Len(strReturn) - 8)
If (InStr(strReturn, vbCr)) Then
strReturn = Left(strReturn, Len(strReturn) - 2)
End If
strReturn = "Handles " & strReturn
Else
strReturn = ""
End If
End If
' set up for parsing the arguments
strLine = Left(strLine, s32RParen - 1)
strLine = Trim(strLine)
If (Len(strLine) > 0) Then
strLine = strLine & "," ' provide for last arg
End If
End If
' 'Count the number of arguments by number of commas.
s32ArgCnt = 0
strArgs = strLine
s32Comma = InStr(strArgs, ",")
Do While s32Comma <> 0
s32ArgCnt = s32ArgCnt + 1
strArgs = Right(strArgs, Len(strArgs) - s32Comma)
s32Comma = InStr(strArgs, ",")
Loop
' 'Store the parameter list in the array.
If s32ArgCnt > 0 Then ' If multiple params, probablt ending with a )
ReDim astrArgs(s32ArgCnt)
s32IX = 0
s32Comma = InStr(strLine, ",")
Do While s32IX < s32ArgCnt
strArgs = Left(strLine, s32Comma - 1)
strLine = Right(strLine, Len(strLine) - s32Comma)
astrArgs(s32IX) = Trim(strArgs)
s32Comma = InStr(strLine, ",")
s32IX = s32IX + 1
Loop
End If
End If
ElseIf (eType = E_LANG_TYPE.CS) Then ' CSharp
' Scope other return function( args)
strClass = ""
s32LParen = InStr(strLine, "(")
strReturn = Left(strLine, s32LParen - 1)
strLine = Right(strLine, Len(strLine) - s32LParen)
s32Space = InStrRev(strReturn, " ")
strFunc = Right(strReturn, Len(strReturn) - s32Space)
strReturn = Left(strReturn, s32Space - 1)
strReturn = Trim(strReturn)
' For now we will leave the scope values in the return string
's32Space = InStrRev(strReturn, " ")
'strReturn = Right(strReturn, Len(strReturn) - s32Space)
If (strFunc.Length = 0) Then Exit Sub ' no function, nothing to do
s32RParen = InStr(strLine, ")")
If (s32RParen > 0) Then
' first we will dump everything after and including the ")"
' we will replace the terminating ")" with a comma for arg parsing
strLine = Left(strLine, s32RParen - 1)
strLine = Trim(strLine)
If (Len(strLine) > 0) Then
strLine = strLine & "," ' provide for last arg
End If
End If
s32ArgCnt = 0
strArgs = strLine
s32Comma = InStr(strArgs, ",")
'Count the number of arguments by number of commas.
Do While s32Comma <> 0
s32ArgCnt = s32ArgCnt + 1
strArgs = Right(strArgs, Len(strArgs) - s32Comma)
s32Comma = InStr(strArgs, ",")
Loop
' 'Store the parameter list in the array.
If s32ArgCnt > 0 Then ' If multiple params, probablt ending with a )
ReDim astrArgs(s32ArgCnt)
s32IX = 0
s32Comma = InStr(strLine, ",")
Do While s32IX < s32ArgCnt
strArgs = Left(strLine, s32Comma - 1)
strLine = Right(strLine, Len(strLine) - s32Comma)
astrArgs(s32IX) = Trim(strArgs)
s32Comma = InStr(strLine, ",")
s32IX = s32IX + 1
Loop
End If
Else ' eType = LANG_CPP
s32Space = InStr(strLine, " ")
s32Class = InStr(strLine, "(")
strReturn = ""
If s32Space < s32Class Then ' it may not have a return data type
strReturn = Left(strLine, s32Space - 1)
strLine = Right(strLine, Len(strLine) - s32Space)
End If
s32Class = InStr(strLine, "::") - 1 'Get the function name.
strClass = ""
If (s32Class > 0) Then 'if no '::' then its a C function
strClass = Left(strLine, s32Class) ' Peel off the class name
strLine = Right(strLine, Len(strLine) - (s32Class + 2))
End If
'Application.PrintToOutputWindow "strClass = " & strClass & ",strLine= " & strLine
s32LParen = InStr(strLine, "(")
strFunc = ""
If (s32LParen > 0) Then
strFunc = Left(strLine, s32LParen - 1)
strFunc = Trim(strFunc)
strLine = Right(strLine, Len(strLine) - (s32LParen))
End If 's32LParen > 0 there was a '('
If (strFunc.Length = 0) Then Exit Sub ' no function, nothing to do
s32RParen = InStr(strLine, ")")
If (s32RParen > 0) Then
' first we will dump everything after and including the ")"
' we will replace the terminating ")" with a comma for arg parsing
strLine = Left(strLine, s32RParen - 1)
strLine = Trim(strLine)
If (Len(strLine) > 0) Then
strLine = strLine & "," ' provide for last arg
End If
End If
s32ArgCnt = 0
strArgs = strLine
s32Comma = InStr(strArgs, ",")
'Count the number of arguments by number of commas.
Do While s32Comma <> 0
s32ArgCnt = s32ArgCnt + 1
strArgs = Right(strArgs, Len(strArgs) - s32Comma)
s32Comma = InStr(strArgs, ",")
Loop
' 'Store the parameter list in the array.
If s32ArgCnt > 0 Then ' If multiple params, probablt ending with a )
ReDim astrArgs(s32ArgCnt)
s32IX = 0
s32Comma = InStr(strLine, ",")
Do While s32IX < s32ArgCnt
strArgs = Left(strLine, s32Comma - 1)
strLine = Right(strLine, Len(strLine) - s32Comma)
astrArgs(s32IX) = Trim(strArgs)
s32Comma = InStr(strLine, ",")
s32IX = s32IX + 1
Loop
End If
End If 'Language type
'Position the cursor one line above the selected text.
'doc.Selection.LineUp
'doc.Selection.LineDown
'doc.Selection.StartOfLine
If (eHdr <> E_HDR_TYPE.NONE) Then
strLineBegin = m_strComment
If (eType = E_LANG_TYPE.VB) Then
strLineBegin = strLineBegin & "-"
End If
'sbld.Append(vbLf & StrToCommentLine_str(strLineBegin, strFunc))
sbld.Append(StrToCommentLine_str(strLineBegin, strFunc))
End If
m_strComment = vbLf & m_strComment
If (eHdr = E_HDR_TYPE.FULL) Then
If eType = E_LANG_TYPE.CS Then ' CSHARP Documenting header
sbld.AppendFormat( _
"{0}" _
& "{0}/<summary>Handles the ? event.</summary>", _
m_strComment)
'If s32ArgCnt < 1 Then
'sbld.AppendFormat("{0} Arguments: NONE", m_strComment)
If s32ArgCnt = 2 Then ' Good bet its an event
s32IX = 0
strArg = astrArgs(s32IX)
s32IX = s32IX + 1
s32IY = strArg.LastIndexOf(" ")
strArg = strArg.Substring(s32IY + 1)
sbld.AppendFormat("{0}/<param name='{1}'>Object sending the event.</param>", _
m_strComment, strArg)
strArg = astrArgs(s32IX)
s32IX = s32IX + 1
s32IY = strArg.LastIndexOf(" ")
strArg = strArg.Substring(s32IY + 1)
sbld.AppendFormat("{0}/<param name='{1}'>Event arguments.</param>", _
m_strComment, strArg)
Else ' func has some arguments
s32IX = 0
Do While s32IX < s32ArgCnt
strArg = astrArgs(s32IX)
s32IX = s32IX + 1
s32IY = strArg.LastIndexOf(" ")
strArg = strArg.Substring(s32IY + 1)
sbld.AppendFormat("{0}/<param name='{1}'>Arg{2}Purpose.</param>", _
m_strComment, strArg, s32IX)
Loop
End If
If strReturn.StartsWith("public ") Then
strReturn = strReturn.Substring(7) ' truncate it off
End If
If strReturn.StartsWith("private ") Then
strReturn = strReturn.Substring(8)
End If
sbld.AppendFormat("{0}/<returns>{2}.</returns>" _
& "{0}/<remarks>Narrative.</remarks>" _
& "{0}", m_strComment, Now, strReturn)
' & "{0}" _
' & "{0} Written By: Mel Shaline - {1:MMMM dd, yyyy}" _
ElseIf eType = E_LANG_TYPE.VB Then
sbld.AppendFormat( _
"{0}" _
& "{0} Function: {2}" _
& "{0} Descr: ", _
m_strComment, strClass, strFunc)
If s32ArgCnt < 1 Then
sbld.AppendFormat( _
"{0} Arguments: NONE", _
m_strComment)
Else ' func has some arguments, 1st one get an arg label
sbld.AppendFormat("{0} Arguments: {1}", _
m_strComment, astrArgs(0))
s32IX = 1
Do While s32IX < s32ArgCnt
sbld.AppendFormat("{0} {1}", _
m_strComment, astrArgs(s32IX))
s32IX = s32IX + 1
Loop
End If
sbld.AppendFormat("{0} Return: {1}", m_strComment, strReturn)
sbld.AppendFormat( _
"{0}" _
& "{0} Written By: Mel Shaline - {1:MMMM dd, yyyy}", _
m_strComment, Now)
Else ' Not CSharp Code
sbld.AppendFormat( _
"{0}" _
& "{0} Class: {1}" _
& "{0} Function: {2}" _
& "{0} Descr: ", _
m_strComment, strClass, strFunc)
If s32ArgCnt < 1 Then
sbld.AppendFormat( _
"{0} Arguments: NONE", _
m_strComment)
Else ' func has some arguments, 1st one get an arg label
sbld.AppendFormat("{0} Arguments: {1}", _
m_strComment, astrArgs(0))
s32IX = 1
Do While s32IX < s32ArgCnt
sbld.AppendFormat("{0} {1}", _
m_strComment, astrArgs(s32IX))
s32IX = s32IX + 1
Loop
End If
sbld.AppendFormat("{0} Return: {1}", m_strComment, strReturn)
sbld.AppendFormat( _
"{0}" _
& "{0} Written By: Mel Shaline - {1:MMMM dd, yyyy}" _
& "{0}", _
m_strComment, Now)
End If
End If
If (eHdr <> E_HDR_TYPE.NONE) Then ' If we have a header, finish it off
sbld.AppendFormat("{2}{0}{1}{2}", strLineBegin, STR_DIVIDER, vbLf)
End If
' now we reformat the definition line for multiple argument lines
If (s32ArgCnt < 1) Then
If (eType = E_LANG_TYPE.CPP _
Or eType = E_LANG_TYPE.CS) Then
If (strClass.Length = 0) Then ' no class, no separator
strArg = ""
Else
strArg = "::"
End If
sbld.AppendFormat("{0} {1}{2}{3}(){4}", _
strReturn, strClass, strArg, strFunc, vbCrLf)
Else ' eType = E_LANG_TYPE.VB
sbld.AppendFormat("{0} {1}() {2}{3}", _
strClass, strFunc, strReturn, vbCrLf)
End If
Else ' argcnt greater than zero
If (eType = E_LANG_TYPE.CPP _
Or eType = E_LANG_TYPE.CS) Then
If (strClass.Length = 0) Then ' no class, no separator
strArg = ""
Else
strArg = "::"
End If
sbld.AppendFormat("{0} {1}{2}{3}({4}", _
strReturn, strClass, strArg, strFunc, vbCrLf)
strLastChar = ","
For s32IX = 0 To (s32ArgCnt - 1) ' all but the last one
If (s32IX = (s32ArgCnt - 1)) Then
strLastChar = " )"
End If
strArg = astrArgs(s32IX)
s32Space = InStr(strArg, " ")
strDType = Left(strArg, s32Space - 1)
strArg = Right(strArg, Len(strArg) - s32Space)
s32Space = 21 - Len(strDType) '23 - Len(strDType)
strSpaces = " "
If (s32Space < 0) Then
s32Space = 0
End If
While s32Space > 0
strSpaces = strSpaces & " "
s32Space = s32Space - 1
End While
sbld.AppendFormat(" {0}{1}{2}{3}{4}", _
strDType, _
strSpaces, _
strArg, _
strLastChar, _
vbCrLf)
Next 's32IX
Else '(eType = E_LANG_TYPE.VB)
sbld.AppendFormat("{0} {1}( _{2}", _
strClass, strFunc, vbCrLf)
strLastChar = ","
For s32IX = 0 To (s32ArgCnt - 1) ' all but the last one
If (s32IX = (s32ArgCnt - 1)) Then
If (strReturn.Length = 0) Then
strLastChar = ")"
Else
strLastChar = ") _"
End If
Else
strLastChar = ", _"
End If
strArg = astrArgs(s32IX)
sbld.AppendFormat(" {0}{1}{2}", _
strArg, _
strLastChar, _
vbCrLf)
Next 's32IX
If (strReturn <> "") Then
sbld.AppendFormat(" {0}{1}", strReturn, vbCrLf)
End If
End If ' argument format language types
End If ' s32ArgCnt < 1 | > 0
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = _
vsSmartFormatOptions.vsSmartFormatOptionsNone
DTE.UndoContext.Open("FormatFunction")
'tsel.Insert(sbld.ToString, vsInsertFlags.vsInsertFlagsInsertAtEnd _
' Or vsInsertFlags.vsInsertFlagsContainNewText)
'txt.SmartFormat()
tsel.Delete()
tsel.Insert(sbld.ToString())
tsel.StartOfLine()
Select Case eHdr '~~~~~~~~~~~~~~
Case E_HDR_TYPE.FULL ' Move up to the description section
If (s32ArgCnt = 0) Then
s32IX = 11
Else
s32IX = (2 * s32ArgCnt) + 10
End If
tsel.LineUp(True, s32IX)
DTE.ActiveDocument.Selection.Indent(2)
tsel.StartOfLine() ' gonna move down and select the "Purpose" word
If (eType = E_LANG_TYPE.CS) Then
tsel.FindText("?", vsFindOptions.vsFindOptionsMatchWholeWord)
Else
tsel.FindText("Purpose", vsFindOptions.vsFindOptionsMatchWholeWord)
End If
'tsel.LineDown(False, 2)
'tsel.CharRight(False, 21)
'tsel.CharRight(False, 19)
Case E_HDR_TYPE.NONE
tsel.LineUp(False, s32ArgCnt + 1)
Case E_HDR_TYPE.PARTIAL
tsel.LineUp(True, s32ArgCnt + 3)
End Select
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
DTE.UndoContext.Close()
' ' Test function invocations that can be pasted in source to test this function
' 'Private Function fncJustReturn() As Integer
' 'End Function
' 'Private Function fncOneArgNoRet(ByVal arg1 As Integer)
' 'End Function
' 'Private Function fncOneArgRet(ByVal arg1 As Integer) As Integer
' 'End Function
' 'Private Function fncTwoArgsRet(ByVal arg1 As Integer, ByVal arg2 As String) As Integer
' 'End Function
' 'Private Function fncTwoArgsNoRet(ByVal arg1 As Integer, ByVal arg2 As String)
' 'End Function
' '=========================================================================
End Sub
'----------- L i n e F o r P a r s i n g W a s h _ s t r -----------
' replaces all multiple tabs and spaces with a single space
'-------------------------------------------------------------------
Private Function LineForParsingWash_str( _
ByVal strIn) _
As String
Dim strLeft As String
Dim strRight As String
Dim s32IX As Integer
' First we replace all tabs with a space
s32IX = InStr(strIn, vbTab)
Do While s32IX <> 0
strLeft = Left(strIn, s32IX - 1)
strRight = Right(strIn, Len(strIn) - (s32IX))
strIn = strLeft & " " & strRight
s32IX = InStr(strIn, vbTab)
Loop
'Then we replace all multiple spaces with a space
s32IX = InStr(strIn, " ")
Do While s32IX <> 0
strLeft = Left(strIn, s32IX)
strRight = Right(strIn, Len(strIn) - (s32IX + 1))
strIn = strLeft & strRight
s32IX = InStr(strIn, " ")
Loop
LineForParsingWash_str = Trim(strIn)
End Function
'------------- S t r T o C o m m e n t L i n e _ s t r -------------
'-------------------------------------------------------------------
Private Function StrToCommentLine_str( _
ByVal strLineBegin As String, _
ByVal strInput As String) _
As String
'DESCRIPTION: function name to comment line
Dim s32IX As Integer
Dim s32Len As Integer
Dim s32Pad As Integer
Dim sbld As StringBuilder
sbld = New StringBuilder(strLineBegin, 70)
s32Len = Len(strInput)
s32Pad = 32 - s32Len
If (s32Pad < 0) Then
s32Pad = 0
End If
sbld.Append("-"c, s32Pad)
' Now take each letter of the string and pad with spaces
For s32IX = 1 To s32Len
sbld.Append(" " + Mid(strInput, s32IX, 1))
Next
sbld.Append(" "c)
sbld.Append("-"c, s32Pad + 1)
StrToCommentLine_str = sbld.ToString()
sbld = Nothing
End Function
'--------- m a c S e l e c t e d T o F u n c C o m m e n t ---------
'-------------------------------------------------------------------
Sub macSelectedToFuncComment()
Dim strSel As String
Dim topline As String
Dim doc As Document
Dim s32IX As Integer
Dim tsel As TextSelection
Dim s32TopLine As Integer
Dim strLineBegin As String
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
'tsel does not have a word select
DTE.ExecuteCommand("Edit.SelectCurrentWord") ' in case word not selected
tsel = doc.Selection
strSel = tsel.Text
s32TopLine = tsel.TopPoint.Line
topline = ActiveDocument.Selection.topline
strLineBegin = m_strComment
If (eType = E_LANG_TYPE.VB) Then
strLineBegin = strLineBegin & "-"
Else
End If
strSel = StrToCommentLine_str(strLineBegin, strSel)
DTE.UndoContext.Open("StrToComment")
tsel.MoveToLineAndOffset(s32TopLine, 1)
tsel.CharLeft()
tsel.Text = vbLf & strSel & vbLf & m_strComment & STR_DIVIDER
tsel.LineDown(False)
tsel.StartOfLine(False)
DTE.UndoContext.Close()
End Sub
'------------- m a c I f E l s e B l o c k I n s e r t -------------
' Inserts an If/else code block where the cursor is
'-------------------------------------------------------------------
Sub macIfElseBlockInsert()
'DESCRIPTION:
Dim doc As Document
Dim s32IX As Integer
Dim tsel As TextSelection
Dim s32TopLine As Integer
Dim strTab As String
Dim s32TabSize As Integer
Dim s32IndentStyle As Integer
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
s32TabSize = doc.TabSize ' Figure out how many spaces in a tab
strTab = ""
Do While s32TabSize > 0
strTab = strTab & " "
s32TabSize = s32TabSize - 1
Loop
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
sbld = New StringBuilder(300)
sbld.AppendFormat("{1}" _
& "{0}if ( nVal == 0 ){1}" _
& "{0}{{{1}" _
& "{0}{0}IfTrueCode();{1}" _
& "{0}}}{1}" _
& "{0}else{1}" _
& "{0}{{{1}" _
& "{0}{0}IfFalseCode();{1}" _
& "{0}}}{1}", _
strTab, vbLf)
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
DTE.UndoContext.Open("AddIfElse")
tsel.Text = sbld.ToString ' put or new block back
tsel.MoveToLineAndOffset(s32TopLine + 1, 1, False)
tsel.EndOfLine(False)
tsel.CharLeft(False, 11)
DTE.UndoContext.Close()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'------------- m a c S w i t c h B l o c k I n s e r t -------------
' Makes a Switch code block
'-------------------------------------------------------------------
Public Sub macSwitchBlockInsert()
Dim doc As Document
Dim s32IX As Integer
Dim tsel As TextSelection
Dim s32TopLine As Integer
Dim strTab As String
Dim s32TabSize As Integer
Dim s32IndentStyle As Integer
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
s32TabSize = doc.TabSize ' Figure out how many spaces in a tab
strTab = "" ' Gonna make the space version of selected tab size
For s32IX = 1 To s32TabSize
strTab = strTab & " "
Next
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
sbld = New StringBuilder(300)
sbld.AppendFormat("{1}" _
& "{0}switch( nVal ){1}" _
& "{0}{0}{{{1}" _
& "{0}{0}case Val1:{1}" _
& "{0}{0}{0}{{{1}" _
& "{0}{0}{0}Val1Code();{1}" _
& "{0}{0}{0}break;{1}" _
& "{0}{0}{0}{{{1}" _
& "{0}{0}default:{1}" _
& "{0}{0}{0}{{{1}" _
& "{0}{0}{0}DefaultCode();{1}" _
& "{0}{0}{0}break;{1}" _
& "{0}{0}{0}}}{1}" _
& "{0}{0}}}// End of switch nVal{1}", _
strTab, vbLf)
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
DTE.UndoContext.Open("AddSwitch")
tsel.Text = sbld.ToString ' put or new block back
' Now we are goin to re-select what we started with
tsel.MoveToLineAndOffset(s32TopLine + 1, 1, False)
tsel.EndOfLine(False)
tsel.CharLeft(False, 6)
DTE.UndoContext.Close()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'---------------- m a c S t a r C o m m e n t O u t ----------------
' Proceeds all the lines in the selected block with "/*" first, " *"
' in between, and "*/" Last
'-------------------------------------------------------------------
Public Sub macStarCommentOut()
Dim doc As Document
Dim s32LF As Integer
Dim tsel As TextSelection
Dim s32TopLine As Integer
Dim s32BottomLine As Integer
Dim strBlkOld As String
Dim s32IndentStyle As Integer
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
' First we need to keep a record of what was selected to begin with
' this also goes to the beginning of the first line and the end
' of the last line so a position of the caret selects the whole line
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
s32BottomLine = tsel.BottomPoint.Line
' even if the user did not select complete lines at the top and
' bottom, the following code makes sure it is block line selected
tsel.MoveToLineAndOffset(s32TopLine, 1, False)
tsel.MoveToLineAndOffset(s32BottomLine, 1, True)
tsel.EndOfLine(True)
strBlkOld = tsel.Text
Trim(strBlkOld)
sbld = New StringBuilder("/*" & vbLf, Len(strBlkOld) + 100) ' start with 50
'Walk down the lines adding " *" at the beginning
s32LF = InStr(strBlkOld, vbLf)
Do While s32LF > 0
sbld.AppendFormat(" *{0}", Left(strBlkOld, s32LF))
strBlkOld = Right(strBlkOld, (Len(strBlkOld) - s32LF))
s32LF = InStr(strBlkOld, vbLf)
Loop
If (Len(strBlkOld) > 0) Then
sbld.AppendFormat(" *{0}", strBlkOld)
End If
sbld.AppendFormat("{0}{1}", vbLf, " */") ' now add the tail piece
' an IndentStyle of "Smart" will susessively indent the next line,
' so before we put the new block we will make sure that mode is
' turned off and replace the original mode when we are done
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
DTE.UndoContext.Open("StarCommentOut")
tsel.Text = sbld.ToString ' put or new block back
tsel.MoveToLineAndOffset(s32BottomLine + 1, 1, False)
tsel.LineDown(False)
DTE.UndoContext.Close()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'----------- m a c F i r s t T w o C h a r s D e l e t e -----------
' Removes the first 2 characters on each line of then selection
'-------------------------------------------------------------------
Public Sub macFirstTwoCharsDelete()
Dim strBlkOld As String
Dim s32TopLine As Integer
Dim s32BottomLine As Integer
Dim s32IndentStyle As Integer
Dim doc As Document
Dim s32LF As Integer
Dim tsel As TextSelection
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
' First we need to keep a record of what was selected to begin with
' this also goes to the beginning of the first line and the end
' of the last line so a position of the caret selects the whole line
tsel = doc.Selection
s32TopLine = tsel.TopPoint.Line
s32BottomLine = tsel.BottomPoint.Line
' even if the user did not select complete lines at the top and
' bottom, the following code makes sure it is block line selected
tsel.MoveToLineAndOffset(s32TopLine, 1, False)
tsel.MoveToLineAndOffset(s32BottomLine, 1, True)
tsel.EndOfLine(True)
strBlkOld = tsel.Text
sbld = New StringBuilder(Len(strBlkOld))
Trim(strBlkOld)
strBlkOld = Right(strBlkOld, Len(strBlkOld) - 2)
s32LF = InStr(strBlkOld, vbLf)
If (s32LF > 1) Then
sbld.Append(Left(strBlkOld, s32LF))
strBlkOld = Right(strBlkOld, (Len(strBlkOld) - s32LF))
s32LF = InStr(strBlkOld, vbLf)
Do While (s32LF > 1)
strBlkOld = Right(strBlkOld, Len(strBlkOld) - 2)
sbld.Append(Left(strBlkOld, s32LF - 2))
strBlkOld = Right(strBlkOld, (Len(strBlkOld) - (s32LF - 2)))
s32LF = InStr(strBlkOld, vbLf)
Loop
End If
' and get the last line that has no vbLf
s32LF = Len(strBlkOld)
If (s32LF > 2) Then
sbld.Append(Right(strBlkOld, s32LF - 2))
End If
' an IndentStyle of "Smart" will susessively indent the next line,
' so before we put the new block we will make sure that mode is
' turned off and replace the original mode when we are done
s32IndentStyle = DTE.Properties("TextEditor", "C/C++").Item("IndentStyle").Value
DTE.Properties("TextEditor", "C/C++").Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
tsel.Text = sbld.ToString ' put or new block back
DTE.Properties("TextEditor", "C/C++").Item("IndentStyle").Value() = s32IndentStyle
' Now we are goin to re-select what we started with
tsel.MoveToLineAndOffset(s32TopLine, 1, False)
tsel.MoveToLineAndOffset(s32BottomLine, 1, True)
tsel.EndOfLine(True)
End Sub
'------------------ m a c R e g i o n I n s e r t ------------------
'-------------------------------------------------------------------
Public Sub macRegionInsert()
Dim strRegName As String
Dim tsel As TextSelection
Dim doc As Document
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP _
And eType <> E_LANG_TYPE.CS _
And eType <> E_LANG_TYPE.VB) Then
ErrorShow(E_ERROR.NOT_TYPE)
Exit Sub
End If
strRegName = InputBox("Region Name?")
If (Not strRegName.Trim = String.Empty) Then
DTE.UndoContext.Open("InsertRegion", False)
tsel = CType(DTE.ActiveDocument.Selection, TextSelection)
With tsel
If (eType = E_LANG_TYPE.VB) Then
.Insert(String.Format("#Region ""{0}""{1}", strRegName, vbCrLf), _
vsInsertFlags.vsInsertFlagsContainNewText Or _
vsInsertFlags.vsInsertFlagsInsertAtStart)
.Insert(String.Format("{0}#End Region{0}", vbCrLf), _
vsInsertFlags.vsInsertFlagsInsertAtEnd Or _
vsInsertFlags.vsInsertFlagsContainNewText)
Else
.Insert(String.Format("#region {0}{1}", strRegName, vbCrLf), _
vsInsertFlags.vsInsertFlagsContainNewText Or _
vsInsertFlags.vsInsertFlagsInsertAtStart)
.Insert(String.Format("{0}#endregion{0}", vbCrLf), _
vsInsertFlags.vsInsertFlagsInsertAtEnd Or _
vsInsertFlags.vsInsertFlagsContainNewText)
End If
End With
DTE.UndoContext.Close()
End If ' strRegName not empty
End Sub
'------------- m a c P r o p e r t i e s C o n v e r t -------------
'-------------------------------------------------------------------
Public Sub macPropertiesConvert()
'DESCRIPTION: Converts "m_" variables to Get/Set class properties
Dim strLine As String
Dim strCodeBlock As String
Dim strVarName As String
Dim strPubName As String
Dim strDataType As String
Dim strOpenCurly As String
Dim strCloseCurly As String
Dim sbld As StringBuilder
Dim astrLines() As String
Dim rexp As Regex
Dim mtch As Match
Dim tsel As TextSelection
Dim doc As Document
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.VB) _
And (eType <> E_LANG_TYPE.CS) Then
ErrorShow(E_ERROR.NOT_TYPE)
Exit Sub
End If
Try
tsel = CType(doc.Selection, TextSelection)
strCodeBlock = tsel.Text
If (strCodeBlock.Length = 0) Then Exit Sub
sbld = New StringBuilder
If (eType = E_LANG_TYPE.VB) Then
rexp = New Regex( _
"(Dim|Private)\s*(?<varname>\S*)\s*(As|As New)\s*(?<typename>\S*)", _
RegexOptions.IgnoreCase Or RegexOptions.ExplicitCapture)
astrLines = Split(strCodeBlock, vbLf)
For Each strLine In astrLines
strLine = strLine.Trim
If Not strLine = String.Empty Then
mtch = rexp.Match(strLine)
If mtch.Success Then
strVarName = mtch.Groups("varname").Value.Trim
strDataType = mtch.Groups("typename").Value.Trim
'this assumes a consistent use of a 2-char prefix
'on private variables... in my case "m_"
strPubName = strVarName.Substring(2)
sbld.AppendFormat( _
"{0}Public Property {1} As {2}{0}" _
& " Get{0}" _
& " Return {3}{0}" _
& " End Get{0}" _
& " Set(ByVal Value As {2}){0}" _
& " {3} = Value{0}" _
& " End Set{0}" _
& "End Property{0}", _
vbCrLf, strPubName, _
strDataType, strVarName)
End If
End If
Next
ElseIf (eType = E_LANG_TYPE.CS) Then ' C Sharp flavor of this
strOpenCurly = "{"
strCloseCurly = "}"
rexp = New Regex("(private|public)\s*(?<typename>\S*)\s*(?<varname>\S*)", _
RegexOptions.IgnoreCase Or RegexOptions.ExplicitCapture)
astrLines = Split(strCodeBlock, vbLf)
For Each strLine In astrLines
strLine = strLine.Trim
If Not strLine = String.Empty Then
mtch = rexp.Match(strLine)
If mtch.Success Then
strVarName = mtch.Groups("varname").Value.Trim
If (strVarName.LastIndexOf(";") > 0) Then
strVarName = strVarName.Substring(0, strVarName.Length - 1)
End If
strDataType = mtch.Groups("typename").Value.Trim
'this assumes a consistent use of a 2-char prefix
'on private variables... in my case "m_"
strPubName = strVarName.Substring(2)
sbld.AppendFormat( _
"{0} public {2} {1}{0}" _
& " {4}{0}" _
& " get{0}" _
& " {4}{0}" _
& " return {3};{0}" _
& " {5}{0}" _
& " set{0}" _
& " {4}{0}" _
& " {3} = value;{0}" _
& " {5}{0}" _
& " {5}{0}", _
vbCrLf, strPubName, _
strDataType, strVarName, _
strOpenCurly, strCloseCurly)
End If
End If
Next
End If
DTE.UndoContext.Open("ConvertProperties")
tsel.Insert(sbld.ToString, _
vsInsertFlags.vsInsertFlagsInsertAtEnd _
Or vsInsertFlags.vsInsertFlagsContainNewText)
tsel.SmartFormat()
DTE.UndoContext.Close()
Catch ex As System.Exception
MsgBox(ex.Message)
End Try
End Sub
'--------- m a c C o p y r i g h t H e a d e r I n s e r t ---------
'-------------------------------------------------------------------
Public Sub macCopyrightHeaderInsert()
Dim strCHdr As String
Dim doc As Document
Dim strExt As String
Dim s32IX As Integer
Dim tsel As TextSelection
Dim strLineBeign As String
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
tsel = doc.Selection
'{0} = end of line, {1} = year, {2} = month
sbld = New StringBuilder(80)
sbld.AppendFormat(STR_COPYRIGHT, _
m_strComment, CStr(Now.Year), String.Format("{0:Y}", Now), vbCr)
tsel = CType(DTE.ActiveDocument.Selection, TextSelection)
DTE.UndoContext.Open("PasteCopyright")
tsel.StartOfDocument(False)
tsel.Insert(sbld.ToString)
DTE.UndoContext.Close()
End Sub
Public Sub macVersionManagerHdrInsert()
'Dim strCHdr As String
Dim doc As Document
Dim strFile As String
Dim s32IX As Integer
Dim tsel As TextSelection
Dim strLineBeign As String
Dim sbld As StringBuilder
Dim eType As E_LANG_TYPE
Dim ynHFile As Boolean
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP _
And eType <> E_LANG_TYPE.CS _
And eType <> E_LANG_TYPE.VB) Then
ErrorShow(E_ERROR.NOT_TYPE)
Exit Sub
End If
sbld = New StringBuilder(600)
ynHFile = False
If (m_strExtension = "h") Then
ynHFile = True
End If
tsel = doc.Selection
sbld.AppendFormat( _
"/*{0}" _
& " * Copyright 1997, 2002 XYZ All Rights Reserved.{0}" _
& " *{0}" _
& " * This software is made available solely pursuant to the terms of a{0}" _
& " * software license agreement which governs its use. Unauthorized {0}" _
& " * duplication, distribution or sale are strictly prohibited.{0}" _
& " *{0}" _
& " * Description:{0}" _
& " *{0}" _
& " * Notes:{0}" _
& " *{0}" _
& " * Original Author(s): Mel Shaline{0}" _
& " * Created on: {1:MMMM dd, yyyy}{0}" _
& " *{0}" _
& " * Revision Control Information:{0}" _
& " *{0}" _
& " * $Workfile${0}" _
& " * $Date${0}" _
& " * $Revision${0}" _
& " *{0}" _
& " * Revision History:{0}" _
& " *{0}" _
& " * $Log${0}" _
& " */{0}" _
& " {0}", _
vbLf, Now)
If ynHFile = True Then
strFile = doc.Name
s32IX = InStr(strFile, ".") ' Get the right most one
strFile = strFile.Substring(0, s32IX - 1)
strFile = strFile.ToUpper()
sbld.AppendFormat( _
"#ifdef MAIN{0}" _
& " static char const {1}_Hdoc[] = ""$Archive$$Workfile$$Date$$Revision$"";{0}" _
& "#endif{0}" _
& "{0}" _
& "#pragma once{0}", _
vbLf, strFile)
Else
If (eType <> E_LANG_TYPE.CS) Then
sbld.AppendFormat("static char ident[] = ""$Archive$$Workfile$$Date$$Revision$"";{0}{0}", _
vbLf)
End If
End If
tsel = CType(DTE.ActiveDocument.Selection, TextSelection)
DTE.UndoContext.Open("VMHeader")
tsel.StartOfDocument(False) ' beginning of doc, do not extend
tsel.Insert(sbld.ToString)
DTE.UndoContext.Close()
End Sub
'------------------ m a c M e l T a g A p p e n d ------------------
'-------------------------------------------------------------------
Public Sub macMelTagAppend()
'DESCRIPTION: Append a string to the line you are on
Dim doc As Document
Dim strExt As String
Dim s32IX As Integer
Dim tsel As TextSelection
Dim strText As String
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.VB _
And eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_TYPE)
Exit Sub
End If
Select Case eType ' NOTE: these are different that standard comments
Case E_LANG_TYPE.CPP
strText = " //"
Case E_LANG_TYPE.VB
strText = " '"
Case Else
Exit Sub
End Select
tsel = doc.Selection
DTE.UndoContext.Open("AppendTag")
tsel.EndOfLine()
tsel.Text = strText & "MS dotNet" ' put our new block back
DTE.UndoContext.Close()
End Sub
'--------- m a c B l a n k L i n e s D e l e t e I n D o c ---------
'-------------------------------------------------------------------
Public Sub macBlankLinesDeleteInDoc()
Dim tsel As TextSelection
Dim doc As Document
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
tsel = doc.Selection
tsel.StartOfDocument()
tsel.EndOfDocument(True)
BlankLinesInSelectionDelete(tsel)
End Sub
'--- m a c B l a n k L i n e s D e l e t e I n S e l e c t i o n ---
'-------------------------------------------------------------------
Public Sub macBlankLinesDeleteInSelection()
'Dim tsel As TextSelection
Dim doc As Document
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
BlankLinesInSelectionDelete(doc.Selection)
End Sub
'------ B l a n k L i n e s I n S e l e c t i o n D e l e t e ------
'-------------------------------------------------------------------
Private Sub BlankLinesInSelectionDelete( _
ByRef tsel As TextSelection)
Dim doc As Document
Dim s32IX As Integer
Dim strBlkNew As String
Dim strBlkOld As String
Dim strDoubleNL As String
Dim s32IndentStyle As Integer
strBlkNew = "" 'start
strBlkOld = tsel.Text
Trim(strBlkOld)
'Walk down the lines removing double LFs
strDoubleNL = vbCrLf & vbCrLf
s32IX = InStr(strBlkOld, strDoubleNL)
Do While s32IX > 0
If (s32IX = 1) Then ' just remove the from vbCrLf
strBlkOld = Right(strBlkOld, (Len(strBlkOld) - 2))
Else
strBlkNew = strBlkNew + Left(strBlkOld, s32IX - 1) ' no vbCrLF
strBlkOld = Right(strBlkOld, (Len(strBlkOld) - (s32IX + 1)))
End If
s32IX = InStr(strBlkOld, strDoubleNL)
Loop
strBlkNew = strBlkNew + strBlkOld
' an IndentStyle of "Smart" will susessively indent the next line,
' so before we put the new block we will make sure that mode is
' turned off and replace the original mode when we are done
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
DTE.UndoContext.Open("BlankLinesDelete")
tsel.Text = strBlkNew ' put or new block back
DTE.UndoContext.Close()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'------------------ m a c G o o g l e S e a r c h ------------------
'-------------------------------------------------------------------
Public Sub macGoogleSearch()
Dim strUrl As String
Dim tsel As TextSelection
Dim doc As Document
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType = E_LANG_TYPE.UNKNOWN) Then
ErrorShow(E_ERROR.UNKNOWN)
Exit Sub
End If
tsel = doc.Selection()
If (tsel.IsEmpty = True) Then '
DTE.ExecuteCommand("Edit.SelectCurrentWord") ' force a word selection
tsel = doc.Selection()
If (tsel.IsEmpty = True) Then ' may not be in a word
ErrorShow(E_ERROR.NO_SELECTION)
Exit Sub
End If
End If
strUrl = "www.google.com/search?q=" + tsel.Text ' Google Search!
DTE.ExecuteCommand("View.URL", strUrl) ' Navigate to it!
End Sub
'' To iterate throught the TextEditor Properties to finD Names
'Dim s32Cnt As Integer
' s32Cnt = DTE.Properties("TextEditor", "C/C++").Count()
' For s32IX = 1 To s32Cnt
' strExt = DTE.Properties("TextEditor", "C/C++").Item(s32IX).Name
' Next
'--------------------------- C P P _ F o r m a t -------------------------------
'
' This code is largely a port to .Net of a VS6 macro module written by Alvaro Mendez
'-+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----
' with modifcations suggested by others. It reproduces 90% of his defined
' functionality and since the source is provided it is expected the user may want to
' modify it to conform to their view of the most desirable format.
' At present this code does not test the context the strings are in,
' i.e., it does not try to figure out if you are in a comment or CPP macro. Generally
' the improvements in readability these macros provide would also benefit those areas.
' (including commented out code)
'------------------ m a c C P P D o c F o r m a t ------------------
'-------------------------------------------------------------------
Public Sub macCPPDocFormat()
CPPFormat(E_MODE.DOC)
End Sub
'------------ m a c C P P S e l e c t i o n F o r m a t ------------
'-------------------------------------------------------------------
Public Sub macCPPSelectionFormat()
CPPFormat(E_MODE.SELECTION)
End Sub
'------------------------ C P P F o r m a t ------------------------
'-------------------------------------------------------------------
Private Sub CPPFormat( _
ByVal eMode As E_MODE)
Dim doc As Document ' This will be our Active Document
Dim tsel As TextSelection
Dim s32IndentStyle As Integer
Dim strNew As String
Dim ynRet As Boolean
Dim strErr As String
Dim eType As E_LANG_TYPE
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
eType = FileType_enum(doc)
If (eType <> E_LANG_TYPE.CPP) Then
ErrorShow(E_ERROR.NOT_CPP)
Exit Sub
End If
' Select the whole file and reformat it
tsel = doc.Selection
If (eMode = E_MODE.DOC) Then
tsel.StartOfDocument() ' now select the whole document
tsel.EndOfDocument(True)
End If
strNew = tsel.Text
strErr = CPPFormat_str(strNew)
strErr = CPPFormat2_str(strNew, "if")
strErr = CPPFormat2_str(strNew, "for")
s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = _
vsSmartFormatOptions.vsSmartFormatOptionsNone
tsel.Delete()
tsel.Insert(strNew)
tsel.SelectAll()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = _
vsSmartFormatOptions.vsSmartFormatOptionsSmart
tsel.SmartFormat()
DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'------------------- C P P F o r m a t 2 _ s t r -------------------
' Here we take a conditional op (if|for|while..) and make sure they
' have their own line
'-------------------------------------------------------------------
Private Function CPPFormat2_str( _
ByRef strIn As String, _
ByVal strOp As String) _
As String
Dim regxOp As Regex
Dim strPatrn As String
Dim optsRegx As RegexOptions
Dim ynMatch As Boolean
Dim mtch As Match
Dim strBefore As String
Dim strMid As String
Dim strAfter As String
Dim strPat2 As String
Dim ynBefore As Boolean
Dim ynBeforeWs As Boolean ' include the before on this line
Dim ynAfterCom As Boolean ' include the after string
Dim ynAfter As Boolean
Dim strReplace As String
Dim sbldReplace As StringBuilder
Dim s32Start As Integer = 0
Dim s32Len As Integer
optsRegx = RegexOptions.IgnoreCase _
Or RegexOptions.Multiline _
Or RegexOptions.ExplicitCapture
strPatrn = "(.*)(" & strOp & "\ \(.+[\)]?)(.*)"
regxOp = New Regex(strPatrn, optsRegx)
sbldReplace = New StringBuilder
mtch = regxOp.Match(strIn, strPatrn)
While (mtch.Success = True) 'Groups(0) = whole line
strReplace = mtch.Groups(0).Value
s32Start = mtch.Index
s32Len = mtch.Length
'Kludge the match would always break the match into piece
' on the first pass, but iterations would fail so I rematch
' with the total original match string
'strBefore = mtch.Groups(1).Value
'strMid = mtch.Groups(2).Value
'strAfter = mtch.Groups(3).Value
mtch = regxOp.Match(strReplace, strPatrn) ' rematch to break up
strBefore = mtch.Groups(1).Value
strMid = mtch.Groups(2).Value
strAfter = mtch.Groups(3).Value
' Lets see if the before is anything but ws
ynBeforeWs = True ' assume it is
ynBefore = False
If (strBefore <> "") Then ' is the before anything but white space
ynBefore = True
strPat2 = "([^\ \t])"
If (regxOp.IsMatch(strBefore, strPat2)) Then
ynBeforeWs = False ' include the after portion on this line
End If
End If
' Lets see if the after has a comment in it
ynAfterCom = False
ynAfter = False
If (strAfter <> "") Then
ynAfter = True
strPat2 = "(.*)(//|/\*)" ' Any comments in str?
If (regxOp.IsMatch(strAfter, strPat2)) Then
ynAfterCom = True ' include the after portion on this line
End If
End If
' now we construct our replacement string
sbldReplace.Remove(0, sbldReplace.Length) 'clear it out
sbldReplace.Append(strBefore)
If (ynBeforeWs = False) Then ' something other that ws
sbldReplace.Append(vbCrLf)
End If
sbldReplace.Append(strMid)
If (ynAfter = True) Then
If (ynAfterCom = True) Then
sbldReplace.Append(strAfter)
Else
sbldReplace.Append(vbCrLf & strAfter)
End If
End If
' Remove the old string the match found
strIn = strIn.Remove(s32Start, s32Len)
' and replace it with the new one
strIn = strIn.Insert(s32Start, sbldReplace.ToString())
' Our work could change the size of the original and
' where we start our next search
s32Start = s32Start + sbldReplace.Length
'see if there are any more of these to do
'reset our pattern for our search, use a short src str
'KLUDGE no oveloaded function for intput, pattern, and start
regxOp.Match(strAfter, strPatrn) ' reset the pattern
mtch = regxOp.Match(strIn, s32Start) 'check for a match
End While
End Function
'-------------------- C P P F o r m a t _ s t r --------------------
' in the comments below I us "ws" (white space) to mean tabs and spaces
' regex use ws (/s) to mean [ \f\n\r\t\v]
'-------------------------------------------------------------------
Private Function CPPFormat_str( _
ByRef strIn As String) _
As String
' We are gonna take the regex engine out for a major spin, some less than obvious
' match patterns. Many of the matches are dependent on the preceeding replaces
' haven taken place, so beware if they are arranged in a different order
' I am reminded of the old medical saw "First Do No Harm"
' Hopefully if a file compiled before these modifications it will
' compile afterwards
Dim regx As Regex
Dim strPtrn As String
Dim mtch As Match
Dim mgrp As Group
'Dim caps As CaptureCollection
Dim s32IX As Integer
Dim strRet As String = ""
'Dim capc As CaptureCollection
Try
'Change multiple ";" on a line to multiple line
' this can make "for" loop invocations look stange
strPtrn = "(;)(.+);" ' more than one ; on a line
regx = New Regex(strPtrn, REGX_OPTS_IGCASE_EXPCAP)
'Replace stops on the first occurence on a line, so iterate till no more
mtch = regx.Match(strIn)
While (mtch.Success = True)
strIn = regx.Replace(strIn, strPtrn, "$1" & vbCrLf & "$2;")
mtch = regx.Match(strIn, strPtrn)
End While
'We only have to iterate now on occurances that can happen more than once
' on a line
' Make all curly braces be on a line by themselves
' nothing should be to the left but ws for the { and }
strIn = regx.Replace(strIn, "([\w\);]+)[ \t]*([\{\}])", "$1" & vbCrLf & "$2")
' handle the {} case
strIn = regx.Replace(strIn, "([\w\);{]+)[ \t]*\}", "$1" & vbCrLf & "}")
' or after them either
strIn = regx.Replace(strIn, "([\{\}])\s*([\w])", "$1" & vbCrLf & "$2")
' Replace 2 or more blank lines(with possible only whitespace) with one
strIn = regx.Replace(strIn, "(\r\n)([ \t]*\r\n){2,}", "$1$2")
' we want all the following operators to be surrounded by spaces
'* / + - = == != += -= *= /= <= >= << >> && || | ?
'first it is safe to check all "=" not followed by ws
' Put a spaces after a "=", not ==
strIn = regx.Replace(strIn, "=([^\s=])", "= $1")
' all single = have a space after them now, user it for space infront
strIn = regx.Replace(strIn, "([\w\)\]])=([^=]?)", "$1 =$2")
' a space before 2 char ops
strPtrn = "([^ \t]+)(\+=|\*=|\-=|/=|\|\||&&|>>|<<|!=)"
'Replace stops on the first occurence on a line, so iterate till no more
mtch = Regex.Match(strIn, strPtrn)
While (mtch.Length > 0)
strIn = regx.Replace(strIn, strPtrn, "$1 $2")
mtch = Regex.Match(strIn, strPtrn)
End While
' now a space after 2 char ops not ending with =
strIn = regx.Replace(strIn, "(\|\||&&|>>|<<)([^ \t=]+)", "$1 $2")
' Now we do singular ops MDAS( * / + - ) and < >
' Combining these has been more trouble than it worth,
' so we do them on a case by case basis
' a * not preceeded by ws or / and not followed by a =
strIn = regx.Replace(strIn, "([^ \t/])\*([^=])", "$1 *$2")
' a * preceeded by ws and not followed by ws or a = or /
strIn = regx.Replace(strIn, "([ \t])\*([^ \t=/])", "$1* $2")
' a / not preceeded by ws or a / or * and not followed by a = or /
strIn = regx.Replace(strIn, "([^ \t/\*])/([^=/])", "$1 /$2")
' a / preceeded by ws and not followed by ws a + or a = or *
strIn = regx.Replace(strIn, "([ \t])/([^ \t=/\*])", "$1/ $2")
' a + not preceeded by ws or a + and not followed by a + or a =
' the "e" prevents breaking expodentials
strIn = regx.Replace(strIn, "([^ e\t\+])\+([^=\+])", "$1 +$2")
' a + not preceeded by a + and not followed by ws a + or a =
strIn = regx.Replace(strIn, "([^\+e])\+([^ \t=\+]+)", "$1+ $2")
' a - not preceeded by ws or a - and not followed by a - or a = or >
strIn = regx.Replace(strIn, "([^ e\t-])-([^=->])", "$1 -$2")
' a - not preceeded by a - and not followed by ws a - or a = or >
strIn = regx.Replace(strIn, "([^-e])-([^- \t>=])", "$1- $2")
' something about >> searching for > prevents the second
' a > not preceeded by ws or - and not followed by a >
strIn = regx.Replace(strIn, "([^ \t-])>([>]?)([^ \t])", "$1 >$2$3")
' a > not preceeded by ws or - and not followed by ws a >
strIn = regx.Replace(strIn, "([^>])>([^> \t])", "$1> $2")
' a < not preceeded by ws or and not followed by a <
strIn = regx.Replace(strIn, "([^ \t<])<([^<])", "$1 <$2")
' a < not preceeded by ws and not followed by ws a <
strIn = regx.Replace(strIn, "([ \t])<([^ \t<])", "$1< $2")
' Put a spaces before a *= += \= -=
'strIn = regx.Replace(strIn, "([^\s])([\*\+\-/])=", "$1 $2=")
' handle if(, for(, while(, switch(, catch(, and return(, put in a space
strIn = regx.Replace(strIn, "([if|for|while|switch|catch|return])\(", "$1 (")
' for while and switch need to be on there own line
strIn = regx.Replace(strIn, "([^ \t])([if|for|while|switch|catch|return])\(", _
"$1" & vbCrLf & "$2")
strIn = regx.Replace(strIn, "([\w\);]+)[ \t]*([\{\}])", "$1" & vbCrLf & "$2")
' handle ->space and take out the space
strIn = regx.Replace(strIn, "->[ \t]+", "->")
strIn = regx.Replace(strIn, "[ \t]+->", "->")
' close the square bracket around value "[]"
strIn = regx.Replace(strIn, "[ \t]+\[", "[")
strIn = regx.Replace(strIn, "\[[ \t]+", "[")
strIn = regx.Replace(strIn, "[ \t]+\]", "]")
'Remove ws before a ;
strIn = regx.Replace(strIn, "[ \t]+;", ";")
'but I do like ws after a comma
strIn = regx.Replace(strIn, ",([^ \t])", ", $1")
' no ws after a ; and before a Cr, a ; Cr pair
strIn = regx.Replace(strIn, ";[ \t]+(\r)", ";$1")
' Other possibilities
'("\:b+::\:b+", "::") ("\:b+(", "(") ("(\:b+", "(")
'("\:b+)", ")") (";)", "; )") (";;\:b+)", ";;)") ("|(", "| (")
'("&(", "& (")
'mtch = Regex.Match(strIn, "for \(")
'If mtch.Length > 0 Then
' mgrp = mtch.Groups(0)
' caps = mgrp.Captures
'End If
Catch excp As System.Exception
strRet = excp.Message
End Try
CPPFormat_str = strRet
End Function
' Reformat the source code in the currently active file (document)
'Function ReformatActiveDocument()
' ReformatActiveDocument = False
' ' Make sure these statements don't end on the same line they started.
' BreakSingleLiners("if (")
' BreakSingleLiners("for (")
' BreakSingleLiners("switch (")
' ' Break up simple else statements on the same line (except "else if")
' Replace("else\:b+if (", "elseif(")
' IsolateOnRight("else\:b+")
' Replace("elseif(", "else if (")
' ' Break up case statements appearing on single lines
' IsolateOnRight("case .+:\:b+")
' IsolateOnRight("default:\:b+")
' IsolateOnLeft("break;")
' ' Add a space between these operators
' FixLessThanAndGreaterThanOperators()
' FixExponents()
' ' Append a space after these
' AppendSpace(",")
' AppendSpace(";")
' ' Make sure the first C++ comment of every line has a space after it.
' InsertSpaceAfterFirstInLineComment()
' ' Replace all the trailing whitespace (thanks to Paul Bludov)
' '''ActiveDocument.Selection.ReplaceText("\:b+\($\)", "\1", dsMatchRegExp)
' ' Run Smart Indent on function blocks only
' SmartIndentFunctionBlocks()
' ' Remove any lines that are considered extraneous (ie. extra blank lines)
' If Not RemoveExtraneousLines() Then
' Exit Function
' End If
' ' Indent every "case" inside switch statements (thanks to Jim Cooper)
' IndentSwitchBody()
' ' Return OK
' ReformatActiveDocument = True
'End Function
'------------------------------------------------------------------------------
' FILE DESCRIPTION: Routines to reformat XML.
' Created by Mark M. Baker - February 3, 2001 (Based on Alvaro Mendez's C/C++ formatter)
' Last Updated: February 4, 2001
'------------------------------------------------------------------------------
'------------------ m a c X M L F o r m a t D o c ------------------
'-------------------------------------------------------------------
Sub macXMLFormatDoc()
XMLFormat(E_MODE.DOC)
End Sub
'------------ m a c X M L F o r m a t S e l e c t i o n ------------
'-------------------------------------------------------------------
Sub macXMLFormatSelection()
XMLFormat(E_MODE.SELECTION)
End Sub
'------------------------ X M L F o r m a t ------------------------
'-------------------------------------------------------------------
Private Sub XMLFormat( _
ByVal eMode As E_MODE)
' Reformats a XML buffer
Dim doc As Document
Dim tsel As TextSelection
Dim s32IndentStyle As Integer
Dim eType As E_LANG_TYPE
Dim strText As String
doc = DTE.ActiveDocument
If (doc Is Nothing) Then
ErrorShow(E_ERROR.NO_DOC_ACTIVE)
Exit Sub
End If
'eType = FileType_enum(doc)
'If (eType <> E_LANG_TYPE.XML) Then
' ErrorShow(E_ERROR.NO_XML)
' Exit Sub
'End If
tsel = doc.Selection
If (eMode = E_MODE.DOC) Then
tsel.StartOfDocument() ' now select the whole document
tsel.EndOfDocument(True)
End If
'//s32IndentStyle = DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value
'//DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value = vsSmartFormatOptions.vsSmartFormatOptionsNone
strText = tsel.Text
tsel.Delete()
tsel.Insert(XMLFormat_str(strText))
'//DTE.Properties("TextEditor", m_strEditor).Item("IndentStyle").Value() = s32IndentStyle
End Sub
'----------------------- I n d e n t _ s t r -----------------------
' returns a string for the indenting on a new line count
'-------------------------------------------------------------------
Function Indent_str( _
ByVal s32Indent) _
As String
Dim sbld As StringBuilder
sbld = New StringBuilder(CInt((s32Indent * 2) + 2))
sbld.AppendFormat(vbLf)
' I prefer 2 spaces, prints correctly everywhere, handles deep nesting
If (s32Indent > 0) Then
sbld.Append(" "c, s32Indent)
sbld.Append(" "c, s32Indent)
'' it could instead be a tab
''sbld.Append(CChar(vbTab), s32Indent)
End If ' s32Indent > 0
Indent_str = sbld.ToString
End Function
'---------------------- T a g S i z e _ s 3 2 ----------------------
' Computes the size of the tag, searches for ">"
'-------------------------------------------------------------------
Function TagSize_s32( _
ByVal s32StartAt As Integer, _
ByRef strIn As String) _
As Integer
Dim s32Cnt As Integer
Dim s32IX As Integer
Dim s32InLen As Integer
Dim strChar As String
s32InLen = Len(strIn)
s32Cnt = 0
For s32IX = s32StartAt To s32InLen
strChar = Mid(strIn, s32IX, 1)
s32Cnt = s32Cnt + 1
If (strChar = ">") Then
Exit For
End If
Next
TagSize_s32 = s32Cnt
End Function
'-------------------- X M L F o r m a t _ s t r --------------------
' Reformats the XML by inserting tabs, keeping track of indention levels,
' handling element text, and dealing with special single element tags.
'-------------------------------------------------------------------
Function XMLFormat_str( _
ByVal strIn As String) _
As String
Dim eTagNext As E_XML_TYPE
Dim eTagPrev As E_XML_TYPE
Dim s32IX As Integer
Dim strChar As String
Dim s32Indent As Integer
Dim strIndent As String
Dim s32Tag As Integer
Dim strTag As String
Dim s32InLen As Integer
Dim sbld As StringBuilder
s32Indent = 0
strIndent = Indent_str(s32Indent)
s32InLen = Len(strIn)
sbld = New StringBuilder(s32InLen + 100)
eTagPrev = E_XML_TYPE.NONE
For s32IX = 1 To s32InLen
strChar = Mid(strIn, s32IX, 1)
If (strChar = "<") Then
eTagNext = Tag_enum(s32IX, strIn)
s32Tag = TagSize_s32(s32IX, strIn)
strTag = Mid(strIn, s32IX, s32Tag)
strTag = StripNewlinesAndTabs_str(strTag)
Select Case eTagNext
Case E_XML_TYPE.START_ELEMENT
sbld.AppendFormat("{0}{1}", strIndent, strTag)
s32Indent = s32Indent + 1
strIndent = Indent_str(s32Indent)
Case E_XML_TYPE.SINGLE_ELEMENT
sbld.AppendFormat("{0}{1}", strIndent, strTag)
Case E_XML_TYPE.END_ELEMENT
s32Indent = s32Indent - 1
strIndent = Indent_str(s32Indent)
If ((eTagPrev = E_XML_TYPE.END_ELEMENT) _
Or (eTagPrev = E_XML_TYPE.SINGLE_ELEMENT)) Then
sbld.AppendFormat("{0}{1}", strIndent, strTag)
Else
sbld.Append(strTag)
End If
Case E_XML_TYPE.START_XML
sbld.Append(strTag)
Case E_XML_TYPE.COMMENT
sbld.AppendFormat("{0}{1}", strIndent, strTag)
End Select
eTagPrev = eTagNext
s32IX = s32IX + s32Tag - 1
' Now we need to find the next tag
eTagNext = TagNext_enum(strIn, s32IX)
Else
If ((eTagPrev = E_XML_TYPE.START_ELEMENT) _
And (eTagNext = E_XML_TYPE.END_ELEMENT)) Then
sbld.Append(strChar)
ElseIf ((strChar <> vbTab) _
And (strChar <> vbNewLine) _
And (strChar <> vbCr) _
And (strChar <> vbLf) _
And (strChar <> " ")) Then
sbld.Append(strChar)
End If
End If
Next
XMLFormat_str = sbld.ToString
End Function
'--------- S t r i p N e w l i n e s A n d T a b s _ s t r ---------
' Removes any existing newlines and tabs in the selection.
'-------------------------------------------------------------------
Function StripNewlinesAndTabs_str( _
ByRef strIn As String) _
As String
Dim s32IX As Integer
Dim strChar As String
Dim strNew As String
Dim s32IY As Integer
Dim s32InLen As Integer
Dim strChar2 As String
Dim s32QCnt As Integer
Dim ynQuotedString As Boolean
Dim ynStripQuotedNewlines As Boolean
ynStripQuotedNewlines = False
ynQuotedString = False
strNew = ""
s32InLen = Len(strIn) ' get the length of the input string
For s32IX = 1 To s32InLen
strChar = Mid(strIn, s32IX, 1)
' is this the beginning of an attribute value?
If (strChar = Chr(34)) Then ' double quote "
If ynQuotedString = True Then
ynQuotedString = False
Else
ynQuotedString = True
' look ahead to the end of the string. count length of Quote.
s32QCnt = 0
For s32IY = s32IX + 1 To s32InLen
strChar2 = Mid(strIn, s32IY, 1)
If (strChar2 = Chr(34)) Then ' double quote "
Exit For
Else
s32QCnt = s32QCnt + 1
End If
Next
' strip newlines from embedded attribute text if text is not too long. devstudio
' can't handle really long lines.
If (s32QCnt < 1000) Then
ynStripQuotedNewlines = True
Else
ynStripQuotedNewlines = False
End If
End If
strNew = strNew + strChar
Else
If (ynQuotedString = True) Then
If (ynStripQuotedNewlines = False) Then
strNew = strNew + strChar
ElseIf ((strChar <> vbNewLine) _
And (strChar <> vbLf) _
And (strChar <> vbCr)) Then
strNew = strNew + strChar
End If
ElseIf ((strChar = vbTab) _
Or (strChar = vbNewLine) _
Or (strChar = vbLf)) Then
strNew = strNew + " "
ElseIf (strChar <> vbCr) Then
strNew = strNew + strChar
End If
End If
Next
StripNewlinesAndTabs_str = strNew
End Function
'------------------------- T a g _ e n u m -------------------------
' Sitting on a "<" look ahead to determine what type of tag this is
'-------------------------------------------------------------------
Function Tag_enum( _
ByVal s32StartAt As Integer, _
ByRef strIn As String) _
As E_XML_TYPE
Dim strChThis As String
Dim strChPrev As String
Dim s32IX As Integer
Dim s32Len As Integer
Tag_enum = E_XML_TYPE.NONE
strChPrev = ""
s32Len = Len(strIn)
For s32IX = s32StartAt To s32Len
strChThis = Mid(strIn, s32IX, 1)
If ((strChPrev = "<") _
And (strChThis = "/")) Then
Tag_enum = E_XML_TYPE.END_ELEMENT
Exit For
ElseIf ((strChPrev = "/") _
And (strChThis = ">")) Then
Tag_enum = E_XML_TYPE.SINGLE_ELEMENT
Exit For
ElseIf (strChThis = ">") Then
Tag_enum = E_XML_TYPE.START_ELEMENT
Exit For
ElseIf ((strChPrev = "<") _
And (strChThis = "?")) Then
Tag_enum = E_XML_TYPE.START_XML
Exit For
ElseIf ((strChPrev = "<") _
And (strChThis = "!")) Then
Tag_enum = E_XML_TYPE.COMMENT
Exit For
End If
strChPrev = strChThis
Next
End Function
'--------------------- T a g N e x t _ e n u m ---------------------
' we just parse what we have until a "<" and then find is type
'-------------------------------------------------------------------
Function TagNext_enum( _
ByRef strIn As String, _
ByVal s32StartAt As Integer) _
As E_XML_TYPE
Dim strChr As String
Dim s32IX As Integer
Dim s32Len As Integer
TagNext_enum = E_XML_TYPE.NONE
s32Len = Len(strIn)
For s32IX = s32StartAt To s32Len
strChr = Mid(strIn, s32IX, 1)
If strChr = "<" Then
TagNext_enum = Tag_enum(s32IX, strIn)
Exit For
End If
Next
End Function
'------------------------ E r r o r S h o w ------------------------
' Show one of the predefined errors in a message box.
'-------------------------------------------------------------------
Sub ErrorShow( _
ByVal eType As E_ERROR)
Dim strMessage
Select Case eType
Case E_ERROR.NO_DOC_ACTIVE
strMessage = "There is no active source file"
Case E_ERROR.NO_SELECTION
strMessage = "Make a text selection and run this macro again."
Case E_ERROR.NOT_CPP
strMessage = "Select a C/C++ source file and run this macro again."
Case E_ERROR.NOT_TYPE
strMessage = "Select an appropriate source file and run this macro again."
Case E_ERROR.NO_XML
strMessage = "Select a XML file and run this macro again."
Case E_ERROR.NOT_VB
strMessage = "Select a VB file and run this macro again."
Case E_ERROR.OUT_OF_MEMORY
strMessage = "This macro is not working properly because " & _
"Visual C++ has apparently run out of memory." & _
vbLf & vbLf & "Unfortunately this is a bug in " & _
"Visual C++. It typically manifests itself " & _
"whenever the macro is run multiple times on very " & _
"large files, inside the same Visual C++ session. " & _
"The only way around it is to open a new Visual " & _
"C++ session for each large file you want to " & _
"reformat." & vbLf & vbLf & "Press OK to go back " & _
"to the original file. You should then exit Visual C++."
Case E_ERROR.UNKNOWN
strMessage = "This is an unknown file type, select an appropriate file" _
& " and run this macro again"
Case Else
strMessage = "Unknown Error"
End Select
MsgBox(strMessage, vbExclamation)
End Sub
Sub macToolWindowsClose()
DTE.Windows.Item(Constants.vsWindowKindOutput).Close()
DTE.Windows.Item(Constants.vsWindowKindTaskList).Close()
DTE.Windows.Item(Constants.vsWindowKindFindResults1).Close()
DTE.Windows.Item(Constants.vsWindowKindFindResults2).Close()
DTE.Windows.Item(Constants.vsWindowKindOutput).Close()
DTE.Windows.Item(Constants.vsWindowKindThread).Close()
DTE.Windows.Item(Constants.vsWindowKindLocals).Close()
DTE.Windows.Item(Constants.vsWindowKindAutoLocals).Close()
DTE.Windows.Item(Constants.vsWindowKindSolutionExplorer).Close()
DTE.Windows.Item(Constants.vsWindowKindMacroExplorer).Close()
DTE.Windows.Item(Constants.vsWindowKindProperties).Close()
DTE.Windows.Item(Constants.vsWindowKindCommandWindow).Close()
DTE.Windows.Item(Constants.vsWindowKindToolbox).Close()
DTE.Windows.Item(Constants.vsWindowKindServerExplorer).Close()
' the following closes the help and index if open
DTE.Windows.Item(Constants.vsWindowKindDynamicHelp).Close()
DTE.Windows.Item("{73F6DD5B-437E-11D3-B88E-00C04F79F802}").Close()
End Sub
Sub macFindSomeTildas()
'DTE.ExecuteCommand("Edit.Find")
DTE.Find.FindWhat = "~~~~~~"
DTE.Find.Target = vsFindTarget.vsFindTargetCurrentDocument
DTE.Find.MatchCase = False
DTE.Find.MatchWholeWord = False
DTE.Find.Backwards = False
DTE.Find.MatchInHiddenText = True
DTE.Find.PatternSyntax = vsFindPatternSyntax.vsFindPatternSyntaxLiteral
DTE.Find.Action = vsFindAction.vsFindActionFind
DTE.Find.Execute()
'DTE.Windows.Item(Constants.vsWindowKindFindReplace).Close()
DTE.ActiveDocument.Selection.LineDown()
DTE.ActiveDocument.Selection.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstText)
End Sub
End Module
Submit an article or tip