C
C
C
C    LIST File Listing Utility
C    =========================
C
C         Author:  William P. Wood, Jr.
C
C         Address: Computer Center
C                  Institute For Cancer Research
C                  7701 Burholme Ave.
C                  Philadelphia, Pa. 19111
C                  (215) 728 2760
C
C         Version: 3.0
C
C         Date:    December 29, 1981
C
C
C
C      *******************************************************
C      *                                                     *
C      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
C      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
C      *         NIH CA06927                                 *
C      *         NIH CA22780                                 *
C      *                                                     *
C      *      DIRECT INQUIRIES TO:                           *
C      *            COMPUTER CENTER                          *
C      *            THE INSTITUTE FOR CANCER RESEARCH        *
C      *            7701 BURHOLME AVENUE                     *
C      *            PHILADELPHIA, PENNSYLVANIA   19111       *
C      *                                                     *
C      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
C      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
C      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
C      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
C      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
C      *      OWNED RIGHTS.                                  *
C      *                                                     *
C      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
C      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
C      *      THE USE OF THIS SOFTWARE                       *
C      *                                                     *
C      *******************************************************
C
C
C define(VAX)
C note the order of the next several defines is significant!
C ICR ONLY  define(NOTICR,# NOT ICR)
C Local ICR functions supported by LIST:
C Invoke LIST on wild card file names
C Route output to printer port of DT80
C Invoke HELP facility for LIST
C Allow screen widths other than SCRWIDTH
C Record or Block i/o.
C set to define(RECORDIO,) for record io
C size of buffer for mark/point
C BLOCK IO  define(MARKSIZE,3)
C defnam - provide defaults for file name, reset new defaults -
C	   compatible with old version, doesn't return version number and
C	   doesn't have special processing for asterisks
      SUBROUTINE DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, RESET)
      BYTE FILE(34)
      BYTE NODE(1), DEV(6), UIC(10), NAME(10), EXT(5), VER(7)
      LOGICAL RESET, ASTRSK
      VER(1) = 0
      ASTRSK = .FALSE.
      CALL FPARSE(FILE, NODE, DEV, UIC, NAME, EXT, VER, RESET, ASTRSK)
      RETURN
      END
C fparse - provide defaults for file name, reset new defaults.
C	   if astrsk is true, asterisks will use the defaults.
      SUBROUTINE FPARSE(FILE, NODE, DEV, UIC, NAME, EXT, VER, RESET, AST
     *RSK)
      BYTE FILE(34), TEMP(34)
      BYTE NODE(1), DEV(6), UIC(10), NAME(10), EXT(5), VER(7)
      LOGICAL RESET, ASTRSK
      INTEGER L, J, ICP, LEN
      INTEGER INDEX, BKSCAN, CONCAT, SCAN
      TEMP(1) = 0
      LEN = CONCAT(TEMP, FILE(SCAN(FILE, ' ', 1)), 34)
      FILE(1) = 0
      J = 1
      L = 0
      ICP = INDEX(TEMP(J), ':')
      IF (.NOT.(ICP .NE. 0)) GOTO 2000
        IF (.NOT.(TEMP(ICP+1) .EQ. ':')) GOTO 2020
          ICP = ICP + 1
          GOTO 2030
2020    CONTINUE
          ICP = 0
2030    CONTINUE
2000  CONTINUE
      CALL ADSTR(ICP, J, L, FILE, TEMP, NODE, 1 - 1, RESET, .FALSE.)
      CALL ADSTR(INDEX(TEMP(J), ':'), J, L, FILE, TEMP, DEV, 6 - 1, RESE
     *T, .FALSE.)
      CALL ADSTR(INDEX(TEMP(J), ']'), J, L, FILE, TEMP, UIC, 10 - 1, RES
     *ET, .FALSE.)
      CALL ADSTR(BKSCAN(TEMP, ' .;', J) - J, J, L, FILE, TEMP, NAME, 10 
     *- 1, RESET, ASTRSK)
      CALL ADSTR(BKSCAN(TEMP, ' ;', J) - J, J, L, FILE, TEMP, EXT, 5 - 1
     *, RESET, ASTRSK)
      CALL ADSTR(LEN + 1 - J, J, L, FILE, TEMP, VER, 7 - 1, RESET, .FALS
     *E.)
      RETURN
      END
C adstr - copy piece of file name for fparse
      SUBROUTINE ADSTR(I, J, L, FILE, TFILE, STR, MXSTR, RESET, ASTRSK)
      INTEGER I, J, L, MXSTR, K
      INTEGER CONCAT, SCAN
      BYTE FILE(1), TFILE(1), STR(1)
      LOGICAL RESET, ASTRSK
      IF (.NOT.(I .EQ. 0)) GOTO 2040
        L = CONCAT(FILE, STR, 34)
        GOTO 2050
2040  CONTINUE
        IF (.NOT.(ASTRSK)) GOTO 2060
          IAST = INDEX(TFILE(J), '*')
          GOTO 2070
2060    CONTINUE
          IAST = 0
2070    CONTINUE
        IF (.NOT.(IAST .NE. 0 .AND. IAST .LE. I)) GOTO 2080
          L = CONCAT(FILE, STR, 34)
          J = SCAN(TFILE, ' ', J + I)
          GOTO 2090
2080    CONTINUE
          K = MIN0(MXSTR, I)
          L = CONCAT(FILE, TFILE(J), L + 1 + K)
          J = SCAN(TFILE, ' ', J + I)
          IF (.NOT.(RESET)) GOTO 2100
            CALL SCOPY(FILE, L + 1 - K, STR, 1)
2100      CONTINUE
2090    CONTINUE
2050  CONTINUE
      RETURN
      END