OS/2 Shareware BBS: 10 Tools/10-Tools.zip/pds.zip/PDEDIT.CMD

OS/2 REXX Batch file | 1994-03-01 | 35KB | 1,408 lines

/*REXX*/

  /***
  signal on HALT    name HaltExit
  signal on ERROR   name ErrorExit
  signal on FAILURE name FailureExit
  signal on SYNTAX  name SyntaxExit
  ***/

main:
parse arg p1
  fDebug   = 'N'
  fDispStax= 'N'
  fDispHelp= 'N'
  fFlSpecQ = 'N'
  sFlSpec = ''
  fIgnoreRXQ = 'N'

  CALL rParseParms p1

  rc = rLoadFuncs('SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs')
  if rc <> 0 then
   do
    Call rSiren 8, 1
    say 'PDEDIT - Error initializing System REXX routines'
    if fIgnoreRXQ = 'Y' then
     do
      say 'PDEDIT - Ignoring error and will attempt to continue'
     end
    else
     do
      say 'PDEDIT - Quitting'
      exit 8
     end
   end

  if fDebug = 'Y' then
   do
    trace ?r
   end

  if fDispStax = 'Y' then
   do
    CALL rDispSyntax 0, 0
   end

  if fDispHelp = 'Y' then
   do
    CALL rDispSyntax 1, 0
   end

  /* Actual routine */
  if fFlSpecQ = 'N' then
   do
    Call rSiren 1, 1
    say 'PDEDIT - Missing file name'
    CALL rDispSyntax 0, 8
   end
  rc   = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  if rc <> 0 then
   do
    Call rSiren 1, 1
    say 'PDEDIT - Unable to initialize the "RXPD" subsystem'
    exit 8
   end

  sGlobal.iMaxRows = 22
  sGlobal.fModifiedQ = 'N'
  sGlobal.iCCBeg = 1
  sGlobal.iCCEnd = 80
  sGlobal.iCCMax = sGlobal.iCCEnd
  sGlobal.sCursorFld='ZCMD'
  sGlobal.iCursorNdx=0
  sGlobal.fDebug=fDebug

  bid = rxPDInit('PDEDIT','GREENHI','RED','REDHI',,25,80)
  if bid = x2c(00000000) then
   do
    Call rSiren 2, 3
    say 'PDEDIT - Error to initializing the "RXPD" subsystem'
    exit 8
   end
  Call rxPDZVarDefine
  iNumAttr = ZVTYPE_LONG+ZVTYPE_RIGHTADJUST+ZVTYPE_LZEROFILL
  rc = rxPDVarDefine(bid, 'sGlobal.iCCBeg', iNumAttr, 4)
  rc = rxPDVarDefine(bid, 'sGlobal.iCCEnd', iNumAttr, 4)
  do i = 1 to sGlobal.iMaxRows
   sPDRow.i  = 0
   sPDRec.i  = ''
  end /* do i = 1 to sGlobal.iMaxRows */

  akey = rxPDDisplay(bid,'PANEL000')
  do while 0 = rDoEdit(bid)
  end /* do while 0 = rDoEdit() */

  /* Save the file */
  Call rDoSAVE

  rc = rxPDTerm(bid)

  exit 0

/**********************************************************************\
 rDoEdit:
  This routine displays a dialog panel for the file.
\**********************************************************************/
rDoEdit:
parse arg bid
  DROP sFlRecs.
  Call rLoadFileStem
  sGlobal.iNdx = 1
  Call rLoadPDStem sGlobal.iNdx

  do FOREVER

   akey = ZESC
   ZCMD = ''
   ZAMT = 'CSR'

   do while akey = ZESC
    akey = rxPDDisplay(bid, 'PANEL001', sGlobal.sCursorFld, sGlobal.iCursorNdx)
    parse var ZCurVar ziCol zFld
    sGlobal.sCursorFld = zFld
    sGlobal.iCursorNdx = ziCol
    if aKey = ZESC then
     do
      Call rLoadPDStem sGlobal.iNdx
     end
   end /*do while akey = ZESC*/

   parse var zFld sFld '.' iPDRow

 /*if akey = ZHOME then */
 /* do                  */
 /*  Call rDoHOME       */
 /*  iterate            */
 /* end                 */
 /*if akey = ZARRWUP then    */
 /* do                       */
 /*  Call rDoARRWUP          */
 /*  iterate                 */
 /* end                      */
 /*if akey = ZARRWDOWN then  */
 /* do                       */
 /*  Call rDoARRWDOWN        */
 /*  iterate                 */
 /* end                      */

   Call rxPDDisplay bid, 'PANELXSYSTEM'

   sGlobal.iMDTCnt = rxPDQueryMDT(bid,'PANEL001')
   if sGlobal.iMDTCnt > 0 then
    do
     if sGlobal.iMDTCnt <> 1 | \rxPDQueryMDT(bid,'PANEL001','ZCMD') then
      do
       rc = rDoUpdateRows()
       if rc <> 0 then                 /* Possible line command error */
        do
         iterate
        end
      end
    end

   select
    when akey = ZARRWUP then
     do
      Call rDoARRWUP
     end
    when akey = ZARRWDOWN then
     do
      Call rDoARRWDOWN
     end
    when akey = ZPGUP then
     do
      Call rDoPGUP
     end
    when akey = ZPGDW then
     do
      Call rDoPGDW
     end
    when akey = ZENTER then
     do
      Call rDoENTER
     end
    when akey = ZHOME then
     do
      Call rDoHOME
     end
    when akey = Z_D_A then
     do
      Call rDoDELETE
     end
    when akey = Z_T_A | akey = ZF2 then
     do
      Call rDoSPLIT
     end
    when akey = Z_J_A then
     do
      Call rDoJOIN
     end
    when akey = Z_I_A | akey = ZF3 then
     do
      Call rDoINSERT
     end
    when akey = Z_R_A | akey = ZF4 then
     do
      Call rDoREPEAT
     end
    when akey = Z_S_A then
     do
      Call rDoSAVE
     end
    when akey = ZPGUP_C then
     do
      Call rDoPGUP_C
     end
    when akey = ZPGDW_C then
     do
      Call rDoPGDW_C
     end
    when akey = ZF10 then
     do
      Call rDoLSCROLL
     end
    when akey = ZF11 then
     do
      Call rDoRSCROLL
     end
    when akey = ZF3_A | akey = ZF4_A then
     do
      return 8
     end
    otherwise
     do
      Call rSiren 4,3
      sGlobal.sCursorFld='ZCMD'
      sGlobal.iCursorNdx=0
     end
   end /* select */

  if sGlobal.iMDTCnt <> 0 & rxPDQueryMDT(bid,'PANEL001','ZCMD') then
   do
    rc = rDoPrimaryCMDS()
    if rc > 4 then
     do
      return rc
     end
   end

  end /*do FOREVER */

  return 0;

/**********************************************************************\
 rDoPrimaryCMDS:
  Routine to test the ZCMD field for possible primary command
\**********************************************************************/
rDoPrimaryCMDS:
  if sGlobal.fDebug = 'RDOPRIMARYCMDS' then
   do
    Call Trace ?r
   end

  svZCMD = ZCMD
  parse var ZCMD ZCMD ZCMDTRLR
  select
   when '' = ZCMD then
    do
    end
   when 'CAN' = TRANSLATE(ZCMD) | 'CANCEL' = TRANSLATE(ZCMD) then
    do
     sGlobal.fModifiedQ = 'N'
     return 8
    end
   when 'D' = TRANSLATE(ZCMD) | 'DEL' = TRANSLATE(ZCMD) then
    do
     ZCMDTRLR = STRIP(ZCMDTRLR)
     if ZCMDTRLR = '' then
      do
       ZCMDTRLR = 1
      end
     if DATATYPE(ZCMDTRLR) <> 'NUM' then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       sShortMsg = ''
       sLongMsg = '"'ZCMDTRLR'" IS NOT A VALID DELETE OPERAND.'
       rc = rxPDSetMsgText(bid,sShortMsg,sLongMsg,,ZALARM_ERROR)
       return 0
      end
     iPCRow = 1
     if ABBREV(sGlobal.sCursorFld,'sPDRec.') then
      do
       iPCRow = iPDRow
      end
     rc = rDeleteRow(iPCRow,ZCMDTRLR);
     if rc <> 0 then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       return 0
      end
     Call rLoadPDStem sGlobal.iNdx
    end
   when 'I' = TRANSLATE(ZCMD) | 'INSERT' = TRANSLATE(ZCMD) then
    do
     ZCMDTRLR = STRIP(ZCMDTRLR)
     if ZCMDTRLR = '' then
      do
       ZCMDTRLR = 1
      end
     if DATATYPE(ZCMDTRLR) <> 'NUM' then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       sShortMsg = ''
       sLongMsg = '"'ZCMDTRLR'" IS NOT A VALID INSERT OPERAND.'
       rc = rxPDSetMsgText(bid,sShortMsg,sLongMsg,,ZALARM_ERROR)
       return 0
      end
     iPCRow = 1
     if ABBREV(sGlobal.sCursorFld,'sPDRec.') then
      do
       iPCRow = iPDRow
      end
     rc = rInsertRow(iPCRow,ZCMDTRLR);
     if rc <> 0 then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       return 0
      end
     Call rLoadPDStem sGlobal.iNdx
    end
   when 'R' = TRANSLATE(ZCMD) | 'REPEAT' = TRANSLATE(ZCMD) then
    do
     ZCMDTRLR = STRIP(ZCMDTRLR)
     if ZCMDTRLR = '' then
      do
       ZCMDTRLR = 1
      end
     if DATATYPE(ZCMDTRLR) <> 'NUM' then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       sShortMsg = ''
       sLongMsg = '"'ZCMDTRLR'" IS NOT A VALID INSERT OPERAND.'
       rc = rxPDSetMsgText(bid,sShortMsg,sLongMsg,,ZALARM_ERROR)
       return 0
      end
     iPCRow = 1
     if ABBREV(sGlobal.sCursorFld,'sPDRec.') then
      do
       iPCRow = iPDRow
      end
     rc = rRepeatRow(iPCRow,ZCMDTRLR);
     if rc <> 0 then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=0
       return 0
      end
     Call rLoadPDStem sGlobal.iNdx
    end
   when 'F' = TRANSLATE(ZCMD) | 'FIND' = TRANSLATE(ZCMD) then
    do
    end
   when 'C' = TRANSLATE(ZCMD) | 'CHANGE' = TRANSLATE(ZCMD) then
    do
    end
   when 'L' = TRANSLATE(ZCMD) | 'LOCATE' = TRANSLATE(ZCMD) then
    do
     if ZCMDTRLR = '' | DATATYPE(ZCMDTRLR) <> 'NUM' then
      do
       sGlobal.sCursorFld = 'ZCMD'
       sGlobal.iCursorNdx=WORDINDEX(svZCMD,2)
       sShortMsg = ''
       sLongMsg = '"'svZCMD'" IS NOT A VALID LOCATE REQUEST.'
       rc = rxPDSetMsgText(bid,sShortMsg,sLongMsg,,ZALARM_ERROR)
       return 0
      end
     sGlobal.iCursorFld = 'ZCMD'
     sGlobal.iCursorNdx = 0
     sGlobal.iNdx = ZCMDTRLR+1
     Call rLoadPDStem sGlobal.iNdx
    end
   otherwise
    do
     sGlobal.sCursorFld = 'ZCMD'
     sGlobal.iCursorNdx=0
     sShortMsg = 'UNKNOWN'
     sLongMsg = '"'ZCMD'" IS NOT A VALID PRIMARY COMAND.'
     rc = rxPDSetMsgText(bid,sShortMsg,sLongMsg,,ZALARM_ERROR)
    end
  end /*select*/

  return 0;

/**********************************************************************\
 rDoUpdateRows:
  Routine to test all fields' MDT state and act accordingly
\**********************************************************************/
rDoUpdateRows:
  /* First, test all rows */
  iUpdState = 0

  do i = 1 to sGlobal.iMDTCnt          /* Test only MDTd fields */
   sUPFld = rxPDQueryMDTFld(bid,'PANEL001',i) /* Retrieve MDTd FldName*/
   parse var sUPFld sUPFld '.' iUPPDRow /* Parse it out */
   select
    when 'sPDRec'  = sUPFld then       /* Data field */
     do
      Call rUpdateRow iUPPDRow         /* Yep, update the file stem */
      iUpdState = 1                    /* Remember we touched one */
     end
    otherwise
     do
     end
   end /*select*/
  end /*do i = 1 to sGlobal.iMDTCnt*/  /* Test only MDTd fields */

  /* 2nd, test for any updated rows */
  if iUpdState = 1 then
   do
    Call rLoadPDStem sGlobal.iNdx
   end

  return 0

/**********************************************************************\
 rDoARRWUP:
  Routine to handle the simple Arrow_Up key
\**********************************************************************/
rDoARRWUP:

  if sFld = 'sPDRec' then
   do
    if iPDRow = 1 then
     do
      sGlobal.sCursorFld = 'ZCMD'
      sGlobal.iCursorNdx = 0
      return 0
     end
    sGlobal.sCursorFld = 'sPDRec.'iPDRow-1
    return 0
   end

  i = sGlobal.iMaxRows
  sGlobal.sCursorFld = 'sPDRec.'i
  sGlobal.iCursorNdx = 0

  return 0

/**********************************************************************\
 rDoARRWDOWN:
  Routine to handle the simple Arrow_DOWN key
\**********************************************************************/
rDoARRWDOWN:

  if sFld = 'sPDRec' then
   do
    if iPDRow = sGlobal.iMaxRows then
     do
      sGlobal.sCursorFld = 'ZCMD'
      sGlobal.iCursorNdx = 0
      return 0
     end
    sGlobal.sCursorFld = 'sPDRec.'iPDRow+1
    return 0
   end

  sGlobal.sCursorFld = 'sPDRec.'1
  sGlobal.iCursorNdx = 0

  return 0

/**********************************************************************\
 rDoPGUP:
  Routine to handle the simple Page_Up key
\**********************************************************************/
rDoPGUP:
  select
   when sFld = 'sPDRec' then
    do
     if iPDRow<>sGlobal.iMaxRows then
      do
       iDelta = sGlobal.iMaxRows - iPDRow
       iNRow = iPDRow + iDelta      /* I.E. iNRow = sGlobal.iMaxRows */
       sGlobal.iNdx = sGlobal.iNdx - iDelta /* Data row to display */
       if sGlobal.iNdx <= 0 then
        do
         iNRow = iNRow + sGlobal.iNdx - 1 /* Back it up */
         sGlobal.iNdx = 1
        end
       sGlobal.sCursorFld=sFld'.'iNRow
      end
     else
      do
       sGlobal.sCursorFld='ZCMD'
       sGlobal.iCursorNdx=0
       sGlobal.iNdx = sGlobal.iNdx - sGlobal.iMaxRows
      end
    end
   otherwise
    do
     sGlobal.sCursorFld='ZCMD'
     sGlobal.iCursorNdx=0
     select
      when ZCMD = '' then
       do
        sGlobal.iNdx = sGlobal.iNdx - sGlobal.iMaxRows
       end
      when DATATYPE(ZCMD) = 'NUM' then
       do
        sGlobal.iNdx = sGlobal.iNdx - ZCMD
        ZCMD = ''
       end
      when TRANSLATE(ZCMD) = 'M' then
       do
        sGlobal.iNdx = 1
        ZCMD = ''
       end
      when TRANSLATE(ZCMD) = 'H' then
       do
        sGlobal.iNdx = sGlobal.iNdx - FORMAT(sGlobal.iMaxRows/2,,0)
        ZCMD = ''
       end
      otherwise
       do
        sGlobal.iNdx = sGlobal.iNdx - sGlobal.iMaxRows
       end
     end /* select */
    end
  end /* select */
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoPGDW:
  Routine to handle the simple Page_Down key
\**********************************************************************/
rDoPGDW:
  select
   when sFld = 'sPDRec' then
    do
     if iPDRow<>1 then
      do
       iDelta = iPDRow - 1
       iNRow = iPDRow - iDelta      /* I.E. iNRow = 1 */
       sGlobal.iNdx = sGlobal.iNdx + iDelta /* Data row to display */
       if sGlobal.iNdx > sFlRecs.0+1 then /* Beyond end of table + EYEC */
        do
         iNRow = (sGlobal.iNdx-sFlRecs.0) /* Move it down */
         sGlobal.iNdx = sFlRecs.0+1
        end
       sGlobal.sCursorFld=sFld'.'iNRow
      end
     else
      do
       sGlobal.sCursorFld='ZCMD'
       sGlobal.iCursorNdx=0
       sGlobal.iNdx = sGlobal.iNdx + sGlobal.iMaxRows
      end
    end
   otherwise
    do
     sGlobal.sCursorFld='ZCMD'
     sGlobal.iCursorNdx=0
     select
      when ZCMD = '' then
       do
        sGlobal.iNdx = sGlobal.iNdx + sGlobal.iMaxRows
       end
      when DATATYPE(ZCMD) = 'NUM' then
       do
        sGlobal.iNdx = sGlobal.iNdx + ZCMD
        ZCMD = ''
       end
      when TRANSLATE(ZCMD) = 'M' then
       do
        sGlobal.iNdx = sFlRecs.0 - sGlobal.iMaxRows + 1
        ZCMD = ''
       end
      when TRANSLATE(ZCMD) = 'H' then
       do
        sGlobal.iNdx = sGlobal.iNdx + FORMAT(sGlobal.iMaxRows/2,,0)
        ZCMD = ''
       end
      otherwise
       do
        sGlobal.iNdx = sGlobal.iNdx + sGlobal.iMaxRows
       end
     end /* select */
    end
  end /* select */
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoLSCROLL:
  Routine to handle the F10 key
\**********************************************************************/
rDoLSCROLL:

  if sFld = 'ZCMD' then
   do
    iShift = sGlobal.iCCMax
   end

  if sFld = 'sPDRec' then
   do
    iShift = sGlobal.iCCMax - sGlobal.iCursorNdx + 1
    if iShift > sGlobal.iCCBeg then
     do
      iShift = sGlobal.iCCBeg - 1
     end
    sGlobal.iCursorNdx = sGlobal.iCursorNdx + iShift
    if iShift >= sGlobal.iCCMax then
     do
      iShift = sGlobal.iCCMax
     end
   end

  sGlobal.iCCBeg = sGlobal.iCCBeg - iShift
  sGlobal.iCCEnd = sGlobal.iCCEnd - iShift

  if sGlobal.iCCBeg <= 0 then
   do
    sGlobal.iCCBeg = 1
    sGlobal.iCCEnd = sGlobal.iCCMax
   end

  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoRSCROLL:
  Routine to handle the F11 key
\**********************************************************************/
rDoRSCROLL:

  if sFld = 'ZCMD' then
   do
    iShift = sGlobal.iCCMax
   end

  if sFld = 'sPDRec' then
   do
    iShift = sGlobal.iCursorNdx - 1
    sGlobal.iCursorNdx = 1
    if iShift <= 0 then
     do
      iShift = sGlobal.iCCMax
     end
   end

  sGlobal.iCCBeg = sGlobal.iCCBeg + iShift
  sGlobal.iCCEnd = sGlobal.iCCEnd + iShift

  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoENTER:
  Routine to handle ENTER
\**********************************************************************/
rDoENTER:

  if sGlobal.iMDTCnt = 0 then
   do
    if zFld = 'ZCMD' then
     do
      sGlobal.sCursorFld='sPDRec.1'
      sGlobal.iCursorNdx=0
     end
    else
     do
      if iPDRow = sGlobal.iMaxRows then
       do
        sGlobal.sCursorFld = 'ZCMD'
        sGlobal.iCursorNdx = 0
       end
      else
       do
        sGlobal.sCursorFld = 'sPDRec.'iPDRow+1
        INTERPRET 'sTst =sPDRec.'iPDRow+1
        sGlobal.iCursorNdx = WORDINDEX(sTst,1)
       end
     end
   end

  return 0

/**********************************************************************\
 rDoHOME:
  Routine to handle HOME
\**********************************************************************/
rDoHOME:
  if ziCol = 1 then
   do
    sGlobal.sCursorFld='ZCMD'
   end
  else
   do
    sGlobal.sCursorFld=zFld
   end
  sGlobal.iCursorNdx=0

  return 0

/**********************************************************************\
 rDoSAVE
  Routine to handle SAVE
\**********************************************************************/
rDoSAVE:
  if sGlobal.fModifiedQ <> 'Y' then
   do
    return 0
   end
  sGlobal.fModifiedQ = 'N'
  return rStoreFileStem()

/**********************************************************************\
 rDoDELETE:
  Routine to handle DELETE
\**********************************************************************/
rDoDELETE:
  if sFld <> 'sPDRec' then
   do
    return 0
   end
  sGlobal.sCursorFld=zFld
  sGlobal.iCursorNdx=0
  rc = rDeleteRow(iPDRow,1);
  if rc <> 0 then
   do
    return 0
   end
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoSPLIT:
  Routine to handle SPLIT
\**********************************************************************/
rDoSPLIT:
  if sFld <> 'sPDRec' then
   do
    return 0
   end
/*sGlobal.sCursorFld=zFld*/
/*sGlobal.iCursorNdx=0   */
  rc = rSplitRow(iPDRow,1);
  if rc <> 0 then
   do
    return 0
   end
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoJOIN:
  Routine to handle JOIN
\**********************************************************************/
rDoJOIN:
  if sFld <> 'sPDRec' then
   do
    return 0
   end
  rc = rJoinRow(iPDRow,1);
  if rc <> 0 then
   do
    return 0
   end
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoINSERT:
  Routine to handle INSERT
\**********************************************************************/
rDoINSERT:
  if sFld <> 'sPDRec' then
   do
    return 0
   end
  sGlobal.sCursorFld=zFld
  sGlobal.iCursorNdx=0
  rc = rInsertRow(iPDRow,1);
  if rc <> 0 then
   do
    return 0
   end
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoREPEAT:
  Routine to handle REPEAT
\**********************************************************************/
rDoREPEAT:
  if sFld <> 'sPDRec' then
   do
    return 0
   end
  sGlobal.sCursorFld=zFld
  sGlobal.iCursorNdx=0
  rc = rRepeatRow(iPDRow,1);
  if rc <> 0 then
   do
    return 0
   end
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoPGUP_C:
  Routine to handle Ctrl+PAGEUP
\**********************************************************************/
rDoPGUP_C:
  sGlobal.sCursorFld='sPDRec.1'
  sGlobal.iCursorNdx=0
  sGlobal.iNdx = 1
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rDoPGDW_C:
  Routine to handle Ctrl+PAGEDOWN
\**********************************************************************/
rDoPGDW_C:
  sGlobal.sCursorFld='sPDRec.1'
  sGlobal.iCursorNdx=0
  sGlobal.iNdx = sFlRecs.0
  Call rLoadPDStem sGlobal.iNdx

  return 0

/**********************************************************************\
 rUpdateRow:
  This routine updates a row in the TSD (maybe)
\**********************************************************************/
rUpdateRow: Procedure Expose sPDRow. sPDRec. sFlRecs. sGlobal.
parse arg iUpdRow
  iRow = sPDRow.iUpdRow
  if iRow = 1 | iRow >= sFlRecs.0 then
   do
    return 4
   end
  if sGlobal.iCCBeg > 1 then
   do
    sFrst = SUBSTR(sFlRecs.iRow,1,sGlobal.iCCBeg-1,' ')
   end
  else
   do
    sFrst = ''
   end
  sMddl = sPDRec.iUpdRow
/*sMddl = SUBSTR(sFlRecs.iRow,sGlobal.iCCBeg,(sGlobal.iCCEnd-sGlobal.iCCBeg+1),' ')*/
  if LENGTH(sFlRecs.iRow) > sGlobal.iCCEnd then
   do
    sLast = STRIP(SUBSTR(sFlRecs.iRow,sGlobal.iCCEnd))
   end
  else
   do
    sLast = ''
   end

  sFlRecs.iRow = sFrst||sMddl||sLast

  if iUpdRow < sGlobal.iMaxRows then
   do
    sGlobal.sCursorFld = 'sPDRec.'iUpdRow+1
    INTERPRET 'sTst =sPDRec.'iUpdRow
    sGlobal.iCursorNdx = WORDINDEX(sTst,1)
   end
  else
   do
    sGlobal.sCursorFld = 'ZCMD'
    sGlobal.iCursorNdx=0
   end
  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rDeleteRow:
  This routine deletes a record
\**********************************************************************/
rDeleteRow:
parse arg iDelRow, iCnt
  iRow = sPDRow.iDelRow
  if iRow = 1 | iRow >= sFlRecs.0 then
   do
    return 4
   end

  /* Let Someone else do the dirty work */
  Call rDeleteRowNum iRow, iCnt

  /* Where to position cursor */
  sGlobal.sCursorFld = 'sPDRec.'iDelRow
  sGlobal.iCursorNdx=0

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rDeleteRowNum:
  This routine deletes a specific record
\**********************************************************************/
rDeleteRowNum:
parse arg iRowNum, iCnt
  if iRowNum = 1 | iRowNum >= sFlRecs.0 then
   do
    return 4
   end

  /* First see if we are deleting too many */
  if iRowNum + iCnt > sFlRecs.0 then
   do
    iCnt = sFlRecs.0 - iRowNum         /* Max to Delete */
   end

  iTRow = iRowNum                      /* Target row number */
  iSRow = iRowNum + iCnt               /* Source row Number */
  iLoop = sFlRecs.0 - iRowNum - iCnt + 1 /* Number of rows to move */
  do iLoop
   sFlRecs.iTRow = sFlRecs.iSRow       /* Copy source to target */
   iTRow = iTRow + 1                   /* Next target */
   iSRow = iSRow + 1                   /* Next source */
  end /*do iLoop*/
  sFlRecs.0 = sFlRecs.0 - iCnt

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rSplitRow:
  This routine Splits a row in the TSD (maybe)
\**********************************************************************/
rSplitRow:
parse arg iSpltRow, iCnt
  iRow = sPDRow.iSpltRow
  if iRow = 1 | iRow >= sFlRecs.0 then
   do
    return 4
   end

  /* Save the current cursor position */
  sSpltCFld = sGlobal.sCursorFld
  iSpltCNdx = sGlobal.iCursorNdx

  /* Split the record into pieces parts */
  iSplit = sGlobal.iCCBeg + sGlobal.iCursorNdx - 1
  if iSplit = 1 then
   do
    sLHalf = ''
    sRHalf = sFlRecs.iRow
   end
  else
   do
    sLHalf = SUBSTR(sFlRecs.iRow,1,iSplit-1)
    sRHalf = SUBSTR(sFlRecs.iRow,iSplit)
   end

  /* Insert a blank line after the current row */
  rc = rInsertRow(iSpltRow,1)

  /* Update the two rows */
  sFlRecs.iRow = sLHalf
  iRow=iRow+1
  sFlRecs.iRow = sRHalf

  /* Restore the current cursor position */
  sGlobal.sCursorFld = sSpltCFld
  sGlobal.iCursorNdx = iSpltCNdx

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rJoinRow:
  This routine Joins a row in the TSD (maybe)
\**********************************************************************/
rJoinRow:
parse arg iJoinRow, iCnt
  iRow = sPDRow.iJoinRow
  /* Note special test for last row */
  if iRow = 1 | iRow+1 >= sFlRecs.0 then
   do
    return 4
   end

  /* Save the current cursor position */
  sJoinCFld = sGlobal.sCursorFld
  iJoinCNdx = sGlobal.iCursorNdx

  /* Join the records */
  iNextRow = iRow+1
  sNewRec=STRIP(sFlRecs.iRow)||sFlRecs.iNextRow
  sFlRecs.iRow=sNewRec

  /* Delete the row after the current row */
  rc = rDeleteRowNum(iNextRow,1)

  /* Restore the current cursor position */
  sGlobal.sCursorFld = sJoinCFld
  sGlobal.iCursorNdx = iJoinCNdx

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rInsertRow:
  This routine Inserts a row in the TSD (maybe)
\**********************************************************************/
rInsertRow:
parse arg iInsRow, iCnt
  iRow = sPDRow.iInsRow
  if iRow >= sFlRecs.0 then
   do
    return 4
   end

  /* Shift the file stem */
  iTRow = sFlRecs.0+iCnt               /* Target row number */
  iSRow = sFlRecs.0                    /* Source row Number */
  iLoop = sFlRecs.0 - iRow             /* Number of rows to move */
  do iLoop
   sFlRecs.iTRow = sFlRecs.iSRow       /* Copy source to target */
   iTRow = iTRow - 1                   /* Next target */
   iSRow = iSRow - 1                   /* Next source */
  end /*do iLoop*/

  /* Blank new rows */
  do iCnt
   sFlRecs.iTRow = ''                  /* Blank new target */
   iTRow = iTRow - 1                   /* Next target */
  end /*do iCnt*/

  /* Account for new rows */
  sFlRecs.0 = sFlRecs.0 + iCnt

  /* Where to position cursor */
  if iInsRow < sGlobal.iMaxRows then
   do
    sGlobal.sCursorFld = 'sPDRec.'iInsRow+1
   end
  else
   do
    sGlobal.sCursorFld = 'sPDRec.'iInsRow
    sGlobal.iNdx = sGlobal.iNdx + 1
   end
  INTERPRET 'sTst =sPDRec.'iInsRow
  sGlobal.iCursorNdx = WORDINDEX(sTst,1)

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rRepeatRow:
  This routine repeats a row in the TSD (maybe)
\**********************************************************************/
rRepeatRow:
parse arg iRptRow, iCnt
  iRow = sPDRow.iRptRow
  if iRow = 1 | iRow >= sFlRecs.0 then
   do
    return 4
   end

  /* Shift the file stem */
  iTRow = sFlRecs.0+iCnt               /* Target row number */
  iSRow = sFlRecs.0                    /* Source row Number */
  iLoop = sFlRecs.0 - iRow             /* Number of rows to move */
  do iLoop
   sFlRecs.iTRow = sFlRecs.iSRow       /* Copy source to target */
   iTRow = iTRow - 1                   /* Next target */
   iSRow = iSRow - 1                   /* Next source */
  end /*do iLoop*/

  /* Init new rows with old row */
  do iCnt
   sFlRecs.iTRow = sFlRecs.iRow        /* Copy it */
   iTRow = iTRow - 1                   /* Next target */
  end /*do iCnt*/

  /* Account for new rows */
  sFlRecs.0 = sFlRecs.0 + iCnt

  /* Where to position cursor */
  if iRptRow < sGlobal.iMaxRows then
   sGlobal.sCursorFld = 'sPDRec.'iRptRow+1
  else
   do
    sGlobal.sCursorFld = 'sPDRec.'iRptRow
    sGlobal.iNdx = sGlobal.iNdx + 1
   end
  sGlobal.iCursorNdx=0

  sGlobal.fModifiedQ = 'Y'
  return 0

/**********************************************************************\
 rLoadPDStem:
  This routine loads the display stem variables beginning with the
  specified index.
\**********************************************************************/
rLoadPDStem:
parse arg iLNdx
  if iLNdx > sFlRecs.0 then
   do
    iLNdx = sFlRecs.0
   end
  if iLNdx < 1 then
   do
    iLNdx = 1
   end
  j = iLNdx
  do i = 1 to sGlobal.iMaxRows
   select
    when j = 1 then
     do
      sPDRow.i    = j
      sPDRec.i    = CENTER(' TOP OF DATA ',sGlobal.iCCMax,'*')
     end
    when j < sFlRecs.0 then
     do
      sPDRow.i    = j
      sPDRec.i    = SUBSTR(sFlRecs.j,sGlobal.iCCBeg,sGlobal.iCCMax,' ')
    /*sPDRec.i    = sFlRecs.j*/
     end
    when j = sFlRecs.0 then
     do
      sPDRow.i    = j
      sPDRec.i    = CENTER(' BOTTOM OF DATA ',sGlobal.iCCMax,'*')
     end
    otherwise
     do
      sPDRow.i    = j
      sPDRec.i    = ''
     end
   end /* select */
   j = j + 1
  end /* do i = 1 to sGlobal.iMaxRows */
  sGlobal.iNdx = iLNdx
  return 0;

/**********************************************************************\
 rLoadFileStem:
  This routine loads the file stem variable.
\**********************************************************************/
rLoadFileStem:
  Call Trace 'Off'
  DROP sFlRecs.
  i = 1
  sFlRecs.0 = i
  sFlRecs.i = ''
  if sFlSpec <> '' then
   do
    state = stream(sFlSpec,'c','query exists')
    if state <> '' then
     do
      rc = rOpenFlSpec(sFlSpec)
      if rc <> 0 then
       do
        sFlRecs.0 = 0
        return 8
       end
      do while 0 < LINES(sFlSpec)
       i = i + 1
       sFlRecs.i = LINEIN(sFlSpec)
      end /*do while 0 < LINES(sFlSpec)*/
      sFlRecs.0 = i
      rc = rCloseFlSpec(sFlSpec)
     end
   end
  i = i + 1
  sFlRecs.0 = i
  sFlRecs.i = ''
  return 0

/**********************************************************************\
 rStoreFileStem:
  This routine store the file stem variable.
\**********************************************************************/
rStoreFileStem:
  i = 1
  if sFlSpec = '' then
   do
    Call BEEP 882, 40
    return 4
   end
  rc = rOpenFlSpec(sFlSpec,'REPL')
  if rc <> 0 then
   do
    return 8
   end
  if sFlRecs.0 > 2 then
   do
    do i = 2 to sFlRecs.0 - 1
     Call rWriteFlSpec sFlSpec, sFlRecs.i
    end /*do i = 2 to sFlRecs.0 - 1 */
   end
  rc = rCloseFlSpec(sFlSpec)
  return 0

/**********************************************************************\
 rOpenFlSpec:
  This routine opens the TSD for output processing and inits the pointer
\**********************************************************************/
rOpenFlSpec:
parse arg sFlSpec, sRepl
  if TRANSLATE(sRepl) = 'REPL' then
   do
    rc = SysFileDelete(sFlSpec)
    if rc > 2 then
     do
      svid = rxPDSaveScreen(bid)
      rc = rxPDDisplay(bid,'PUPDELETEERR')
      rc = rxPDRestoreScreen(bid,svid)
      rc = rxPDTerm(bid)
      exit 256
     end
   end
  state = stream(sFlSpec,'c','open')
  if state <> 'READY:' then
   do
    svid = rxPDSaveScreen(bid)
    rc = rxPDDisplay(bid,'PUPOPENERR')
    rc = rxPDRestoreScreen(bid,svid)
    return 8
   end
  return 0

/**********************************************************************\
 rCloseFlSpec:
  This routine closes the TSD
\**********************************************************************/
rCloseFlSpec:
parse arg sFlSpec
  state = stream(sFlSpec,'c','close')
  return 0

/**********************************************************************\
 rWriteFlSpec:
  This routine sequentially writes the TSD
\**********************************************************************/
rWriteFlSpec:
parse arg sFlSpec, sRec
  err = lineout(sFlSpec,sRec)
  if err <> 0 then
   do
    svid = rxPDSaveScreen(bid)
    rc = rxPDDisplay(bid,'PUPWRITEERR')
    rc = rxPDRestoreScreen(bid,svid)
    rc = rxPDTerm(bid)
    exit 256
   end
  return 0

HaltExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'PDEDIT processing halted by request;'
  exit 0

ErrorExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'PDEDIT processing failed due to unknown error;'
  exit 24

FailureExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'PDEDIT processing failed due to unknown failure;'
  exit 32

SyntaxExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'PDEDIT processing failed due to syntax error;'
  exit 64

rParseParms:
parse arg p1

  do Forever
   w1 = word(p1,1)
   parse var w1 with "/" f1 ":" v1
   select
    when (w1 = '') then
     do
      return 0
     end
    when TRANSLATE(w1) = '/IRX' then
     do
      fIgnoreRXQ='Y'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(w1) = '/DEBUG' then
     do
      fDebug='Y'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = 'D' then
     do
      fDebug = TRANSLATE(v1)
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = '?' then
     do
      fDispStax='Y'
      fDispHelp='N'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = 'H' then
     do
      fDispStax='N'
      fDispHelp='Y'
      p1 = SUBWORD(p1,2)
     end
    otherwise
     do
      select
       when fFlSpecQ <> 'Y' then
        do
         fFlSpecQ = 'Y'
         sFlSpec = w1
         p1 = SUBWORD(p1,2)
        end
       otherwise
        do
         Call rSiren 8, 1
         say 'PDEDIT - Too many parms specified; Parm "'w1'" unknown;'
         CALL rDispSyntax 0 8
        end
      end /* select */
     end
   end
  end

  return 0

rDispSyntax: Procedure
parse upper arg iHelp iExit

  say ' Syntax  : PDEDIT {<options>} {filespec}'
  say '           PDEDIT {/?|/h}'
  if iHelp > 0 then
   do
    CALL rDispHelp
   end

  exit iExit

rDispHelp: Procedure

  say ' Parms   : filespec   - File name to edit.'
  say ''
  say ' Options : /?         - Display command syntax.'
  say '           /h         - Display this help info.'
  say ' Examples:'
  say '    PDEDIT /h'
  say ' '
  say '    PDEDIT config.sys'

  return ''

/* rSiren: does the siren bit by running the scale based upon a       */
/*    frequency specified by the caller.                              */
rSiren: Procedure
   Parse Arg freq, cycle
   note.1 = 262 * freq /* middle C */
   note.2 = 294 * freq /* D */
   note.3 = 330 * freq /* E */
   note.4 = 349 * freq /* F */
   note.5 = 392 * freq /* G */
   note.6 = 440 * freq /* A */
   note.7 = 494 * freq /* B */
   note.8 = 524 * freq /* C */
   do j = 1 to cycle
    call beep note.8,250 /* hold each note for a 1/4 second */
    call beep note.1,250 /* hold each note for a 1/4 second */
   end j
   Return

rLoadFuncs:
parse arg sREP, sDll, sRtn
  rxrc = RxFuncAdd(sREP, sDll, sRtn)
  signal on syntax name xLoadFuncs
  interpret 'Call 'sRtn
  return 0

xLoadFuncs:
  return 127