Wiki Home

Vcx Cmt


Namespace: WIN_COM_API
* Program VcxCmt.prg
* Adds {headers, returns} to all the methods of all the classes in a dir.
* By CarlKarsten

lOneDir( "d:\vfe6\vfeframe\libs\" )

return
**********************************************************************
function lOneDir( tcVcxDir )
* Process all VCX's in tcVCXdir,

local ;
	lcVcxDir, ;
	laVcxs(1), lnVcxs, lcVcx, ;
	lnI

lcVcxDir = addbs( tcVcxDir )

lnVcxs = aDir( laVcxs, lcVcxDir + "*.vcx" )

if lnVcxs = 0
	? "No vcx's found in " + lcVcxDir
endif

for lnI = 1 to lnVcxs
	lcVcx = laVcxs( lnI, 1 )
	lOneVcx( lcVcxDir + lcVcx )
endfor

return
**********************************************************************
function lOneVcx( tcVcx )
* Process One VCX
* comments the method field of the vcx

? tcVcx

use (tcVcx) exclusive

* Sort Methods
replace all Methods with ;
	lCmtMth( methods, objName, tcVcx ) for !empty( methods )

* add objectname and vcx to header, add return to end if needed.
replace all Methods with ;
	lSrtMth( methods ) for !empty( methods )

* Sort comments so that PdDn-ing thourgh methods are also sorted
* Took this out.  it may have a bad side effect.
* replace reserved3  with  laSrtMem( reserved3 ) ;
	for !empty( reserved3 )

use

* "Fixes" some pointers that align methods in the class browser to the code.
compile classlib (tcVcx)

return
**********************************************************************
function lCmtMth( tcMth, tcCls, tcVcx )

* Adds a comment to the top of each method: object::method {vcx}
* and a return at the end
* Parameters:
* tcMth: Methods from Method field of a vcx.
* tcCls: Class cotaining these methods -- from class field (trim(class))
* tcVcx: name of VCX file this class is in

local ;
	laLins(1), lnLins, lcLin, ;
	lcMthCod, ;
	llRetOk

* If we never find any code, no need for a return statement
llRetOk = .t.
lcMthCod = ""
lnLins = alines( laLins, tcMth )
for each lcLin in laLins

 	do case

		case lcLin = "PROCEDURE"
			lcLin = lcLin + CHR(13) + CHR(10) ;
				+ "** Method: " ;
				+ tcCls + "::" + substr( lcLin, len( "PROCEDURE" )+2 )+ "() " ;
				+ "{" + tcVcx + "}"

		case lcLin = "** Method: " and "::" $ lcLin and "{" $ lcLin and lower( right( lclin, 5 ) ) = ".vcx}"
			* Eat this header line, a new header has been added.
			loop

		case lcLin = "ENDPROC"
			* If the last non blank line was not "return", add a return.
			if !llRetOk
				lcLin = "return" + CHR(13) + CHR(10) ;
					+ lcLin
			endif

		case lower( lcLin ) = "return"
                        * found a return, so don't add one unless we find more code
			llRetOk = .T.

		case !empty( lcLin ) and !inlist( rtrim( lcLin ), "*", "&"+"&" )
                        * found code, so we need a return
			llRetOk = .f.

	endcase

	lcMthCod = lcMthCod + lcLin + CHR(13) + CHR(10)

endfor

return lcMthCod
**********************************************************************
function lSrtMth( tcMth )

* Sorts procedures file by procedure name

local ;
	lnSel, ;
	laLins(1), lnLins, lcLin, ;
	lcMthNam, ;
	lcMthCod, ;
	lcRet

lnSel = select()

create cursor Mths ( cMthNam c(60), cMthCod m )
lnLins = alines( laLins, tcMth )
lcMthCod = ""
for each lcLin in laLins

 	lcMthCod = lcMthCod + lcLin + CHR(13) + CHR(10)
	do case 
		case lcLin = "PROCEDURE"
			lcMthNam = substr( lcLin, len( "PROCEDURE " ) )
		case lcLin = "ENDPROC"
 			insert into Mths values ( lcMthNam, lcMthCod )
			lcMthCod = ""
	endcase

endfor

* Sort by proc name
index on cMthNam tag cMthNam

* Make a big string out of all the procs
lcRet = ""
scan
	lcRet = lcRet + cMthCod
endscan

select (lnSel)

return lcRet
**********************************************************************
function laSrtMem( tcMem )
* Sort Memo

set step on

local ;
	lnMlns, laMlns(1), lcMln, ;
	lcRet

* Put in array
ALINES( laMLns, tcMem )

* Sort
asort( laMlns )

* Put back into big string
lcRet = ""
for each lcMln in laMlns
	lcRet = lcRet + lcMln + chr(13) + chr(10)
endfor

return lcRet
**********************************************************************
* eof: VcxCmt.prg


Variant of Vcx Cmt.prg by Vlad Tokarev
Some code sections marked with "VT".


* Program VcxCmt.prg
* Adds {headers, returns, footers}
* to all the methods of all the classes in a dir.
* By CarlKarsten

#Define CRLF Chr(13)+Chr(10)

set safety off
set alternate to (program() + '.log')
set alternate on
set safety on

lOneDir(FullPath(''))
* lOneDir( "d:\vfe7\vfeframe\libs\" )
* lOneDir( "d:\dev\apps\dis\libs\", "*.vcx" )

* lOneDir( "D:\dev\util\pjx\trakproj\", "*.vcx" )
* lOneDir( "D:\dev\josh\skedstar", "*.scx" )

* lOneDir( "d:\vfe6\tools\builderb\" )
* lOneDir( "d:\vfe7\sample\libs\", "*.vcx")
* lOneDir( "d:\vfe7\ilibs\", "ip*vcx")
* lOneDir( "d:\vfe6\classes\" )
* lOneDir( "d:\vfe6\ilibs\", "*.vcx" )
* lOneDir( "d:\stonefield\sfreports", "SfReports.vcx" )
* lOneDir( "d:\stonefield\sfcommon\", "*.vcx" )
* lOneDir( "d:\stonefield\sfquery\", "*.vcx" )
* lOneDir( ".\", "STUD_ED.scx" )
* lOneDir( "d:\dev\tests\carcolors\ilibs\", "*.vcx" )
* lOneDir( ".\", "*.vcx" )
* lOneDir( "d:\vfe7\tools\pjxhookx\", "*.vcx" )


set alternate off
set alternate to
Return
**********************************************************************
Function lOneDir( tcVcxDir, tcVcxMask )
* Process all VCX's in tcVCXdir,

Local ;
	lcVcxDir, ;
	lcVcxMask, ;
	laVcxs(1), lnVcxs, lcVcx, ;
	lnI

lcVcxDir = Addbs( tcVcxDir )
lcVcxMask = Iif( Empty( tcVcxMask), "*.vcx", tcVcxMask )

lnVcxs = Adir( laVcxs, lcVcxDir + lcVcxMask )

If lnVcxs = 0
	? "No vcx's found in " + lcVcxDir
Endif

For lnI = 1 To lnVcxs
	lcVcx = laVcxs( lnI, 1 )
	lOneVcx( lcVcxDir + lcVcx )
Endfor

Return
**********************************************************************
Function lOneVcx( tcVcx )
* Process One VCX
* comments the method field of the vcx

? tcVcx

Use (tcVcx) Exclusive

* Browse FIELDS METHODS FOR !Empty( METHODS )

Try
	* add objectname and vcx to header, add return to end if needed.
*	Replace All Methods With ;
*		lCmtMth( Methods, Parent, objName, tcVcx ) For !Empty( Methods )
	Replace All Methods With ;
		lCmtMth( Methods, Parent, objName, tcVcx ) ;
		For !Empty( Methods ) and not Deleted()

	* lCmtMth( methods, objName, tcVcx ) for !empty( methods )

	* Sort Methods
*	Replace All Methods With ;
*		lSrtMth( Methods ) For !Empty( Methods )
	Replace All Methods With ;
		lSrtMth( Methods ) For !Empty( Methods ) and not Deleted()

	* This stopped working about the time vfp8 came out, but stopped in 7 too - i don't get it.
	* Sort reserved3 so that PdDn-ing thourgh methods are also sorted
	* replace reserved3 with laSrtMem( reserved3 ) ;
	*	for !empty( reserved3 )

	* "Fixes" some pointers that align methods in the class browser to the code.
	* This you need if you mess with the method field.
	USE
		
	Compile Classlib (tcVcx)

Catch To loError When loError.Message = "Variable 'METHODS' is not found."
	USE
		
Endtry

Return
**********************************************************************
Function lCmtMth( tcMth, tcParent, tcCls, tcVcx )
* function lCmtMth( tcMth, tcCls, tcVcx )

* Adds a comment to the top of each method: object::method {vcx}
* and a return at the end
* and a comment at the end too
* Parameters:
* tcMth: Methods from Method field of a vcx.
* tcCls: Class cotaining these methods -- from class field (trim(class))
* tcVcx: name of VCX file this class is in

* MODIFY CLASS ATTENDEESFORM OF "d:\dev\apps\cc\libs\aforms.vcx" method pgfAttendees.pagList.grdAttendees.enabled_assign
* Class attendeesform of d:\dev\apps\cc\libs\AFORMS.VCX Method grdAttendees.enabled_assign
Local ;
	llComment, ;		&& VT
	lnI, ;			&& VT
	llInProcedure, ;	&& VT
	laLins(1), lnLins, lcLin, ;
	lcLin2, ;		&& VT
	lcMthCod, ;
	llRetOk, ;
	lcFull, lcClass, lcObj, lcMethod, lcCurMethod

lcFull = Iif( Empty( tcParent ), "", tcParent + "." ) + tcCls
lcClass = Substr( lcFull, 1, At(".", lcFull+".")-1 )
lcObj = Iif( "."$lcFull, Substr( lcFull, At(".", lcFull)+1 ), "" )

* If we never find any code (including comments), no need for a return statement
llRetOk = .T.
llComment = .T.
llInProcedure = .F.
lcMthCod = ""
lnLins = Alines( laLins, tcMth )

* VT - 'For Each' has 255 limit
* For Each lcLin In laLins
For lnI=1 to lnLins
	lcLin = laLins[lnI]

	* correcting work of ReFox 9 MMII 
	IF LEFT(lcLin, 9) = 'FUNCTION '
		lcLin = STRTRAN(lcLin, 'FUNCTION ', 'PROCEDURE ')
	ENDIF
	IF LEFT(lcLin, 7) = 'ENDFUNC'
		lcLin = STRTRAN(lcLin, 'ENDFUNC', 'ENDPROC')
	ENDIF
	IF NOT llInProcedure
		lcLin = STRTRAN(lcLin, '*', '')
	ENDIF

	Do Case

		Case lcLin = "PROCEDURE "

			llInProcedure = .T.
			lcMethod = Iif( !Empty(lcObj), lcObj + ".", "" ) + Substr( lcLin, Len( "PROCEDURE" )+2 )
			Do Case
				Case Lower( Justext( tcVcx )) = "vcx"
					lcCurMethod = "** Modify Class "
				Case Lower( Justext( tcVcx )) = "scx"
					lcCurMethod = "** Modify Form "
			Endcase

			lcCurMethod = lcCurMethod ;
				+ lcClass + " of [" + tcVcx + "]" ;
				+ " Method " + lcMethod

			lcLin = lcLin + CRLF + lcCurMethod

		Case lcLin = "** Method: " And "::" $ lcLin And "{" $ lcLin And Lower( Right( lcLin, 5 ) ) = ".vcx}"
			* Eat this way OLD header line, a new header has been added.
			Loop

		Case lcLin = "** Class " And " of [" $ lcLin And " Method " $ lcLin
			* Eat this OLD header line, a new header has been added.
			Loop

		Case lcLin = "** Modify " And " of [" $ lcLin And " Method " $ lcLin
			* Eat this header line, a new header has been added.
			Loop

		Case lcLin = "ENDPROC"

			* We can rebuild it - it will be better than it was before.
			lcLin = ""

			* If the last non blank line was not "return", add a return.
			If !llRetOk
*			If !llRetOk and llComment
				? lcClass + " of [" + tcVcx + "]" + " Method " + lcMethod
				? 'Added "Return .t."'
				* lcLin = lcLin + "** next line (Return) added by " + PROGRAM(0) + CRLF
				lcLin = lcLin + "Return .t." + CRLF
			Endif
*			lcLin = lcLin + lcCurMethod + CRLF + CRLF
			lcLin = lcLin + lcCurMethod + CRLF
			lcLin = lcLin + "ENDPROC" + CRLF
			llInProcedure = .F.
			llComment = .T.

		Case Lower( Alltrim( Chrtran(lcLin, Chr(9), "" ) ) ) = "return"
			* found a return, so don't add one unless we find more code
			llRetOk = .T.

		Case !Empty( lcLin )

			* found code, so we need a return

			* I used to skip methods that only had a comment in them. That was wrong.
			* Even a comment in a method will cause
			* that method to get executed, not the code in the parent class.
			* You don't really see this in the debugger, because with no real code,
			* there is nothing for the debugger to step to, so it just exits the method.
			* So putting a return in the 'empty' method is a good idea so you can see
			* in the bugger which method executed

			lcLin2 = Lower( ltrim( Chrtran(lcLin, Chr(9), "" ) ) )
			do case
				case lcLin2 = '*'
				case lcLin2 = '&'+'&'
				case lcLin2 = 'note '
				otherwise
					llComment = .F.
			endcase

			llRetOk = .F.

	Endcase

	lcMthCod = lcMthCod + lcLin + CRLF

Endfor

Return lcMthCod
**********************************************************************
Function lSrtMth( tcMth )

* Sorts procedures file by procedure name

Local ;
	lnI, ;	&& VT
	lnSel, ;
	laLins(1), lnLins, lcLin, ;
	lcMthNam, ;
	lcMthCod, ;
	lcRet

lnSel = Select()

Create Cursor Mths ( cMthNam c(60), cMthCod m )
lnLins = Alines( laLins, tcMth )
lcMthCod = ""

* VT - 'For Each' has 255 limit
* For Each lcLin In laLins
For lnI=1 to lnLins
	lcLin = laLins[lnI]

	lcMthCod = lcMthCod + lcLin + CRLF
	Do Case
		Case lcLin = "PROCEDURE "
			lcMthNam = Substr( lcLin, Len( "PROCEDURE " ) )
		Case lcLin = "ENDPROC"
			Insert Into Mths Values ( lcMthNam, lcMthCod )
			lcMthCod = ""
	Endcase

Endfor

* Sort by proc name
* Index On cMthNam Tag cMthNam
Index On Upper(cMthNam) Tag cMthNam	&& VT

* Make a big string out of all the procs
lcRet = ""
Scan
	lcRet = lcRet + cMthCod
Endscan
Use

Select (lnSel)

Return lcRet
**********************************************************************
Function laSrtMem( tcMem )
	* Sort Memo

	Local ;
		lnMlns, laMLns(1), lcMln, ;
		lcRet

	* Put in array
	Alines( laMLns, tcMem )

	* Sort
	Asort( laMLns )

	* Put back into big string
	lcRet = ""
	For Each lcMln In laMLns
		lcRet = lcRet + lcMln + Chr(13) + Chr(10)
	Endfor

	Return lcRet
	**********************************************************************
	* eof: VcxCmt.prg


Contributor: Carl Karsten Vlad Tokarev
Category Code Samples
( Topic last updated: 2004.05.27 10:38:01 PM )