; PROTFORM
;
; Program for Proteus
;
; (C) 1998-2004 Simone Zanella Productions
;
; Pretty-printer for Proteus programs: add standard formatting,
; keeping line length below 75 characters;
; vanilla syntax check.
;
; This is the standard formatting (!ifdef..!endif just like IF..FI):
;
; IF test           REPEAT              SWITCH exp [func]
;   method            method            ON exp1
; ELSE                CONTINUE            method
;   method            BREAK             ONC exp2
; FI                UNTIL test            method
;                                       OTHER
;                                         method
;                                       OFF
;
; WHILE test        FUNCTION name([par1, [par2..]])
;   method            method
;   CONTINUE        RETURN value
;   BREAK
; LOOP
;
; FOR id = exp1 TO exp2 [STEP exp3]
;   method
;   CONTINUE
;   BREAK
; NEXT

; !bdoc..!edoc blocks, just like TEXT constants, are left unmodified.

; Initialize program
FUNCTION ONSTART()

  IF STREQ(ARGV(3), "..")
    CONSOLELN "Syntax: " ARGV(1) " " ARGV(2) " source destination"
    CONSOLELN ""
    CONSOLELN "Purpose: format source into destination (Proteus pretty-printer)"
    ABORT 0
  FI

  _IndLev = 0
  _LastLine = ""
  _LineLength = 75

  ; Increase indentation for the following methods
  _MI = VECCREATE("FOR","REPEAT","WHILE","IF","FUNCTION",\
                  "SWITCH","!ifdef","!ifndef")

  _RetVar = "RETURN"

  ; Decrease indentation for the following methods
  _MD = VECCREATE("LOOP","UNTIL",_RetVar,"OFF",\
                  "FI","NEXT","!endif")

  ; Delete indentation for current line, keeping it for the following lines
  _MS = VECCREATE("ON","ONC","ELSE","OTHER","!else")

  ; Sort arrays, for using BSEARCH
  SORT(_MI, 4, 1)
  SORT(_MD, 4, 1)
  SORT(_MS, 4, 1)

  _InDoc = 0
  _InText = 0
RETURN

; Print TEXT constants as they are
; Stampa le costanti TEXT verbatim
IF InText
  S = RTRIM(L, " \t")
  IF STREQ(RIGHT(S, STRLEN(TextTerm)), TextTerm)
    InText = 0
  FI
  PRINTLN L
  IGNORE
FI

; Print blocks between !bdoc and !edoc as they are
IF InDoc
  S = TOKEN(LTRIM(L, " "), 1, " ")
  SWITCH S STRIEQ
    ON "!BDOC"
      INC(@InDoc)
    ON "!EDOC"
      DEC(@InDoc)
      IF LT(InDoc, 0)
        CONSOLELN "Too many \"!EDOC\" directives (line " N " )"
        ABORT 1
      FI
  OFF
  PRINTLN L
  IGNORE
FI

PL = ALLTRIM(L, " ")

; Splitted line - merge it
IF STREQ(RIGHT(PL, 1), "\\")
  IF ISNOTEMPTY(LastLine)
    LastLine = LastLine " "
  FI
  LastLine = LastLine LEFT(PL, DEC(STRLEN(PL)))
  LastLine = RTRIM(LastLine, " ")
  IF EOF
    CONSOLELN "Unterminated line (" N ")"
    ABORT 1
  FI
  IGNORE
FI

; Add last segment at the end of a splitted line
IF ISNOTEMPTY(LastLine)
  LastLine = LastLine " " PL
  PL = RTRIM(LastLine, " ")
  LastLine = ""
FI

OldLev = IndLev

; Method name
FTok = UPPER(TOKEN(PL, 1, " "))

; Find method in arrays
IF ISNOTEMPTY(FTok)
  X = BSEARCH(MI, 4, FTok)
  IF X
    ; Increase indentation
    INC(@IndLev)
  ELSE
    X = BSEARCH(MD, 4, FTok)
    IF X
      ; If RETURN, decreases indentation only when the function declaration is completed
      IF OR(EQ(IndLev, 1), STRINEQ(FTok, RetVar))
        ; Decrease indentation
        DEC(@IndLev)
      FI
    ELSE
      X = BSEARCH(MS, 4, FTok)
      IF X
        ; Decrease indentation for this line only
        OldLev = DEC(IndLev)
      ELSE
        ; Check if line is special (!BDOC, TEXT..)
        SWITCH Ftok STRIEQ
          ON "!EDOC"
            CONSOLELN "Too many \"!EDOC\" directives (line " N " )"
            ABORT 1
          ON "!BDOC"
            INC(@InDoc)
            PRINTLN L
            IGNORE
          ON "TEXT"
            InText = 1
            X = POSTOKEN(L, 3, " ")
            IF STREQ(SUBSTR(L, X, 1), "=")
              TextTerm = RESTFROM(L, POSTOKEN(L, 4, " "))
            ELSE
              TextTerm = RESTFROM(L, X)
            FI
            IF STREQ(LEFT(TextTerm, 1), "\"")
              RTRIM(@TextTerm, " ")
              STRIPQUOTES(@TextTerm)
              CTRAN(@TextTerm)
            ELSE
              ; Forces the interpretation of TextTerm as a number
              ADD(@TextTerm, 0)
            FI
            PRINTLN L
            IGNORE
        OFF
      FI
    FI
  FI
FI

; Syntax error
IF LT(IndLev, 0)
  CONSOLELN "Syntax error in program " F "!"
  ABORT 1
FI

; Indentation increased - print line with old indentation
IF GT(IndLev, OldLev)
  NL = REPLICATE(" ", MUL(OldLev, 2))
ELSE
  ; Print line with current indentation
  NL = REPLICATE(" ", MUL(IndLev, 2))
FI

Line = NL PL

; Line too long: split
IF GT(STRLEN(Line), LineLength)

  TL = STRDUP(Line)
  RL = ""
  P = STRLEN(Line)

  ; If remark, split on spaces
  IF IN(LEFT(PL, 1), ";#")
    WHILE GT(P, 0)
      Car = RIGHT(TL, 1)
      DEC(@P)
      RL = Car RL
      TL = LEFT(TL, P)

      ; Line can be truncated only on spaces
      IF LE(P, LineLength)
        WHILE AND(P, STRNEQ(Car, " "))
          Car = RIGHT(TL, 1)
          DEC(@P)
          RL = Car RL
          TL = LEFT(TL, P)
        LOOP
        ; Space found
        IF P
          PRINTLN TL " \\"
          TL = RL
          RL = ""
          P = STRLEN(TL)
          IF LE(P, LineLength)
            BREAK
          FI
          CONTINUE
        FI
      FI
      ; A line without spaces? Don't truncate, keep it.
      IF NOT(P)
        TL = RL
      FI
    LOOP
  ELSE
    WHILE GT(P, 0)
      Car = CHOP(@TL)
      DEC(@P)
      RL = Car RL

      ; End of string: find start
      IF STREQ(Car, "\"")
        Car = CHOP(@TL)
        DEC(@P)
        RL = Car RL
        WHILE AND(P, \
                    OR(STRNEQ(Car, "\""), \
                       STREQ(SUBSTR(TL, P, 1), "\\") ) )
          Car = CHOP(@TL)
          DEC(@P)
          RL = Car RL
        LOOP
        IF AND(NOT(P), STRNEQ(LEFT(RL, 1), "\""))
          CONSOLELN "Unterminated string at line " N "."
          ABORT 1
        FI
      FI

      IF NOT(P)
        TL = RL
        P = 0
      ELSE
        IF LT(P, LineLength)
          IF IN(Car, ",() ")
            ; Line can be truncated here            

            TL = TL Car
            RL = RIGHT(RL, DEC(STRLEN(RL)))
            PRINTLN TL IIF(STREQ(Car, " "), "\\", " \\")
            TL = RL
            RL = ""
            P = STRLEN(TL)
            IF LE(P, LineLength)
              BREAK
            FI
            CONTINUE
          FI
        FI
      FI
    LOOP
  FI
  PRINTLN TL
ELSE
  PRINTLN Line
FI