A little tool to remove unneeded constants...

[Michael Vogel]

When reducing a code to post a snippet here, it is a lousy job to get rid of unneeded constants, so I wrote a quick and dirty tool doing this for me...

Code: Select all

;{ Constant-Checker by Michael Vogel V1.oo}

	; INSTALLATION:
	; copy compiled exe into the directory "...\Purbasic\Catalogs"
	; install the tool using the parameter "%TEMPFILE"
	; use the PureBasic as the working directory (or adapt the OpenPreferences path below)
	; Select 'Wait until tool quits' And 'Reload source after tool has quit'

	;	%COMPILEFILE\..\Catalogs\Tool ConstantChecker.exe
	;	"%TEMPFILE"
	;	%COMPILEFILE\..
	;	&Check Constants...
	;	Menu Or Shortcut

	; 	× Wait until tool quits
	; 	× Reload Source after tool has quit
	; 	× into the current source


	; /!\ Warnings
	;  -	does not show correct values correctly in all cases (BitEnumeration or Enumeration x)
	;  -	does not support multi line statements, like #a=1 : #b=2 etc.
	
;}

; Define

	#TestMode=0

	; Dateinamen holen...
	CompilerIf #TestMode
		Global InputFile.s="Test.pb"
	CompilerElse
		If CountProgramParameters()<>1
			MessageBox_(0,"'ConstantChecker' benötigt einen Parameter!"+#CR$+"(%TEMPFILE)","Fehler",#MB_ICONERROR| #MB_OK)
			End
		EndIf
		Global InputFile.s=ProgramParameter()
	CompilerEndIf
	Global OutputFile.s=InputFile+"~"


	Structure ConstType
		Name.s
		Value.s
		Type.i
		Line.i
		Count.i
	EndStructure

	Global Dim Source.s(0)
	Global Dim Consts.ConstType(0)

	Global SrcCount
	Global SrcPrefix
	Global SrcOffset

	Global ConCount
	Global ConLength
	Global ConMode
	Global ConEnum

	Enumeration
		#Unsorted
		#Ascending
		#Descending
	EndEnumeration

	Structure LVWSORT
		hWndListView.l;	Fensterhandle des ListView-Controls
		SortKey.l;		Spalte, die sortiert werden soll
		SortType.b;		Typ der zu sortierenden Daten
		SortOrder.b;		Sortierrichtung
	EndStructure

	Enumeration
		#SortString
		#SortValue
	EndEnumeration

	#Undefined=-1

	Enumeration
		#ListLine
		#ListName
		#ListValue
		#ListCount
	EndEnumeration

	Structure ListSortType
		Column.i
		Order.i
	EndStructure

	Global ListSort.ListSortType

; EndDefine

Procedure SourceCheck(*z)

	SrcPrefix=#Null
	SrcOffset=#Null

	Repeat
		SrcPrefix=PeekA(*z+SrcOffset)
		SrcOffset+1
		Select SrcPrefix
		Case ' ',#TAB
			SrcStart+1
		Case #Null
			SrcOffset=#Null
			Break
		Default
			Break
		EndSelect
	ForEver

EndProcedure
Procedure ConstantCheck(*z)

	Protected char

	ConLength=2

	Repeat
		char=PeekA(*z+ConLength)
		Select char
		Case 'a' To 'z','A' To 'Z', '0' To '9', '_'
			ConLength+1
		Default
			Break
		EndSelect
	ForEver

EndProcedure
Procedure.s ValueCheck(*z)

	Protected char
	Protected left

	Repeat
		char=PeekA(*z+left)
		left+1
		Select char
		Case '=',#Null
			Break
		EndSelect
	ForEver

	If char
		Repeat
			char=PeekA(*z+left)
			Select char
			Case ' ',#TAB
			Default
				Break
			EndSelect
			left+1
		ForEver

		If char
			right=left
			Select char
			Case '0' To '9'
				Repeat
					char=PeekA(*z+right)
					Select char
					Case '0' To '9','-','.'
					Default
						Break
					EndSelect
					right+1
				ForEver
			Case '"'
				right+1
				Repeat
					char=PeekA(*z+right)
					right+1
					Select char
					Case '"',#Null
						Break
					EndSelect
				ForEver
			Case '#'
				right+1
				Repeat
					char=PeekA(*z+right)
					Select char
					Case ';',#Null
						Break
					EndSelect
					right+1
				ForEver
			EndSelect

			ProcedureReturn PeekS(*z+left,right-left)
		EndIf

	EndIf

	ProcedureReturn "?"

EndProcedure
Procedure SourceConstant(s.s)

	ConstantCheck(@s)

	ConCount+1
	ReDim Consts(ConCount)

	With Consts(ConCount)
		\Name=Left(s,ConLength)
		\Line=SrcCount
		\Type=ConMode
		\Value="?"

		If ConMode
			\Value=Str(ConEnum)
			ConEnum+1
		Else
			s=Mid(s,ConLength+1)
			\Value=ValueCheck(@s)
		EndIf
		; Debug \Name+" = "+\Value+" (#"+Str(\Line)+", "+Str(\Type)+")"

	EndWith

EndProcedure
Procedure CheckConstant(s.s)

	Protected n

	n=ConCount
	While n
		If s=Consts(n)\Name
			Consts(n)\Count+1
			; Break
		EndIf
		n-1
	Wend

EndProcedure
Procedure CheckLineDelete()

	Protected n

	n=ConCount
	While n
		If Consts(n)\Line=SrcCount
			If Consts(n)\Count=#Null
				ProcedureReturn #True
				Break
			EndIf
		EndIf
		n-1
	Wend
	
	ProcedureReturn #False

EndProcedure

Procedure.l CompareStrings(*value1,*value2,order)

	If order=#Ascending
		ProcedureReturn CompareMemoryString(*value1,*value2,#PB_String_NoCase)
	Else
		ProcedureReturn -CompareMemoryString(*value1,*value2,#PB_String_NoCase)
	EndIf

EndProcedure
Procedure.l CompareValues(value1.s,value2.s,order)

	Protected d.d

	d=ValD(value1)-ValD(value2)
	If order=#Descending
		d=-d
	EndIf

	If d<0
		ProcedureReturn -1
	ElseIf d=0
		ProcedureReturn CompareStrings(@value1,@value2,order)
	Else
		ProcedureReturn 1
	EndIf

EndProcedure
Procedure.s ListIconGetText(*sort.LVWSORT,value.l)

	Protected *buffer
	Protected item.LV_ITEM
	Protected length.l
	Protected result.s=""

	*Buffer=AllocateMemory(512)

	If (*buffer)
		item\mask=#LVIF_TEXT
		item\iSubItem=*sort\SortKey
		item\pszText=*buffer
		item\cchTextMax=(512/SizeOf(Character))-1

		length=SendMessage_(*sort\hWndListView,#LVM_GETITEMTEXT,value,@item)
		If length>0
			result=PeekS(*buffer,length)
		EndIf
		FreeMemory(*buffer)

	EndIf

	ProcedureReturn result

EndProcedure
Procedure.l ListIconCompare(value1.l,value2.l,sort.l)

	Protected *sort.LVWSORT
	Protected entry1.s,entry2.s

	*sort=sort
	entry1=ListIconGetText(*sort,value1)
	entry2=ListIconGetText(*sort,value2)

	If entry1=entry2
		ProcedureReturn 0
	EndIf

	Select *sort\SortType
	Case #SortString;  ' Spalteninhalte sind Strings
		ProcedureReturn CompareStrings(@entry1,@entry2,*sort\SortOrder)
	Case #SortValue
		ProcedureReturn CompareValues(entry1,entry2,*sort\SortOrder)
	EndSelect

EndProcedure
Procedure ListIconSort(gadget,column,order,sorttype)

	Protected id
	Protected sort.LVWSORT

	id=GadgetID(gadget)

	sort\hWndListView=id
	sort\SortKey=column
	sort\SortOrder=order
	sort\SortType=SortType

	SendMessage_(id,#LVM_SORTITEMSEX,@sort,@ListIconCompare())

EndProcedure
Procedure.i ListIconGetOrder(gadget,column)

	gadget=SendMessage_(GadgetID(gadget),#LVM_GETHEADER,0,0);		Header-ID

	Protected item.HD_ITEM
	item\mask=#HDI_FORMAT

	If SendMessage_(gadget,#HDM_GETITEM,column,@item)
		If (item\fmt&#HDF_SORTUP)=#HDF_SORTUP
			ProcedureReturn #Ascending
		ElseIf (item\fmt&#HDF_SORTDOWN)=#HDF_SORTDOWN
			ProcedureReturn #Descending
		Else
			ProcedureReturn #Unsorted
		EndIf

	Else
		ProcedureReturn #Undefined

	EndIf

EndProcedure
Procedure ListIconSetIcon(gadget,column,order)

	Protected count
	Protected item.HD_ITEM
	Protected n

	gadget=SendMessage_(GadgetID(gadget),#LVM_GETHEADER,0,0);		Header-ID
	count=SendMessage_(gadget,#HDM_GETITEMCOUNT,0,0)

	While n<count
		item\mask=#HDI_FORMAT

		SendMessage_(gadget,#HDM_GETITEM,n,@item);				0: Error

		item\mask=#HDI_FORMAT
		If (n=column And order<>#Unsorted)
			Select order
			Case #Ascending
				item\fmt& ~#HDF_SORTDOWN
				item\fmt|#HDF_SORTUP
			Case #Descending
				item\fmt& ~#HDF_SORTUP
				item\fmt|#HDF_SORTDOWN
			EndSelect
		Else
			item\fmt& ~#HDF_SORTUP
			item\fmt& ~#HDF_SORTDOWN
		EndIf

		SendMessage_(gadget,#HDM_SETITEM,n,@item);				0: Error

		n+1
	Wend

EndProcedure
Procedure ListIconSortColumn(gadget,column)

	Protected order

	If ListIconGetOrder(gadget,column)=#Ascending
		order=#Descending
	Else
		order=#Ascending
	EndIf

	If column=#ListName
		ListIconSort(gadget,column,order,#SortString)
	Else
		ListIconSort(gadget,column,order,#SortValue)
	EndIf

	ListIconSetIcon(gadget,column,order)

	ListSort\Column=column
	ListSort\Order=order

EndProcedure
Procedure ListIconCallback(WindowID,Message,wParam,lParam)

	Protected *Message.NM_LISTVIEW

	Select Message
	Case #WM_NOTIFY
		*Message=lParam
		If *Message\hdr\code=#LVN_COLUMNCLICK
			ListIconSortColumn(GetDlgCtrlID_(*Message\hdr\hwndfrom),*Message\iSubItem)
		EndIf
	Default
	EndSelect

	ProcedureReturn #PB_ProcessPureBasicEvents

EndProcedure

Procedure Doit()

	Protected n
	Protected s.s,z.s

	ReadFile(1,InputFile)

	While Eof(1)=#Null
		z=ReadString(1)
		SrcCount+1
		ReDim Source(SrcCount)
		Source(SrcCount)=z
		If z
			SourceCheck(@z)
			Select SrcPrefix
			Case 'E'
				s=Mid(z,SrcOffset,11)
				If s="Enumeration"
					ConMode=1
					ConEnum=0
				ElseIf s="EndEnumerat"
					ConMode=0
				EndIf
				;Debug z
			Case '#'
				SourceConstant(Mid(z,SrcOffset))
			Case ';'
			Default
				n=FindString(z,"#")
				While n
					z=Mid(z,n)
					ConstantCheck(@z)
					CheckConstant(Left(z,ConLength))
					z=Mid(z,ConLength+1)
					n=FindString(z,"#")
				Wend
			EndSelect
		EndIf
	Wend
	CloseFile(1)

	OpenWindow(0,0,0,380,400,"Constants",#PB_Window_ScreenCentered|#PB_Window_Invisible)
	ListIconGadget(0,0,0,380,360,"Line",50)
	AddGadgetColumn(0,1,"Constant",150)
	AddGadgetColumn(0,2,"Value",100)
	AddGadgetColumn(0,3,"Used",50)

	ButtonGadget(101,5,365,120,30,"Disable Constants")
	ButtonGadget(102,130,365,120,30,"Delete Constants")
	ButtonGadget(111,255,365,120,30,"Close")

	For n=1 To ConCount
		With Consts(n)
			AddGadgetItem(0,n-1,Str(\Line)+#LF$+\Name+#LF$+\Value+#LF$+Str(\Count))
		EndWith
	Next n

	SetWindowCallback(@ListIconCallback())
	HideWindow(0,0)

	n=0
	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_Gadget
			Select EventGadget()
			Case 101
				n=1
			Case 102
				n=2
			Case 111
				End
			EndSelect
		Case #PB_Event_CloseWindow
			End
		EndSelect
	Until n

	CompilerIf #TestMode=#Null

		DeleteFile(OutputFile)

		If RenameFile(InputFile,OutputFile)=0
			MessageBox_(0,"'ConstantChecker' konnte keine Temporärdatei erstellen","Fehler",#MB_ICONERROR| #MB_OK)
			End
		EndIf

		If CreateFile(2,InputFile)
			If ReadFile(1,OutputFile)
				SrcCount=0
				While Eof(1)=#Null
					z=ReadString(1)
					SrcCount+1
					If CheckLineDelete()
						If n=1
							WriteStringN(2,"; /!\ "+z)
						EndIf
					Else
						WriteStringN(2,z)
					EndIf
				Wend
				CloseFile(1)
			EndIf
			CloseFile(2)
		EndIf

	CompilerEndIf

EndProcedure

Doit()

[RSBasic]

Good idea
Can you add function to find of unneeded variables and unused procedures?

[Michael Vogel]

Good idea
Can you add function to find of unneeded variables and unused procedures?

Procedures should be possible using the same strategy but checking variables - indeed a good idea - could be much more complicate, because global, local, static variables must be checked in a different way and some other specific things, maybe someone else want to implement that

[IdeasVacuum]

Concerning variables, using EnableExplicit from the outset really makes a difference, as does having a formal variable naming system.