Iterate, Incr

[Borje Hagsten]

Writing a parser that can deal with all kinds of exceptions is a real
challenge. Found an interesting situation, with comments after extended
lines.: (most examples I've seen so far will fail on this one)

FUNCTION OpenFileDialog (BYVAL hWnd AS LONG, _            ' parent window
                         BYVAL Caption AS STRING, _       ' caption
                         Filespec AS STRING, _            ' filename
                         BYVAL InitialDir AS STRING, _    ' start directory
                         BYVAL Filter AS STRING, _        ' filename filter
                         BYVAL DefExtension AS STRING, _  ' default extension
                         Flags AS DWORD _                 ' flags
                         ) AS LONG

One solution that seems to work fine, please feel free to do what you like with it:

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Sample of Sub/Function lister for PB code. Parses given file and
' creates a "DECLARE" style result, for easy copy and paste into your
' code. Should handle all aspects, including trailing comments in
' lines, "broken" with an underscore ("_") character. Can be optimized
' for better speed, but pretty fast as it is, so..
'
' Public Domain, March 2001 by Borje Hagsten
' ..but as always, use at your own responsibility..  [img]http://www.powerbasic.com/support/forums/smile.gif[/img]
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE
#INCLUDE "WIN32API.INC"
%ID_TEXT     = 20
%ID_TEXT2    = 21
 
GLOBAL TheArray() AS STRING, SubStr() AS STRING, SubCount AS LONG
 
DECLARE CALLBACK FUNCTION DlgProc() AS LONG
DECLARE FUNCTION FileToArray(BYVAL TheFile AS STRING) AS LONG
DECLARE SUB GetSubs
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Create dialog and controls, etc
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS LONG, File AS STRING
 
  DIALOG NEW 0, "Sub/Function lister",,,  300, 200, %WS_SYSMENU, 0 TO hDlg
 
  CONTROL ADD BUTTON, hDlg, 10, "&Start", 190, 166, 50, 14
  CONTROL ADD BUTTON, hDlg, 11, "E&xit",  242, 166, 50, 14
  CONTROL ADD TEXTBOX, hDlg, %ID_TEXT, "", 4, 4, 288, 152, _
                       %WS_CHILD OR %ES_MULTILINE OR %ES_WANTRETURN OR %ES_NOHIDESEL OR _
                       %WS_HSCROLL OR %ES_AUTOHSCROLL OR %WS_VSCROLL OR %ES_AUTOVSCROLL, _
                       %WS_EX_CLIENTEDGE
 
  CONTROL ADD LABEL, hDlg, -1, "File to scan:",  4, 158, 50, 10
  File = "c:\pbdll60\samples\pbnote\pbnote.bas"  '<- NOTE - change to proper path..
  CONTROL ADD TEXTBOX, hDlg, %ID_TEXT2, File, 4, 168, 178, 12, _
                       %WS_CHILD OR %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE
 
  DIALOG SHOW MODAL hDlg CALL DlgProc
 
END FUNCTION
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgProc() AS LONG
  LOCAL I AS LONG, txt AS STRING
 
  SELECT CASE CBMSG
     CASE %WM_COMMAND
        IF CBCTL = 10 THEN
           CONTROL GET TEXT CBHNDL, %ID_TEXT2 TO txt
           IF LEN(txt) = 0 THEN EXIT FUNCTION                 'if no length, leave
           IF (GETATTR(txt) AND %ATTR_DIR) THEN EXIT FUNCTION 'if directory, leave
 
           IF DIR$(txt, 55) <> "" THEN                        'if file exist, work
              FileToArray txt                                 'load file into array
              GetSubs                                         'parse out subs/functions
              txt = ""
              ARRAY SORT SubStr(), COLLATE UCASE              'sort result
              FOR I = 0 TO UBOUND(SubStr)
                 txt = txt & "DECLARE " & SubStr(I) & $CRLF   'create declaration string
              NEXT
              CONTROL SET TEXT CBHNDL, %ID_TEXT, txt          'show result
           END IF
           BEEP
 
        ELSEIF CBCTL = 11 THEN
           DIALOG END CBHNDL
        END IF
  END SELECT
 
END FUNCTION
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Load a text file into an array
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION FileToArray(BYVAL TheFile AS STRING) AS LONG
  LOCAL c AS LONG, NumRecs AS LONG, Buf AS STRING
 
  OPEN TheFile FOR BINARY AS #1
     GET$ #1, LOF(1), Buf
  CLOSE #1
 
  Numrecs = TALLY(Buf, $CRLF)            '<- line feed count
  IF Numrecs = 0 THEN EXIT FUNCTION
 
  REDIM TheArray(Numrecs)                '<- reset arrays
  REDIM SubStr(0) : SubCount = 0
 
  OPEN TheFile FOR INPUT AS #1 LEN = 32767
     FOR c = 0 TO Numrecs - 1
       LINE INPUT #1, TheArray(c)        '<- read line by line into array
     NEXT
  CLOSE #1
 
  FUNCTION = c - 1                       '<- if we ever should need it..
END FUNCTION
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Get subs and functions from an array, into another array
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB GetSubs
  LOCAL I AS LONG, J AS LONG, K AS LONG, sFlag AS LONG, txt AS STRING
 
  FOR I = 0 TO UBOUND(TheArray)
     TheArray(I) = TRIM$(TheArray(I), CHR$(9))        'remove eventual tabs
     K = INSTR(TheArray(I), "'")
     IF K THEN                                        'if trailing comment
        txt = LEFT$(TheArray(I), K - 1)               'only use text up to comment
        txt = TRIM$(txt)                              'trim away leading/ending spaces
     ELSE
        txt = TRIM$(TheArray(I))                      'trim away leading/ending spaces
     END IF
 
     IF sFlag = 0 THEN                                'if we are looking for start
        IF LEFT$(UCASE$(txt), 9) = "FUNCTION " THEN   'if start is found
           sFlag = 2 : J = I                          'set flag and store I in J
        ELSEIF LEFT$(UCASE$(txt), 4) = "SUB " THEN
           sFlag = 1 : J = I
        ELSEIF LEFT$(UCASE$(txt), 18) = "CALLBACK FUNCTION " THEN
           sFlag = 2 : J = I
        END IF
 
     ELSE
        SELECT CASE sFlag                             'what kind of end?
        CASE 1
           IF LEFT$(UCASE$(txt), 7) = "END SUB" THEN  'proper end is found
              REDIM PRESERVE SubStr(SubCount)         'redim target
              GOSUB GetProperString                   'get properly formatted compare string
              DO WHILE RIGHT$(txt, 1) = "_"           'enter loop if..
                 SubStr(SubCount) = SubStr(SubCount) + TheArray(J) + $CRLF + SPACE$(8) 'add some for line feed, etc..
                 INCR J                               'next line
                 GOSUB GetProperString                'get properly formatted compare string
              LOOP
              SubStr(SubCount) = SubStr(SubCount) + TheArray(J) 'get stored element, J
              INCR SubCount                                  'increase counter
              sFlag = 0                                      'reset flag and search for next
           END IF
 
        CASE 2
           IF LEFT$(UCASE$(txt), 12) = "END FUNCTION" THEN 'same as above, but for functions
              REDIM PRESERVE SubStr(SubCount)
              GOSUB GetProperString
              DO WHILE RIGHT$(txt, 1) = "_"
                 SubStr(SubCount) = SubStr(SubCount) + TheArray(J) + $CRLF + SPACE$(8)
                 INCR J
                 GOSUB GetProperString
              LOOP
              SubStr(SubCount) = SubStr(SubCount) + TheArray(J)
              INCR SubCount
              sFlag = 0
           END IF
        END SELECT
     END IF
  NEXT
EXIT SUB
 
GetProperString :
  K = INSTR(TheArray(J), "'")
  IF K THEN                               'if trailing comment
     txt = LEFT$(TheArray(J), K - 1)      'only use text up to comment
     txt = TRIM$(txt)                     'trim away leading/ending spaces
  ELSE
     txt = TRIM$(TheArray(J))             'trim away leading/ending spaces
  END IF
  RETURN
 
END SUB

------------------

[Borje Hagsten]

A few things: Like Lance says - first remove/replace eventual Tab
characters (CHR$(9) since you don't need/wan't them anyway. Not that
PBedit ever stores any tab characters, but just to make sure, like
if code was written in another editor, for example..

Then simply TRIM$(BasData.. before you even start looking at the
string. Makes code a bit cleaner and further handling much easier.

Use a flag instead of "If x = "function=" Then", since "=" sometimes
may come after 14 spaces, whatever. If flag is 0, set Flag according
to what you have found, start of Function or Sub. If flag is 1, look
for "End Sub", if flag is 2, look for "End Function", as an example.
Reset flag when end is found and look for next start. Simple a and
faster way to avoid mixing up with "Function =".

Also, UCASE is actually about 20-25% faster than LCASE$. Finally,
when you think you have found start of a function, you can use
something like: (BTW, can BasData and IncData really use same counter?)

  BasData(lLoop) = TRIM$(BasData(lLoop))
  DO WHILE Right$(BasData(lLoop),1) = "_"
     IncData(nLoop) = IncData(nLoop) + $CRLF + BasData(lLoop)
     INCR lLoop
  LOOP

Note: if BasData doesn't end with "-", the loop never will be entered.


------------------

[Scott Turchin]

One quick question on this scalar piece...

If A$ = lcase$(Blah blah)...I lose formatting in the INC file...

I know PB will SHOW it as proper syntax/format etc (caps, mixed case, lcase).....
Anyway to avoid that and just clean it up without trying every combination known to mankind for each word?


Scott

------------------
Scott

[Scott Turchin]

Wow, cool, I may employ that scalar thing !!
Your right, forgot about FOr, I'm really bad about that...
I went through the help file and kept coming across this statement:

Remove$ is case sensitive
Instr is case sensitive
Is case sensitive

is case sensitive...

Aaaaaaarghhhh hehe

Think I'll be able to do this, lotta parsing and formatting but should work..
I forgot about callbacks....sheesh....that ought to be easy though because it cannot be a multi-line function header, right?
Ie Callback function abc_
ABC,_
As Long


Because if it is, well that's not my problem at that point...




------------------
Scott

[Lance Edmonds]

You are free to mess with the counter variable as you choose within the loop.

Think of a FOR..NEXT loop as discrete code, which is essentially how it operates internally, thus:

'FOR x = istart TO iStop
x = istart
WHILE x <= iStop
 ...
 INCR x ' increment the loop counter.
WEND

As you can see, if add yet enother INCR statement inside the loop counter in the loop, the loop logic will still work fine. Loop counters are just normal memory (or preferably register) variables afterall.

Additionally, you can quite legally jump in and out of a FOR..NEXT loop with a GOTO, but that is considered to be a poor technique (read: spaghetti code).

Finally, your code that analyses the source code looks like it is not going to handle extreme formatting conditions. FOr example, if there is more than one space character between "FUNCTION" and "=", your code will assume a function prototype has been found.

It is most likely you need to consider removing unnecessary whitespace from the code before parsing it. Instead of:

If LCase$(Left(BasData(lLoop),9)) = "function=" Or LCase$(Left(BasData(lLoop),10)) = "function =" Then Iterate

Something like this:

a$ = lcase$(BasData(iLoop)) ' copy to a scalar to avoid frequent subscript math
replace chr$(9) with chr$(32) in a$
while instr(a$, "  ") ' 2 spaces
  replace "  " with " " in a$
wend
if left(a$,9)) = "function=" then
  ...
elseif left$(a$,8) = "callback" then
  ...
elseif left$(a$,3) = "sub" then
  ...
endif

Any comments? (barring discussion on further optimization!)

------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>

[Scott Turchin]

What happens if I incr lLoop at this point??
Do I get a stack problem or is it OK?
For lLoop = 1 to 65k ''''etc
If Right$(Trim$(BasData(lLoop),1) = "_" Then 'Multi-line function header
incr Loop '
IncData(lLoop) = BasData(lLoop)
end if
Next

This may be the easy answer but could eat my stack too (???)


------------------
Scott

[Scott Turchin]

This may be more a formatting question than anything...
I have a for next loop, ie
For lLoop = 1 to lCount 'Where lcount can be as high as 65k

Next

If a string in this datastring that will be parsed inside the for next loop contains a "_"
on the last character then I want to grab the next piece of the
array and incr the For loop.

If I iterate will I lose my place on the stack?
I could just incr the counter and grab the next piece but then I will re-iterate
through the code on the next loop through...

This is actually my PBCC MAKEINC.BAS file that I'm working on to create declarations from .BAS files...

ie, this is the code

For lLoop = 1 To lCount
    If LCase$(Left$(BasData(lLoop),3)) = "sub" Then
    End If
    If LCase$(Left$(BasData(lLoop),8)) = "function" Then 'This has potential to include "Function =", parse for that
       If LCase$(Left(BasData(lLoop),9)) = "function=" Or LCase$(Left(BasData(lLoop),10)) = "function =" Then Iterate
       'Should be an actual function now.
       IncData(lLoop) = "Declare " & BasData(lLoop)
       If Right$(Trim$(BasData(lLoop),1) = "_" Then 'Multi-line function header
          'Need to grab lLoop + 1, +2 until "_" is not on the end.
       End If
    End If
    
Next

Is that clear as mud? I need to keep grabbing BasData(lLoop) + 1, +2 until the "_" is not found on the right Trim$ of the string....


Scott

------------------
Scott