Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-09 - decus/20-34/reusr6.for
There are 3 other files named reusr6.for in the archive. Click here to see a list.
      SUBROUTINE REUSER
C     RENBR(REUSR6/DIALOG OF SWITCHES THEN NAMES 1 PER LINE
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS VERSION  OF THE   USER  COMMAND DIALOG PROCESSOR
C     FOR RENBR RUNS ON THE PDP-10 COMPUTER.  COMMAND TYPED
C     BY THE USER CONSISTS OF 1 OR  SEVERAL  SWITCHES  WITH
C     NUMERIC ARGUMENTS.  FILE NAMES WILL BE ACCEPTED 1 PER
C     LINE IF A /D SWITCH IS ISSUED.  ONLY A  SINGLE  INPUT
C     FILE  CAN  BE  PROCESSED DURING A SINGLE EXECUTION OF
C     THIS PROGRAM.
C
      COMMON/RNBONE/I     ,IALPHA,IBASE ,IBR   ,IBREAK,
     1IEND  ,IENTER,IEOF  ,IERR  ,IFILL ,IFORM ,IFREAR,
     2IHIHDO,IIN   ,ILEVEL,ILPT  ,INCR  ,INCSAV,INDENT,
     3INDSAV,ININAM,INIOPR,INIPRT,INITOC,INRCPY,INRFND,
     4IOUT  ,IPAGE ,IPASS ,IPOINT,ISPACE,ISPLIT,ISPR  ,
     5ISTART,ISTN  ,ITAB  ,ITBL  ,ITITLE,ITRACE,ITTY  ,
     6J     ,JBGN  ,JBREAK,JEND  ,JEOF  ,JFORM ,JIN   ,
     7JIN1  ,JLEVEL,JMPBGN,JMPEND,JOBNUM,JOUT  ,JPASS ,
     8JPOINT,JSPLIT,JSTN  ,JTAB  ,JTBL  ,JTTY  ,K     ,
     9KBGN  ,KEND  ,KLEVEL,KMDMAX,KMDMIN,KNDGRP,KNT
C
      COMMON/RNBTWO/KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
     1KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE ,KPASS ,
     2KPOINT,KPYEND,KSTN  ,KTAB  ,KUTNUM,KUTPAG,KUTPNT,
     3KUTSPL,L     ,LCLNUM,LCLPNT,LCLSPL,LEFT  ,LEND  ,
     4LIKE  ,LMTTOC,LNGCOM,LNGNAM,LNGNXT,LOWDO ,LOWER ,
     5LOWSHO,LOWTOC,LOW1  ,LOW2  ,LPOINT,LPTTTY,LRGNUM,
     6LRGPNT,LRGSPL,LRGTOC,LSTKNT,LSTN  ,LSTSTN,LTAB  ,
     7M     ,MANY  ,MASTER,MAXCOM,MAXEND,MAXLIN,MAXPNT,
     8MAXPRT,MAXSPL,MAXTOC,MID   ,MODBAS,MODINC,MODMAX,
     9MODMIN,MODNEW,MODOLD,MOST  ,MOVE  ,MSTN  ,MTAB
C
      COMMON/RNBTHR/N     ,NCD   ,NEED  ,NEWNUM,NEWSTN,
     1NONFOR,NOWTOC,NSTN  ,NTAB  ,NUM   ,NXTEND,NXTLST
C
      COMMON/RNBFOU/INRSTR(21)  ,JPNT(10)    ,LINREF(9)   ,
     1 MCHOPR(51)  ,NNEW(1000)  ,NOLD(1000)  ,NOTOPR(51)  ,
     2 NUMPNT(5000),NUMPRS(655) ,NUMTOC(112) ,NUMTYP(7)
C
      COMMON/RNBFIV/LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
     1LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,LTRQOT,
     2LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,LTRTAB,LTR1ST,
     3LTR2ND,LWRDDD,LWREEE,LWRHHH
C
      COMMON/RNBSIX/LTRABC(26)  ,LTRBGN(5)   ,LTRBIG(2211),
     1 LTRCOM(6)   ,LTRDGT(10)  ,LTREND(3)   ,LTRFLG(8)   ,
     2 LTRKEY(5)   ,LTRNAM(10)  ,LTROPR(51)  ,LTRPRS(331) ,
     3 LTRSPL(2000),LTRSRT(26)  ,LTRTOC(168) ,LTRTOP(117) ,
     4 LTRTTL(5)   ,LTRTYP(55)  ,LTRUSE(6)   ,LTR120(120) ,
     5 LWRABC(26)  ,LWRBGN(5)   ,LWREND(3)   ,LWRFLG(8)   ,
     6 LWRKEY(5)   ,LWRPRS(331) ,LWRSRT(26)  ,LWRTTL(5)
C
C     SINGLE CHARACTER VARIABLES IN COMMON/RNBFIV/
      CHARACTER*1 LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
     1     LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,
     2     LTRQOT,LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,
     3     LTRTAB,LTR1ST,LTR2ND,LWRDDD,LWREEE,LWRHHH
C
C     CHARACTER ARRAYS IN COMMON/RNBSIX/
      CHARACTER*1 LTRABC,LTRBGN,LTRBIG,LTRCOM,LTRDGT,
     1     LTREND,LTRFLG,LTRKEY,LTRNAM,LTROPR,LTRPRS,
     2     LTRSPL,LTRSRT,LTRTOC,LTRTOP,LTRTTL,LTRTYP,
     3     LTRUSE,LTR120,LWRABC,LWRBGN,LWREND,LWRFLG,
     4     LWRKEY,LWRPRS,LWRSRT,LWRTTL
C
      CHARACTER*10 FILSRC,FILRNB,FILLPT,FILSPC
      DATA FILSPC/'          '/
C
C     CLEAR DEFAULT VALUES
      JPASS=1
      IF(MASTER.EQ.0)GO TO 2
      IF(MASTER.NE.1)GO TO 78
      WRITE(ITTY,1)
    1 FORMAT(' RENBR (03/85)'/' Type /H for Help')
    2 JIN=JTAB
      JBGN=IFORM
      JEND=JFORM
    3 IPAGE=0
      ISPACE=0
      INCR=0
      IBASE=0
      INDENT=0
      ISPLIT=0
      IFILL=0
      ITAB=0
      IFORM=JBGN
      JFORM=JEND
      JTAB=JIN
      LTAB=0
      ITBL=1
      JMPEND=0
      JMPBGN=0
      KMDMIN=0
      KMDMAX=0
      ITRACE=0
      WRITE(ITTY,4)
    4 FORMAT(' OPTIONS: ',$)
      READ(JTTY,5)(LTRBIG(I),I=1,70)
    5 FORMAT(70A1)
C
C     INTERPRET OPTIONS
      INDEX=0
      LPTTTY=0
    6 INDEX=INDEX+1
    7 IF(INDEX.GT.70)GO TO 46
      LTRNOW=LTRBIG(INDEX)
      IF(LTRNOW.EQ.LTRSPC)GO TO 6
      IF(LTRNOW.EQ.LTRTAB)GO TO 6
C
C     TEST LETTER TO DETERMINE WHAT OPTION IS DESIRED
    8 KNDFLG=0
    9 KNDFLG=KNDFLG+1
      IF(KNDFLG.GT.26)GO TO 6
      IF(LTRABC(KNDFLG).EQ.LTRNOW)GO TO 10
      IF(LWRABC(KNDFLG).NE.LTRNOW)GO TO 9
C     GO TO( A, B, C, D, E, F, G, H, I, J,
C    1       K, L, M, N, O, P, Q, R, S, T,
C    2       U, V, W, X, Y, Z),KNDFLG
   10 GO TO(21,19,14, 6,20,20,20,45,21,20,
     1      12,20,19, 6, 6,21, 6, 6,20,13,
     2      15,17,21, 6, 6,11),KNDFLG
   11 ITRACE=1
      GO TO 6
   12 ISPLIT=0
      GO TO 18
   13 ITAB=1
      GO TO 16
   14 ITAB=0
      GO TO 16
   15 ITAB=-1
   16 IF(INCR.EQ.0)INCR=1
      GO TO 6
   17 LPTTTY=1
   18 IF(IPAGE.EQ.0)IPAGE=1
      GO TO 6
   19 IF(INCR.EQ.0)INCR=1
      GO TO 21
   20 IF(IPAGE.EQ.0)IPAGE=1
C
C     EVALUATE NUMBER TO RIGHT OF LETTER
   21 NUMFLG=0
      KNDNUM=0
   22 INDEX=INDEX+1
      IF(INDEX.GT.70)GO TO 27
      LTRNOW=LTRBIG(INDEX)
      IF(LTRNOW.EQ.LTRSPC)GO TO 23
      IF(LTRNOW.NE.LTRTAB)GO TO 24
   23 IF(KNDNUM.LE.0)GO TO 22
      GO TO 27
   24 DO 26 L=1,10
      IF(LTRDGT(L).NE.LTRNOW)GO TO 26
      IF(KNDNUM.GT.1)GO TO 25
      KNDNUM=1
      NUMFLG=(10*NUMFLG)+L-1
      GO TO 22
   25 NUMFLG=(10*NUMFLG)-L+1
      GO TO 22
   26 CONTINUE
      IF(KNDNUM.GT.0)GO TO 27
      IF(LTRNOW.EQ.LTRPLS)KNDNUM=1
      IF(LTRNOW.EQ.LTRMNS)KNDNUM=2
      IF(KNDNUM.GT.0)GO TO 22
      IF(KNDNUM.NE.0)GO TO 27
      IF(LTRNOW.EQ.LTRCLN)KNDNUM=-1
      IF(KNDNUM.NE.0)GO TO 22
C     GO TO( A, B, C, D, E, F, G, H, I, J,
C    1       K, L, M, N, O, P, Q, R, S, T,
C    2       U, V, W, X, Y, Z,L/,J/,M/),KNDFLG
   27 INDEX=INDEX-1
      IF(KNDFLG.EQ.9)GO TO 39
      IF(NUMFLG.LT.0)NUMFLG=0
      GO TO(29,31, 6, 6,43,40,30, 6,39,32,
     1       7,41,33, 6, 6,28, 6, 6,44, 6,
     2       7, 6,37, 6, 6, 6,38,34,35),KNDFLG
   28 IPAGE=NUMFLG
      IF(IPAGE.EQ.0)IPAGE=1
      GO TO 6
   29 INDENT=NUMFLG
      IF(INDENT.EQ.0)INDENT=1
      GO TO 6
   30 ISPACE=NUMFLG
      IF(ISPACE.EQ.0)ISPACE=1
      GO TO 6
   31 IBASE=NUMFLG
      GO TO 6
   32 JMPBGN=NUMFLG
      KNDFLG=28
      GO TO 21
   33 KMDMIN=NUMFLG
      KNDFLG=29
      GO TO 21
   34 JMPEND=NUMFLG
      GO TO 6
   35 IF(NUMFLG.GT.0)GO TO 36
      IF(KMDMIN.GT.0)NUMFLG=99999
      IF(KMDMIN.EQ.0)KMDMIN=-1
   36 IF(KMDMIN.EQ.0)KMDMIN=1
      KMDMAX=NUMFLG
      GO TO 6
   37 JTAB=NUMFLG
      IF(JTAB.EQ.0)JTAB=JIN
      LTAB=1
      GO TO 6
   38 IF(NUMFLG.GT.10)IFORM=NUMFLG
      GO TO 6
   39 INCR=NUMFLG
      IF(INCR.EQ.0)INCR=1
      GO TO 6
   40 IFILL=0
      GO TO 42
   41 IFILL=1
   42 JFORM=NUMFLG
      IF(JFORM.LE.10)JFORM=JEND
      IFORM=JBGN
      IF(IFILL.EQ.0)GO TO 6
      IF(ISPLIT.EQ.0)ISPLIT=1
      IF(INDEX.GT.70)GO TO 6
      KNDFLG=27
      GO TO 21
   43 ITBL=NUMFLG+1
      IF(ITBL.EQ.1)ITBL=2
      GO TO 6
   44 ISPLIT=NUMFLG+1
      GO TO 6
C
C     ISSUE HELP MESSAGE
   45 CALL REHELP(ITTY)
      GO TO 3
C
C     REPORT OPTIONS SELECTED
   46 IF(IPAGE.NE.0)GO TO 47
      IF(INCR.NE.0)GO TO 47
      IF(MASTER.EQ.0)GO TO 89
      GO TO 3
   47 IF(INDENT.GT.0)WRITE(ITTY,48)INDENT
   48 FORMAT(4X,'Add Block Indent',1I5)
      IF(LTAB.NE.0)WRITE(ITTY,49)JTAB
   49 FORMAT(2X,'Width of Tab Stops',1I5)
      IF(IPAGE.EQ.0)GO TO 58
      WRITE(ITTY,50)IPAGE
   50 FORMAT(10X,'Listing Options'/9X,'Page Number',1I5)
      IF(ISPACE.NE.0)WRITE(ITTY,51)ISPACE
   51 FORMAT(2X,'Gap Interstatement',1I5)
      IF(IFILL.EQ.0)WRITE(ITTY,52)JFORM
   52 FORMAT(10X,'Form Feeds',1I5)
      IF(IFILL.NE.0)WRITE(ITTY,53)JFORM,IFORM
   53 FORMAT(10X,'Line Feeds',1I5,':',1I5)
      IF((JMPBGN+JMPEND).NE.0)WRITE(ITTY,54)JMPBGN,JMPEND
   54 FORMAT(2X,'Jump at Top/Bottom',1I5,':',1I5)
      IF(ISPLIT.EQ.0)WRITE(ITTY,55)
   55 FORMAT(3X,'Keep Lines Intact')
      I=ISPLIT-1
      IF(ISPLIT.NE.0)WRITE(ITTY,56)I
   56 FORMAT(4X,'Split Long Lines',1I5)
      I=ITBL-1
      IF(I.NE.0)WRITE(ITTY,57)I
   57 FORMAT(1X,'Extra Table Content',1I5)
      IF(INCR.EQ.0)GO TO 70
   58 WRITE(ITTY,59)
   59 FORMAT(6X,'Renumbering Options')
      IF(KMDMIN.GT.0)GO TO 61
      IF(KMDMIN.EQ.0)GO TO 63
      WRITE(ITTY,60)
   60 FORMAT(2X,'Maintain Numbering')
      GO TO 66
   61 WRITE(ITTY,62)KMDMIN,KMDMAX
   62 FORMAT(3X,'Modify Only Range',1I5,':',1I5)
   63 WRITE(ITTY,64)INCR
   64 FORMAT(11X,'Increment',1I5)
      IF(IBASE.NE.0)WRITE(ITTY,65)IBASE
   65 FORMAT(16X,'Base',1I5)
   66 IF(ITAB.LT.0)WRITE(ITTY,67)
   67 FORMAT(' Uniform Left Margin')
      IF(ITAB.EQ.0)WRITE(ITTY,68)
   68 FORMAT(7X,'Column Format')
      IF(ITAB.GT.0)WRITE(ITTY,69)
   69 FORMAT(10X,'Tab Format')
C
C     OPEN LISTING FILE
   70 IF(IPAGE.LE.0)GO TO 76
      WRITE(ITTY,71)
   71 FORMAT(' Listing Title: ',$)
      READ(JTTY,72)(LTRTOP(I),I=1,54)
   72 FORMAT(54A1)
      IF(LPTTTY.NE.0)GO TO 75
   73 WRITE(ITTY,74)
   74 FORMAT('    Output Listing File: ',$)
      READ(JTTY,81)FILLPT
      IF(FILLPT.EQ.FILSPC)GO TO 73
      OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT',
     1DEVICE='LPT')
      GO TO 76
   75 OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT',
     1DEVICE='TTY')
C
C     OPEN RENUMBERED OUTPUT FILE
   76 IF(INCR.EQ.0)GO TO 79
      WRITE(ITTY,77)
   77 FORMAT(' Output Renumbered File: ',$)
      READ(JTTY,81)FILRNB
      IF(FILRNB.EQ.FILSPC)GO TO 76
      OPEN(UNIT=IOUT,FILE=FILRNB,ACCESS='SEQOUT')
      GO TO 79
C
C     OPEN INPUT FILE
   78 CLOSE(UNIT=IIN)
      IF(LPTTTY.NE.0)GO TO 89
   79 WRITE(ITTY,80)
   80 FORMAT('      Input Source File: ',$)
      READ(JTTY,81)FILSRC
   81 FORMAT(1A10)
      IF(FILSRC.EQ.FILSPC)GO TO 84
      OPEN(UNIT=IIN,FILE=FILSRC,ACCESS='SEQIN',ERR=82)
      IF(MASTER.EQ.1)GO TO 86
      GO TO 90
   82 WRITE(ITTY,83)
   83 FORMAT(' File cannot be read')
      GO TO 79
   84 IF(MASTER.NE.1)GO TO 89
      WRITE(ITTY,85)
   85 FORMAT(' First input file must be specified')
      GO TO 79
C
C     POSITION PAPER IF TELETYPE OUTPUT
   86 IF(IPAGE.EQ.0)GO TO 90
      IF(LPTTTY.EQ.0)GO TO 90
      IF(IFILL.EQ.0)GO TO 90
      WRITE(ITTY,87)
   87 FORMAT(1X/' Position paper',
     1' (carriage return or local line feed)'/
     2' then type non-space character',
     3' and carriage return')
   88 READ(JTTY,5)LTRNOW
      IF(LTRNOW.EQ.LTRSPC)GO TO 88
      GO TO 90
C
C     RETURN TO CALLING PROGRAM
   89 JPASS=0
   90 RETURN
      END