*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/26 17:16:18  mclareni
* Initial revision
*
*
#include "comis/pilot.h"
*CMZ :  1.18/00 17/02/94  16.09.33  by  Vladimir Berezhnoi
*-- Author : V.Berezhnoi
      INTEGER FUNCTION CSIMED(J,N)
***--------------------------
*     it is local comis editor
***---------------------------
#include "comis/cspar.inc"
#include "comis/csrec.inc"
#include "comis/cspnts.inc"
        COMMON/CSCONT/LCONT
*
      PARAMETER (MXSLIN=100)
      CHARACTER *80 SOURCE(MXSLIN)
      CHARACTER *32 FILENM, SOLD*80, SNEW*80
      INTEGER CSTINF,CSTFRF
      INTEGER GSNLAB
      COMMON /CSGSCM/IGSST,JGSST,NGSST,NGSPAR,JGSSB,GSNLAB
****
*     *
*     S     -> DINPS                 ^S1
*     S1    ->  PRET        DT       ^S
*              'EDIT'       DSEDT    ^S
*              'S'      DS  RG  DSS  ^S
*              'I'     RG1  DI       ^S
*              'D'      RG  DD       ^S
*              'Q'      DQ
*              'E'      DE
*              'HELP'/'H'   DH       ^S
*              'T'      RG  DT       ^S
*               RG      PRG DT       ^S
*               E
*     RG     -> '-'     INUMB/T      DRM
*               '+'     INUMB/T      DRP
*               'W'     DW
*               'F'     DF    DR1    ^RG2
*               'L'     DL    DR1    ^RG2
*               INUMB   DR1          ^RG2
*               DCUR
*     RG1    -> INUMB/T       DIN
*     RG2    -> ':'/ '/'             ^RG3
*               DRNUM
*     RG3    -> 'F'     DF    DR2
*               'L'     DL    DR2
*                INUMB/T      DR2
****
      INTEGER GSCMST(210),GSSTRC(4),GSSTRP(33)
      DATA GSCMST/
     *0,6,2,8,7,0,15,6,3,6,13,8,1,0,23,4,1,6,24,8,1,0,35,4,3,6,15,7,103,
     *6,16,8,1,0,45,4,5,7,163,6,17,8,1,0,55,4,7,7,103,6,14,8,1,0,61,4,9,
     *6,12,0,67,4,11,6,18,0,79,4,13,5,74,4,15,6,19,8,1,0,89,4,17,7,103,
     *6,13,8,1,0,99,7,103,6,8,6,13,8,1,0,0,3,1,0,114,4,19,6,11,5,111,1,
     *6,4,0,125,4,21,6,11,5,122,1,6,5,0,131,4,23,6,20,0,141,4,25,6,21,6,
     *6,8,172,0,151,4,27,6,22,6,6,8,172,0,159,6,11,6,6,8,172,0,0,6,7,0,
     *0,6,11,5,169,1,6,23,0,182,4,29,5,179,4,31,8,186,0,0,6,10,0,194,4,
     *25,6,21,6,9,0,202,4,27,6,22,6,9,0,0,6,11,5,208,1,6,9,0/
      DATA GSSTRC/
     *4HEDIT,4HSQHE,4HLP-+,4HWF://
      DATA GSSTRP/
     *0,4,4,1,2,1,1,1,5,1,0,1,6,4,6,1,3,1,10,1,11,1,12,1,13,1,8,1,14,1,
     *15,1,-1/
#if !defined(CERNLIB_IBM)
      DATA FILENM/'COMIS.EDT'/
#endif
#if defined(CERNLIB_IBMMVS)
      DATA FILENM/'COMIS.EDT'/
#endif
#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_IBMMVS))
      DATA FILENM/'COMIS EDT'/
#endif
      JSOLD=MJSCHA(SOLD)
      JSNEW=MJSCHA(SNEW)
      ASSIGN 99 TO LBEG
      GO TO 100
 99   JGSST=J
      NGSST=N
      IPRG=1
      IPRET=0
      IF(NGSST.EQ.0)IPRET=1
      JGSSB=0
        NGSPAR=0
    1 CALL CSGSCL(GSCMST(1),GSSTRC(1),GSSTRP(1),I)
      GO TO (2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
     *21,22,23,24,25),GSNLAB
    2 CONTINUE
      IF(IGSST.LE.0)THEN
        GO TO (71,71,72,73,74,75),1-IGSST
        GO TO 77
 71     CALL CSSOUT('MED: syntax error')
        GO TO 77
 72     CALL CSSOUT('ommited delimiter')
        GO TO 77
 73     CALL CSSOUT('[TOP]')
        GO TO 77
 74     CALL CSSOUT('buffer is empty')
        GO TO 77
 75     CALL CSSOUT('[EOB]')
 77     CALL CSSINP(REC,'MED>',NSR)
        IF (NSR .LT. 0) THEN
            CSIMED = 0
            LCONT=0
            RETURN
        END IF
        N=NSR
        J=JSR
        GO TO 99
      ENDIF
      CSIMED=IGSST
      IF(IGSST.EQ.2)CSIMED=0
      LCONT=0
**      IF(CSIMED.EQ.1)THEN
        CALL CSLFRE(JPMB)
        JPMC=0
        DO 333 I=1,NSTRL
          CALL CSPUTL(JPMC,SOURCE(I),LENOCC(SOURCE(I)),0)
          IF(JPMB.EQ.0)JPMB=JPMC
 333    CONTINUE
**      ENDIF
      RETURN
*   DINPS
    3 CONTINUE
      IPRG=1
      IF(NGSST.LE.0) THEN
        IF(IPRET.EQ.0)CALL CSSINP(REC,'MED>',NGSST)
        IF(NGSST .LT. 0) THEN
          CSIMED=0
          LCONT=0
          RETURN
        END IF
        JGSST=JSR
        IPRET=0
        IF(NGSST.EQ.0)IPRET=1
      ENDIF
      GO TO 1
*   PRET
    4 CONTINUE
      IGSST=IPRET
      IPRET=0
      NLB=LINE+1
      NLE=NLB
      GO TO 1
*   DRP
    6 CONTINUE
      NLB=LINE+IABS(NUM)
      NLE=NLB
      GO TO 1
*   DRM
    5 CONTINUE
      NLB=LINE-IABS(NUM)
      NLE=NLB
      GO TO 1
*   DW
   21 CONTINUE
      NLB=1
      NLE=NSTRL
      GO TO 1
*   DF
   22 CONTINUE
      NUM=1
      GO TO 1
*   DL
   23 CONTINUE
      NUM=NLINES
      GO TO 1
*   DR1
    7 CONTINUE
      NLB=NUM
      GO TO 1
*   DCUR
    8 CONTINUE
      IPRG=0
      NLB=LINE
      NLE=LINE
      GO TO 1
*   PRG
    9 CONTINUE
      IGSST=IPRG
      GO TO 1
*   DR2
   10 CONTINUE
      IF(NUM.NE.-1)THEN
        NLE=NUM
      ELSE
        NLE=LINE
      ENDIF
      GO TO 1
*   DRNUM
   11 CONTINUE
      NLE=NLB
      GO TO 1
*   INUMB
   12 CONTINUE
      K=MKBLAN(JGSST,NGSST)
      IGSST=MLNUMB(JGSST,NGSST,NUM)
      IF(IGSST.EQ.0)NUM=-1
      GO TO 1
*   DT
   14 CONTINUE
      KEY=2
      GO TO 101
*   DD
   15 CONTINUE
      KEY=3
      GO TO 101
*   DS
   16 CONTINUE
      KDIL=MKCHAR(JGSST)
      LOLD=0
      JGSST=JGSST+1
      JOB=JGSST
      NGSST=NGSST-1
      IF(NGSST.LE.0)GO TO 702
*                   --------
 112  IF(MKCHAR (JGSST).EQ.KDIL)GO TO 113
      JGSST=JGSST+1
      NGSST=NGSST-1
      IF(NGSST.LE.0)GO TO 702
*                   ---------
      LOLD=LOLD+1
      GO TO 112
 113  JGSST=JGSST+1
      LNEW=0
      NGSST=NGSST-1
        JNB=JGSST
      IF(NGSST.LE.0)GO TO 702
*                    --------
  114 IF(MKCHAR(JGSST).EQ.KDIL) GO TO 115
      JGSST=JGSST+1
      NGSST=NGSST-1
      IF(NGSST.LE.0) GO TO 702
*                   ----------
      LNEW=LNEW+1
      GO TO 114
  115 JGSST=JGSST+1
      NGSST=NGSST-1
      SOLD=' '
      SNEW=' '
      CALL CCOPYS(JOB,JSOLD,LOLD)
      CALL CCOPYS(JNB,JSNEW,LNEW)
      GO TO 1
*   DSS
   17 CONTINUE
      KEY=1
      NSUBST=0
      GO TO 101
*   DI
   18 CONTINUE
      KEY=4
      GO TO 101
*   DIN
   24 CONTINUE
      IF(NUM.NE.-1)THEN
        NLB=NUM
        NLE=NUM
      ELSE
        NLB=LINE
        NLE=LINE
      ENDIF
      GO TO 1
*   DE
   19 CONTINUE
      IGSST=1
      GO TO 1
*   DQ
   13 CONTINUE
      IGSST=2
      GO TO 1
*   DH
   20 CONTINUE
      CALL CSMHEL
      GO TO 1
  101 IF(NLB.LT.0) GO TO 703
*                  ---------
      IF(NLB.GT.NLINES) GO TO 705
*                       ---------
      NLE=MIN0(NLINES,NLE)
      NLE=MAX0(NLE,1)
      IF(KEY.EQ.4)THEN
         NLE=NLB
      ELSE
         IF(NLINES.LE.0)GOTO 704
*                       --------
         IF(NLB.EQ.0)GOTO 703
*                    ---------
      ENDIF
      IF(NLB.GT.NLE)THEN
         ISTEP=-1
      ELSE
         ISTEP=1
      ENDIF
      GO TO(81,82,83,84),KEY
*            S, T, D, I
*SUBSTITUTION
   81 CONTINUE
      DO 601 LINE=NLB,NLE,ISTEP
        I=INDEX(SOURCE(LINE),SOLD(1:LOLD))
        IF(I.GT.0)THEN
          IF(I.EQ.1)THEN
            REC1=SNEW(1:LNEW) // SOURCE(LINE)(I+LOLD:)
          ELSE
            REC1=SOURCE(LINE)(1:I-1) // SNEW(1:LNEW)
     +         //SOURCE(LINE)(I+LOLD:)
          ENDIF
          SOURCE(LINE)=REC1
          NSUBST=NSUBST+1
        ENDIF
 601  CONTINUE
      GO TO 88
* TYPE
   82 CONTINUE
      DO 602 LINE=NLB,NLE,ISTEP
  201 JS=MJSCHA(SOURCE(LINE))
      NB=MNBLAN(JS,80)
      WRITE(REC1(1:4),'(I3,1X)')LINE
      REC1(5:)=SOURCE(LINE)(1:NB)
      CALL CSSOUT(REC1(1:NB+4))
  602 CONTINUE
      GO TO 88
* KILL
   83 CONTINUE
      IF(ISTEP.GT.0)THEN
        JJ=NLB
        K=NLE+1
        L=NLE-NLB+1
      ELSE
        JJ=NLE
        K=NLB+1
        L=NLB-NLE+1
      ENDIF
      DO 603 I=K,NSTRL
        SOURCE(JJ)=SOURCE(I)
  603   JJ=JJ+1
      NLINES=NLINES-L
      NSTRL=NSTRL-L
      GO TO 88
*   KEY=I
  84  KDIL=MKCHAR(JGSST)
      IF(NGSST.LE.0) GO TO 702
      JGSST=JGSST+1
      NGSST=NGSST-1
      ILINE=0
 1170 JB=JGSST
      NB=0
  117 IF(NGSST.LE.0)GO TO 118
      IF(MKCHAR(JGSST).EQ.KDIL)GO TO 120
      JGSST=JGSST+1
      NGSST=NGSST-1
      NB=NB+1
      GO TO 117
  118 ASSIGN 119 TO LINS
      GO TO 401
  119 CALL CSSINP(REC,'MEDI',NGSST)
      JGSST=JSR
      GO TO 1170
  120 JGSST=JGSST+1
      NGSST=NGSST-1
      ASSIGN 88 TO LINS
*      GO TO 401
* INSERT
  401 ILINE=ILINE+1
      LINE=NLB+ILINE
      REC1=' '
      IF(NB.GT.0)CALL CCOPYS(JB,JSR1,NB)
      IF(NSTRL.GE.MXSLIN)THEN
        PRINT *,' CSIMED: Too long source'
        ILINE=ILINE-1
        GO TO 88
      ENDIF
      DO 604 I=NSTRL,LINE,-1
 604  SOURCE(I+1)=SOURCE(I)
      SOURCE(LINE)=REC1
      NLINES=NLINES+1
      NSTRL=NSTRL+1
      GO TO LINS
 88   LINE=NLE
      IF(KEY.EQ.3)THEN
         IF(NLB.LE.NLE)LINE=NLB
         IF(NLB.GT.NLE)LINE=NLE
      ELSEIF(KEY.EQ.4)THEN
         LINE=NLB+ILINE
      ELSEIF(KEY.EQ.1)THEN
         PRINT *,NSUBST,' substitutions'
**         NN=4
**         JJ=JSR1
**         CALL CBIS(NSUBST,JJ,NN)
**         IF(N.GT.0)CALL CSSETC(JJ,NN,KBLN)
**         REC1(5:)='substitutions'
**         CALL CSSOUT(REC1(1:20))
      ENDIF
      GO TO 1
*   DSEDT
   25 CONTINUE
      I=CSTINF(FILENM)
      IF(I.EQ.0)GO TO 1
      CALL CSSEDT(FILENM)
      IF(FILENM(1:1).EQ.'@')THEN
        FILENM(1:1)='C'
        GO TO 1
      ENDIF
      I=CSTFRF(FILENM)
      ASSIGN 501 TO LBEG
      GO TO 100
 501  CALL CSSINP(REC,'MED>',NSR)
      JGSST=JSR
      NGSST=NSR
      IPRG=1
      IPRET=0
      IF(NGSST.EQ.0)IPRET=1
      GO TO 1
 100  LCONT=1
      I=JPMB
      NSTRL=0
 1001 IF(I.EQ.0)GO TO 102
      NSTRL=NSTRL+1
      IF(NSTRL.GE.MXSLIN)THEN
        PRINT *,' CSIMED: Too long source'
        NSTRL=NSTRL-1
        GO TO 705
      ENDIF
      CALL CSGETL(I,SOURCE(NSTRL),NC,MARK)
      GO TO 1001
 102  NLINES=NSTRL
      LINE=NLINES
      GO TO LBEG
*  701 IGSST=-1
*      GO TO 1
  702 IGSST=-2
      GO TO 1
  703 IGSST=-3
      GO TO 1
  704  IGSST=-4
      GO TO 1
  705  IGSST=-5
      GO TO 1
      END
