/* REXX ***************************************************************/
/* -------------------------------------------------------------------*/
/* Name:       BOX                                                    */
/* Short       Draws a comment-box around lines (COBOL,PLI,REXX,JCL)  */
/* Type:       REXX Macro                                             */
/* Author:     Norbert Haas                                           */
/* Syntax:     BOX .label1 .label2 <char> <language>                  */
/* Parameter:  .label 1/2 = ISPF-Edit-Label                           */
/*             char = fillin char (optional, Default = '*') for the   */
/*                       edge above and belowe                        */
/*             language = COBol (default)                             */
/*                        PLI oder PL1                                */
/*                        JCL oder CNTL                               */
/*                        REXx                                        */
/*                                                                    */
/* Examples:   BOX .a .b                                              */
/*             BOX .x .x (just one line)                              */
/*             BOX .from .to - C                                      */
/*             BOX .U .V REXX                                         */
/*                                                                    */
/* Version   Author        Date      Why                              */
/* --------- ------------- --------- -------------------------------- */
/* V01.05    N.Haas        28.05.03  remarks in english               */
/* V01.04    N.Haas        06.02.03  | => KONKAT(), ODER()            */
/* V01.03    N.Haas        29.11.94  PLI und REX eingefuehrt          */
/* V01.02    N.Haas        21.10.93  Nur bis Spalte 71, nicht 72      */
/* V01.01    N.Haas        04.10.93  User_State eingefuehrt           */
/* V01.00    N.Haas        12.10.92  Erstellung                       */
/**********************************************************************/
"ISREDIT MACRO (parm)"
"ISPEXEC CONTROL ERRORS RETURN"

/* save cursor ------------------------------------------------------ */
"ISREDIT (csrrow,csrcol) = CURSOR"

/* User_State ------------------------------------------------------- */
"ISREDIT (usrst)  = USER_STATE"

/* divide parm and notice number of words --------------------------- */
parm = TRANSLATE(parm)
PARSE VALUE parm WITH p.1 p.2 p.3 p.4 .
anz_worte = WORDS(PARM)

/* examine parms ---------------------------------------------------- */
IF ODER(anz_worte < 2, anz_worte > 4) THEN DO
   zedsmsg = 'PARAMETER INVALID'
   zedlmsg = 'MACRO BOX NEEDS TWO LABEL PLUS TWO OPTIONAL PARM.'
   SIGNAL mistake
END

/* distribute parms ------------------------------------------------- */
anz_lab = 0
anz_char = 0
anz_lang = 0

DO i = 1 TO anz_worte
   SELECT
      /* is parm a libe (label) ? ----------------------------------- */
      WHEN (p.i /= '')  &,
           (SUBSTR(p.i,1,1) = '.')  &,
           (DATATYPE(SUBSTR(p.i,2),'M')) THEN DO
         anz_lab = anz_lab + 1                /* number of line-parms */
         IF anz_lab = 1 THEN
            n.2 = p.i                     /* move parm to 2. new-parm */
         ELSE
            n.3 = p.i                     /* move parm to 3. new-parm */
         p.i = ''                                      /* delete parm */
      END
      /* is parm a language ? --------------------------------------- */
      WHEN (p.i /= '')  &,
           (ODER(LEFT(p.i,3) = 'COB',,
                 LEFT(p.i,3) = 'PLI', LEFT(p.i,3) = 'PL1',,
                 LEFT(p.i,3) = 'JCL', LEFT(p.i,4) = 'CNTL',,
                 LEFT(p.i,3) = 'REX')) THEN DO
         anz_lang = anz_lang + 1          /* number of language parms */
         IF anz_lang = 1 THEN
            n.4 = LEFT(p.i,3)             /* move parm to 4. new-parm */
         p.i = ''                                      /* delete parm */
      END
      /* parm is char ----------------------------------------------- */
      OTHERWISE DO
         anz_char = anz_char + 1              /* number of char-parms */
         n.1 = p.i                        /* move parm to 1. new-parm */
         p.i = ''                                      /* delete parm */
      END
   END
END

/* examine number of labels ----------------------------------------- */
SELECT
   WHEN anz_lab = 0 THEN DO
      zedsmsg = 'LABEL ERROR'
      zedlmsg = 'MACRO BOX NEEDS TWO ISPF-LABEL TO WORK WITH.'
      SIGNAL mistake
   END
   WHEN anz_lab = 2 THEN DO
      /* examine label ---------------------------------------------- */
      "ISREDIT (von) = LINENUM " n.2
      IF rc > 0 THEN DO
         zedsmsg = 'INVALID LABEL'
         zedlmsg = 'INVALID LABEL SPECIFIED. LABEL' n.2 'NOT FOUND.'
         SIGNAL mistake
      END
      "ISREDIT (bis) = LINENUM " n.3
      IF rc > 0 THEN DO
         zedsmsg = 'INVALID LABEL'
         zedlmsg = 'INVALID LABEL SPECIFIED. LABEL' n.3 'NOT FOUND.'
         SIGNAL mistake
      END
   END
   OTHERWISE DO
      zedsmsg = 'PROBABLE LABEL ERROR'
      zedlmsg = 'LABEL RECOGNIZED AS INVALID. ALLWAYS USE A',
                'COMBINATION OF TWO LABELS.'
      SIGNAL mistake
   END
END

/* examine number of chars ------------------------------------------ */
SELECT
   WHEN anz_char = 0 THEN DO
      n.1 = '*'
   END
   WHEN anz_char = 1 THEN DO
      SELECT
         WHEN LENGTH(n.1) = 1 THEN NOP                /* parm was >*< */
         WHEN LENGTH(n.1) = 3 THEN DO               /* parm was >'*'< */
            n.1 = SUBSTR(n.1,2,1)
         END
         OTHERWISE DO
            zedsmsg = 'INVALID PARAMATERS'
            zedlmsg = 'CHARACTER INVALID. PUT STRING IN QUOTES'
            SIGNAL mistake
         END
      END
   END
   OTHERWISE DO
      zedsmsg = 'INVALID PARAMATERS'
      zedlmsg = 'MACRO BOX DOES NOT SUPPORT MORE THAN ONE CHARACTER.'
      SIGNAL mistake
   END
END

/* examine number of languages -------------------------------------- */
SELECT
   WHEN anz_lang = 0 THEN DO
      n.4 = 'COB'                                          /* Default */
   END
   WHEN anz_lang = 1 THEN NOP
   OTHERWISE DO
      zedsmsg = 'INVALID PARAMATERS'
      zedlmsg = 'MACRO BOX DOES NOT SUPPORT MORE THAN ONE LANGUAGE',
                'PARMAMETER.'
      SIGNAL mistake
   END
END

/* swap from / to --------------------------------------------------- */
IF von > bis THEN DO
   temp = von
   von = bis
   bis = temp
END

/* loop ------------------------------------------------------------- */
col = 1
DO row = von TO bis
   "ISREDIT CURSOR = " row col
   SELECT
      WHEN (n.4 = 'COB') THEN DO
         "ISREDIT CHANGE .ZCSR .ZCSR  7 p'=' '*'"
         "ISREDIT CHANGE .ZCSR .ZCSR 71 p'=' '*'"
      END
      WHEN (LEFT(n.4,2) = 'PL') THEN DO
         "ISREDIT CHANGE .ZCSR .ZCSR  '/*' '  '"
         "ISREDIT CHANGE .ZCSR .ZCSR  '*/' '  '"
         "ISREDIT CURSOR = " row col
         "ISREDIT CHANGE .ZCSR .ZCSR  2 p'==' '/*'"
         "ISREDIT CHANGE .ZCSR .ZCSR 71 p'==' '*/'"
      END
      WHEN ODER(n.4 = 'JCL' , n.4 = 'CNT') THEN DO
         "ISREDIT CHANGE .ZCSR .ZCSR  1 p'===' '//*'"
      END
      WHEN (n.4 = 'REX') THEN DO
         "ISREDIT CHANGE .ZCSR .ZCSR  1 p'==' '/*'"
         "ISREDIT CHANGE .ZCSR .ZCSR 71 p'==' '*/'"
      END
      OTHERWISE NOP
   END
END

/* above / belowe --------------------------------------------------- */
SELECT
   WHEN (n.4 = 'COB') THEN DO
      box_line = '      *'
      do i = 8 to 70
         box_line = KONKAT(box_line, n.1)
      end
      box_line = KONKAT(box_line, '*         ')
   END
   WHEN (LEFT(n.4,2) = 'PL') THEN DO
      box_line = ' /*'
      do i = 4 to 70
         box_line = KONKAT(box_line, n.1)
      end
      box_line = KONKAT(box_line, '*/        ')
   END
   WHEN ODER(n.4 = 'JCL', n.4 = 'CNT') THEN DO
      box_line = '//*'
      do i = 4 to 71
         box_line = KONKAT(box_line, n.1)
      end
      box_line = KONKAT(box_line, '         ')
   END
   WHEN (n.4 = 'REX') THEN DO
      box_line = '/* '
      do i = 4 to 69
         box_line = KONKAT(box_line, n.1)
      end
      box_line = KONKAT(box_line, ' */        ')
   END
   OTHERWISE NOP
END
"ISREDIT LINE_AFTER" bis "= '"box_line"'"
"ISREDIT LINE_BEFORE" von "= '"box_line"'"

/* Reset ------------------------------------------------------------ */
"ISREDIT RESET CHG"

/* reset User_State ------------------------------------------------- */
"ISREDIT USER_STATE = (usrst)"

/* reset cursor ----------------------------------------------------- */
"ISREDIT CURSOR = " csrrow csrcol

/* finish ----------------------------------------------------------- */
EXIT 1

/* ================================================================== */

MISTAKE:
   /* Fehlerbehandlung ---------------------------------------------- */
   "ISPEXEC SETMSG MSG(ISRZ001)"
EXIT -8