Cruise

     * Display file entries like REVISE does (using file's DICT)
     * Written by Will Johnson
     * BE SURE TO INSTALL THE TCL.II INCLUDE BEFORE TRYING TO COMPILE THIS!
     *
     * Apply conversions if any to each multi-value
     * Use DICT VOC to control DICTs if specified
     * Don't display multi-value only fields
     * Use MCP to suppress non-printables
     * Allow edit as a command
     * Allow exploding one multi-valued field
     *
     EQUATE FALSE TO 0, TRUE TO 1
     TEST.MODE = FALSE
     $INCLUDE FFT.BP TCL.II
     GOSUB OPEN.FILES
     GOSUB GET.ITEMLIST
     GOSUB BUILD.DICT.TABLE
     IF TEST.MODE THEN GOSUB DISPLAY.DICT.TABLE
     FOR I.DICT.TABLE = 1 TO S.DICT.TABLE
        T.LABEL = DICT.TABLE<1,I.DICT.TABLE>
        IF T.LABEL =  THEN T.LABEL = "<NO LABEL>"
     NEXT I.DICT.TABLE
     GOSUB PROCESS.RECORDS
     STOP
     *
     OPEN.FILES:
     OPEN 'VOC' TO F.VOC ELSE
        N.OFE = 'VOC' ; GOSUB OPEN.FILE.ERROR
     END
     K.VOC = "F2R"
     READ EXISTS FROM F.VOC,K.VOC ELSE
        R.VOC = "D":@AM:"2":@AM:@AM:"3R":@AM:"S"
        WRITE R.VOC ON F.VOC,K.VOC
     END
     RETURN
     *
     OPEN.FILE.ERROR:
     PRINT 'Cannot open file ':N.OFE:'. Hit ENTER':
     INPUT CONT ; STOP
     RETURN
     *
     GET.ITEMLIST:
     WORD.COUNT = DCOUNT(TRIMB(SENTENCE),' ')
     LAST.WORD = FIELD(TRIMB(SENTENCE),' ',WORD.COUNT)
     IF LAST.WORD[1,1] = '(' THEN
        OPTIONS.EXIST = TRUE ; OPTIONS = LAST.WORD[2,LEN(LAST.WORD)]
        WORD.COUNT -= 1
     END ELSE OPTIONS.EXIST = FALSE ; OPTIONS = 
     IF C.WORD < WORD.COUNT THEN
        ITEM.SPECIFIED = TRUE
        SELECT.LIST = FALSE ; GROUPCODE = "G":(C.WORD-1):" 99"
        ITEM.LIST = OCONV(SENTENCE,GROUPCODE)
        CONVERT "'" TO "" IN ITEM.LIST
        CONVERT " " TO @AM IN ITEM.LIST
     END ELSE
        ITEM.SPECIFIED = FALSE
        READLIST LISTEXISTS THEN
           SELECT.LIST = TRUE ; SELECT LISTEXISTS
        END ELSE SELECT.LIST = FALSE
     END
     RETURN
     *
     * Select the DICT of the target file, or if already a DICT
     * then select the DICT VOC file, sorting it by field number
     * Then for each dict entry, if it's a D type and it's not the key
     *  to the file, and we haven't found a definition for this field
     *  number before then: we add the label to the field number
     *  position in the table line 1, and the conversion (if any) to
     *  the field number position in the table line 2.
     *
     BUILD.DICT.TABLE:
     IF DICT.FLAG THEN CMD = "VOC" ELSE CMD = N.FILE
     CMD = "SSELECT DICT ":CMD:" BY F2R"
     EXECUTE CMD, SELECT > DICT.LIST
     DICT.TABLE =  ; DONE = FALSE ; LABEL.WIDTH = 0
     LOOP
        READNEXT DK.FILE FROM DICT.LIST ELSE DONE = TRUE
     UNTIL DONE DO
        READ DR.FILE FROM DF.FILE, DK.FILE THEN
           DICT.TYPE = DR.FILE<1>
           IF DICT.TYPE[1,1] = 'D' THEN
              IF NUM(DR.FILE<2>) AND DR.FILE<2> > 0 THEN
                 IF DICT.TABLE<2,DR.FILE<2>> =  THEN
                    T.LABEL = DR.FILE<4>
                    CONVERT @VM TO ' ' IN T.LABEL
                    T.LABEL = TRIM(T.LABEL)
                    IF T.LABEL =  THEN T.LABEL = DK.FILE
                    DICT.TABLE<1,DR.FILE<2>> = T.LABEL
                    L.LABEL = LEN(T.LABEL)
                    IF L.LABEL > LABEL.WIDTH THEN LABEL.WIDTH = L.LABEL
                    DICT.TABLE<2,DR.FILE<2>> = DR.FILE<3>
                 END
                 IF DR.FILE<7> # "" THEN
                    DICT.TABLE<3,DR.FILE<2>> = DR.FILE<7>
                 END
                 DICT.TABLE<4,DR.FILE<2>> = DK.FILE
              END
           END
        END
     REPEAT
     IF LABEL.WIDTH<10 THEN LABEL.WIDTH=10        ; *set min label wdt
     IF LABEL.WIDTH>35 THEN LABEL.WIDTH=35        ; *set max label wdt
     LEFT.JUST = "L#":LABEL.WIDTH ; RIGHT.JUST = "R#":LABEL.WIDTH
     S.DICT.TABLE = DCOUNT(DICT.TABLE<1>,@VM)
     RETURN
     *
     DISPLAY.DICT.TABLE:
     PRINT "NUM":" ":"FIELD DESC" ("L#":LABEL.WIDTH):" ":
     PRINT "CONVERSION":" ":"ASSOCIATION"
     FOR I.DICT.TABLE = 1 TO S.DICT.TABLE
        GOSUB DISPLAY.A.DICT.ENTRY
     NEXT I.DICT.TABLE
     PRINT "Hit ENTER. ": ; INPUT CONT
     RETURN
     *
     DISPLAY.A.DICT.ENTRY:
     PRINT I.DICT.TABLE"R%3":" ":
     PRINT DICT.TABLE<1,I.DICT.TABLE> ("L#":LABEL.WIDTH):" ":
     PRINT DICT.TABLE<2,I.DICT.TABLE>"L#8":" ":
     PRINT DICT.TABLE<3,I.DICT.TABLE>"L#12":" ":
     IF DICT.TABLE<4,I.DICT.TABLE> =  THEN
        PRINT
     END ELSE
        PRINT DICT.TABLE<4,I.DICT.TABLE>
     END
     RETURN
     *
     PROCESS.RECORDS:
     IF TEST.MODE THEN
        IF SELECT.LIST THEN PRINT "SELECT ": ELSE PRINT "NO SELECT ":
        PRINT "LIST ACTIVE.  HIT ENTER": ; INPUT CONT
     END
     BEGIN CASE
        CASE SELECT.LIST ; NULL
        CASE ITEM.SPECIFIED ; SELECT ITEM.LIST
        CASE 1 ; SELECT F.FILE
     END CASE
     DONE = FALSE
     LOOP
        READNEXT K.FILE ELSE DONE = TRUE
     UNTIL DONE DO
     REREAD:
        READ R.FILE FROM F.FILE,K.FILE THEN
           PRINT @(-1): N.FILE:' ':K.FILE:' ':@LOGNAME
           S.FILE = DCOUNT(R.FILE,@AM) ; GOSUB PROCESS.ONE.RECORD
           IF UPCASE(FIELD(@LOGNAME,'\',2)) = "W.JOHNSON" THEN
              PRINT 'ENTER for next rec, E TO Edit, H for Help,':
              PRINT ' Q to stop, # to expand ':
              INPUT CONT
              BEGIN CASE
                 CASE CONT = 'Q'
                    CLEARSELECT ; STOP
                 CASE NUM(CONT)
                    BEGIN CASE
                       CASE CONT < 1 ; NULL
                       CASE CONT > S.FILE ; NULL
                       CASE CONT # INT(CONT) ; NULL
                       CASE 1 ; GOSUB EXPAND.FIELD
                    END CASE
                 CASE CONT = 'E'
                    EXECUTE "ED ":N.FILE:" ":K.FILE
                    GO REREAD
                 CASE CONT = 'H'
                    GOSUB HELP
              END CASE
           END
        END
     REPEAT
     RETURN
     *
     * Don't show me anything for fields with nothing in them. However:
     * If I have a field with something in it and NO corresponding
     *  Dict entry, then we show '<no label>' on that line.
     * So the size I walk through, is the size of the record itself
     * not the size of the Dict table I've here built.
     *
     * Don't show fields composed only of value-marks
     * Suppress non-printables, but tell me when I've done that
     PROCESS.ONE.RECORD:
     EXPLODE = FALSE
     FOR I.DICT.TABLE = 1 TO S.FILE
        GOSUB PROCESS.ONE.FIELD
     NEXT I.DICT.TABLE
     RETURN
     *
     PROCESS.ONE.FIELD:
     T.FILE = R.FILE<I.DICT.TABLE>
     * SKIP FIELD IF EMPTY OR ONLY VMS
     IF CONVERT(@VM,,T.FILE) =  THEN RETURN
     *
     IF EXPLODE THEN GOSUB DISPLAY.A.DICT.ENTRY
     GOSUB OUTPUT.LABEL
     GOSUB CONVERT.OUTPUT
     GOSUB SUPPRESS.CONTROL.CHARS
     *
     IF EXPLODE THEN
        CONVERT "_" TO @VM IN T.OUTPUT
        VALUE.WIDTH = 78-LABEL.WIDTH
        SPACE.PAD = SPACE(LABEL.WIDTH)
        S.T.OUTPUT = DCOUNT(T.OUTPUT,@VM)
        PRINT T.OUTPUT<1,1>
        FOR I.T.OUTPUT = 2 TO S.T.OUTPUT
           T.T.OUTPUT = T.OUTPUT<1,I.T.OUTPUT>
           PRINT SPACE.PAD:" (":I.DICT.TABLE"R%3":
           PRINT ".":I.T.OUTPUT"R%3":"): ": T.T.OUTPUT
        NEXT I.T.OUTPUT
     END ELSE
        CONVERT "_" TO "]" IN T.OUTPUT
        VALUE.WIDTH = 78-(LABEL.WIDTH + 8)
        SPACE.PAD = SPACE(78-VALUE.WIDTH)
        T.OUTPUT = FOLD(T.OUTPUT,VALUE.WIDTH)
        S.T.OUTPUT = DCOUNT(T.OUTPUT,@AM)
        PRINT T.OUTPUT<1>
        FOR I.T.OUTPUT = 2 TO S.T.OUTPUT
           PRINT SPACE.PAD: T.OUTPUT<I.T.OUTPUT>
        NEXT I.T.OUTPUT
     END
     RETURN
     *
     OUTPUT.LABEL:
     T.LABEL = DICT.TABLE<1,I.DICT.TABLE>
     IF T.LABEL =  THEN T.LABEL = '<no label>'
     IF LEN(T.LABEL) > LABEL.WIDTH THEN
        PRINT T.LABEL LEFT.JUST:
     END ELSE
        PRINT T.LABEL RIGHT.JUST:
     END
     IF EXPLODE THEN
        PRINT " (":I.DICT.TABLE"R%3":".001":"):":
     END ELSE
        PRINT " (":I.DICT.TABLE"R%3":"):":
     END
     RETURN
     *
     CONVERT.OUTPUT:
     T.CONV = DICT.TABLE<2,I.DICT.TABLE>
     S.T.FILE = DCOUNT(T.FILE,@VM) ; T.OUTPUT = 
     FOR I.T.FILE = 1 TO S.T.FILE
        T.OUTPUT<1,I.T.FILE> = OCONV(T.FILE<1,I.T.FILE>,T.CONV)
     NEXT I.T.FILE
     CONVERT @VM TO "_" IN T.OUTPUT
     RETURN
     *
     SUPPRESS.CONTROL.CHARS:
     CT.OUTPUT = OCONV(T.OUTPUT,'MCP')  ; *REM NON-PRINTABLES
     IF CT.OUTPUT = T.OUTPUT THEN PRINT " ": ELSE
        PRINT ".": ; T.OUTPUT = CT.OUTPUT
     END
     RETURN
     *
     EXPAND.FIELD:
     EXPLODE = TRUE
     I.DICT.TABLE = CONT
     GOSUB PROCESS.ONE.FIELD
     PRINT 'Hit ENTER, or Q TO STOP ': ; INPUT CONT
     IF CONT = 'Q' THEN STOP
     RETURN
     *
     HELP:
     PRINT "Help doesn't yet work, press ENTER": ; INPUT CONT
     RETURN
     *
  END