Make Declares List

Share your advanced PureBasic knowledge/code with the community.
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Make Declares List

Post by IdeasVacuum »

Parse a single PB source code file for Procedures and create a list of declares from them, saved to Clipboard. Option to append list to a file if processing more than one source.

If your project starts to grow into something bigger than first intended, you will possibly get 'Procedure does not exist' messages from the Compiler. This is where the advanced declaration of Procedures works wonders, but some developers find it tedious to include/update them. So this is for you:

Code: Select all

;GetDeclares.pb PB5.30 x86 UTF8 27/08/2015

;*******************************************************************************************************
; NOTE: If there is a DataSection, it is assumed to be at the end of the file.
;       If not true in your files, comment out 2 lines following "Stop Search if DataSection found".
;
;       sgLastPathFile: record of last path used to make file selection faster/easier.
;
;       The CheckBox background colour is defined using Windows API. If not using Windows, you could
;       delete the WinCallback Procedure and the setting of the Window back colour.
;
;       Declares for 1 source code file are saved to the clipboard.
;       Optionally, Declares for all source code files processed are appended to a file: "Declares.pbi".
;*******************************************************************************************************

EnableExplicit

UsePNGImageDecoder()

Enumeration
#WinMain
#FileIO
#ChkBox
#TxtFileIn
#BtnSort
#BtnStart
#StrFileIn
#BtnBrowse
EndEnumeration

Global NewList sgAllProcs.s()         ;List of Declares
Global              sgEOF.s = "@EOF@" ;Artificial End-of-file (belt and braces)

Global    sgLastPathFile.s = "C:\LastPath.txt"
Global       igSortBtnOn.i = #False
Global       igInProcess.i = #False
Global   sgDefaultFolder.s = "C:\"
Global      igBtnBrwsImg.i = CatchImage(10, ?BtnBrowse)
Global          igFormat.i = 0
Global         qgFileLen.q = 0
Global          *gTextBuff

Global igLabelTextColour.i = RGB(000,000,000)
Global   igStrTextColour.i = RGB(016,016,016)
Global       igWinColour.i = RGB(096,096,096)
Global            hBrush.i = CreateSolidBrush_(igWinColour)
Global       igFontGui10.i = LoadFont(0, "Microsoft Sans Serif", 10, #PB_Font_Bold | #PB_Font_HighQuality + 2)
Global      igFontStrs12.i = LoadFont(1, "Microsoft Sans Serif", 12, #PB_Font_HighQuality + 2)

Procedure SaveLastPath()
;#----------------------
              If CreateFile(#FileIO, sgLastPathFile)

                      WriteStringN(#FileIO, sgDefaultFolder, #PB_UTF8)
                         CloseFile(#FileIO)
              EndIf
EndProcedure

Procedure GetLastPath()
;#---------------------
              If(FileSize(sgLastPathFile) > 0)

                     If ReadFile(#FileIO, sgLastPathFile)

                             sgDefaultFolder = ReadString(#FileIO, #PB_UTF8)
                             CloseFile(#FileIO)
                     EndIf
              EndIf
EndProcedure

Procedure ToggleSortBtn()
;#-----------------------
              Select igSortBtnOn

                        Case #False: SetGadgetText(#BtnSort, "Sort ON")  : igSortBtnOn = #True
                        Case  #True: SetGadgetText(#BtnSort, "Sort OFF") : igSortBtnOn = #False
              EndSelect
EndProcedure

Procedure.s GetEol()
;#------------------
;Determine End of Line String: Windows = CRLF, Unix/Linux = LF, Classic Mac = CR, Mac OSX = LF
Protected sEOL.s, sCR.s, sLF.s, iCR.i = 0, iLF.i = 0

              iCR = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), #CR$, 1, #PB_String_NoCase)
              iLF = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), #LF$, 1, #PB_String_NoCase)

              If((iCR > 0) And (iLF = 0))

                    sEOL = #CR$

              ElseIf((iCR = 0) And (iLF > 0))

                    sEOL = #LF$

              Else
                    sEOL = #CRLF$ ;Default
              EndIf

              ProcedureReturn(sEOL)
EndProcedure

Procedure ListAll(sFullPath.s)
;#----------------------------
Protected            sLine.s, sCodeLine.s, sDeclare.s, sClip.s, sChar1.s,  sEOL.s
Protected        qLenBytes.q, qLineLenBytes.q
Protected      qStartChars.q, qEndChars.q, iProc.i, iOk.i = 0, iCnt.i = 0
Protected  sExportFilePath.s = GetPathPart(sFullPath)
Protected  sExportFilename.s = GetFilePart(sFullPath, #PB_FileSystem_NoExtension)
Protected             sExt.s = GetExtensionPart(sFullPath)
Protected      sExportFile.s = sExportFilePath + "Declares.pbi"
Protected           sTitle.s = ";" + sExportFilename + "." + sExt
Protected    sEndProcedure.s = "EndProcedure" + sEOL ;Required because last file line could be 'EndProcedure', but without an EOL
Protected iEndProcLenChars.i = Len(sEndProcedure)
Protected  iExportFileReqd.i = GetGadgetState(#ChkBox)

ClearList(sgAllProcs())

              If(qgFileLen > 1)

                     sEOL = GetEol()

                     Repeat
                              ;Find 'Procedure'
                              qStartChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), "Procedure", qStartChars, #PB_String_NoCase)
                              If(qStartChars = 0) : Break : EndIf

                              ;Find EOL
                                   qEndChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), sEOL, qStartChars, #PB_String_NoCase)
                                       sLine = Mid(PeekS(*gTextBuff, qgFileLen, igFormat), qStartChars, (qEndChars - qStartChars))
                               qLineLenBytes = StringByteLength(sLine, igFormat)
                                 qStartChars = qEndChars + Len(sEOL)
                                   qLenBytes = qLenBytes + qLineLenBytes ;Progress in Bytes

                                  iProc = FindString(sLine, "Procedure", 1, #PB_String_NoCase)
                               If(iProc > 0)

                                      ;Test for variants that are not 'Procedure'
                                         iOk = FindString(sLine, "Procedures", 1, #PB_String_NoCase)
                                      If(iOk < 1)

                                                iOk = FindString(sLine, "_Procedure", 1, #PB_String_NoCase)
                                             If(iOk < 1)

                                                       iOk = FindString(sLine, "EndProcedure", 1, #PB_String_NoCase)
                                                    If(iOk < 1)

                                                              iOk = FindString(sLine, "ProcedureReturn", 1, #PB_String_NoCase)
                                                           If(iOk < 1)

                                                                       sCodeLine = Trim(sLine)
                                                                          sChar1 = Left(sCodeLine, 1)
                                                                   If Not(sChar1 = ";")

                                                                           ;'Procedure' Found
                                                                           AddElement(sgAllProcs())
                                                                                      sgAllProcs() = ReplaceString(sCodeLine, "Procedure", "Declare", #PB_String_NoCase)

                                                                                                                          iCnt = iCnt + 1
                                                                           SetGadgetText(#StrFileIn, "Processing: " + Str(iCnt)) : While WindowEvent() : Wend

                                                                           ;Since 'Procedure' has been found, jump to 'EndProcedure'
                                                                              qStartChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), "EndProcedure", qStartChars, #PB_String_NoCase)
                                                                           If(qStartChars = 0) : Break : EndIf ;Something wrong with the file or this code :(
                                                                                    sLine = Mid(PeekS(*gTextBuff, qgFileLen, igFormat), qStartChars, iEndProcLenChars)
                                                                              qStartChars = qStartChars + iEndProcLenChars ;Next 'Find' Starts at end of last 'Find'
                                                                            qLineLenBytes = StringByteLength(sEndProcedure, igFormat)
                                                                                qLenBytes = qLenBytes + qLineLenBytes ;Progress in Bytes
                                                                   EndIf
                                                           EndIf
                                                    EndIf
                                             EndIf
                                      EndIf
                               Else
                                      ;Stop Search if "DataSection" found (comment-out if your DataSections are not at the end of the file)
                                         iOK = FindString(sLine, "DataSection", 1, #PB_String_NoCase)
                                      If(iOk > 0) : Break : EndIf

                                      ;Stop Search if gEOF found (EOF for the purposes of this process)
                                         iOK = FindString(sLine, sgEOF, 1, #PB_String_NoCase)
                                      If(iOk > 0) : Break : EndIf

                               EndIf ;(iProc > 0)

                     Until((qLenBytes = qgFileLen) Or (qLenBytes > qgFileLen))

                     If(igSortBtnOn = #True)

                               SortList(sgAllProcs(), #PB_Sort_Ascending | #PB_Sort_NoCase)
                     EndIf

                     ;To Clipboard
                     sClip = sTitle + sEOL

                     ForEach sgAllProcs()

                            sClip = sClip + sgAllProcs() + sEOL
                     Next

                     SetClipboardText(sClip) : sClip = ""

                     ;Append File
                     If(iExportFileReqd = #PB_Checkbox_Checked)

                            If OpenFile(#FileIO, sExportFile, #PB_File_Append)

                                     WriteString(#FileIO, sTitle + sEOL, igFormat)

                                     ForEach sgAllProcs()

                                             WriteString(#FileIO, sgAllProcs() + sEOL, igFormat)
                                     Next

                                     WriteString(#FileIO, sEOL, igFormat)
                                       CloseFile(#FileIO)
                            EndIf
                     EndIf

                     SetGadgetText(#StrFileIn, "Done! Declare Total" + ": " + Str(iCnt))
              Else
                     MessageRequester("Make Declare List", "Problem: No file?")
              EndIf

              igInProcess = #False
EndProcedure

Procedure PfReadFile(sFullPath.s)
;#-------------------------------

               If ReadFile(#FileIO, sFullPath)

                        igFormat = ReadStringFormat(#FileIO)
                       qgFileLen = Lof(#FileIO)
                      *gTextBuff = AllocateMemory(qgFileLen + 32)

                       ReadData(#FileIO, *gTextBuff, qgFileLen)
                          PokeS(*gTextBuff + qgFileLen, sgEOF)
                      CloseFile(#FileIO)
               Else
                      MessageRequester("Make Declare List", "Problem: Could not open file")
               EndIf
EndProcedure

Procedure.s BrowseForFile()
;#-------------------------
Protected      sPat.s = "PB include file (*.pbi)|*.pbi|PB file (*.pb)|*.pb|All PB files (*.pb *.pbi *.pbf)|*.pb;*.pbi;*.pbf|All files (*.*)|*.*"
Protected sFullPath.s = OpenFileRequester("Make Declare List: " + "Browse to and Select File", sgDefaultFolder, sPat, 0)

              If(FileSize(sFullPath) > 0)

                         SetGadgetText(#StrFileIn, sFullPath)
                             ClearList(sgAllProcs())
                      sgDefaultFolder = GetPathPart(sFullPath)
                      SaveLastPath()
                        PfReadFile(sFullPath)
              EndIf

              ProcedureReturn(sFullPath)
EndProcedure

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
;#-----------------------------------------------
Protected iReturn.i = #PB_ProcessPureBasicEvents

              Select uMsg

                         Case  #WM_CTLCOLORSTATIC

                               Select lParam   ;API call: allows choosing gadgets by their number

                                       Case GadgetID(#ChkBox)

                                            iReturn = hBrush
                               EndSelect
              EndSelect

              ProcedureReturn iReturn
EndProcedure

Procedure Win()
;#-------------
Protected iFlags.i = #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered

              If OpenWindow(#WinMain, 0, 0, 560, 85, "Make Declare List [Saved to Clipboard]", iFlags)

                            SetWindowColor(#WinMain,igWinColour)
                              WindowBounds(#WinMain, 560, 85, #PB_Ignore, 85)

                            CheckBoxGadget(#ChkBox,       5,   6, 300,  20, "Append List to Declares.pbi")
                              ButtonGadget(#BtnSort,    310,   6, 120,  24, "Sort OFF")
                              ButtonGadget(#BtnStart,   435,   6, 120,  24, "Make List")
                                TextGadget(#TxtFileIn,    5,  34, 200,  16, "PB Source File")
                              StringGadget(#StrFileIn,    5,  54, 520,  26, "", #PB_String_BorderLess | #PB_String_ReadOnly)
                         ButtonImageGadget(#BtnBrowse,  530,  54,  26,  26, igBtnBrwsImg)

                             GadgetToolTip(#BtnBrowse, "Browse to Select PB file (*.pb *.pbi *.pbf)")
                             GadgetToolTip(#BtnSort,   "Select to sort/not sort Declares List alphabetically")
                             GadgetToolTip(#BtnStart,  "Select to make Declares List")

                             SetGadgetFont(#ChkBox, igFontGui10)
                             SetGadgetFont(#TxtFileIn, igFontGui10)

                             SetGadgetFont(#StrFileIn, igFontStrs12)

                            SetGadgetColor(#ChkBox, #PB_Gadget_FrontColor, igLabelTextColour)

                            SetGadgetColor(#TxtFileIn, #PB_Gadget_FrontColor, igLabelTextColour)
                            SetGadgetColor(#TxtFileIn, #PB_Gadget_BackColor, igWinColour)

                            igSortBtnOn = #False

                         SetWindowCallback(@WinCallback())
              EndIf
EndProcedure

Procedure WaitForUser()
;----------------------
Protected iExit = #False
Protected sFullPath.s = ""

              Repeat

                    Select WaitWindowEvent(1)

                               Case #PB_Event_CloseWindow: iExit = #True

                               Case #PB_Event_RestoreWindow, #PB_Event_SizeWindow

                                                             ;X                           ;Y          ;W                      ;H
                                    ResizeGadget(#StrFileIn, #PB_Ignore,                  #PB_Ignore, WindowWidth(#WinMain) - 40, #PB_Ignore)
                                    ResizeGadget(#BtnBrowse, WindowWidth(#WinMain) - 30,  #PB_Ignore, #PB_Ignore,             #PB_Ignore)
                                    ResizeGadget(#BtnSort,   WindowWidth(#WinMain) - 250, #PB_Ignore, #PB_Ignore,             #PB_Ignore)
                                    ResizeGadget(#BtnStart,  WindowWidth(#WinMain) - 125, #PB_Ignore, #PB_Ignore,             #PB_Ignore)

                               Case #PB_Event_Gadget

                                          Select EventGadget()

                                                     Case #BtnBrowse: sFullPath = BrowseForFile()
                                                     Case   #BtnSort: ToggleSortBtn()
                                                     Case  #BtnStart
                                                                             If(igInProcess = #False)
                                                                                     igInProcess = #True
                                                                                     ListAll(sFullPath)
                                                                             EndIf
                                          EndSelect
                    EndSelect

              Until iExit = #True

EndProcedure

        Win()
GetLastPath()
WaitForUser()

If *gTextBuff : FreeMemory(*gTextBuff) : EndIf

End

DataSection
  BtnBrowse:
  Data.q $0A1A0A0D474E5089,$524448490D000000,$1800000018000000,$3D77E00000000608,$59487009000000F8
  Data.q $0E0000C40E000073,$00001B0E2B9501C4,$DE07454D49740700,$24B9FB01330F0201,$584574070000005F
  Data.q $00726F6874754174,$0C00000048CCAEA9,$6373654474584574,$006E6F6974706972,$0A00000023210913
  Data.q $79706F4374584574,$0FAC007468676972,$45740E0000003ACC,$6974616572437458,$00656D6974206E6F
  Data.q $09000000090FF735,$74666F5374584574,$FF705D0065726177,$5845740B0000003A,$69616C6373694474
  Data.q $8FB4C0B70072656D,$7458457408000000,$00676E696E726157,$0700000087E61BC0,$72756F5374584574
  Data.q $00EB83FFF5006563,$4374584574080000,$F600746E656D6D6F,$7406000000BF96CC,$656C746954745845
  Data.q $01000027D2EEA800,$ED894854414449C9,$9F871840D36F3F95,$40A085DAA34ECFB3,$A58803A95A81235B
  Data.q $037C40622A03282C,$581958D826502DFA,$6C426262421502F9,$DC6A0924F9425448,$32F3FE7C4969A23F
  Data.q $82C8512B1A88B6B8,$3BBF3F5EEFB267D4,$D3BD76EDDAA77D9F,$AC8885E8A28DBCE9,$ED5AB507529400B2
  Data.q $FA69A76D7AD5AB53,$BF2116F012F318CE,$5DDBB751E4924BC0,$2C68AA4EEC9249D6,$68E04CFBCA5B7509
  Data.q $B24924A7B3671164,$C6CA7E3B96BD27AB,$71793B5B0A52824A,$7264B9E8FC50C86C,$377FD359111135C9
  Data.q $53A7865EEB19CB04,$DF655A4FA78D6082,$E3C6FD7CBE2FC9C9,$5480324BEA986220,$6CAB73BD16679F84
  Data.q $4C7AEB615C572B2B,$37364D5BD58379B3,$E1E35C68DC3D8EEE,$7EE23953234603F6,$065D88331F4F10FF
  Data.q $E7EF3E4E78078D46,$556DEFF7052A76CF,$91DF19F8F87C15F6,$4EE3B4028B9CA032,$558159AC5F434C15
  Data.q $C3A2A602AE30B751,$2B6A729869600430,$FB8F4F093FC1EFCC,$2201E76678421D1C,$FE3397E42229E7F9
  Data.q $AFFFFBC29E1415A6,$6C409901ECC055C1,$8A234E5BBD54510C,$082A179D8F1C710C,$0476E7612D700102
  Data.q $1F26C5E9B7CEE380,$A032A9930D6EF7DC,$4A19EB372117AC07,$29568708110337CD,$98015E03D81A7A07
  Data.q $664FB3E7B73DD14C,$4D80701F7F7DF6CF,$DE07BC07B8905FC0,$DDB042AFD70A01FC,$454900000000060C
  Data.q $0000826042AE444E
EndDataSection
[/size]

I have written this to suit the way I work, everyone is free to modify it to suit their needs - don't ask me to do it for you :)

Edit: Modified to remove the glitches reported by Vera
Last edited by IdeasVacuum on Fri Aug 28, 2015 6:17 am, edited 1 time in total.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Make Declares List

Post by Kwai chang caine »

Several code already exist on the forum to do this style of function
But you have right, it's always better when it's personal code, when we have enough knowledge to make it :wink:

I have tested the append mode and that works
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: Make Declares List

Post by Vera »

Thank you for sharing Image

It runs fine on Linux for me
... except when hitting #BtnStart while there's no valid address in the stringfield. :mrgreen: I helped myself and added some dis&enable gadget commands.

Another thing I would likely change is not to add a file-name to the declare-file if the result was zero. But then again - who would choose a file without procedures anyway ;-)

greets ~ Vera
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Make Declares List

Post by IdeasVacuum »

Hi Vera
except when hitting #BtnStart while there's no valid address in the stringfield
Strange - you should see a message requester saying "Problem: No file?"

When I'm going through a lot of files, especially if the project had to be set-aside for some time, I found including the titles even when no Procedures were found was a help - there might be something in the file that causes the list maker to fail, so the 'orphan' titles are a reminder to check by hand. It was the odd failure that resulted in the artificial EOF being added.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: Make Declares List

Post by Vera »

IdeasVacuum wrote:Strange - you should see a message requester saying "Problem: No file?"
This doesn't happen in both cases. If I start the app and directly hit #BtnStart I get an IMA in GetEol() at:

Code: Select all

iCR = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), #CR$, 1, #PB_String_NoCase)
saying: "The given address is zero".

I think that " Protected sEOL.s = GetEol()" is processed before the following code from ListAll(sFullPath.s) is regarded. So it doesn't come to the point to test If(qgFileLen > 1) is empty.

And the other situation is clicking #BtnStart while the result-string of a prior check ist still in the string-field.
This is true for GetEol() and for If(qgFileLen > 1) but after that it freezes the app.

Applying a debugger-breakpoint in the Repeat-loop I get a further compiler warning for line:

Code: Select all

If *gTextBuff : FreeMemory(*gTextBuff) : EndIf
saying: "Invalid memory-access".

Sorry that I can't dig deeper into this. And if I'm the only one with this side-effect it could be left at that and I'll just continue gladly with the disable-gadget switch.


Ah yes - I can see that it does make sense to rather have these 'orphan' titles.
Thanks for sharing some insights :-)

edit: adjusted engl. expression
Last edited by Vera on Sun Aug 30, 2015 11:44 am, edited 1 time in total.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Make Declares List

Post by davido »

@IdeasVacuum,
Thank you for sharing such a useful utility. :D

Thanks also for taking the trouble to explain how to make it work cross-platform. Works great on my MacBook.
DE AA EB
Post Reply