/*REXX*/
       'ISREDIT MACRO(PARMS)'
/*    TRACE ?r */
/*-------------------------------------------------------------------*/
/* This SPF Macro:                                                   */
/*   1. Determines which language is present based on extenstion.    */
/*   2. Calls compiler for language.                                 */
/*   3. Displays any error messages from compiler on screen next to  */
/*      buggy code.                                                  */
/* This Macro is currently setup to work for the following languages:*/
/*   1. .ZBS - BASIC using 32 Bit Software's ZBASIC 4.7              */
/*             Parms: P = use mark's preprocessor                    */
/*   2. .PBS - BASIC using Power BASIC 3.x                           */
/*   3. .C   - C using Mix Software's PowerC 2.2                     */
/*             Parms: S or none = small memory model                 */
/*                    M = medium memory model                        */
/*                    L = large memory model                         */
/*   4. .PRG - XBase using Clipper 5.1                               */
/*   5. .COB - Micro Focus COBOL                                     */
/*   6. .CBL - Realia/2 COBOL  (Computer Associates)                 */
/*   7. .BAT - PC Magazine's Public Domain DOS Batch compiler        */
/*   8. .REX - Personal REXX 3.0 Compiler                            */
/*   9. .PBC - BASIC Windows Console Compiler (PowerBASIC)           */
/*  10. .DL6 - PowerBASIC DLL 6.0 Compiler - 32 bit                  */
/*  10. .DL2 - PowerBASIC DLL 2.0 Compiler - 16 bit                  */
/*  11. .BAS - Visual BASIC 6.0 (Enterprise Edition)                 */
/*  12. .PHP - PHP on Windows (no server required)                   */
/*              Note: Change pathing to match your PHP .ini file     */
/* Syntax:                                                           */
/*   At the command line, enter COM and press enter.  If the code    */
/*   has been modifed since loading, it is saved first then compiled.*/
/* Options:                                                          */
/*   For C enter S for small model, M for medium model or L for      */
/*               large model.                                        */
/*   For COBOL, Enter MF to use the Micro Focus COBOL compiler or    */
/*              no option to use the REALIA/2 Compiler.              */
/* NOTE: This macro uses two envrionment variables to determine where*/
/*       the compilers reside:                                       */
/*       DVAR = Drive where compilers are located (mine are on E)    */
/*       UTIL = Root directory of compiler directory (mine is \U     */
/*              \u                                                   */
/*       Here is where my compilers are:                             */
/*       PowerBASIC DOS    E:\U\PB35                                 */
/*              CONSOLE    E:\U\PBCC10\BIN                           */
/*          WINDOWS/DLL    E:\U\PBDLL60\BIN                          */
/*       Look at the code, change it to meet your needs              */
/* By Mark McDonald - 09Jul2001                                      */
/*-------------------------------------------------------------------*/
/*--- Get Arguments(If Any)---*/
       OPT1 = TRANSLATE(PARMS)
/*--- Declare Variable Constants and Flags ---*/
       FOUND_ONE = 0
/*--- Get rid of previous error lines ---*/
       'ISREDIT RESET SPECIAL'
/*--- If source has not been saved, save it ---*/
       'ISREDIT (MODIFIED) = DATA_CHANGED'
       IF (MODIFIED=YES) THEN
         'ISREDIT SAVE'
/*--- Retrieve Path/File Name of Source File ---*/
       'ISREDIT (FILENAME) = DATASET'
       FILENAME = TRANSLATE(FILENAME)
/*--- Determine Path of Source ---*/
      SPATH = SUBSTR(FILENAME,1,LASTPOS("\",FILENAME)-1,1)
      SDRV = SUBSTR(SPATH,1,1,' ')
/*--- Retrieve Member Name of Source File ---*/
       'ISREDIT (FULLNAME) = MEMBER'
       FULLNAME = TRANSLATE(FULLNAME)
       MEMNAME = SUBSTR(FULLNAME,1,POS('.',FULLNAME) -1)
/*--- Get DOS Variable DRV - Determines Drive for Compiler (Except VB6) ---*/
       DVAR = 'H'
       UTIL = DVAR":\U"
/*--- Get Path ---*/
      T = LASTPOS('\',FULLNAME,1)
      PATH = LEFT(FULLNAME,T)
/*--- Get Extenstion of File Name ---*/
       EXNT = SUBSTR(FULLNAME,POS('.',FULLNAME)+1,3)
/*--- Set Name of Compile Result File ---*/
       RESULT = 'C:\TEMP\'SUBSTR(DATE('J'),3,3," ")''TIME('S')'.TXT'
       TBAT = 'C:\TEMP\'SUBSTR(DATE('J'),3,3," ")''TIME('S')'.BAT'
/*--- Visual BASIC 6.0 (Windows)- VB Does not like space in Filename or path! ---*/
      IF EXNT = 'BAS' THEN
        DO
          TBAT = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\VB6.EXE"
          TBAT = TBAT" "FILENAME"  /m /out "RESULT
          ADDRESS DOS TBAT
          SIGNAL SETUPJMP
        END
/*--- PHP (Windows) -------------------------------------------------*/
      IF EXNT = "PHP" THEN
        DO
          RESULT = "C:\TEMP\DRET.PHP"
          ADDRESS DOS "ECHO -- > "RESULT
          ADDRESS DOS 'c:\PHP\php-win.exe 'FULLNAME
          SIGNAL SETUPJMP
        END
/*--- Power BASIC DLL 6.0 Compiler (Windows) ------------------------*/
      IF EXNT = 'DL6' THEN
        DO
          RESULT = SPATH'\'MEMNAME".LOG"
/*        ADDRESS DOS 'ECHO Z > 'RESULT   */
/*        TBAT = 'H:\U\PBDLL60\BIN\PBDLL.EXE /I'SPATH' /L /Q 'FILENAME   */
          ADDRESS DOS 'H:\U\PBDLL60\BIN\PBDLL.EXE /I /L 'FILENAME
          SIGNAL SETUPJMP
        END
/*--- Power BASIC Console Compiler 1.0 (Windows) --------------------*/
      IF EXNT = 'PBC' THEN
        DO
          RESULT = SPATH'\'MEMNAME".LOG"
          TBAT = UTIL'\PBCC10\BIN\PBCC.EXE /I'SPATH' /L /Q 'FILENAME
          INTERPRET 'ADDRESS DOS TBAT'
          SIGNAL SETUPJMP
        END
/*--- Prepare Common Call Commands (DOS Only) -----------------------*/
      T = LINEOUT(TBAT,SUBSTR(FILENAME,1,2," "))
      T = LINEOUT(TBAT,'CD 'SPATH)
/*--- Borland TASM 3.0 (DOS) ----------------------------------------*/
      IF EXNT = 'ASM' THEN
        T = LINEOUT(TBAT,UTIL'\BC\BIN\TASM.EXE /zn 'FILENAME'  > 'RESULT)
/*--- Microsoft C6 (DOS) --------------------------------------------*/
      IF EXNT = 'MCS' THEN
        T = LINEOUT(TBAT,UTIL'\C600\BIN\CL /AL /batch 'FILENAME'  > 'RESULT)
/*--- PowerC (DOS) --------------------------------------------------*/
      IF EXNT = 'C  ' THEN
        T = LINEOUT(TBAT,UTIL'\PC\PC.EXE /ml/e/c/q/zn/i'UTIL'\PC 'FILENAME' > 'RESULT)
/*--- ZBASIC (DOS) --------------------------------------------------*/
      IF EXNT = 'ZBS' THEN
        CALL ZBASIC
/*--- DOS BATCH Compiler (DOS) --------------------------------------*/
      IF EXNT = 'BAT' THEN
        T = LINEOUT(TBAT,UTIL'\B\BAT2EXEC.COM 'FILENAME'  > 'RESULT)
/*--- Power BASIC 3.5 (DOS) -----------------------------------------*/
      IF EXNT = 'PBS' THEN
        T = LINEOUT(TBAT,UTIL'\PB35\PBC.EXE /CE 'FILENAME'  > 'RESULT)
/*--- CLIPPER (DOS) -------------------------------------------------*/
      IF EXNT = 'PRG' THEN
        T = LINEOUT(TBAT,UTIL'\CLIPPER 'FILENAME' /M  > 'RESULT)
/*--- Realia COBOL (DOS) --------------------------------------------*/
      IF (EXNT = 'CBL' | exnt = 'COB') THEN
        T = LINEOUT(TBAT,UTIL'\REAL2\COBOL.EXE 'FILENAME'  > 'RESULT)
/*         --- Micro Focus Option? ---*/
/*         IF OPT1 = MF THEN                   */
/*           CALL MFCOBOL                      */
/*         ELSE                                */
/*           CALL REAL2                        */
      T = LINEOUT(TBAT,'EXIT')
      T = LINEOUT(TBAT)
      'ISREDIT DOS 'TBAT
   SETUPJMP:
      CALL INERROR
      EXIT 0
/*--------------------------------------------------------------------*/
/*                             Subroutines                            */
/*--------------------------------------------------------------------*/
/*--- MFCOBOL 3.1.4 (DOS) --------------------------------------------*/
   MFCOBOL:
     'ISREDIT DOS 'DVAR':\BATCH\SPFBAT.BAT COB 'FILENAME', 'RESULT' 'SPATH' 'MEMNAME'.OBJ,'
     TERM = ' '
     CALL INERROR
   RETURN
/*--- REAL2 4.2 (DOS) ------------------------------------------------*/
   REAL2:
     'ISREDIT DOS 'DVAR':\BATCH\SPFBAT.BAT CBL 'FILENAME', 'RESULT' 'SPATH' 'MEMNAME'.OBJ,'
     CALL INERROR
   RETURN
/*--- ZBASIC 4.7 -----------------------------------------------------*/
   ZBASIC:
     'ISREDIT DOS 'DVAR':\BATCH\SPFBAT.BAT BAS 'FILENAME'  'RESULT' 'SPATH' 'MEMNAME
     CALL INERROR
   RETURN
/*--- PowerC 2.2 -----------------------------------------------------*/
   POWERC:
/*   --- Small Model ---*/
/*   IF OPT1 = '' | OPT1 = 'S' | OPT1 = 's' THEN             */
/*     OPT1 = 'ms'                                           */
/*   --- Medium Model ---*/
/*   IF OPT1 = 'M' | OPT1 = 'm' THEN                         */
/*     OPT1 = 'mm'                                           */
/*   --- Large Model ---*/
     OPT1 = 'L'
     IF OPT1 = 'L' | OPT1 = 'l' THEN
       OPT1 = 'mm'
/*   ADDRESS CMD 'cd C:\util\powerc'*/
     'ISREDIT DOS 'DVAR':\BATCH\SPFBAT.BAT C 'FILENAME'  'RESULT' 'SPATH
/*   ADDRESS CMD DVAR':\util\powerc\pc /'OPT1'/e/t/c 'FILENAME' > 'RESULT*/
/*   ADDRESS CMD 'CD 'PATH*/
     TERM = '-'
     CALL INERROR
   RETURN
/*--------------------------------------------------------------------*/
   INERROR:
/*   --- Reset Error Flag ---*/
     FOUND_ONE = 0
/*   --- Loop Through Compile Result File - Put Into Array ---*/
     CNT = 0
     DO WHILE LINES(RESULT) > 0
       CNT = CNT + 1
       DATA.CNT = LINEIN(RESULT)
     END
     TCNT = CNT
     REAL2FLG = 0
     'ISREDIT (LLINE) = LINENUM .ZLAST'
/*   --- Loop Through Array - Position Error Messages With Source Code ---*/
     DO CNT = 1 TO TCNT
       DATALINE = DATA.CNT
       LINENO = 0
/*     --- Extract Source Code Line Number ---*/
/*     --- PHP - Line Number is Last Word in Error Message ---*/
       IF EXNT = "PHP" THEN
         LINENO = WORD(DATALINE,WORDS(DATALINE))
/*     --- PowerC ---*/
       IF EXNT = 'C' & POS("Wrong memory model",DATA.3) > 0 THEN
         LINENO = 1
       IF EXNT = 'C' & POS("** Unresolved references:",DATA.3) > 0 THEN
         LINENO = 1
       IF EXNT = 'C' & POS(FULLNAME,DATALINE) > 0 THEN
         PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
/*     --- Boraland Assembler ---*/
       IF EXNT = 'ASM' & POS(FULLNAME,DATALINE) > 0 THEN
         PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
/*     --- Clipper 5.1 ---*/
       IF EXNT = 'PRG' & POS(FULLNAME,DATALINE) > 0 THEN
         PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
/*     --- Power BASIC ---*/
       IF EXNT = 'PBS' THEN
         DO
           IF POS(FULLNAME,DATALINE) > 0 THEN
             PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
           ELSE DO
               IF POS("): Error ",DATALINE) > 0 THEN
                 DO
                   PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
                   IF POS(":",LINENO,1) > 0 THEN
                     DO
                       LINENO = TRANSLATE(LINENO," ",":"," ")
                       LINENO = WORD(LINENO,2)
                     END
                 END
             END
         END
/*     --- Visual BASIC 6.0 ---*/
       IF EXNT = 'BAS' THEN
         DO
           IF POS("Compile Error in File",DATALINE) > 0 THEN
             DO
               PARSE VAR DATALINE TOSS1 ', Line ' LINENO ':' TOSS
               LINENO = LINENO + 1
             END
         END
/*     --- Power BASIC DLL Compiler ---*/
       IF EXNT = 'DL6' THEN
         DO
           IF POS(FULLNAME,DATALINE) > 0 THEN
             PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
           ELSE DO
               IF POS("Error ",DATALINE) > 0 THEN
                 DO
                   PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
                   IF POS(":",LINENO,1) > 0 THEN
                     DO
                       LINENO = TRANSLATE(LINENO," ",":"," ")
                       LINENO = WORD(LINENO,2)
                     END
                 END
             END
           END
/*     --- Power BASIC Console Compiler ---*/
       IF EXNT = 'PBC' THEN
         DO
           IF POS(FULLNAME,DATALINE) > 0 THEN
             PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
           ELSE DO
               IF POS("): Error ",DATALINE) > 0 THEN
                 DO
                   PARSE VAR DATALINE TOSS1 '(' LINENO ')' TOSS
                   IF POS(":",LINENO,1) > 0 THEN
                     DO
                       LINENO = TRANSLATE(LINENO," ",":"," ")
                       LINENO = WORD(LINENO,2)
                     END
                 END
             END
         END
/*     --- ZBASIC 4.7 ---*/
       IF EXNT = 'ZBS' & POS('Text buffer FULL!',DATALINE) > 0 THEN
         LINENO = 1
       IF EXNT = 'ZBS' & POS('in Stmt',DATALINE) > 0 THEN
         LINENO = SUBSTR(DATALINE,POS(',Line',DATALINE)+6,8)
/*     --- Micro-Focus COBOL ---*/
       IF EXNT = 'CBL' | EXNT = 'COB' THEN
         DO
           IF OPT1 = 'MF' THEN
             DO
               LNCNT = CNT - 1
               IF POS(')**',DATALINE) > 73 THEN
               LINENO = WORD(DATA.LNCNT,1)
             END
/*         --- Realia 2 COBOL ---*/
           ELSE DO
               THOLD = SUBSTR(DATALINE,11,1)
               IF THOLD = 'E' | THOLD = 'W' THEN
                 DO
                   LNCNT = CNT - 1
                   PARSE VAR DATALINE LINENO TOSS
                 END
             END
         END
/*     --- Do We Need to Remove Column Number? ---*/
       T = 0
       T  =  POS(':',LINENO,1)
       IF T > 0 THEN
         DO
           LINENOHOLD = LINENO
           LINENO = SUBSTR(LINENO,1,T-1)
         END
/*     --- Make Sure LINENO Does NOT Contain Spaces ---*/
/*     LINENO = ABS(LINENO)        */
/*     --- Does This Line Show the Start of an Error? ---*/
       IF LINENO < 1 THEN
         ITERATE
/*     --- Error Line Beyond End if file? ---*/
       IF LINENO > LLINE THEN LINENO = LLINE
       DO
         FOUND_ONE = 1
/*       --- Insert First Error Note Line Into Code ---*/
         CALL SEPLINE1
/*       --- PowerBASIC Console Compiler? (PBC) ---*/
         IF EXNT = "PBC" | EXNT = "DL6" THEN
           DO
             DATALINE = TOSS1' 'LINENOHOLD
             CALL FIXQUOTES
             DATALINE = TOSS
           END
/*       --- Visual BASIC 6? ---*/
         IF EXNT = "BAS" THEN
           DO
             DATALINE = TOSS1
             CALL FIXQUOTES
             DATALINE = "Line "LINENO":"TOSS
           END
/*       --- Place Error Lines ---*/
         DO FOREVER
           CALL FIXQUOTES
           CNT = CNT + 1
/*         --- Exit Forever Loop? ---*/
           IF CNT > TCNT THEN
             LEAVE
/*         --- Get Next Error Line ---*/
           ELSE
             DATALINE = DATA.CNT
           T = LEFT(DATALINE,LENGTH(TERM))
           IF T = TERM THEN
             LEAVE
         END
/*       --- Insert Compile Error Separator Line Into Code ---*/
         CALL SEPLINE2
       END
     END
/*   --- Determine If Error Found/Do Appropriate Condition ---*/
     CALL IFERROR
   RETURN
/*--------------------------------------------------------------------*/
   SEPLINE1:
     ERRLINE = COPIES('=',69)
     "ISREDIT LINE_BEFORE " LINENO "= NOTELINE " ERRLINE
   RETURN
/*--------------------------------------------------------------------*/
   SEPLINE2:
     ERRLINE = COPIES('=',69)
     "ISREDIT LINE_AFTER " LINENO "= NOTELINE " ERRLINE
   RETURN
/*--------------------------------------------------------------------*/
/*--- Change quotes(single/double) to tildes - prevents REXX errors --*/
   FIXQUOTES:
     ERRLINE = TRANSLATE(DATALINE,"~","'")
     ERRLINE = TRANSLATE(ERRLINE,'~','"')
     "ISREDIT LINE_BEFORE " LINENO "= NOTELINE  '"ERRLINE"'"
   RETURN
/*-------------------------------------------------------------------*/
/*--- Positions Cursor to first error line and exits macro ----------*/
   IFERROR:
     IF FOUND_ONE = 1 THEN
       DO
         'ISREDIT LOCATE FIRST SPECIAL'
       END
     ELSE
       DO
         ZEDSMSG = "COMPILE SUCCESSFUL"
         ZEDLMSG = "COMPILER FOUND NO SYNTAX ERRORS DURING COMPILE."
       END
     'ISPEXEC SETMSG MSG(ISRZ000)'
     EXIT 0                             /*Returns to Source Code*/
   RETURN
/*---------------------------------------------------------------*/
  MVAR: PROCEDURE
   ARG X
   X = TRANSLATE(X)
/* --- Build Semi-Unique Result File Name ---*/
   RESULT = 'C:\TEMP\'SUBSTR(DATE('J'),3,3," ")''TIME('S')
   TBAT = RESULT'.BAT'
   RESULT = RESULT'.TXT'
/* --- Build/Execute Temp BAT File ---*/
   T = LINEOUT(TBAT,'SET > 'RESULT)
   T = LINEOUT(TBAT,'EXIT')
   T = LINEOUT(TBAT)
   'ISREDIT DOS 'TBAT
/* --- Find VAR ---*/
   DO WHILE LINES(RESULT) > 0
     T = TRANSLATE(LINEIN(RESULT))
     T = TRANSLATE(T," ","=")
     IF WORD(T,1) = X THEN
       DO
         RETURN WORD(T,2)
       END
   END
   XR = ""
  RETURN XR
/*---------------------------------------------------------------*/