Author Topic: Code-Formatter PB 10  (Read 160131 times)

0 Members and 1 Guest are viewing this topic.

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #165 on: December 18, 2011, 03:40:50 PM »
Hello,
 INSTANCE have built in Split Line

input:
Code: [Select]
INSTANCE arObj() AS VARIANT: INSTANCE arKey() AS STRING   

output:
Code: [Select]
        INSTANCE arObj()                AS VARIANT
        INSTANCE arKey()                AS STRING       
regards Peter
« Last Edit: December 26, 2011, 10:25:23 AM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #166 on: December 21, 2011, 03:35:11 PM »
Hello,
 A new error removed

old input:
Code: [Select]
%LIST_MODULES_ALL = %LIST_MODULES_32BIT OR% LIST_MODULES_64BIT         

old output:
Code: [Select]
%LIST_MODULES_ALL = %LIST_MODULES_32BITOR%LIST_MODULES_64BIT         

new output:
Code: [Select]
%LIST_MODULES_ALL                 = %LIST_MODULES_32BIT OR %LIST_MODULES_64BIT         
« Last Edit: December 26, 2011, 10:25:52 AM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #167 on: December 22, 2011, 08:10:46 PM »
Hello,
have added new check button. There are therefore no longer blanks inserted. Because there are problems with macros to make this!

regards Peter
« Last Edit: December 26, 2011, 10:24:00 AM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #168 on: December 23, 2011, 11:51:04 AM »
Hello,
 have errors in formatting removed with a new check button.

 regards Peter
« Last Edit: December 26, 2011, 10:24:57 AM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #169 on: December 23, 2011, 08:58:59 PM »
Hello,

new fixup. with IF Then Block

regards Peter
« Last Edit: December 26, 2011, 10:23:40 AM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #170 on: December 24, 2011, 09:37:19 PM »
Hello,
I can not resist, even at Christmas. I have two little mistakes now eliminated!

You can test all'm grateful for any feedback! :)

regards Peter
« Last Edit: December 26, 2011, 10:23:18 AM by Peter Weis »

Offline Paul Elliott

  • Full Member
  • ***
  • Posts: 164
  • User-Rate: +40/-32
Re: Code-Formatter PB 10
« Reply #171 on: December 25, 2011, 04:20:10 PM »
Peter,

In the short time that I've looked at your latest code, it is my opinion that you have
WAY over complicated the program. It seems that every new glitch that you find causes
you to rework a large section of code and that introduces more glitches.

With no comments within the code as to exactly what is going on and why.  This leads
to errors in other sections caused by the new changes.

Your new options make changes in output of sections that are unrelated to what they
are meant to affect. Sometimes in a single run of your program  some variables are split
up and aligned  and in the next procedure all variables are pretty much as they were in
the source. Sometimes code gets indented way to the right as if you can not find the end
of a section. Other times it gets set to the left margin for dozens of sections or variables get
outdented 2 or 3 tab stops. And all this within 1 run.

LATER:
tried running in PB Debugger but kept getting error 9 array subscript error in
Function splitline.
END LATER

As near as I can tell you still haven't responded to all the points I made earlier.

You need to put a check on the reading of the .CFG file to make sure that it matches the
current UDT. And make sure that you update the current UDT from all the screen options
before doing any work.

And yes, it is very possible to do almost everything based on the original Line2Words arrays
with only 3 or 4 very small extra routines to handle the odd bit of coding.

I'll check back in about a month to see how you are getting along.

Happy New Year!!

« Last Edit: December 25, 2011, 07:01:17 PM by Paul Elliott »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #172 on: December 25, 2011, 10:26:52 PM »
Hi Paul,
 occurred give me the line in your source code where the error is. So I can then look at what is the problem
 Thank you!

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #173 on: December 25, 2011, 10:53:28 PM »
small reference even for today

 The thing Formatted at least now have super built today still TRY, CATCH, FINAL

 Moreover FOR Next, DO LOOP WHILE WEND and whom in a row!
« Last Edit: December 26, 2011, 10:33:46 AM by Peter Weis »

Offline Paul Elliott

  • Full Member
  • ***
  • Posts: 164
  • User-Rate: +40/-32
Re: Code-Formatter PB 10
« Reply #174 on: December 25, 2011, 11:03:33 PM »
As I said, I'm not doing any more until at least the end of January 2012.

Too bad you tossed out so much code. All those PB keywords you mentioned were working
perfectly before you messed them up. They all are working perfectly in the code I've got.

Why don't you try TESTING the program before you post?




Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #175 on: December 25, 2011, 11:10:36 PM »
Hi Paul,
 Then you just go on time!

 Mine is too stupid

I'm only time away from the project
« Last Edit: December 26, 2011, 10:53:16 AM by Peter Weis »

Offline Paul Elliott

  • Full Member
  • ***
  • Posts: 164
  • User-Rate: +40/-32
Re: Code-Formatter PB 10
« Reply #176 on: December 29, 2011, 02:31:48 PM »
Hi,

Found another thing we have to consider.

ALIGN BLOAT COM COMPILE COMPILER DEBUG DIM
ELSE ELSEIF ENDIF EXPORT IF INCLUDE MESSAGES
OPTION PBFORMS REGISTER RESOURCE STACK TOOLS UTILITY

are 21 PB keywords that normally start with # but have synonyms
that start with $.  At least in PB Win v10 & CC v6.
And that would cause them to be classed as string equates and may be
reformatted incorrectly.

How about changing the $ to # in the source as it gets processed after
Line2Words but before RebuildLine? Or maybe before Line2Words?
And maybe appending a small statement about the change to the
end of the output file?
That way it is taken care of once and we don't have to perform a check
every place to make sure we're not dealing with a string equate.

Just a thought as I'm not sure if anyone will actually use the $ form.

« Last Edit: December 29, 2011, 06:21:23 PM by Paul Elliott »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #177 on: December 29, 2011, 07:34:30 PM »
Paul, 
you has quite that must be changed.  In Is_Space I have so rewritten which it it recognize!  In Line2Words and RebuildLine is there somewhat more work has unfortunately no time for it!
In Is_Space only one role plays $IF, $ELSE, $ELSEIF, $ENDIF, the remainder plays also no role for it!

Code: [Select]
FUNCTION Is_Space(BYREF s AS STRING) AS INTEGER

    STATIC cclass AS INTEGER
    STATIC cinterface AS INTEGER
    STATIC cmacro AS INTEGER
    STATIC cflag AS INTEGER
    STATIC cselect AS INTEGER

    LOCAL s1 AS STRING
    LOCAL pbword AS STRING
    LOCAL termstr AS STRING
    LOCAL i AS INTEGER
    LOCAL p AS LONG


    p = 1
    s1 = UCASE$(LTRIM$(s))
    findPBWord s1, p, pbword, termstr

    IF eflag THEN
        Einzug+=1
        eflag = 0
    END IF


    SELECT CASE pbword
        CASE "#ENDIF", "$ENDIF"
            Einzug+=-1

        CASE "END"
            findPBWord s1, p, pbword, termstr
            SELECT CASE pbword
                CASE "FUNCTION", "SUB", "FASTPROC", "METHOD", "PROPERTY", "IF", "TYPE", "UNION", "TRY"
                    Einzug+=-1

                CASE "SELECT"
                    IF cflag THEN
                        einzug+=-2
                    ELSE
                        Einzug+=-1
                    END IF

                CASE "MACRO"
                    Einzug+=-1
                    cmacro = %False
                CASE "INTERFACE"
                    Einzug+=-1
                    cinterface = 0
                CASE "CLASS"
                    Einzug+= -1
                    cclass = %False
            END SELECT
        CASE "ELSE", "ELSEIF", "#ELSE", "$ELSE", "#ELSEIF", "$ELSEIF", "CATCH", "FINALLY"
            eflag = %TRue
            einzug+=-1

        CASE "IF"
            IF find_Then(s1) THEN
                eflag = %true
            END IF

        CASE "SELECT"
            eflag = %TRUE
            cselect = %True
            cflag = %False
        CASE "CASE"
            IF cselect THEN
            IF cflag = %False THEN
                eflag =%TRUE
                cflag = %True
            ELSE
                Einzug+=-1
                eflag =%TRUE
            END IF
            END IF

        CASE "SUB", "#IF", "$IF", "TRY"
            eflag = %True
        CASE "FOR"
            IF FindBefehl("NEXT") = 0 THEN
                EFlag = %True
            END IF
        CASE "NEXT"
            Einzug+=-1
        CASE "TYPE"
            eflag = %TRUE
        CASE "DO"
            IF FindBefehl("LOOP") = 0 THEN
                eFlag = %TRUE
            END IF
        CASE "LOOP"
            Einzug+=-1


        CASE "WHILE"
            IF FindBefehl("WEND") = 0 THEN
                eFlag = %TRUE
            END IF
        CASE "WEND"
            Einzug+=-1
        CASE "CLASS"
            EFlag = %True
            cclass = %True



        CASE "INTERFACE"
            IF cclass THEN
                Eflag = %True
            ELSEIF cinterface = 0 THEN
                EFlag = %True
                cinterface = 1
            END IF


        CASE "FUNCTION", "FASTPROC", "CLASS"
            FOR i = p TO LEN(s1)
                termstr = MID$(s1, i, 1)
                IF termstr = "=" THEN
                    EXIT FOR
                ELSEIF termstr <> " " THEN
                    EFlag = %True
                    EXIT FOR
                END IF
            NEXT i
        CASE "MACRO"
            IF INSTR(s1, "=") = 0 THEN
                EFlag = %True
                cmacro = %True
            END IF


        CASE "METHOD", "PROPERTY"

            IF (cclass AND cinterface = 0) OR cmacro = %True THEN
                FOR i = p TO LEN(s1)
                    termstr = MID$(s1, i, 1)
                    IF termstr = "=" THEN
                        EXIT FOR
                    ELSEIF termstr <> " " THEN
                        EFlag = %True
                        EXIT FOR
                    END IF
                NEXT i
            END IF
        CASE "THREAD", "CALLBACK"
            findPBWord s1, p, pbword, termstr
            IF pbword = "FUNCTION" THEN
                EFlag = %True
            END IF
        CASE ELSE
    END SELECT
    IF Einzug < 0 THEN Einzug = 0

    FUNCTION = Einzug

END FUNCTION                           


Greet Peter 
« Last Edit: December 29, 2011, 07:39:04 PM by Peter Weis »

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #178 on: January 06, 2012, 03:33:57 PM »
Hello,
has small errors in Is_Space removes
TYPE SET has no introduction!

Code: [Select]
FUNCTION Is_Space(BYREF s AS STRING) AS INTEGER

    STATIC   cclass                     AS INTEGER
    STATIC   cinterface                 AS INTEGER
    STATIC   cmacro                     AS INTEGER
    STATIC   cflag                      AS INTEGER
    STATIC   cselect                    AS INTEGER

    LOCAL    s1                         AS STRING
    LOCAL    pbword                     AS STRING
    LOCAL    termstr                    AS STRING
    LOCAL    i                          AS INTEGER
    LOCAL    p                          AS LONG


    p = 1
    s1 = UCASE$(LTRIM$(s))
    findPBWord s1, p, pbword, termstr

    IF eflag THEN
        Einzug+=1
        eflag = 0
    END IF


    SELECT CASE pbword
        CASE "#ENDIF", "$ENDIF"
            Einzug+=-1

        CASE "END"
            findPBWord s1, p, pbword, termstr
            SELECT CASE pbword
                CASE "FUNCTION", "SUB", "FASTPROC", "METHOD", "PROPERTY", "IF", "TYPE", "UNION", "TRY"
                    Einzug+=-1

                CASE "SELECT"
                    IF cflag THEN
                        einzug+=-2
                    ELSE
                        Einzug+=-1
                    END IF
                    cflag = %True

                CASE "MACRO"
                    Einzug+=-1
                    cmacro = %False
                CASE "INTERFACE"
                    Einzug+=-1
                    cinterface = 0
                CASE "CLASS"
                    Einzug+= -1
                    cclass = %False
            END SELECT
        CASE "ELSE", "ELSEIF", "#ELSE", "$ELSE", "#ELSEIF", "$ELSEIF", "CATCH", "FINALLY"
            eflag = %TRue
            einzug+=-1

        CASE "IF"
            IF find_Then(s1) THEN
                eflag = %true
            END IF

        CASE "SELECT"
            eflag = %TRUE
            cselect = %True
            cflag = %False
        CASE "CASE"
            IF cselect THEN
                IF cflag = %False THEN
                    eflag =%TRUE
                    cflag = %True
                ELSE
                    Einzug+=-1
                    eflag =%TRUE
                END IF
            END IF

        CASE "SUB", "#IF", "$IF", "TRY"
            eflag = %True
        CASE "FOR"
            IF FindBefehl("NEXT") = 0 THEN
                EFlag = %True
            END IF
        CASE "NEXT"
            Einzug+=-1
        CASE "TYPE"
            findPBWord s1, p, pbword, termstr
            IF pbword <> "SET" THEN                                   ' 06.01.2012 TYPE Set does no Type
                eflag = %TRUE

            END IF
        CASE "DO"
            IF FindBefehl("LOOP") = 0 THEN
                eFlag = %TRUE
            END IF
        CASE "LOOP"
            Einzug+=-1


        CASE "WHILE"
            IF FindBefehl("WEND") = 0 THEN
                eFlag = %TRUE
            END IF
        CASE "WEND"
            Einzug+=-1
        CASE "CLASS"
            EFlag = %True
            cclass = %True



        CASE "INTERFACE"
            IF cclass THEN
                Eflag = %True
            ELSEIF cinterface = 0 THEN
                EFlag = %True
                cinterface = 1
            END IF


        CASE "FUNCTION", "FASTPROC", "CLASS"
            FOR i = p TO LEN(s1)
                termstr = MID$(s1, i, 1)
                IF termstr = "=" THEN
                    EXIT FOR
                ELSEIF termstr <> " " THEN
                    EFlag = %True
                    EXIT FOR
                END IF
            NEXT i
        CASE "MACRO"
            IF INSTR(s1, "=") = 0 THEN
                EFlag = %True
                cmacro = %True
            END IF


        CASE "METHOD", "PROPERTY"

            IF (cclass AND cinterface = 0) OR cmacro = %True THEN
                FOR i = p TO LEN(s1)
                    termstr = MID$(s1, i, 1)
                    IF termstr = "=" THEN
                        EXIT FOR
                    ELSEIF termstr <> " " THEN
                        EFlag = %True
                        EXIT FOR
                    END IF
                NEXT i
            END IF
        CASE "THREAD", "CALLBACK"
            findPBWord s1, p, pbword, termstr
            IF pbword = "FUNCTION" THEN
                EFlag = %True
            END IF
        CASE ELSE
    END SELECT
    IF Einzug < 0 THEN Einzug = 0

    FUNCTION = Einzug

END FUNCTION                         


Greet Peter 

Offline Peter Weis

  • Sr. Member
  • ****
  • Posts: 326
  • User-Rate: +15/-4
  • Gender: Male
Re: Code-Formatter PB 10
« Reply #179 on: January 07, 2012, 04:49:32 PM »
Hello,
 added $IF, $ELSEIF, $ENDIF in function RebuildLine () now! But I had to change also the function Line2Words ()!

New funktion  RebuildLine:
Code: [Select]
FUNCTION RebuildLine(BYREF w() AS STRING, BYREF wordcount AS LONG) AS STRING    ' 11/18/2011
    '----------------------------------------------------------------
    'Reassemble a source line from the individual tokens in string
    'array Words() standardize puncuation, spacing and indentation.
    '  w()         [in/out] array of source words/tokens
    '  wordcount   [in/out] # words/tokens in array
    ' NOPE   fo          [in/out] udt of formatting options
    'Returns the formatted source code line
    '----------------------------------------------------------------
    LOCAL    i&                                  ' NASTY HABIT
    LOCAL    stemp                      AS STRING
    LOCAL    comment                    AS STRING
    LOCAL    schr                       AS STRING
    LOCAL    spacer                     AS LONG  'helper with indenting
    LOCAL    WordNo                     AS LONG

    schr = LEFT$(w(1), 1)
    IF schr = "'" THEN
        m_ExitFunction(SPACE$(fc.indent) + w(1)) 'return full comment line
    ELSEIF UCASE$(LEFT$(w(1), 5)) = "DATA" THEN  'line is data
        m_ExitFunction(w(1))                     'return unmodified
    ELSEIF schr = "!" THEN
        IF LEN(w(2)) > 1 THEN                    'inline assembler comment
            stemp = LSET$(SPACE$(fc.indent) + w(1), fo.remcol - 1) + w(2)
        ELSE
            stemp = SPACE$(fc.indent) + w(1)
        END IF
        m_ExitFunction(stemp)
    END IF
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'If last item in token array is a inline comment, save it to
    'be inserted later.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    schr = LEFT$(w(WordCount), 1)
    IF schr = "'" OR schr = ";" THEN
        comment = w(WordCount)
        IF LEN(comment) <= 1 THEN
            comment = ""                         'make blank line
        END IF
        DECR WordCount
    END IF
    IF w(1) = "ELSEIF" THEN

    END IF

    IF fo.lineupequates THEN
        schr = LEFT$(w(1), 1)
        IF (schr = "%" OR schr = "$") AND w(2) = "=" THEN    'test 1
            IF fo.capequates THEN
                w(1) = UCASE$(w(1))
            END IF
            i& = MAX&(LEN(w(1)) + 2, fo.equatescolumn - fc.indent)
            stemp = LSET$(w(1), i& - 2) + " ="
            FOR i& = 3 TO wordcount
                stemp = stemp + " " + TRIM$(w(i&))
            NEXT
            IF LEN(comment) AND LEN(stemp) < fo.remcol - 1 THEN
                stemp = SPACE$(fc.indent) + LSET$(stemp, fo.remcol - 1) + TRIM$(comment)
            ELSE
                'w(0) = comment
                stemp = SPACE$(fc.indent) + RTRIM$(stemp) & SPACE$(fo.tabsize) & comment    ' 11/18/2011 PDE
                comment = ""
            END IF
            m_ExitFunction(stemp)
        END IF
    END IF
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'process each token in array w()
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    stemp = ""
    DO
        INCR WordNo                              'first/next word
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        'Is word abreviated print statement ?. Expand and capitilize
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        schr = LEFT$(w(WordNo), 1)
        IF w(WordNo) = "?" THEN                  'expand to PRINT (PBCC)
            w(WordNo) = "PRINT"
        ELSEIF schr = $DQ THEN                   'string literal
            stemp = stemp + w(WordNo) + " "      'simply add it
            ITERATE DO
        ELSEIF schr = "%" OR schr = "$" THEN     'equates
            IF fo.capequates THEN
                w(WordNo) = UCASE$(w(WordNo))
            END IF
        ELSEIF schr = "!" THEN
            stemp = stemp + w(WordNo)            'assembler line
            spacer = fc.indent
            fc.indent = 0
            EXIT DO
        END IF

        SELECT CASE UCASE$(w(WordNo))            'process the token
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Check to see if token is a label (wordcount = 2), only thing
                'allowed on a line with a label is a comment and that was
                'removed above. Should it fail this test its assumed to be
                'part of a multi-statement line. Labels always start in col 1
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE ":"                             'check for label
                stemp = RTRIM$(stemp)
                IF WordCount = 2 THEN            'we assume a label (name + :)
                    spacer = fc.indent           'save indent value
                    fc.indent = 0                'move label to left margin
                END IF
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Try to distinguish between array and something else as to
                'whether or not there should be a space preecding these. Need
                'to test for a PB intrinsic function like ATTRIB(xxx) vs OR
                '(xx + yy).
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE "(", "["
                IF INSTR( "+-*/\=><", w(WordNo - 1)) = 0 THEN
                    stemp = RTRIM$(stemp)
                END IF
                SELECT CASE UCASE$(w(WordNo - 1))
                    CASE "IF", "ELSEIF", "AND", "OR", "NOT", "ISFALSE", "ISTRUE", "XOR", "TO"
                        stemp = stemp + " "      'add spacing
                END SELECT
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'We never want any space to proceed these delimiters
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE ")", ",", "]", "[", ";", "."
                stemp = RTRIM$(stemp)            'no preceding space
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Catch <>, >=, <= combinations to eliminate < >, > =,. etc.
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE "<", ">", "="
                IF INSTR( "<>=+-*ORAND", w(WordNo - 1)) THEN    ' 05/06/2011 PDE added + - * not sure how to handle OR AND
                    stemp = RTRIM$(stemp)
                END IF
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Compare last token to THEN, nothing else on line means started
                'a multi-line IF block. Any comment already removed above.
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE "THEN"
                IF WordNo = WordCount THEN
                    spacer = spacer + fo.tabsize 'change for next line
                END IF
            CASE "TYPE"                          '06.01.2012   for TYPE SET
                IF (WordNo = 1) AND (w(WordNo + 1) <> "SET") THEN spacer = spacer + fo.tabsize

            CASE "UNION", "TRY", "FUNCTION", "SUB", "INTERFACE", "PROPERTY"
                IF (WordNo = 1) AND (w(WordNo + 1) <> "=") THEN spacer = spacer + fo.tabsize

            CASE "CLASS"
                IF WordNo = 1 AND UCASE$(w(WordNo + 1)) <> "METHOD" THEN
                    INCR fc.inClass
                END IF
                IF WordNo = 1 AND w(WordNo + 1) <> "=" THEN spacer = spacer + fo.tabsize

            CASE "METHOD"
                IF WordNo = 1 AND fc.inClass > 0 THEN
                    IF INSTR(ztext(CurrentLine), "=") = 0 THEN
                        spacer = spacer + fo.tabsize    ' next line
                    END IF
                END IF

                '         case "FOR"
                '          if Is_there(w(),"NEXT",WordCount) then
                '             IF (WordNo = 1) THEN spacer = spacer + fo.tabsize
                '          end if
                Construct( "FOR", "NEXT")
                Construct( "WHILE", "WEND")
                Construct( "DO", "LOOP")

            CASE "MACRO"
                IF WordNo = 1 AND UCASE$(w(2)) = "FUNCTION" OR (wordNo = 1 AND INSTR(zText(currentline), "=") = 0) THEN
                    spacer = spacer + fo.tabsize
                END IF
            CASE "CALLBACK"                      ' 05/09/2011 PDE need to indent same as normal FUNCTION
                IF WordNo = 1 AND UCASE$(w(2)) = "FUNCTION" THEN
                    spacer = spacer + fo.tabsize
                END IF
            CASE "SELECT"
                IF WordNo = 1 THEN spacer = spacer + (fo.tabsize * 2)
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Handle ELSEIF seperately since it appears on same line with THEN
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE "#IF", "$IF"                    'these require no line ending THEN   06.01.2012 $IF
                spacer = spacer + fo.tabsize
            CASE "ELSEIF"
                fc.indent = fc.indent - fo.tabsize    'change for this line


            CASE "#ELSEIF", "$ELSEIF", "#ELSE", "$ELSE"    '06.01.2012 for $ELSEIF or $ELSE
                fc.indent = fc.indent - fo.tabsize    'change for this line

            CASE "#ENDIF", "$ENDIF"              '06.01,2012  for $ENDIF
                fc.indent = fc.indent - fo.tabsize

            CASE "ELSE", "CASE"
                IF WordNo = 1 THEN               'first word?
                    spacer = spacer + fo.tabsize 'change for next line
                    fc.indent = fc.indent - fo.tabsize    'change for this line
                END IF
            CASE "END"
                SELECT CASE UCASE$(w(WordNo + 1))
                    CASE "TYPE", "IF", "UNION", "SUB", "FUNCTION", "INTERFACE", "TRY", "MACRO", "METHOD", "PROPERTY"
                        fc.indent = fc.indent - fo.tabsize
                    CASE "CLASS"
                        DECR fc.inClass
                        spacer = 0               ' next line
                        fc.indent = fc.indent - fo.tabsize    ' this line
                    CASE "SELECT"
                        fc.indent = fc.indent - (fo.tabsize * 2)
                END SELECT
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Check for the close of a looping block. If its on the same
                'line as loop start, keep same indent.
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            CASE "WEND", "NEXT", "LOOP"
                IF wordno = 1 THEN
                    schr = UCASE$(stemp)         'standardize
                    spacer = 0                   'be sure this = 0
                    fc.indent = fc.indent - fo.tabsize    'default is close loop
                    IF INSTR(schr, "DO ") THEN   'test
                        fc.indent = fc.indent + fo.tabsize
                    ELSEIF INSTR(schr, "WHILE ") THEN
                        fc.indent = fc.indent + fo.tabsize
                    ELSEIF INSTR(schr, "ITERATE") THEN
                        fc.indent = fc.indent + fo.tabsize
                    END IF
                END IF
        END SELECT

        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        'No space following "([]"
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        IF w(wordno) = "." THEN
            stemp = RTRIM$(stemp) + "."
        ELSEIF INSTR( "(][", w(WordNo - 1)) THEN
            stemp = RTRIM$(stemp) + w(WordNo) + " "
        ELSE
            stemp = stemp + w(WordNo) + " "
        END IF
    LOOP WHILE WordNo < WordCount
    IF fc.indent < 0 THEN fc.indent = 0          'stay at left margin
    stemp = SPACE$(fc.indent) + RTRIM$(stemp)    'final formated line
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'Add any line comment preserved above. Fit failure returns
    'inline comment in w(0)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    w(0) = ""
    IF LEN(comment) THEN
        IF LEN(stemp) < fo.remcol THEN
            stemp = LEFT$(stemp + SPACE$(fo.RemCol - 1), fo.RemCol - 1) + comment
        ELSE
            ' w(0) = SPACE$(fo.indent) + comment
            stemp = RTRIM$(stemp) & SPACE$(fo.tabsize) & comment    ' 11/18/2011
            comment = ""
        END IF
    END IF
    fc.indent = fc.indent + spacer               'new indent value
    FUNCTION = stemp                             'return formatted source line
END FUNCTION                                                                     

New function Line2Words
Code: [Select]
FUNCTION Line2Words(BYREF work AS ASCIZ * %MAX_LINELEN, BYREF w() AS STRING) AS LONG    ' 11/18/2011
    '-------------------------------------------------------------------
    'Parse source line into word/token array w(). Handle special cases for
    'REM, DATA, string literals, ASM, !, '.
    '  work     [in/out] source code line text
    '  w()      [in/out] array of words/tokens
    ' NOPE  fo       [in/out] udt of formatting options
    'Returns count of words/tokens found
    '-------------------------------------------------------------------
    LOCAL    stemp                      AS STRING
    LOCAL    ncount                     AS LONG  'word/token count
    LOCAL    pchr                       AS BYTE PTR
    LOCAL    s1                         AS LONG

    ' REPLACE $TAB WITH SPACE$(fo.tabsize) IN work *** replaced with following 05/06/2011 PDE
    work = TAB$(work, fo.tabsize)

    work = S_TRIMBA(work)
    'X_AU "-----------------------------------"+$CRLF+TRIM$(work)+$CRLF+"--------------------------"
    stemp = UCASE$(TRIM$(work))                            'standardize incomming text
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'These need no or limited processing
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    IF LEFT$(stemp, 1) = "'" OR _                          'remark
        LEN(stemp) = 0 OR _                                    'blank line
        LEFT$(stemp, 5) = "DATA " THEN                         'DATA statments ignored
        w(1) = TRIM$(work)
        m_ExitFunction(1)
    ELSEIF LEFT$(stemp, 4) = "REM " THEN
        w(1) = "'" + TRIM$(MID$(work, 5))                  'replace REM with '
        m_ExitFunction(1)
    ELSEIF LEFT$(stemp, 4) = "ASM " THEN                   'replace ASM with !
        w(1) = "!" + RTRIM$(EXTRACT$(MID$(work, 5), ANY "';"))
        w(2) = ";" + TRIM$(REMAIN$(work, ANY ";'"))
        m_ExitFunction(2)
    ELSEIF LEFT$(stemp, 1) = "!" THEN
        w(1) = TRIM$(EXTRACT$(work, ANY "';"))             'up to any comment
        w(2) = ";" + TRIM$(REMAIN$(work, ANY ";'"))
        m_ExitFunction(2)                                  'two words/tokens
    END IF
    stemp = ""                                             'clear for reuse
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'Parse remainder
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    pchr = VARPTR(work)                                    'point to first byte
    DO
        IF @pchr = 34 THEN                                 'quote start?
            GOSUB SaveWord                                 'save any current word/token
            s1 = pchr                                      'save string start
            DO
                INCR pchr                                  'next string character
            LOOP UNTIL @pchr = 34                          'quoted string finished
            stemp = PEEK$(s1, pchr - s1 + 1)
            GOSUB SaveWord
            INCR pchr                                      'next byte/character
            ITERATE DO
        END IF
        IF @pchr = 39 THEN                                 'inline "'" remark
            GOSUB SaveWord
            'balance of line
            stemp = MID$(work, pchr - VARPTR(work) + 1)
            EXIT DO                                        'line done
        END IF
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        'Check for one of the standard delimters
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        IF INSTR( " ,\=+-/^*)(:[];><.", CHR$(@pchr)) THEN
            GOSUB SaveWord
            IF @pchr <> 32 THEN
                stemp = CHR$(@pchr)
                GOSUB SaveWord
            END IF
        ELSE
            stemp = stemp + CHR$(@pchr)                    'add char to current token
        END IF
        INCR pchr
    LOOP WHILE @pchr <> 0                                  'check for line end
    GOSUB SaveWord
    m_ExitFunction(ncount)                                 'return token count

    SaveWord:
    IF LEN(stemp) THEN                                     'anything to do?
        INCR ncount                                        'next array element
        w(ncount) = stemp                                  'save it
        w(ncount+1) =""                                    'kill next Element    07.01.2012
        '   X_AU STR$(ncount)+"-"+stemp
        stemp = ""                                         'erase working string
    END IF
    RETURN

END FUNCTION                           

Greet Peter
« Last Edit: January 07, 2012, 06:17:48 PM by Peter Weis »