Macros for Code Cleanup and Auto Implementing

Backgound

1. I don't like the way code gets autogererated by Visual Studio. I personally think the multiple protected and public statements in the class header are terrible. I want at most one public, one protected, and one private section (in that order).
2. I almost always want to define the default constructor, copy constructor, destructor, and assignment operator. Quite often, in the private section to prevent the copying of the class.
3. I usually first define most of the interface part of a class, then the implementation.
4. I'm lazy.

This article provides a couple of macros that:

1. Clean up autogenerated code
2. Implement methods defined in a class header.
3. Generate constructors and so forth.

Description

There are a bunch of private helper macros used internally. The public macros are:

PrettifyClassHeader
Cleans up (typically autogenerated) class header by

1. Arranging code into one public, one protected, and one private block
2. Removing MFC comments
3. Commenting debug section

Usage: Select class definition not including the { and } and run it.

DefineStructors
Generates destructor, constructors, assignment operator. Commented as disabled if generated in the private section.
Usage: Put the cursor somewhere in the class definition's { and } and run macro.

ImplementSelection
Generates an implementaion skeleton for the selected methods.
Uses the GetFriendFile macro for switching to the .cpp file.
Usage: Select method definitions in the class header and run macro.

Feel free to modify at will. Suggestions for improvements/cooler solutions are welcome...

'---------------------------------------------------------------
' CleanUp
' Clean up autogenerated files
'---------------------------------------------------------------
Sub CleanUp()
  Dim ext, fileSentry

  if FileType<> 1 then
    MsgBox "Only works on C/C++ files"
    exit sub
  end if

  ' I'm certain I'll use _MSC_VER > 1000
  DeleteLinesWith "#if _MSC_VER > 1000"
  DeleteLinesWith "#endif // _MSC_VER > 1000"

  ext = GetExt(ActiveDocument.Name)
  if ext = ".h" or ext = ".hpp" then
    ' Replace the AFX_FILENAME1234BARFBARF__INCLUDED_ with
    ' FILENAME_H
    fileSentry = UCASE(ActiveDocument.Name)
    fileSentry = Replace(fileSentry, ".", "_")
    ActiveDocument.ReplaceText "AFX_.+__INCLUDED_", fileSentry, _
                               dsMatchRegExp
  end if
End Sub

'---------------------------------------------------------------
' PrettifyClassHeader
' Cleans up (possibly autogenerated) class header
' Select class header NOT including the { and }
' PrettifyClassHeader will then:
'     1. Arrange code into one public, one protected, and
'        one private block
'     2. Remove MFC comments
'     3. Comment debug section
'---------------------------------------------------------------
Sub PrettifyClassHeader()
' DESCRIPTION: Cleans up (possibly autogenerated) class header
  Dim sPubl,sProt,sPriv, sAFX_VIRTUAL, sAFX_MSG, sAFX_DATA,
  Dim iAccess, aLines, iLower, iUpper, i, sOut, s
  if Documents.Count = 0 then
    exit sub
  end if

  '---------------------------------------------------------------
  ' Phase 1: Arrange code into 1 public, 1 protected and 1 private
  ' block. Also handle the various AFX_ sections.
  '---------------------------------------------------------------
  sPubl = "public:" & vbCrLf & _
      Comment("Public Construction") & vbCrLf & _
      Comment("Public Queries") & vbCrLf & _
      Comment("Public Commands") & vbCrLf
  sProt = "protected:" & vbCrLf & _
      Comment("Protected Construction") & vbCrLf
  sPriv = "private:" & vbCrLf & _
      Comment("Disabled Methods") & vbCrLf & _
      Comment("Private Helper Methods") & vbCrLf & _
      Comment("Members") & vbCrLf
  sAFX_VIRTUAL  = ""
  sAFX_MSG  = ""
  sAFX_DATA  = ""

  ' 1:Public 2:Protected 3:Private 4:AFX_VIRTUAL 5:AFX_MSG
  ' 6:AFX_DATA
  iAccess = 3
  aLines = Split(ActiveDocument.Selection, vbCrLf, -1, 1)
  iLower = LBound(aLines)
  iUpper = UBound(aLines)

  For i = iLower To iUpper
      s = aLines(i)

    if Left(s, 7) = "public:" then
      iAccess = 1
    elseif Left(s,10) = "protected:" then
      iAccess = 2
    elseif Left(s, 8) = "private:" then
      iAccess = 3
    elseif Instr(s, "//{{AFX_VIRTUAL") >0 then
      iAccess = 4
      sAFX_VIRTUAL = Comment("Class Wizard Managed Virtual Methods")
                     & vbCrLf & s & vbCrLf
    elseif Instr(s, "//{{AFX_MSG") >0 then
      iAccess = 5
      sAFX_MSG = Comment("Class Wizard Managed Message Map Methods")
                 & vbCrLf & s & vbCrLf
    elseif Instr(s, "//{{AFX_DATA") >0 then
      iAccess = 6
      sAFX_DATA = Comment("Class Wizard Managed Dialog Data") &
                  vbCrLf " s & vbCrLf
    else
      select case iAccess
        case 1
          sPubl = sPubl & s & vbCrLf
        case 2
          sProt = sProt & s & vbCrLf
        case 3
          sPriv = sPriv &s& vbCrLf
        case 4
            sAFX_VIRTUAL = sAFX_VIRTUAL & s & vbCrLf
        case 5
            sAFX_MSG = sAFX_MSG & s & vbCrLf
        case 6
            sAFX_DATA = sAFX_DATA & s & vbCrLf
      end select
    end if
  Next

  ' Here is where the output order is defined. If you, for example,
  ' prefer to have the AFX_DATA section public, let it follow the
  ' sPubl section.
  sOut =  sPubl & vbCrLf & _
          sProt & vbCrLf & _
          sAFX_VIRTUAL & vbCrLf & _
          sAFX_MSG & vbCrLf & _
          sPriv & vbCrLf & _
          sAFX_DATA
  '---------------------------------------------------------------
  ' Phase 2: Remove MFC comments
  '---------------------------------------------------------------
  sOut = Replace(sOut, "// ClassWizard generated virtual function _
                 overrides", "")
  sOut = Replace(sOut, "// Generated message map functions", "")
  sOut = Replace(sOut, "// Attributes", "")
  sOut = Replace(sOut, "// Operations", "")
  sOut = Replace(sOut, "// Implementation", "")
  sOut = Replace(sOut, "// standard constructor", "")
  sOut = Replace(sOut, "// Overrides", "")
  sOut = Replace(sOut, "// Construction", "")
  sOut = Replace(sOut, "// Dialog Data", "")
  sOut = Replace(sOut, vbTab & vbTab & "// NOTE: the ClassWizard _
                 will add data members here" & vbCrLf, "")
  sOut = Replace(sOut, vbTab & vbTab & "// NOTE - the ClassWizard _
                 will add and remove member functions here" _
                 & vbCrLf, "")
  sOut = Replace(sOut, vbTab & vbTab & "//    DO NOT EDIT what _
                 you see in these blocks of generated code !" _
                 & vbCrLf, "")
  ' Also remove some empty lines
  sOut = Replace(sOut, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
  sOut = Replace(sOut, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
  sOut = Replace(sOut, vbCrLf & vbTab & vbCrLf, "")
  '---------------------------------------------------------------
  ' Phase 3: Comment debug section
  '---------------------------------------------------------------
  sOut = Replace(sOut, "#ifdef _DEBUG", Comment("Debug Methods") _
                 & vbCrLf & "#ifdef _DEBUG")
  '---------------------------------------------------------------
  ' All Done!
  '---------------------------------------------------------------
  ActiveDocument.Selection = sOut
End Sub

'---------------------------------------------------------------
' DefineStructors
' Create constructor/destructor/assignment operator for the class
' at insertion point
'---------------------------------------------------------------
Sub DefineStructors()
' DESCRIPTION: Generate con/de-structors and assignment operator.
  Dim className, iLine, src, sOut, iAccess
  if FileType<> 1 then
    MsgBox "Only works on C/C++ files"
    exit sub
  end if
  src = GetStringUpToSelection
  className = CurrentClass(src)
  if (className<>"") then
    sOut = ""
    iAccess = GetCurrentAccessScope(src)
    if iAccess = 1 then sOut = vbCrLf _
                 & Comment("Public Construction") & vbCrLf
    if iAccess = 2 then sOut = vbCrLf _
                 & Comment("Protected Construction") & vbCrLf
    if iAccess = 3 then sOut = Comment("Disabled Methods") & vbCrLf
    sOut = sOut & _
      vbTab & "// Default constructor" & vbCrLf & _
      vbTab & className & "();" & vbCrLf & _
      vbTab & "// Copy constructor" & vbCrLf & _
      vbTab & "explicit " & className _
            & "(const " & className &"&);" & vbCrLf & _
      vbTab & "// Destructor" & vbCrLf & _
      vbTab & "~" & className & "();" & vbCrLf

    if iAccess = 1 then sOut = sOut & vbCrLf _
                 & Comment("Public Operators") & vbCrLf
    if iAccess = 2 then sOut = sOut & vbCrLf & Comment("Protected _
                 Operators") & vbCrLf
    if iAccess = 3 then sOut = sOut & vbCrLf
    sOut = sOut & _
      vbTab & "// Assignment operator" & vbCrLf & _
      vbTab & className & "& operator = _
            (const " & className &"&);" & vbCrLf

    ActiveDocument.Selection.Text = sOut
  else
    MsgBox "Class name not found"
  end if
End Sub

'---------------------------------------------------------------
' ImplementSelection
' Creates implementations of selected methods in the class
' definition.
' Uses GetFriendFile macro to switch to .cpp file if applicable
'---------------------------------------------------------------
Sub ImplementSelection()
' DESCRIPTION: Implements selected method defs.
  Dim src, className, ext, aLines, iLower, iUpper, s, pos, ch, i, _
      body, sOut
  if FileType<> 1 then
    MsgBox "Only works on C/C++ files"
    exit sub
  end if
  src = ActiveDocument.Selection
  className = CurrentClass(GetStringUpToSelection)
  ext = GetExt(ActiveDocument.Name)
  if ext = ".h" or ext = ".hpp" then
    ExecuteCommand "GetFriendFile"
  end if
  aLines = Split(src, vbCrLf, -1, 1)
  iLower = LBound(aLines)
  iUpper = UBound(aLines)
  sOut = ""
  body = vbCrLf & "{" & vbCrLf & vbTab & "// ..." & vbCrLf &   "}" _
         & vbCrLf & vbCrLf
  For i = iLower To iUpper
    s = aLines(i)
    s = Replace(s, vbTab, " ")
    s = Replace(s, "virtual", "")
    s = Replace(s, "static", "")
    s = Replace(s, " =0", "")
    s = Replace(s, "= 0", "")
    s = Replace(s, "=0", "")
    s = Replace(s, ";", "")
    s = Replace(s, " (", "(")
    s = Trim(s)

    ' Find the left most (
    pos = InStr(1, s, "(")
    if (pos>0) then
      ' Go left until space
      pos = InStr(1, s, "(")-1
      ch = Mid(s, pos, 1)
      while (pos > 1 and ch<>" ")
        pos = pos -1
        ch = Mid(s, pos, 1)
      wend

      ' Inject "classname::" and append implementation body.
      s = Left(s,pos) & className & "::" & Mid(s, pos+1) & body

      sOut = sOut & s
    end if
  next
  ActiveDocument.Selection.EndOfDocument
  ActiveDocument.Selection.Text = sOut
End Sub

'---------------------------------------------------------------
' GetIdentifier(src, pos)
' Return the first almost(*) valid C++ identifier in src
' starting at pos
'
' (*) Almost since it will consider identifier starting with
' 0..9 as OK, but it works for my intended use anyway
'---------------------------------------------------------------
Private Function GetIdentifier(src, pos)
  Dim s,i, ch
  s = ""
  GetIdentifier = ""
  For i = pos To Len(src)
    ch = Mid(src, i, 1)
    if (ch >= "a" And ch <= "z") or _
       (ch >= "A" And ch <= "Z") or _
       (ch >= "0" And ch <= "9") or _
       ch = "_" Then
      s = s & ch
    else
      if s<>"" then
        GetIdentifier = s
        exit function
      end if
    End If
  Next
End Function

'---------------------------------------------------------------
' CurrentClass(src)
' Return a class name definition from src by going "backwards",
' skipping class definitions within the current class
'---------------------------------------------------------------
private function CurrentClass(src)
  dim iDepth, iPos, i, classPos, ident
  CurrentClass = ""
  iDepth = 1 ' Keep track of { and } to ignore sub class
             ' definitions.
  iPos = 0   ' Position of last { processed
  for i=Len(src) to 1 step -1
      ' iPos = 0 if we're on the same { } level as when we started
      if iPos = 0 then
      if Mid(src,i,1) = "}" then iDepth = iDepth+1
      if Mid(src,i,1) = "{" then
        iDepth = iDepth-1
        if iDepth = 0 then
          iPos = i
        end if
      end if
    else
      classPos = Instr(i, src, "class")
      if classPos>0 then
        ident = GetIdentifier(src, i+6)
        if ident<>"" then
           CurrentClass = ident
           exit function
        end if
      end if
    end if
  next
end function

'---------------------------------------------------------------
' max(a,b)
' Self explanatory
'---------------------------------------------------------------
private function max(a,b)
  if a>b then max = a else max = b
end function

'---------------------------------------------------------------
' GetStringUpToSelection
' Returns string of entire fil up to the selection's position.
' Note: Unselects everything in the process.
'       Selection's position unchanged though.
'---------------------------------------------------------------
private function GetStringUpToSelection
  Dim s
  if Application.Documents.Count=0 then Exit Function
  ActiveDocument.Selection.StartOfDocument dsExtend
  s = ActiveDocument.Selection.Text
  ActiveDocument.Selection.CharRight
  GetStringUpToSelection = s
end function

'---------------------------------------------------------------
' GetCurrentAccessScope(src)
' Returns the last access scope identified in src
' Returned value: 1 public
'                 2 protected
'                 3 private
' Returns 3 by default (ie assumed private if not explicitly set)
' Gets confused if there are more than one of each kind, for
' examplein sub class definitions. This would be fixed with calls
' to InStrRev instead of InStr (not available in my version of VB,
' alas)
'---------------------------------------------------------------
private function GetCurrentAccessScope(src)
  Dim iPriv, iProt, iPubl, iRes, iMax
  iRes = 3 ' private by default
  ' Get the postitions of scope keywords
  iPubl = Instr(src,"public:")
  iProt = Instr(src,"protected:")
  iPriv = Instr(src,"private:")
  ' Compute the highest position (ie the last)
  iMax = max(max(iPubl, iProt), iPriv)
  if iMax = iPubl then iRes = 1
  if iMax = iProt then iRes = 2
  if iMax = iPriv then iRes = 3
  GetCurrentAccessScope = iRes
end function

'---------------------------------------------------------------
' GetExt
' Returns the extension part of a filename in lowercase
'---------------------------------------------------------------
private Function GetExt(name)
  Dim pos, ext
  ext = name
  pos = Instr(ext, ".")
  if pos > 0 then
    Do While pos <> 1
      ext = Mid(ext, pos, Len(ext) - pos + 1)
      pos = Instr(ext, ".")
    Loop
    ext = LCase(ext)
  end if
  GetExt = ext
end function

'---------------------------------------------------------------
'FileType (Ripped from Sample.dsm)
'Returns the file type of ActiveDocument
'Return value:  0 Unknown file type
'               1 C-related file, this includes .c, .cpp, .cxx,
'                 .h, .hpp, .hxx
'               2 Java-related file, this includes .jav, .java
'               3 ODL-style file, .odl, .idl
'               4 Resource file, .rc, .rc2
'               5 HTML-style file, this includes .html, and .htm
'               6 VBS-style file, .dsm
'               7 Def-style file, .def
'
'---------------------------------------------------------------
private Function FileType
  Dim ext, pos, doc
  FileType = 0
  if Application.Documents.Count>0 then
      Set doc = ActiveDocument
    ext = GetExt(doc.Name)
    If ext = ".rc" Or ext = ".rc2" Then
      FileType = 4
    ElseIf doc.Language = dsCPP Then
      FileType = 1
    ElseIf doc.Language = dsJava Then
      FileType = 2
    ElseIf doc.Language = dsIDL Then
      FileType = 3
    ElseIf doc.Language = dsHTML_IE3 Or _
           doc.Language = dsHTML_RFC1866 Then
      FileType = 5
    ElseIf doc.Language = dsVBSMacro Then '
      FileType = 6
    ElseIf ext = ".def" Then
      FileType = 7
    End If
  end if
End Function

'---------------------------------------------------------------
' DeleteLinesWith(txt)
' Delete all lines containing the text txt
'---------------------------------------------------------------
private sub DeleteLinesWith(txt)
  while ActiveDocument.Selection.FindText(txt, dsMatchFromStart)
    ActiveDocument.Selection.StartOfLine dsFirstColumn
    ActiveDocument.Selection.LineDown dsExtend
    ActiveDocument.Selection.Delete
  wend
end sub

'---------------------------------------------------------------
' Comment(s)
' Return a string with a commented section, kind of like this
' comment but in C++
'---------------------------------------------------------------
private function Comment(s)
    Dim sLine
  sLine = 
"//---------------------------------------------------------------"
  Comment = vbTab & sLine & vbCrLf & _
            vbTab & "// " & s & vbCrLf & _
        vbTab & sLine
end function