TclStack: Difference between revisions

Latest revision as of 22:54, 13 September 2019

This program is an attempt to make TCL a more productive place for programmers. You can edit the command stack using standard bash/emacs key-bindings. There is also a stack of program files being worked on and shortcuts for the common operations of editing, compiling, running and interacting with version control.

Planned new features include tab-completion on commands, file and dictionary names (how to make it quick with thousands of entries is a problem).

The help information gives a good overview of what is currently there (though aliases, program token expansion and setting the prompt are extras not mentioned).

            PRINT 'Ctrl-A     Start of line     Ctrl-R      Toggle insert mode'
            PRINT 'Ctrl-B     Back one char     Ctrl-W      Delete word'
            PRINT 'Ctrl-D     Delete char       Ctrl-X      Forward word'
            PRINT 'Ctrl-E     End of line       Ctrl-Z      Back word'
            PRINT 'Ctrl-F     Forward char      '
            PRINT 'Ctrl-G     Cancel line       '
            PRINT 'Ctrl-I     Forward word      ~xxx        Search for xxx'
            PRINT 'Ctrl-J     Delete to end     .Lm,n       List entry m thru n'
            PRINT 'Ctrl-M     Accept line       .Rn         Restore entry n, edit'
            PRINT 'Ctrl-N     Next line         .Dm,n       Delete entry m thru n'
            PRINT 'Ctrl-P     Previous line     Q           Quit back to TCL'
            PRINT
            PRINT '/   List the program stack   //  List the stack with cvs status'
            PRINT '[[/Nx]] Add a New program,'
            PRINT '[[/Ex]] Edit the x`th program    [[/WW]] Edit the program list'
            PRINT '[[/Wx]] VI the x`th program      [[/S]]  Sort the program stack'
            PRINT '[[/Bx]] Compile the x`th program [[/BR]] Compile and run'
            PRINT '[[/CI]] Checkin a program to cvs [[/D]]  Show diff with cvs version'

See also:

GetLineStack - a subroutine to allow cursor editing in wy50, vt100

CVS Integration "helpers"

***************************************************************************
* Program: STACK
* Author : Ian McGowan
* Created: 1989-06-13
* Updated: 2019-09-13
* License: (c) 1989-2019 Ian McGowan, released under MIT license
* Comment: Stacks TCL commands, utilities for programmers
***************************************************************************
* https://github.com/ianmcgowan/SCI.BP/blob/master/STACK
CRT 'Version 2019-09 Autocomplete'
EQUATE INSERT TO '1',REPLACE TO '-1',BEEP TO CHAR(7)
EQUATE RET TO 13, ESC TO 27, UP.KEY TO 1, DOWN.KEY TO 2
EQUATE PG.UP.KEY TO 21, PG.DOWN.KEY TO 22
EQUATE NUL TO '',SPC TO ' ',TRUE TO 1, FALSE TO 0
EQUATE SEARCH TO '~', UNIX TO '!'
EQUATE BELL TO CHAR(7), OTHERWISE TO 1
TERM=UPCASE(GETENV("TERM"))
CS=@(-1);EOL=@(-4);EOS=@(-3);UP=@(-10);BON=@(-81);BOFF=@(-82)
PROMPT NUL
*
LONG.LINE = 9999;LIST.DET.FLAG=0;TIME.COMMAND=0
EXECUTING = FALSE;SL.ACTIVE = FALSE
*
PWD=GETENV("PWD")
I=LEN(PWD) ; ACC=NUL
FOR F=I TO 1 STEP -1
  IF PWD[F,1] = '/' THEN EXIT
  ACC=PWD[F,1]:ACC
NEXT F
*
USERNAME=UPCASE(@LOGNAME)
HOME.DIR=GETENV("HOME")
STACK.ITEM='.STACK_':USERNAME
ALIAS.ITEM='.STACK.ALIAS_':USERNAME
PROGRAM.ITEM='.STACK.PROGRAM_':USERNAME
SETTING.ITEM='.STACK.SETTING_':USERNAME
HOME.FILE='HOME.':UPCASE(USERNAME)
OPEN 'VOC' TO VOC ELSE STOP 201,'VOC'
OPEN '_HOLD_' TO HOLD ELSE STOP 201,'_HOLD_' ;* Exists in every Unidata account
R='DIR' ; R<2>=HOME.DIR ; R<3>='D_VOC'
WRITE R ON VOC, HOME.FILE
OPEN HOME.FILE TO HOME.F ELSE STOP 201, HOME.FILE
OPEN 'CTLGTB' TO CTLGTB ELSE STOP 201,'CTLGTB'
OPEN 'CTLG'   TO CTLG   ELSE STOP 201,'CTLG'
OPEN 'STACK.AC' TO AC ELSE
  EXECUTE \CREATE.FILE STACK.AC 967,8192\
  OPEN 'STACK.AC' TO AC ELSE ABORT
END
*
SETTINGS      = ';'        ;* DEFAULT COMMAND SEPERATOR
SETTINGS<2>   = '.'        ;* DEFAULT STACK CHAR
SETTINGS<3>   = '/'        ;* DEFAULT PROG CHAR
SETTINGS<4>   = 9999       ;* DEFAULT MAX # LINES IN STACK
SETTINGS<5>   = '!vi'      ;* DEFAULT SCREEN EDITOR (try !joe :)
SETTINGS<6>   = 'AE'       ;* DEFAULT LINE EDITOR
SETTINGS<7>   ='* Edited :';* DEFAULT HEADER STRING
SETTINGS<8>   = TRUE       ;* DEFAULT USE GET.LINE SUBR
SETTINGS<9>   = 'BP.DEV'   ;* DEFAULT WORK FILE
SETTINGS<10>  = FALSE      ;* DEFAULT = CONVERT TO UCASE
SETTINGS<11>  = ""         ;* DEFAULT STARTUP COMMAND
SETTINGS<12>  = "#R#A>"    ;* DEFAULT PROMPT
SETTINGS<13>  = -2         ;* DEFAULT X DISPLACEMENT FOR PROMPT
SETTINGS<14>  = "bash"     ;* DEFAULT SHELL FOR UNIX COMMANDS
SETTINGS<15>  = ""         ;* DEFAULT PROGRAM STACK TO USE
*
READ R FROM HOME.F, SETTING.ITEM ELSE R=NUL
I=DCOUNT(SETTINGS,@AM)
FOR F=1 TO I
  IF R<F> # NUL THEN SETTINGS<F> = R<F>
NEXT F
COMMAND.SEPERATOR = SETTINGS<1>
STACK.CHAR   = SETTINGS<2>
PROG.CHAR    = SETTINGS<3>
MAX.STACK    = SETTINGS<4>
WP.VERB      = SETTINGS<5>
ED.VERB      = SETTINGS<6>
STAMP.STRING = SETTINGS<7>
GET.LINE.FLAG= SETTINGS<8>
WORK.FILE    = SETTINGS<9>
MCU.ON       = SETTINGS<10>
STARTUP      = SETTINGS<11>
PROMT        = SETTINGS<12>
X.DISP       = SETTINGS<13>
DEF.SHELL    = SETTINGS<14>
STACK.NAME   = SETTINGS<15>
WRITE SETTINGS ON HOME.F, SETTING.ITEM
*
IF STACK.NAME = '' THEN
  PROGRAM.ITEM='.STACK.PROGRAM_':USERNAME
END ELSE
  PROGRAM.ITEM='.STACK.PROGRAM_':USERNAME:'_':STACK.NAME
END
READ PROGRAMS FROM HOME.F, PROGRAM.ITEM ELSE PROGRAMS = NUL
*
EXEC.LINE="!hostname" ; CAP.ACTIVE=TRUE ; GOSUB EXEC.SUB
HOST.NAME=EXEC.CAP<1>
*
READ STACK FROM HOME.F, STACK.ITEM ELSE STACK = NUL
PRINT DCOUNT(STACK,@AM):' commands in stack ':HOME.DIR:'/':HOME.FILE
READ ALIASES FROM HOME.F, ALIAS.ITEM ELSE ALIASES = NUL
* Override with my favorites for now.  It's a pain to manage per system.
ALIASES<1>='ACTIVE'
ALIASES<1,2>='CS'
ALIASES<1,3>='L'
ALIASES<2>='SELECT LS.MASTER WITH NUM.OF.ASSETS > "0"'
ALIASES<2,2>='CLEARSELECT'
ALIASES<2,3>='LIST LS.MASTER'
OLD.X.DISP=X.DISP
RTN=NUL
* IL9/IL10 Check
IL.VER=''
OPEN 'ACCOUNT.PARAMS' TO ACCOUNT.PARAMS THEN
  READ R FROM ACCOUNT.PARAMS, 'VERSION' ELSE R=''
  IL.DB=PWD
  IL.VER=R<4>:'/':R<8>:'.':R<26>
END ELSE
  EXECUTE \!cat DBConfig.xml | grep DataSource | awk -F '[<>]' '{print $3}'\ CAPTURING JDBC
  JDBC=JDBC<1>
  EXECUTE \!grep \:JDBC:\ ../../jdbc-bridge/bin/jdbc.properties | grep -v "^#" | grep url\ CAPTURING IL.DB
  IL.DB=IL.DB<1>
  OSREAD VER FROM 'version.properties' ELSE VER='il.version=10'
  CONVERT CHAR(10) TO @AM IN VER
  FOR F=1 TO DCOUNT(VER,@AM)
    IF FIELD(VER<F>,'=',2) # '' THEN IL.VER=FIELD(VER<F>,'=',2) ; EXIT
  NEXT F
END
CRT IL.VER:' ':IL.DB
IF STARTUP # NUL THEN ANS=STARTUP ; GOSUB COMMAND ; STARTUP=NUL
ANS=NUL
*
LOOP
  GOSUB GET.TERM.WIDTH ;* In case terminal font or window size changes
  GOSUB EXPAND.PROMPT
  PRINT BON:PROMPT.DISP:BOFF:
  X = LEN(PROMPT.DISP) + X.DISP
  ENTRY = NUL;LEN = LONG.LINE;DISP.LEN=TERM.WIDTH-1-X
  GOSUB GET.INPUT
  ANS=ENTRY
  * Reread the program and command stack, since they may be modified
  * in another session
  READ PROGRAMS FROM HOME.F, PROGRAM.ITEM ELSE PROGRAMS = NUL
  READ STACK FROM HOME.F, STACK.ITEM ELSE STACK = NUL
  READ ALIASES FROM HOME.F, ALIAS.ITEM ELSE ALIASES = NUL
  IF RTN # ESC THEN GOSUB COMMAND
REPEAT
*
GET.INPUT:
  IF GET.LINE.FLAG THEN
    *CALL GET.LINE.STACK(X,LEN,DISP.LEN,ENTRY,RTN)
    GOSUB GET.LINE
  END ELSE
    PRINT @(X):;INPUT ENTRY
    RTN = RET
  END
RETURN
*
COMMAND:
  MAX.STACK=DCOUNT(STACK,@AM)
  BEGIN CASE
      * Map up and down arrows to .R1 and .Rn
    CASE RTN = UP.KEY
      ANS = '.R1'
    CASE RTN = PG.UP.KEY
      IF UNASSIGNED(P2) THEN P2 = 20
      IF UNASSIGNED(P1) THEN P1 = 1
      P2 = P2 + 20
      P1 = P1 + 20
      IF P2 > MAX.STACK THEN P2 = MAX.STACK
      IF P1 > MAX.STACK-20 THEN P1 = MAX.STACK-20
      ANS = '.L':P1:',':P2
    CASE RTN = PG.DOWN.KEY
      IF UNASSIGNED(P2) THEN P2 = 20
      IF UNASSIGNED(P1) THEN P1 = 1
      P2 = P2 - 20
      P1 = P1 - 20
      IF P2 < 20 THEN P2=20
      IF P1 < 1 THEN P1=1
      ANS = '.L':P1:',':P2
    CASE ANS='?'
      ANS='.H'
  END CASE
  IF ANS = NUL THEN RETURN
  UNIX.COMMAND=FALSE
  IF ANS[1,1] = UNIX THEN UNIX.COMMAND=TRUE
  OLD.STACK = STACK
  START.WORD.SEARCH = 1
  COMMAND.LIST = ANS
  COMMAND.COUNT = 1
  IF STARTUP#NUL THEN EXECUTING=TRUE ELSE EXECUTING=FALSE
  IF UNIX.COMMAND THEN
    * Don't look for ; for unix commands
    GOSUB DO.COMMAND
  END ELSE
    LOOP
      ANS = FIELD(COMMAND.LIST,COMMAND.SEPERATOR,COMMAND.COUNT)
    UNTIL ANS = NUL DO
      GOSUB DO.COMMAND
      COMMAND.COUNT = COMMAND.COUNT + 1
    REPEAT
  END
  WRITE ALIASES ON HOME.F, ALIAS.ITEM
RETURN
*
DO.COMMAND:
  IF NOT(UNIX.COMMAND) THEN
    IF MCU.ON THEN ANS = TRIM(UPCASE(ANS))
    IF ANS[1,5] # 'ALIAS' THEN GOSUB EXPAND.ALIASES
    GOSUB EXPAND.PROG.CHARS
  END
  IF ANS='!' THEN ANS='!':DEF.SHELL
  LEN.ANS = LEN(ANS)
  SEARCH.FOR=NUL
  CAP.ACTIVE=FALSE
  FIRST.WORD=FIELD(ANS,' ',1)
  UPDATE.STACK.FLAG=TRUE
  BEGIN CASE
    CASE ANS[1,1] = STACK.CHAR
      ANS = TRIM(UPCASE(ANS))
      GOSUB STACK.COMMAND
      UPDATE.STACK.FLAG=FALSE
    CASE ANS[1,1] = PROG.CHAR
      ANS = TRIM(UPCASE(ANS))
      GOSUB PROG.COMMAND
      UPDATE.STACK.FLAG=FALSE
    CASE ANS[1,1] = SEARCH
      GOSUB SEARCH.COMMAND
      UPDATE.STACK.FLAG=FALSE
    CASE UPCASE(ANS) = 'OFF' OR UPCASE(ANS) = 'Q'
      GOSUB WRITE.INFO
      STOP
    CASE FIRST.WORD='AC'
      GOSUB BUILD.AC
    CASE FIRST.WORD = 'ALIAS'
      GOSUB DO.ALIAS
    CASE FIRST.WORD = 'SE'
      FILE=FIELD(ANS,' ',2)
      ID=FIELD(ANS,' ',3)
      GOSUB SEARCH.BY.EXAMPLE
    CASE FIRST.WORD = 'CI'
      * CONTRACT INQUIRY
      CONTRACT=FIELD(ANS,' ',2)
      DATA 0
      DATA 0
      DATA 0
      DATA 0
      IF CONTRACT # '' THEN
        CONVERT '.' TO '-' IN CONTRACT
        DATA FIELD(CONTRACT,'-',1)
        DATA FIELD(CONTRACT,'-',2,2)
      END
      EXEC.LINE=\CMAINT.00\ ; GOSUB EXEC.SUB
    CASE FIRST.WORD = 'CM'
      * CONTRACT MAINTENANCE
      CONTRACT=FIELD(ANS,' ',2)
      DATA 1
      DATA 0
      DATA 0
      DATA 0
      IF CONTRACT # '' THEN
        CONVERT '.' TO '-' IN CONTRACT
        DATA FIELD(CONTRACT,'-',1)
        DATA FIELD(CONTRACT,'-',2,2)
      END
      EXEC.LINE=\CMAINT.00\ ; GOSUB EXEC.SUB
    CASE FIRST.WORD = 'CCI'
      * CUSTOMER INQUIRY
      DATA 0
      DATA 0
      DATA 0
      IF FIELD(ANS,' ',2) # '' THEN
        DATA FIELD(ANS,' ',2)
      END
      EXEC.LINE=\CDMAINT.00\ ; GOSUB EXEC.SUB
    CASE FIRST.WORD = 'CCM'
      * CUSTOMER MAINTENANCE
      DATA 1
      DATA 0
      DATA 0
      IF FIELD(ANS,' ',2) # '' THEN
        DATA FIELD(ANS,' ',2)
      END
      EXEC.LINE=\CDMAINT.00\ ; GOSUB EXEC.SUB
    CASE ANS = 'TM'
      DATA 1
      DATA 0
      EXEC.LINE=\TMAINT.00\ ; GOSUB EXEC.SUB
    CASE FIRST.WORD = 'CHECK.FILE'
      GOSUB CHECK.FILE
    CASE ANS = 'ICONV'
      CONV='I'
      GOSUB CONV
    CASE ANS = 'OCONV'
      CONV='O'
      GOSUB CONV
    CASE ANS = 'RULER'
      GOSUB GET.TERM.WIDTH
      GOSUB RULER
    CASE FIRST.WORD = 'PIVOT'
      GOSUB PIVOT
    CASE FIRST.WORD = 'PROF'
      GOSUB PROFILE
    CASE FIRST.WORD = 'DDD'
      GOSUB DDD
    CASE FIRST.WORD = 'BPI'
      GOSUB BPI
    CASE FIRST.WORD = 'SF'
      GOSUB SEARCH.FILE
    CASE FIRST.WORD = 'AF'
      GOSUB ATB.FIND
    CASE ANS='PARAM'
      GOSUB LIST.PARAM
    CASE FIRST.WORD = 'PICKLE'
      GOSUB PICKLE
    CASE ANS='SETTINGS'
      GOSUB SETTINGS
    CASE FIRST.WORD='RS'
      GOSUB RECALL.SHELL
    CASE FIRST.WORD='FIND.MENU'
      GOSUB FIND.MENU
    CASE ANS='LISTA'
      GOSUB LISTA
    CASE FIRST.WORD = 'DESC'
      GOSUB IL10.DESC
    CASE FIRST.WORD = 'XREF'
      GOSUB IL10.XREF
    CASE FIRST.WORD = 'FIELD'
      GOSUB IL10.AF
    CASE FIRST.WORD = 'NED'
      GOSUB IL10.NED
    CASE FIRST.WORD = 'NSEL'
      GOSUB IL10.NSEL
    CASE FIRST.WORD = 'SQL'
      GOSUB SQL.SEL
    CASE FIRST.WORD = 'SQLF'
      GOSUB SQL.FILE
    CASE FIRST.WORD = 'SQL-LIST'
      GOSUB SQL.SEL.LIST
    CASE OTHERWISE
      EXEC.LINE = ANS
      T1=SYSTEM(12)
      GOSUB EXEC.SUB
      IF TIME.COMMAND THEN PRINT SYSTEM(12)-T1:' ms'
  END CASE
  IF UPDATE.STACK.FLAG THEN GOSUB UPDATE.STACK
RETURN
*
DO.ALIAS:
  AL = FIELD(ANS,SPC,2)
  STRING = NUL;I = 3
  LOOP
    F = FIELD(ANS,SPC,I)
  UNTIL F = NUL DO
    STRING = STRING:SPC:F
    I = I + 1
  REPEAT
  BEGIN CASE
    CASE AL = NUL AND STRING = NUL
      GOSUB LIST.ALIAS
    CASE STRING = NUL
      GOSUB LIST.ONE.ALIAS
    CASE 1
      GOSUB SET.ALIAS
  END CASE
RETURN
*
SET.ALIAS:
  STRING=STRING[2,LONG.LINE]
  PRINT AL:'=':STRING
  LOCATE AL IN ALIASES<1> BY 'AL' SETTING P THEN
    ALIASES<2,P> = STRING
  END ELSE
    INS AL BEFORE ALIASES<1,P>;INS STRING BEFORE ALIASES<2,P>
  END
RETURN
*
LIST.ALIAS:
  I = DCOUNT(ALIASES<1>,@VM)
  FOR F = 1 TO I
    PRINT ALIASES<1,F>,ALIASES<2,F>
  NEXT F
RETURN
*
LIST.ONE.ALIAS:
  LOCATE AL IN ALIASES<1> BY 'AL' SETTING P ELSE PRINT AL:' not found';RETURN
  X=0;LEN=99;DISP.LEN=30;ENTRY=ALIASES<2,P>
  GOSUB GET.INPUT
  IF RTN = 27 THEN RETURN
  ALIASES<2,P> = ENTRY
  IF ENTRY = NUL THEN DEL ALIASES<1,P>;DEL ALIASES<2,P>
RETURN
*
EXEC.SUB:
  IF EXEC.LINE = NUL THEN RETURN
  IF EXEC.LINE = 'CLEARSELECT' THEN CLEARSELECT
  IF CAP.ACTIVE THEN
    EXECUTE EXEC.LINE CAPTURING EXEC.CAP
  END ELSE
    EXECUTE EXEC.LINE
  END
  IF SYSTEM(11) > 0 THEN SL.ACTIVE = TRUE ELSE SL.ACTIVE = FALSE
  CAP.ACTIVE=FALSE
RETURN
*
EXPAND.PROG.CHARS:
  * expand //10 to be IV.BP IV.EQP.MNT for example
  POS = 1
  LOOP
    I = INDEX(ANS,PROG.CHAR:PROG.CHAR,POS)
  UNTIL I = 0 DO
    VAR = NUL;IDX = I+2
    LOOP
      C = ANS[IDX,1]
    UNTIL NOT(NUM(C)) OR C = NUL DO
      VAR = VAR:C
      IDX = IDX+1
    REPEAT
    IF NUM(VAR) AND VAR > 0 THEN
      ANS = ANS[1,I-1]:PROGRAMS<VAR>:ANS[IDX,LONG.LINE]
    END ELSE
      POS = POS + 1
    END
  REPEAT
RETURN
*
EXPAND.ALIASES:
  SWAP SPC WITH @VM IN ANS ; POS = 1
  LOOP
    R = ANS<1,POS>
  UNTIL R = NUL DO
    LOCATE R IN ALIASES<1> BY 'AL' SETTING P THEN ANS<1,POS> = ALIASES<2,P>
    POS = POS + 1
  REPEAT
  SWAP @VM WITH SPC IN ANS
RETURN
*
EXPAND.PROMPT:
  IF SL.ACTIVE THEN
    PROMPT.DISP='#R':SYSTEM(11):'-SEL>'
    OLD.X.DISP=X.DISP
    X.DISP=-2
  END ELSE
    PROMPT.DISP = PROMT
    X.DISP=OLD.X.DISP
  END
  CTR = 1
  LOOP
    I = INDEX(PROMPT.DISP,'#',CTR)
  UNTIL I = 0 DO
    F = PROMPT.DISP[I+1,1]
    L = PROMPT.DISP[1,I-1];R = TRIM(PROMPT.DISP[I+2,LONG.LINE])
    BEGIN CASE
      CASE F = 'B'
        PROMPT.DISP = L:CHAR(7):R
      CASE F = 'A'
        PROMPT.DISP = L:ACC:R
      CASE F = 'T'
        PROMPT.DISP = L:OCONV(TIME(),'MTS'):R
      CASE F = 'D'
        PROMPT.DISP = L:OCONV(DATE(),'D'):R
      CASE F = 'E'
        PROMPT.DISP = L:CHAR(ESC):R
      CASE F = 'R'
        PROMPT.DISP = L:CHAR(13):CHAR(10):R
      CASE F = '#'
        PROMPT.DISP = L:'#':R
        CTR = CTR + 1
      CASE F = 'U'
        PROMPT.DISP = L:USERNAME:R
      CASE F = 'H'
        PROMPT.DISP=L:FIELD(HOST.NAME,".",1):R
      CASE OTHERWISE
        CTR = CTR + 1
    END CASE
  REPEAT
RETURN
*
STACK.COMMAND:
  BEGIN CASE
    CASE ANS='.D'
      LIST.DET.FLAG=NOT(LIST.DET.FLAG)
    CASE ANS[1,2] = '.L'
      IF ANS = '.L' THEN ANS = '.L,20'
      GOSUB GET.PARAMS
      IF RANGE.ERROR THEN RETURN
      I = DCOUNT(STACK,@AM)
      IF I = 0 THEN PRINT 'No items present';RETURN
      IF P2 > I THEN P2 = I
      PRINT
      FOR F = P2 TO P1 STEP -1
        IF LIST.DET.FLAG THEN
          PRINT SPC:F'R#3':" ":STACK<F,1>'L#20':' ':OCONV(STACK<F,2>,'D-YMD'):' ':OCONV(STACK<F,3>,'MTS'):' ':STACK<F,4>
        END ELSE
          PRINT SPC:F'R#3':" ":STACK<F,4>
        END
      NEXT F
    CASE ANS[1,2] = '.R' OR ANS[1,2] = '.X'
      IF STACK = NUL THEN PRINT BELL ELSE GO EDIT
    CASE ANS = '.P'
      PRINT '#R - Return  #A - Account  #D - Date  #T - Time #P - Port'
      PRINT '#E - Escape  #L - Level    #U - User  #H - Host'
      PRINT 'Prompt':
      X = 7;DISP.LEN = 60;ENTRY = PROMT;LEN = 99;GOSUB GET.INPUT
      PROMT = ENTRY
      PRINT 'Enter the X displacement for input :':
      ENTRY = NUL;LEN = 5;DISP.LEN = 5;X = 37;GOSUB GET.INPUT
      X.DISP = ENTRY
      IF NOT(NUM(X.DISP)) THEN X.DISP = 0
      SETTINGS<12> = PROMT
      SETTINGS<13> = X.DISP
      OLD.X.DISP=X.DISP
    CASE ANS = '.H'
      CRT '--------------------------- TCL STACK COMMANDS --------------------------------'
      CRT 'Ctrl-A      Start of line              Ctrl-R           Toggle insert mode'
      CRT 'Ctrl-B      Back one char              Ctrl-U           Page Up'
      CRT 'Ctrl-D      Delete char                Ctrl-V           Page Down'
      CRT 'Ctrl-E      End of line                Ctrl-W           Delete word'
      CRT 'Ctrl-F      Forward char               Ctrl-X           Forward word'
      CRT 'Ctrl-G      Cancel line                Ctrl-Z           Back word'
      CRT 'Ctrl-I      Forward word               ~xyz             Search for xyz'
      CRT 'Ctrl-J      Delete to end              .D               Toggle detail off/on'
      CRT 'Ctrl-L      Clear screen               .Lm,n            List entry m thru n'
      CRT 'Ctrl-M      Accept line                .Rn              Restore entry n, edit'
      CRT 'Ctrl-N      Next line                  .H               Help'
      CRT 'Ctrl-P      Previous line              Q/INFO           Quit back to TCL'
      CRT '---------------------- PROGRAM STACK COMMANDS ---------------------------------'
      CRT '/           List the active prog stack'
      CRT '/LL         List available prog stacks /L BLAH          Switch stack to BLAH'
      CRT '/Nx         Add a New program          /Fx              Format the x`th program'
      CRT '/Ex         Edit the x`th program      /WW              Edit the program list'
      CRT '/Wx         VI the x`th program        /S               Sort the program stack'
      CRT '/Bx         Compile the x`th program   /BR              Compile and run'
      CRT '---------------------------- UTILITIES ----------------------------------------'
      CRT '                         ----------IL9---------'
      CRT 'AF          ATB Finder, search definitions                          - AF MRKTNG'
      CRT 'DDD         Search dictionary definitions                 - DDD LS.MASTER EQUIP'
      CRT 'LISTA       Show users logged in, as well as locks'
      CRT '                         ----------IL10--------'
      CRT 'FIELD       Show IL10 attribute/field metadata            - FIELD LS.NET.INVEST'
      CRT 'NED         Edit an IL10 record                 - NED LS.MASTER 123-1234567-000'
      CRT 'NSEL        Run a simple UD command - NSEL LS.INV.NUM N.CONTRACT.KEY N.DATE.DUE'
      CRT 'DESC        Describe columns in a table                - DESC LS_OI_CTD_INVOICE'
      CRT 'SQL         Run a SQL command -SQL SELECT TOP 10 ALTERNATE_ID FROM LS_MASTER_NF'
      CRT 'SQLF        Run a SQL command from a file        - SQLF /tmp/queries/Query1.sql'
      CRT 'SQL-LIST    SQL to L1 -SQL-LIST L1 SELECT TOP 10 ALTERNATE_ID FROM LS_MASTER_NF'
      CRT 'XREF        Show IL10 file/table metadata                      - XREF LS.MASTER'
      CRT '                              ---INFOLEASE---'
      CRT 'BPI         List table definitions                        - BPI LS.CTD.PYMTHIST'
      CRT 'CHECK.FILE  Show strings in a compiled program /P|/S    - CHECK.FILE DISP.00 /P'
      CRT '{C}CI/CM/TM {Customer}Contract Inquiry/Maintenance/Table Maintenance'
      CRT 'FIND.MENU   Search the menus                                   - FIND.MENU VOID'
      CRT 'PARAM       Show parameter file mapping'
      CRT 'RS          Edit a recall                                       RS DK.AUDIT.RPT'
      CRT '                             -----GENERAL-----'
      CRT 'ICONV/OCONV Test format masks/Convert Data'
      CRT 'PICKLE      Store data records in prog     - PICKLE DICT LS.MASTER UATB.BIG.ATB'
      CRT 'PIVOT       Summary data                - PIVOT LS.MASTER LESSOR GROSS.CONTRACT'
      CRT 'PROF        Profile data     - PROF LS.MASTER BRANCH NUM.OF.ASSETS BOOKING.DATE'
      CRT 'RULER       Reset term width, show ruler'
      CRT 'SETTINGS    Change settings'
      CRT 'SF          Search files and dictionaries            - SF DICT LS.MASTER ASSETS'
    CASE ANS = '.T'
      TIME.COMMAND=NOT(TIME.COMMAND)
    CASE ANS = '.U'
      IF MCU.ON THEN MCU.ON = FALSE;PRINT 'upper case off' ELSE MCU.ON = TRUE;PRINT 'UPPER CASE ON'
    CASE OTHERWISE
      PRINT 'There is no such STACK command':BELL
      PRINT '? for help'
  END CASE
RETURN
*
GET.PARAMS:
  I = INDEX(ANS,',',1)
  IF I # 0 THEN
    L = I-1;P1 = NUL
    LOOP
      IF NUM(ANS[L,1]) THEN P1 = ANS[L,1]:P1;L=L-1 ELSE EXIT
    REPEAT
    P2 = ANS[I + 1, LEN.ANS]
  END ELSE
    P1 = NUL
    LOOP
      IF NUM(ANS[LEN.ANS,1]) THEN P1 = ANS[LEN.ANS,1]:P1;LEN.ANS=LEN.ANS-1 ELSE EXIT
    REPEAT
    IF P1 = NUL THEN P1 = 1
    P2 = P1
  END
  IF P1 = NUL THEN P1 = 1
  IF P2 = NUL THEN P2 = MAX.STACK
  IF NUM(P1) & NUM(P2) & P1 > 0 THEN
    RANGE.ERROR = FALSE
  END ELSE
    RANGE.ERROR = TRUE
    PRINT 'Range Error':BELL
  END
RETURN
*
EDIT:
  * Some of the stuff in here is redundant, repeating COMMAND
  * but to gosub command introduces re-entrancy problems
  * That's why we use the dreaded GOTO command
  N = ANS[3,LEN.ANS]
  IF NOT(NUM(N)) THEN PRINT 'No such line number - ':N:BELL;RETURN
  IF N = NUL THEN N = 1
  LOOP WHILE N # NUL AND STACK<N> # NUL DO
    PRINT UP:N 'R%3':':':EOL:
    ENTRY = STACK<N,4>
    IF ENTRY = "" THEN ENTRY = STACK<N> ;* Legacy stack commands, no timestamp
    X = 5;DISP.LEN = TERM.WIDTH-1-X;LEN = LONG.LINE
    IF ENTRY # NUL THEN
      OLD.ENTRY = ENTRY
      GOSUB GET.INPUT
      ANS = ENTRY
    END
    BEGIN CASE
      CASE RTN = UP.KEY
        IF SEARCH.FOR # NUL THEN
          GO SEARCH.COMMAND
        END ELSE
          N = N + 1
          IF STACK<N> = NUL THEN N = 1
        END
      CASE RTN = DOWN.KEY
        N = N - 1
        IF N = 0 THEN
          N=1; PRINT BELL:
        END
      CASE RTN = RET
        UNIX.COMMAND=FALSE
        IF ANS[1,1] = UNIX THEN UNIX.COMMAND=TRUE
        IF UNIX.COMMAND THEN
          EXECUTING = FALSE
          IF N = 1 AND ENTRY = OLD.ENTRY THEN EXECUTING = TRUE
          GOSUB DO.COMMAND
          N=NUL
        END ELSE
          C.LIST = ANS
          C.COUNT = 1
          LOOP
            ANS = FIELD(C.LIST,COMMAND.SEPERATOR,C.COUNT)
          UNTIL ANS = NUL DO
            EXECUTING = FALSE
            IF N = 1 AND ENTRY = OLD.ENTRY THEN EXECUTING = TRUE
            GOSUB DO.COMMAND
            C.COUNT = C.COUNT + 1
          REPEAT
          N = NUL
        END
      CASE RTN = ESC
        N = NUL
    END CASE
  REPEAT
RETURN
*
SEARCH.COMMAND:
  * Search the stack for a string
  IF SEARCH.FOR = NUL THEN SEARCH.FOR = ANS[2,LONG.LINE]
  FOUND = FALSE
  FOR F = START.WORD.SEARCH TO MAX.STACK UNTIL FOUND OR STACK<F> = NUL
    IF INDEX(STACK<F,4>,SEARCH.FOR,1) # 0 THEN FOUND = TRUE
  NEXT F
  IF FOUND THEN
    START.WORD.SEARCH = F
    ANS = '.R':F-1
    GO EDIT
  END
  PRINT BELL:SEARCH.FOR:' event not found'
RETURN
*
PROG.COMMAND:
  IF ANS = PROG.CHAR OR ANS=PROG.CHAR:PROG.CHAR THEN GO PRINT.PROG.INFO
  GOSUB PARSE.PROG.COM
  ANS=PROG.COM:SPC:B.FILE:SPC:B.ITEM
  *GOSUB UPDATE.STACK
  BEGIN CASE
    CASE PROG.COM = '/WW'
      WRITE PROGRAMS ON HOME.F, PROGRAM.ITEM
      WP.FILE=HOME.FILE
      WP.ITEM=PROGRAM.ITEM
      GOSUB WP.EDIT
      READ PROGRAMS FROM HOME.F, PROGRAM.ITEM ELSE PROGRAMS = NUL
    CASE PROG.COM = '/N'
      GOSUB GET.PROG.NAME
      IF RTN=13 THEN
        PROGRAMS<PROG.NUM> = PROG
        WRITE PROGRAMS ON HOME.F, PROGRAM.ITEM
      END
      IF B.FILE # '' THEN
        OPEN B.FILE TO F THEN
          OPTIONS=''
          READ DUMMY FROM F, B.ITEM ELSE
            PRINT B.ITEM:' not found.  Use standard header? ':
            INPUT YORN
            IF YORN = 'Y' THEN
              HEADER=STR('*',80)
              HEADER<2>='* Program: ':B.ITEM
              HEADER<3>='* Author : ':USERNAME
              HEADER<4>='* Date   : ':OCONV(DATE(),"D-YMD") ;* E.g. 2017-04-20
              HEADER<5>='* Version: 1.0'
              HEADER<6>='* Comment: Do NOT skip the description'
              HEADER<7>=STR('*',80)
              WRITE HEADER ON F, B.ITEM
            END
          END
          CLOSE F
          WP.FILE=B.FILE
          WP.ITEM=B.ITEM
          GOSUB WP.EDIT
        END ELSE
          PRINT B.FILE:' is not a file in this account'
        END
      END
    CASE PROG.COM = '/H'
      OPTIONS='LESS'
      *CALL CVS.LOG(RTN, B.FILE, B.ITEM, OPTIONS)
    CASE PROG.COM = '/L'
      * Load a new program stack
      STACK.NAME=TRIM(OPTIONS)
      IF STACK.NAME = '' THEN
        PROGRAM.ITEM='.STACK.PROGRAM_':USERNAME
      END ELSE
        PROGRAM.ITEM='.STACK.PROGRAM_':USERNAME:'_':STACK.NAME
      END
      READ PROGRAMS FROM HOME.F, PROGRAM.ITEM ELSE PROGRAMS = NUL
      SETTINGS<15>=STACK.NAME
      GOSUB WRITE.INFO
    CASE PROG.COM = '/LL'
      * List the different program stacks
      EXEC.LINE=\SSELECT \:HOME.FILE:\ WITH @ID = ".STACK.PROGRAM]"\
      GOSUB EXEC.SUB
      LOOP
        READNEXT ID ELSE EXIT
        PRINT ID
      REPEAT
    CASE PROG.COM = '/CI'
      * Check it in
      OPTIONS=''
      *CALL CVS.CHECKIN(RTN, B.FILE, B.ITEM, OPTIONS)
    CASE PROG.COM = '/D'
      * CVS Diff
      OPTIONS='SHOW'
      *CALL CVS.DIFF(RTN, B.FILE, B.ITEM, OPTIONS)
    CASE B.FILE[1,1] = '*' OR B.FILE=''
      NULL ;* Don't do anything with 'comment' or blank entries
    CASE PROG.COM = '/BR'
      GOSUB COMPILE
      EXEC.LINE = B.ITEM
      GOSUB EXEC.SUB
    CASE PROG.COM = '/B'
      GOSUB COMPILE
    CASE PROG.COM = '/E' OR PROG.COM = '/W'
      OPEN B.FILE TO F ELSE PRINT 'Cannot open ':B.FILE:BELL;RETURN
      READ R1 FROM F, B.ITEM ELSE R1=NUL
      IF PROG.COM = '/E' THEN
        EXEC.LINE = ED.VERB:SPC:PROG:OPTIONS
        GOSUB EXEC.SUB
      END ELSE
        WP.FILE=B.FILE
        WP.ITEM=B.ITEM
        GOSUB WP.EDIT
      END
      CLOSE F
    CASE PROG.COM = '/F'
      GOSUB BFORMAT
    CASE PROG.COM = '/R'
      OPEN B.FILE TO F ELSE PRINT 'Cannot open ':B.FILE:BELL;RETURN
      READV R FROM F, B.ITEM, 1 ELSE R=NUL
      CLOSE F
      EXEC.LINE = B.ITEM:OPTIONS
      GOSUB EXEC.SUB
    CASE PROG.COM = '/S'
      * A slow sort of the program stack
      READ REC FROM HOME.F, PROGRAM.ITEM ELSE PRINT 'CANNOT READ ':HOME.FILE:' ':PROGRAM.ITEM ; RETURN
      SORT='AL' ; NEW.REC=''
      I=DCOUNT(REC,@AM)
      FOR F=1 TO I
        L=REC<F>
        LOCATE L IN NEW.REC BY SORT SETTING POS ELSE NULL
        INS L BEFORE NEW.REC<POS>
      NEXT F
      WRITE NEW.REC ON HOME.F, PROGRAM.ITEM
    CASE OTHERWISE
      PRINT 'There is no such PROGRAM command':BELL
      PRINT '? for help'
  END CASE
RETURN
*
COMPILE:
  OPTIONS=''
  * Check for global catalog
  READ DUMMY FROM CTLGTB, B.ITEM THEN
    PRINT B.ITEM:' is cataloged globally'
    OPTIONS='G'
  END
  *
  * Check for local catalog
  READ DUMMY FROM CTLG, B.ITEM THEN
    PRINT B.ITEM:' is cataloged locally'
    OPTIONS :='L'
  END
  *
  * Check for direct catalog
  READ DUMMY FROM VOC, B.ITEM THEN
    IF INDEX(DUMMY<2>,'/CTLG/',1)=0 THEN
      PRINT B.ITEM:' is cataloged direct to ':DUMMY<2>
      OPTIONS :='D'
    END
  END
  *
  IF LEN(OPTIONS) > 1 THEN
    PRINT "OPTIONS=":OPTIONS
    PRINT "I do not like green eggs and ham, nor do I like"
    PRINT "programs cataloged twice.  You must fix, Sam"
    RETURN
  END
  *
  LOOP
  UNTIL OPTIONS#'' DO
    PRINT 'Catalog ':B.ITEM:' -- D)irect, L)ocal or G)lobal :':
    INPUT OPTIONS
    OPTIONS=UPCASE(OPTIONS)
    IF OPTIONS = '/' OR OPTIONS='' THEN RETURN
    * Have to enter D, L or G
    IF OPTIONS # 'L' AND OPTIONS # 'G' AND OPTIONS # 'D' THEN OPTIONS=''
  REPEAT
  *
  EXEC.LINE = 'BASIC ':B.FILE:' ':B.ITEM:' -D' ;* -D includes symbol table
  PRINT EXEC.LINE
  GOSUB EXEC.SUB
  *
  BEGIN CASE
    CASE OPTIONS='G'
      EXEC.LINE = 'CATALOG ':B.FILE:' ':B.ITEM:' FORCE'
      PRINT EXEC.LINE
      GOSUB EXEC.SUB
      * Global, so remove direct or local pointers
      READ R FROM VOC, B.ITEM THEN DELETE VOC, B.ITEM
    CASE OPTIONS='L'
      EXEC.LINE = 'CATALOG ':PROG:' LOCAL FORCE'
      PRINT EXEC.LINE
      GOSUB EXEC.SUB
      * Object is in CTLG file, so remove from SOURCE file
      OPEN B.FILE TO F ELSE PRINT 'Cannot open ':B.FILE:BELL;RETURN
      DELETE F, '_':B.ITEM
      CLOSE F
    CASE OPTIONS='D'
      EXEC.LINE = 'CATALOG ':B.FILE:' ':B.ITEM:' DIRECT FORCE'
      PRINT EXEC.LINE
      GOSUB EXEC.SUB
  END CASE
  *
  EXEC.LINE = 'NEWPCODE' ;* This loads a new version of globally cataloged programs
  GOSUB EXEC.SUB
RETURN
*
PARSE.PROG.COM:
  PROG.NUM = NUL
  F = FIELD(ANS,SPC,1);L = LEN(F);I = L
  LOOP
    IF NUM(F[I,1]) THEN PROG.NUM = F[I,1]:PROG.NUM ELSE EXIT
    I = I - 1
  REPEAT
  IF PROG.NUM = NUL THEN PROG.NUM = 1
  OPTIONS = ANS[L+1,LONG.LINE]
  PROG.COM = ANS[1,I]
  PROG = PROGRAMS<PROG.NUM>
  B.FILE = FIELD(PROG,SPC,1)
  B.ITEM = FIELD(PROG,SPC,2)
RETURN
*
GET.PROG.NAME:
  X = 15;DISP.LEN = 50;LEN = LONG.LINE;ENTRY = PROG
  PRINT 'Program Name :':
  GOSUB GET.INPUT
  ANS = UPCASE(ENTRY)
  IF RTN # 13 THEN RETURN
  GOSUB EXPAND.ALIASES
  IF INDEX(ANS,SPC,1) THEN
    B.FILE = FIELD(ANS,SPC,1)
    B.ITEM = FIELD(ANS,SPC,2)
    PROG=ANS
  END ELSE
    IF ANS = NUL THEN
      B.FILE = NUL ; B.ITEM = NUL ;PROG = NUL
    END ELSE
      B.FILE = WORK.FILE ; B.ITEM = ANS ; PROG = B.FILE:SPC:B.ITEM
    END
  END
RETURN
*
PRINT.PROG.INFO:
  I = DCOUNT(PROGRAMS,@AM)
  PRINT STACK.NAME
  FOR F = 1 TO I
    IF PROGRAMS<F> # NUL THEN
      CH=' '
      IF ANS=PROG.CHAR:PROG.CHAR THEN
        * We want cvs status as well
        FILE=FIELD(PROGRAMS<F>,' ',1)
        ITEM=FIELD(PROGRAMS<F>,' ',2)
        R=''
        *CALL CVS.STATUS(R,FILE,ITEM,'')
        STATUS=R<1>
        WORK.VER=R<2>
        CVS.VER=R<3>
        BEGIN CASE
          CASE STATUS='UPTODATE'
            CH='  ':WORK.VER'L#9'
          CASE STATUS='MODIFIED'
            CH='> ':WORK.VER'L#4':' ':CVS.VER'L#4'
          CASE 1
            CH='! ':SPACE(9)
        END CASE
      END
      PRINT F 'L#5':CH:' ':PROGRAMS<F>
    END
  NEXT F
RETURN
*
WRITE.INFO:
  WRITE STACK ON HOME.F, STACK.ITEM
  WRITE ALIASES ON HOME.F, ALIAS.ITEM
  WRITE PROGRAMS ON HOME.F, PROGRAM.ITEM
  WRITE SETTINGS ON HOME.F, SETTING.ITEM
RETURN
*
UPDATE.STACK:
  INS ACC:@VM:DATE():@VM:TIME():@VM:ANS BEFORE STACK<1>
  WRITE STACK ON HOME.F, STACK.ITEM
RETURN
*
WP.EDIT:
  * Edit a record using a visual editor (e.g. vi, joe or emacs)
  DICT=0
  IF FIELD(WP.FILE,' ',1)='DICT' THEN WP.FILE=FIELD(WP.FILE,' ',2) ; DICT=1
  READ REC FROM VOC, WP.FILE ELSE PRINT WP.FILE:' - no VOC item' ; RETURN
  IF (REC<1>#'DIR' AND REC<1>#'LD') OR DICT THEN
    * Copy to a temp DIR type and edit there, ignore the race conditions!
    IF DICT THEN WP.FILE='DICT ':WP.FILE
    OPEN WP.FILE TO T ELSE PRINT WP.FILE:' - cannot OPEN' ; RETURN
    READ R FROM T, WP.ITEM ELSE PRINT WP.ITEM:' - not found' ; RETURN
    WRITE R ON HOLD, WP.ITEM
    WP.PATH='_HOLD_'
    DIR.TYPE=0
  END ELSE
    WP.PATH=REC<2>
    IF REC<1>='LD' THEN
      IF INDEX(FILE,',',1) THEN
        WP.PATH=REC<2>:FIELD(FILE,',',2)
      END ELSE
        WP.PATH=REC<2>:'/':FIELD(REC<2>,'/',DCOUNT(REC<2>,'/'))
      END
    END
    DIR.TYPE=1
  END
  EXEC.LINE=WP.VERB:' ':WP.PATH:'/':WP.ITEM
  GOSUB EXEC.SUB
  IF NOT(DIR.TYPE) THEN
    * Copy back to original location
    READ R FROM HOLD, WP.ITEM ELSE R=''
    WRITE R ON T, WP.ITEM
    CLOSE T
  END
RETURN
*
CHECK.FILE:
  PARAM.CTR=1 ; PROG.FLAG=0 ; FILE.FLAG=0 ; ALL.FLAG=0
  LOOP
    P=FIELD(ANS,' ',PARAM.CTR)
  UNTIL P='' DO
    IF P[1,1] = '/' THEN
      P=P[2,1]
      BEGIN CASE
        CASE P='P'
          PROG.FLAG=1
        CASE P='F'
          FILE.FLAG=1
        CASE P='A'
          ALL.FLAG=1
      END CASE
    END ELSE
      PROG=P
    END
    PARAM.CTR += 1
  REPEAT
  IF PROG.FLAG=0 AND FILE.FLAG=0 THEN ALL.FLAG=1
  *
  IF PROG # '' THEN
    READ CAT.PTR FROM VOC, PROG ELSE PRINT 'Cannot read VOC ':PROG ; RETURN
  END ELSE
    LOOP
      PRINT 'Enter the program to scan ':
      INPUT PROG
      IF PROG = '' OR PROG = '/' THEN RETURN
      READ CAT.PTR FROM VOC, PROG THEN EXIT
      PRINT 'Cannot read VOC ':PROG
    REPEAT
  END
  *
  EXECUTE "!strings ":CAT.PTR<2>:" > $HOME/FILE.LIST"
  *
  FILE.LIST=''
  READ R FROM HOME.F, 'FILE.LIST' THEN
    I=DCOUNT(R,@AM)
    FOR F=1 TO I
      TEST.FILE=R<F>
      IF FILE.FLAG THEN
        OPEN TEST.FILE TO DUMMY THEN
          LOCATE TEST.FILE IN FILE.LIST BY 'AL' SETTING POS ELSE
            INS TEST.FILE BEFORE FILE.LIST<POS>
            PRINT 'FILE:':TEST.FILE
          END
          CLOSE DUMMY
        END
      END
      IF PROG.FLAG THEN
        READ DUMMY FROM VOC, TEST.FILE THEN
          *IF DUMMY = 'C' THEN PRINT 'PROG: ':TEST.FILE
          IF DUMMY<1>='C' THEN PRINT 'PROG: ':TEST.FILE'L#25':' ':DUMMY<2>
        END
      END
      IF ALL.FLAG THEN
        PRINT TEST.FILE
      END
    NEXT F
  END
RETURN
*
CONV:
  * Handy way to check ICONV/OCONV data
  LOOP
    PRINT 'Enter mask:':
    INPUT MASK
    IF MASK='' OR MASK='/' THEN RETURN
    PRINT 'Enter data:':
    INPUT DTA
    PRINT 'Result:':
    IF CONV='I' THEN PRINT ICONV(DTA,MASK) ELSE PRINT OCONV(DTA,MASK)
  REPEAT
RETURN
*
RULER:
  CRT 'Term width=':TERM.WIDTH
  FOR F=1 TO TERM.WIDTH
    C=SEQ(0)+MOD(F,10)
    IF MOD(F,10) THEN PRINT CHAR(C): ELSE PRINT ' ':
  NEXT F
  PRINT
  SUP.NEXT=0
  FOR F=1 TO TERM.WIDTH
    BEGIN CASE
      CASE MOD(F+1,10)=0 AND (F+1)/10 > 9
        PRINT (F+1)/10:
        SUP.NEXT=1
      CASE MOD(F,10)=0 AND F/10 <= 9
        PRINT F/10:
        SUP.NEXT=0
      CASE MOD(F,5)=0 AND NOT(SUP.NEXT)
        PRINT '+':
      CASE 1
        IF NOT(SUP.NEXT) THEN PRINT ' ':
        SUP.NEXT=0
    END CASE
  NEXT F
  PRINT
RETURN
*
PIVOT:
  * Summarize a field, e.g. PIVOT LS.MASTER LESSOR GROSS.CONTRACT EQUIPMENT.COST
  FILE=FIELD(ANS," ",2) ; ATB =FIELD(ANS," ",3) ; ATB2=FIELD(ANS," ",4) ; ATB3=FIELD(ANS," ",5) ; ATB4=FIELD(ANS," ",6)
  OPEN "DICT ":FILE TO DICT ELSE PRINT "DICT ":FILE:' not a filename' ; RETURN
  READ UREC FROM DICT,"UATB.COUNTER" ELSE
    UREC=\I\;UREC<2>=\"1"\;UREC<4>=\CNTR\;UREC<5>=\8R\;UREC<6>=\S\
    WRITE UREC ON DICT,"UATB.COUNTER"
  END
  CLOSE DICT
  EXEC.LINE = \SORT \:FILE:\ BY \:ATB:\ BREAK-ON \:ATB:\ TOTAL UATB.COUNTER \
  IF ATB2 # "" THEN EXEC.LINE := \ TOTAL \:ATB2
  IF ATB3 # "" THEN EXEC.LINE := \ TOTAL \:ATB3
  IF ATB4 # "" THEN EXEC.LINE := \ TOTAL \:ATB4
  EXEC.LINE := \ (IDH \
  GOSUB EXEC.SUB
RETURN
*
PROFILE:
  * Profile a field, e.g. PROFILE LS.MASTER REQ.SIGNATURE.PHONE
  FILE=FIELD(ANS," ",2) ; ATB =FIELD(ANS," ",3) ; ATBS=FIELD(ANS," ",4,99)
  EXEC.LINE = \SORT \:FILE:\ WITH \:ATB:\ \:ATB:\ \:ATBS
  GOSUB EXEC.SUB
RETURN
*
DDD:
  * Tweak DICT VOC with some pickle juice
  R    =\DICT VOC#AM#@ID#AM#D#AM#0#AM##AM#VOC#AM#30L#AM#S#AM#\
  R<-1>=\DICT VOC#AM#F1#AM#D#AM#1#AM##AM##AM#5L#AM#S#AM#\
  R<-1>=\DICT VOC#AM#F2#AM#D#AM#2#AM##AM##AM#50L#AM#S#AM#\
  OPEN 'DICT VOC' TO FVAR ELSE RETURN
  FOR F=1 TO DCOUNT(R,@AM)
    REC=R<F>
    SWAP "#AM#" WITH @AM IN REC
    FILE=REC<1> ; DEL REC<1>
    ITEM=REC<1> ; DEL REC<1>
    WRITE REC ON FVAR,ITEM
  NEXT F
  CLOSE FVAR
  *
  * List the DICT, e.g DDD AS.MASTER EQUIP
  FILE = FIELD(ANS," ",2)
  SSTR = FIELD(ANS," ",3)
  FIND.STR=""
  IF SSTR # "" THEN FIND.STR = \WITH @ID = "[\:SSTR:\]" \
  EXEC.LINE=\SORT DICT \:FILE:\ @ID F1 F2 BY F1 BY F2 \:FIND.STR:\ USING DICT VOC (I \
  GOSUB EXEC.SUB
RETURN
*
SEARCH.FILE:
  FILE = FIELD(ANS," ",2)
  ICTR=3
  IF FILE='DICT' THEN ICTR+=1 ; FILE='DICT ':FIELD(ANS," ",3)
  OPEN FILE TO FVAR ELSE PRINT FILE:' - not found' ; RETURN
  SSTR = FIELD(ANS," ",ICTR)
  IF SSTR='' THEN PRINT 'Search for:': ; INPUT SSTR
  IF SSTR='' THEN RETURN
  *
  SSTR1=UPCASE(SSTR)
  SSTR2=DOWNCASE(SSTR)
  SSTR3=OCONV(SSTR,"MCT")
  *
  DATA SSTR
  DATA SSTR1
  DATA SSTR2
  DATA SSTR3
  DATA ""
  EXEC.LINE=\ESEARCH \:FILE:\ WITH @ID # "_]" USING DICT VOC\ ; CAP.ACTIVE=TRUE
  GOSUB EXEC.SUB
  *
  CTR=0 ; FOUND.RECS=''
  LOOP
    READNEXT ID ELSE EXIT
    READ REC FROM FVAR, ID THEN
      IDX = INDEX(UPCASE(REC),SSTR1,1)
      IF IDX OR INDEX(UPCASE(ID),SSTR1,1) THEN
        CTR+=1
        FOUND.RECS<1,CTR>=ID
        IDX -= 10 ; IF IDX < 1 THEN IDX=1
        LINE=REC[IDX,45]
        CONVERT @VM TO "]" IN LINE
        CONVERT @AM TO "~" IN LINE
        LINE=OCONV(LINE,"MCP")
        FOUND.RECS<2,CTR>=LINE
      END
    END
  REPEAT
  CLOSE FVAR
  *
  QUIT = 0 ; CTR=1 ; MAX.ITEMS=DCOUNT(FOUND.RECS<1>,@VM)
  IF MAX.ITEMS=0 THEN PRINT SSTR:' Not found' ; RETURN
  HDR=@(-1):\SEARCHING FOR "\:SSTR1:\,\:SSTR2:\,\:SSTR3:\" IN \:FILE
  PRINT HDR
  LOOP
    PRINT CTR'R#4':' ':FOUND.RECS<1,CTR>'L#25':FOUND.RECS<2,CTR>'L#65'
    CTR+=1
    IF CTR/20=INT(CTR/20) THEN GOSUB SEARCH.FILE.PROMPT
    IF QUIT THEN RETURN
  REPEAT
RETURN
*
SEARCH.FILE.PROMPT:
  PRINT ; PRINT 'B)ack, E)dit #, V)iew #, W)P#, /:':
  INPUT OPTION
  BEGIN CASE
    CASE OPTION='B'
      CTR-=40
      IF CTR<1 THEN CTR=1
    CASE OPTION[1,1]='E'
      EXEC.LINE=ED.VERB:\ \:FILE:\ \:FOUND.RECS<1,OPTION[2,99]>
      GOSUB EXEC.SUB
      CTR-=20
      IF CTR<1 THEN CTR=1
    CASE OPTION[1,1]='W'
      WP.FILE=FILE
      WP.ITEM=FOUND.RECS<1,OPTION[2,99]>
      GOSUB WP.EDIT
      CTR-=20
      IF CTR<1 THEN CTR=1
    CASE OPTION[1,1]='V'
      PRINT CS:
      EXEC.LINE=\CT \:FILE:\ \:FOUND.RECS<1,OPTION[2,99]>
      GOSUB EXEC.SUB
      CTR-=20
      IF CTR<1 THEN CTR=1
      PRINT 'Press ENTER:':
      INPUT AAA
    CASE OPTION # ''
      * ENTER to keep moving forward
      QUIT=1
  END CASE
  PRINT HDR
RETURN
*
IL10.NED:
  OPEN '_HOLD_' TO F.HOLD ELSE STOP 201,'_HOLD_'
  FILE.NAME=FIELD(ANS,' ',2)
  K.FILE=FIELD(ANS,' ',3)
  CALL FILE.OPEN(PROGRAM.NAME, FILE.NAME, F.FILE, 'STOP')
  CALL IDS.READ(R.FILE, F.FILE,  K.FILE, 0, 0, BCI.ERROR)
  IF BCI.ERROR # '' THEN PRINT BCI.ERROR ; R.FILE=''
  R.ORIG=R.FILE
  *
  LOOP
    PRINT DCOUNT(R.FILE,@AM):' fields in record'
    PRINT 'Enter E)dit, L)ist, S)ave or Q)uit:':
    INPUT OPT
    BEGIN CASE
      CASE OPT='L'
        SHOW.BPI=0 ; BPI.XREF=''
        OPEN 'DATABASE.FILES,IL' TO IL ELSE PRINT 201,'DATABASE.FILES,IL' ; RETURN
        OPEN 'IL.BPI' TO IL.BPI ELSE PRINT 201,'IL.BPI' ; RETURN
        READV BPI FROM IL, FILE.NAME, 14 THEN
          * Sample: Attached to FLOAT.INCOME bpi.
          N=DCOUNT(BPI,' ')
          BPI=FIELD(BPI,' ',N-1)
          READ BPI.LAYOUT FROM IL.BPI, BPI THEN
            * Sample: EQUATE GROSS.FINANCE               TO MASTER(1)
            SHOW.BPI=1
            FOR R=1 TO DCOUNT(BPI.LAYOUT,@AM)
              L=TRIM(BPI.LAYOUT<R>)
              IF FIELD(L,' ',1)='EQUATE' THEN
                FLD.NAME=FIELD(L,' ',2)
                FLD.POS=FIELD(FIELD(L,' ',4),'(',2)
                FLD.POS=FIELD(FLD.POS,')',1)
                BPI.XREF<FLD.POS>=FLD.NAME
              END
            NEXT R
          END ELSE
            PRINT 'Cannot read BPI:':BPI
          END
        END ELSE
          PRINT 'Cannot get BPI name for:':FILE.NAME
        END
        *
        PRINT @(-1):'FILE:':FILE.NAME:' ITEM:':K.FILE
        FOR F=1 TO DCOUNT(R.FILE,@AM)
          R=R.FILE<F>
          CONVERT @VM TO "|" IN R
          CONVERT @SVM TO "\" IN R
          IF SHOW.BPI THEN
            PRINT F'R#3':' ':BPI.XREF<F>'L#25':'=':R[1,80]
          END ELSE
            PRINT F'R#3':' ':R
          END
        NEXT F
        PRINT 'PRESS ENTER:':
        INPUT AAA
      CASE OPT='S'
        CALL IDS.WRITE(R.FILE, F.FILE, K.FILE, 0, 0)
        PRINT 'Saved.  Press ENTER to continue:':
        R.ORIG=R.FILE
        INPUT AAA
      CASE OPT='E'
        R=R.FILE
        SWAP CHAR(13):CHAR(10) WITH '||' IN R
        WRITE R ON F.HOLD, K.FILE
        EXECUTE \ED _HOLD_ \:K.FILE
        READ R FROM F.HOLD, K.FILE ELSE R=''
        SWAP '||' WITH CHAR(13):CHAR(10) IN R
        IF R # R.FILE THEN
          PRINT 'Record changed, use S to save'
          R.FILE=R
        END
        DELETE F.HOLD, K.FILE
      CASE OPT='Q'
        IF R.FILE#R.ORIG THEN
          PRINT 'Record changed, are you sure (Y/N):':
          INPUT YORN
          IF YORN # 'Y' THEN OPT=''
        END
    END CASE
  UNTIL OPT='Q' DO
  REPEAT
RETURN
*
BPI:
  OPEN 'DATABASE.FILES,IL' TO IL ELSE STOP 201,'DATABASE.FILES,IL'
  OPEN 'IL.BPI' TO IL.BPI ELSE STOP 201,'IL.BPI'
  BPI=FIELD(ANS,' ',2)
  IF BPI='' THEN PRINT 'Usage: BPI <name of infolease file|name of BPI>' ; RETURN
  * Param 2 can be a BPI or a FILENAME
  READ DUMMY FROM IL.BPI, BPI ELSE
    READV BPI FROM IL, BPI, 14 ELSE PRINT 'Cannot read DATABASE.FILES,IL',BPI ; RETURN
    * Sample: Attached to FLOAT.INCOME bpi.
    N=DCOUNT(BPI,' ')
    BPI=FIELD(BPI,' ',N-1)
    READ DUMMY FROM IL.BPI, BPI ELSE PRINT 'Cannot get BPI name' ; RETURN
  END
  EXEC.LINE=\AE IL.BPI \:BPI
  GOSUB EXEC.SUB
  CLOSE IL
  CLOSE IL.BPI
RETURN
*
RECALL.SHELL:
  DATA 1
  DATA 1
  RECALL=FIELD(ANS,' ',2)
  IF RECALL # '' THEN DATA RECALL
  EXECUTE \RECALL.00\
RETURN
*
FIND.MENU:
  OPEN "DB.MENUS" TO MENU.F ELSE STOP 201,"DB.MENUS"
  STR=FIELD(ANS,' ',2)
  IF STR='' THEN
    PRINT "Enter menu or program to search for : ": ; INPUT STR
    IF STR="" OR STR="/" THEN RETURN
  END
  STR = OCONV(STR,"MCU")
  MENU.LIST=''
  MENU.LIST<1>=1
  MENU.LIST<2>=0
  MENU.CTR=1
  LOOP
    MENU=MENU.LIST<1,MENU.CTR>
    PATH=MENU.LIST<2,MENU.CTR>
    IF MENU='' THEN EXIT
    GOSUB SEARCH.MENU
    MENU.CTR+=1
  REPEAT
  CLOSE MENU.F
RETURN
*
SEARCH.MENU:
  READ R FROM MENU.F, MENU THEN
    TITLES = OCONVS(R<2>,"MCU") ; PROGS  = OCONVS(R<3>,"MCU") ; FLAGS = R<4> ; TYPES = R<5>
    I = DCOUNT(PROGS,@VM)
    FOR F = 1 TO I
      IF INDEX(PROGS<1,F>,STR,1) # 0 OR INDEX(TITLES<1,F>,STR,1) # 0 THEN
        PRINT MENU"R#5":" ":TITLES<1,F>"L#27":"  ":TYPES<1,F>'L#1':" ":PROGS<1,F>"L#50":" ":PATH:',':F
      END
      IF FLAGS<1,F>='M' THEN MENU.LIST<1,-1>=PROGS<1,F> ; MENU.LIST<2,-1>=PATH:',':F
    NEXT F
  END
RETURN
*
BFORMAT:
  STAR  = '*' ; COLON = ':' ; TAB=CHAR(9)
  IND = 0
  *
  * These are all commands that may have ELSE or THEN statements
  * (or blocks) following them
  SPECIAL.CASES = "GET":@AM:"INPUT":@AM:"LOCATE":@AM:"LOCK":@AM:"MATREAD":@AM:"MATREADU":@AM
  SPECIAL.CASES := "MATWRITE":@AM:"MATWRITEU":@AM:"OPEN":@AM:"PROCREAD":@AM
  SPECIAL.CASES := "PROCWRITE":@AM:"READ":@AM:"READNEXT":@AM:"READSEQ":@AM:"READT":@AM:"READU":@AM:"READV":@AM
  SPECIAL.CASES := "READVU":@AM:"REWIND":@AM:"SEEK":@AM:"WEOF":@AM:"WRITESEQ":@AM
  SPECIAL.CASES := "WRITET"
  *
  DEF.INDENT=2
  FORMATS=":":@VM:"BEGIN":@VM:"CASE":@VM:"ELSE":@VM:"END":@VM:"FOR":@VM
  FORMATS :="IF":@VM:"LOOP":@VM:"NEXT":@VM:"REPEAT":@VM:"RETURN":@VM
  FORMATS :="THEN":@VM:"UNTIL":@VM:"WHILE"
  * THIS.IND is the amount this line will be in or outdented
  FORMATS<2>=0:@VM:0:@VM:-1:@VM:0:@VM:-1:@VM:0:@VM:0:@VM
  FORMATS<2> :=0:@VM:-1:@VM:-1:@VM:-1:@VM:0:@VM:-1:@VM:-1
  * NEXT.IND is the amount that all following lines will be indented
  FORMATS<3>=1:@VM:2:@VM:0:@VM:1:@VM:-1:@VM:1:@VM:1:@VM
  FORMATS<3> :=1:@VM:-1:@VM:-1:@VM:-1:@VM:1:@VM:0:@VM:0
  FORMATS<4>=DEF.INDENT
  *
  OPEN B.FILE TO FI ELSE PRINT 'Cannot open ':B.FILE ; RETURN
  READ REC FROM FI,B.ITEM ELSE PRINT "CANNOT READ ":B.FILE:" ":B.ITEM ; RETURN
  *WRITE REC ON FI,B.NAME:".BAK"
  SWAP CHAR(9) WITH SPACE(DEF.INDENT) IN REC
  *
  I = DCOUNT(REC,@AM)
  IF I < 2 THEN RETURN
  FOR F = 1 TO I
    PRINT STAR:
    L = REC<F> ; NEXT.LINE=REC<F+1>
    GOSUB FORMAT.LINE
    REC<F> = L
  NEXT F
  WRITE REC ON FI,B.ITEM
  PRINT STAR ; PRINT I:" lines of ":B.ITEM:" formatted"
  CLOSE FI
RETURN
*
FORMAT.LINE:
  L=TRIM(L,' ','B')
  CONVERT TAB TO "" IN L
  FIRST.WORD = FIELD(L,SPC,1)
  LEN.FIRST.WORD = LEN(FIRST.WORD)
  LOCATE FIRST.WORD IN SPECIAL.CASES BY 'AL' SETTING SPECIAL ELSE SPECIAL = 0
  NUM.SPACES = COUNT(L,SPC) + 1
  LAST.WORD = FIELD(L,SPC,NUM.SPACES)
  NEXT.TO.LAST.WORD = FIELD(L,SPC,NUM.SPACES-1)
  THIS.IND = 0
  NEXT.IND = 0
  BEGIN CASE
    CASE L=""
      L="*" ;* Makes pasting code around easier with no blank lines
    CASE FIRST.WORD[LEN.FIRST.WORD,1] = COLON OR NUM(FIRST.WORD)
      * A label
      IND = 0
      LOCATE COLON IN FORMATS<1> SETTING POS ELSE POS = 0
      THIS.IND = FORMATS<2,POS>
      NEXT.IND = FORMATS<3,POS>
    CASE FIRST.WORD = "IF"
      LOCATE FIRST.WORD IN FORMATS<1> SETTING POS ELSE POS = 0
      IF LAST.WORD = "THEN" THEN
        THIS.IND = FORMATS<2,POS>
        NEXT.IND = FORMATS<3,POS>
      END
    CASE FIRST.WORD = "END"
      SECOND.WORD = FIELD(L,SPC,2)
      IF SECOND.WORD = "ELSE" THEN
        LOCATE "ELSE" IN FORMATS<1> SETTING POS ELSE POS = 0
        THIS.IND = -FORMATS<3,POS>
        NEXT.IND = FORMATS<2,POS>
      END ELSE
        IF SECOND.WORD = "CASE" THEN
          LOCATE "BEGIN" IN FORMATS<1> SETTING POS ELSE POS = 0
          THIS.IND = -FORMATS<3,POS>
          NEXT.IND = -FORMATS<3,POS>
        END ELSE
          LOCATE FIRST.WORD IN FORMATS<1> SETTING POS ELSE POS = 0
          THIS.IND = FORMATS<2,POS>
          NEXT.IND = FORMATS<3,POS>
        END
      END
    CASE SPECIAL
      * Find last word - skip until a space
      IF LAST.WORD = "ELSE" OR LAST.WORD = "THEN" THEN
        LOCATE LAST.WORD IN FORMATS<1> SETTING POS ELSE POS = 0
        THIS.IND = FORMATS<2,POS>
        NEXT.IND = FORMATS<3,POS>
      END
    CASE FIRST.WORD = "FOR" AND NEXT.TO.LAST.WORD = "NEXT"
      * FOR loop on one line means do nothing
    CASE FIRST.WORD = "RETURN" AND TRIM(NEXT.LINE) # "*"
      * RETURN without a blank line means do nothing
    CASE 1
      LOCATE FIRST.WORD IN FORMATS<1> SETTING POS ELSE POS = 0
      IF POS # 0 THEN
        THIS.IND = FORMATS<2,POS>
        NEXT.IND = FORMATS<3,POS>
      END
  END CASE
  L = SPACE((IND+THIS.IND)*DEF.INDENT):L
  *L = STR(TAB,IND+THIS.IND):L ;* In my misguided youth, tabs seemed cool
  IND = IND + NEXT.IND
RETURN
*
GET.LINE:
  * SUBROUTINE GET.LINE(X,LEN,DISP.LEN,XXDATA,RTN)
  * X           = X POS
  * LEN         = MAX ALLOWED LENGTH
  * DISP.LEN    = MAX DISPLAYED LEN
  * XXDATA      = ON INPUT  VARIABLE XXDATA
  *             = ON OUTPUT RETURNED STRING
  * RTN         = SEQ(CHAR PRESSED TO EXIT)
  * -----------------
  * Important globals
  * CP          = Cursor Position, Y coordinate on the screen 0 -> DISP.LEN
  * CH.PTR      = Pointer into string being edited            1 -> LEN
  * POS         = Pointer to first char currently displayed   1 -> LEN
  * ASC.CH      = The numeric value of the key just entered
  *
  ECHO OFF
  XXDATA = ENTRY
  MODE = INSERT ; TEMP.XXDATA = XXDATA
  BASE = @(X) ; MASK = 'L#':DISP.LEN
  PRINT BASE:
  CURR.LEN = LEN(XXDATA)
  GOSUB GO.END
  RTN=''
  *
  LOOP
    PRINT @(X+CP):
    CH=IN()
    ASC.CH = SEQ(CH)
    EXIT.FLAG=FALSE
    BEGIN CASE
      CASE ASC.CH = 1
        GOSUB GO.BEGIN
      CASE ASC.CH = 2
        GOSUB LEFT
      CASE ASC.CH = 4
        GOSUB DEL
      CASE ASC.CH = 5
        GOSUB GO.END
      CASE ASC.CH = 6
        GOSUB RIGHT
      CASE ASC.CH = 8
        GOSUB BACK
      CASE ASC.CH = 9
        GOSUB AUTO.COMPLETE
      CASE ASC.CH = 10
        GOSUB DEL.TO.END
      CASE ASC.CH = 13
        EXIT.FLAG = TRUE
        RTN=13
      CASE ASC.CH = 14
        RTN=2
        EXIT.FLAG=TRUE
      CASE ASC.CH = 16
        RTN=1
        EXIT.FLAG=TRUE
      CASE ASC.CH = 18
        GOSUB INSRT
      CASE ASC.CH = PG.UP.KEY
        EXIT.FLAG=TRUE
        RTN=PG.UP.KEY
      CASE ASC.CH = PG.DOWN.KEY
        EXIT.FLAG=TRUE
        RTN=PG.DOWN.KEY
      CASE ASC.CH = 23
        GOSUB DELETE.WORD
      CASE ASC.CH = 24
        GOSUB FORWARD.WORD
      CASE ASC.CH = 7 OR ASC.CH = 12
        IF ASC.CH = 12 THEN PRINT @(-1):
        XXDATA = ''
        EXIT.FLAG=TRUE
        RTN=13
      CASE ASC.CH = 26
        GOSUB BACK.WORD
      CASE ASC.CH = 27
        GOSUB ESC.KEY
      CASE ASC.CH < 27
        PRINT @(0):ASC.CH:
      CASE ASC.CH = 127
        GOSUB BACK
      CASE 1
        GOSUB ORD
    END CASE
    CURR.LEN = LEN(XXDATA)
  UNTIL EXIT.FLAG DO
  REPEAT
  IF XXDATA[CURR.LEN,1] = SPC THEN XXDATA = XXDATA[1,CURR.LEN-1]
  ECHO ON ; PRINT BASE:XXDATA MASK
  ENTRY=XXDATA
RETURN
*
AUTO.COMPLETE:
  * Grab the current word and figure out max completion
  WORD='' ; WORD.CTR=''
  CH.PTR.TMP=CH.PTR-1
  LOOP
    C=XXDATA[CH.PTR.TMP,1]
  UNTIL C=' ' OR CH.PTR.TMP=0 DO
    WORD=C:WORD
    CH.PTR.TMP-=1
  REPEAT
  *
  * Count which word we're on - there are different auto-completes for 1, 2 or 3+
  IF CH.PTR.TMP=0 THEN
    WORD.CTR=1 ;* Trying to autocomplete a command
    WORD='CMD_':WORD
  END ELSE
    CH.PTR.TMP-=1
    LOOP
      C=XXDATA[CH.PTR.TMP,1]
    UNTIL C=' ' OR CH.PTR.TMP=0 DO
      CH.PTR.TMP-=1
    REPEAT
    IF CH.PTR.TMP=0 THEN
      WORD.CTR=2 ;* Trying to autocomplete a filename
      WORD='FILE_':WORD
    END ELSE
      WORD.CTR=3 ;* Trying to autocomplete from a dictionary
      FNAME=FIELD(XXDATA,' ',2)
      WORD='DICT-':FNAME:'_':WORD
    END
  END
  *
  IF XXDATA[CURR.LEN,1] = SPC THEN XXDATA = XXDATA[1,CURR.LEN-1]
  CURR.LEN=LEN(XXDATA)
  *
  LOOP
    READ AC.LIST FROM AC, WORD ELSE CRT BEEP: ; RETURN
    * Ok, we have some auto-completion candidates, need to do two things
    * 1) Check to see if we're done, return if so, or
    * 2) List top 20 possible completions if there are more than one
    IF DCOUNT(AC.LIST<1>,@VM)=1 AND DCOUNT(AC.LIST<2,1>,@SVM)=1 THEN
      NEWF=AC.LIST<2>[LEN(WORD)+1,999]
      XXDATA:=NEWF:' '
      PRINT BASE:XXDATA:EOS:
      CURR.LEN=LEN(XXDATA)
      GOSUB GO.END
      RETURN
    END ELSE
      CRT CS:@(0,0):BON:PROMPT.DISP:BOFF:XXDATA
      NUM.CP=DCOUNT(AC.LIST<1>,@VM)
      IF NUM.CP>20 THEN NUM.CP=20
      FOR CP=1 TO NUM.CP
        CRT CP'R#2':') ':FIELD(AC.LIST<1,CP>,'_',2,99):' (':
        NUM.CP2=DCOUNT(AC.LIST<2,CP>,@SVM)
        NUM.CP2.MAX=NUM.CP2
        IF NUM.CP2>3 THEN NUM.CP2=3
        FOR CP2=1 TO NUM.CP2
          CRT FIELD(AC.LIST<2,CP,CP2>,'_',2,99):
          IF CP2<NUM.CP2 THEN CRT ',':
        NEXT CP2
        IF NUM.CP2 # NUM.CP2.MAX THEN CRT ' [+':NUM.CP2.MAX-NUM.CP2:']':
        CRT ')'
      NEXT CP
      WORD.CONTINUE=IN()
      ASC.VAL = SEQ(WORD.CONTINUE)
      CRT CS:@(0,0):BON:PROMPT.DISP:BOFF:XXDATA:
      BEGIN CASE
        CASE ASC.VAL=13 OR ASC.VAL=27
          CURR.LEN=LEN(XXDATA)
          GOSUB GO.END
          RETURN
        CASE ASC.VAL>=32 AND ASC.VAL<127
          WORD:=WORD.CONTINUE
          XXDATA:=WORD.CONTINUE
      END CASE
    END
  REPEAT
RETURN
*
ORD:
  * Ordinary key pressed
  IF CH.PTR # LEN+1 THEN
    IF MODE = INSERT THEN
      IF CURR.LEN = LEN THEN
        PRINT BEEP:
        GOTO SKIP1
      END ELSE
        XXDATA = XXDATA[1,CH.PTR-1]:CH:XXDATA[CH.PTR,CURR.LEN]
      END
    END ELSE
      XXDATA = XXDATA[1,CH.PTR-1]:CH:XXDATA[CH.PTR+1,CURR.LEN]
    END
    CH.PTR = CH.PTR + 1
    IF CP # DISP.LEN THEN
      PRINT @(X+CP):CH:
      IF MODE = INSERT THEN
        PRINT XXDATA[CH.PTR,DISP.LEN-CP-1]:
      END
      CP = CP + 1
    END ELSE
      POS = POS + 1
      PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
    END
  END ELSE
    PRINT BEEP:
  END
SKIP1:
RETURN
*
RIGHT:
  * There are 3 situations here -
  * 1 We're pressing the right arrow thru existing text       (CH.PTR = CURR.LEN)
  * 2 We've typed text and are at the end when we press right (CH.PTR > CURR.LEN)
  * 3 We're in the middle of text, pressing the right arrow   (CH.PTR < CURR.LEN)
  IF CH.PTR < LEN THEN
    IF CH.PTR > CURR.LEN THEN PRINT BEEP: ; GOTO SKIP2
    IF CH.PTR = CURR.LEN THEN
      * If the last char is not a space make it one
      IF XXDATA[CURR.LEN,1] # SPC THEN
        XXDATA = XXDATA:SPC
        IF CP # DISP.LEN THEN PRINT @(X+CP+1):SPC:
        CURR.LEN = CURR.LEN + 1
      END ELSE
        PRINT BEEP:
        GOTO SKIP2
      END
    END
    CH.PTR = CH.PTR + 1
    IF CP # DISP.LEN THEN
      * We're not at the end of display so just move the cursor
      CP = CP + 1
    END ELSE
      * We are at the end of the display so leave cursor where
      * it is and scroll through line
      POS = POS + 1
      PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
    END
  END ELSE
    PRINT BEEP:
  END
SKIP2:
RETURN
*
FORWARD.WORD:
  * Tab key pressed - move forwards a word
  IF CH.PTR >= CURR.LEN THEN
    PRINT BEEP:
  END ELSE
    LOOP
      CH.PTR = CH.PTR + 1
      CP = CP + 1
    UNTIL XXDATA[CH.PTR,1] = SPC OR CH.PTR = CURR.LEN DO
    REPEAT
    IF CH.PTR # CURR.LEN THEN
      LOOP
        CH.PTR = CH.PTR + 1
        CP = CP + 1
      UNTIL XXDATA[CH.PTR,1] # SPC OR CH.PTR = CURR.LEN DO
      REPEAT
    END
    IF CP > DISP.LEN THEN
      CP = DISP.LEN
      POS = CH.PTR - DISP.LEN
      PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
    END
  END
RETURN
*
LEFT:
  * If we're not at the start of data, move left
  IF CH.PTR # 1 THEN
    CH.PTR = CH.PTR - 1
    IF CP # 0 THEN
      * We're not at the start of the display so just move the cursor
      CP = CP - 1
    END ELSE
      * We are at the start of the display so leave cursor and scroll
      POS = POS - 1
      PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
    END
  END ELSE
    PRINT BEEP:
  END
RETURN
*
DEL:
  * Delete the character at the cursor and redisplay from this point
  XXDATA = XXDATA[1,CH.PTR-1]:XXDATA[CH.PTR+1,CURR.LEN]
  CURR.LEN = CURR.LEN - 1
  PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
RETURN
*
BACK:
  * Backspace key pressed
  IF CH.PTR # 1 THEN
    CH.PTR = CH.PTR - 1
    XXDATA = XXDATA[1,CH.PTR-1]:XXDATA[CH.PTR+1,CURR.LEN]
    CURR.LEN = CURR.LEN - 1
    IF CP # 0 THEN
      CP = CP - 1
    END ELSE
      POS = POS - 1
    END
    PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
  END ELSE
    PRINT BEEP:
  END
RETURN
*
INSRT:
  * Toggle between insert and replace modes
  MODE = -MODE
RETURN
*
ESC.KEY:
  * ESC pressed, or extended key - wyse50 arrow keys
  * Get next char of extended command
  ALLOW = 0
  EXT.KEY=IN()
  EXT = SEQ(EXT.KEY)
  EXT.KEY = OCONV(EXT.KEY,'MCU')
  BEGIN CASE
    CASE EXT.KEY = 'D'
      GOSUB DELETE.WORD
    CASE EXT.KEY = '[' OR EXT.KEY = 'O'
      EXT.KEY=IN()
      BEGIN CASE
        CASE EXT.KEY = 'C'
          GOSUB RIGHT
        CASE EXT.KEY = 'D'
          GOSUB LEFT
        CASE EXT.KEY = 'A'
          RTN=1
          EXIT.FLAG=TRUE
        CASE EXT.KEY = 'B'
          RTN=2
          EXIT.FLAG=TRUE
      END CASE
  END CASE
RETURN ; * From ESC key
*
BACK.WORD:
  * Shift tab pressed - go back a word
  IF CH.PTR = 1 THEN
    PRINT BEEP:
  END ELSE
    * 2 situations - either we're in a word already or
    * we're at the start of a word
    * If in a word - loop to the start of the word
    * otherwise skip spaces, and then move to start of word
    IF XXDATA[CH.PTR-1,1] # SPC THEN
      LOOP
      UNTIL XXDATA[CH.PTR-1,1] = SPC OR CH.PTR = 1 DO
        CH.PTR = CH.PTR - 1
        CP = CP - 1
      REPEAT
    END ELSE
      * Skip spaces
      LOOP
      UNTIL XXDATA[CH.PTR-1,1] # SPC OR CH.PTR = 1 DO
        CH.PTR = CH.PTR - 1
        CP = CP - 1
      REPEAT
      IF CH.PTR > 1 THEN
        * At word end - move to start of word
        LOOP
        UNTIL XXDATA[CH.PTR-1,1] = SPC OR CH.PTR = 1 DO
          CH.PTR = CH.PTR - 1
          CP = CP - 1
        REPEAT
      END
    END
    IF CP < 0 THEN
      CP = 0
      POS = CH.PTR
      PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
    END
  END
RETURN
*
DEL.TO.END:
  * Delete from cursor to end of line
  IF CH.PTR = 1 THEN
    XXDATA = ''
    CP = 0
    POS = 1
  END ELSE
    XXDATA = XXDATA[1,CH.PTR-1]
  END
  CURR.LEN = LEN(XXDATA)
  PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
RETURN
*
DELETE.WORD:
  * Delete to space at right of cursor
  IF CH.PTR >= CURR.LEN THEN
    PRINT BEEP:
  END ELSE
    C = CH.PTR
    LOOP
      C = C + 1
    UNTIL XXDATA[C,1] = SPC OR C = CURR.LEN DO
    REPEAT
    XXDATA = XXDATA[1,CH.PTR-1]:XXDATA[C+1,CURR.LEN]
    CURR.LEN = CURR.LEN - C + CH.PTR - 1
    PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
  END
RETURN
*
GO.BEGIN:
  * Go to the start of data and redisplay
  CP = 0
  CH.PTR = 1
  POS = 1
  PRINT BASE:XXDATA MASK:
RETURN
*
GO.END:
  * Move to the end of data and redisplay
  IF XXDATA[CURR.LEN,1] # SPC THEN
    XXDATA = XXDATA:SPC
    CURR.LEN = CURR.LEN + 1
  END
  IF CURR.LEN < DISP.LEN THEN
    CP = CURR.LEN - 1
    POS = 1
  END ELSE
    CP = DISP.LEN - 1
    POS = CURR.LEN - DISP.LEN + 1
  END
  CH.PTR = CURR.LEN
  PRINT BASE:XXDATA[POS,DISP.LEN] MASK:
RETURN
*
ATB.FIND:
  OPEN "IL.TB.CHNG.LOG" TO IL.TB.CHNG.LOG ELSE STOP 201,"IL.TB.CHNG.LOG"
  OPEN "IL.CHANGE.LOG.INDEX" TO IL.CHANGE.LOG.INDEX ELSE STOP 201,"IL.CHANGE.LOG.INDEX"
  OPEN "REV.ATB.LOG" TO REV.ATB.LOG ELSE STOP 201,"REV.ATB.LOG"
  OPEN "HELP.TEXT.USA" TO HELP.TEXT.USA ELSE STOP 201,"HELP.TEXT.USA"
  MSK="L#22"
  ATB = FIELD(ANS," ",2)
  *
  IF ATB="" THEN
    PRINT "ENTER ATB NAME: ": ; INPUT ATB
    IF ATB="" OR ATB="/" THEN RETURN
  END
  *
  READ AREC FROM REV.ATB.LOG,ATB ELSE
    ATBREC="" ; TEST=""
    EXEC.LINE=\SSELECT REV.ATB.LOG = "[\:ATB:\]"\
    GOSUB EXEC.SUB
    CTR=0
    LOOP
      READNEXT ID ELSE EXIT
      CTR+=1
      PRINT CTR "L#4":ID
      ATBREC<CTR>=ID
      IF MOD(CTR,23)=0 THEN PRINT "[ENTER]": ; INPUT TEST
      IF TEST = "/" THEN EXIT
    REPEAT
    PRINT
    PRINT "Enter choice (1-":CTR:"): ": ; INPUT CHOICE
    IF CHOICE="" OR CHOICE="/" THEN RETURN
    ATB=ATBREC<CHOICE>
    IF ATB="" THEN RETURN
    READ AREC FROM REV.ATB.LOG,ATB ELSE PRINT 'Not found' ; RETURN
  END
  *
  MAXV=DCOUNT(AREC<5>,@VM)
  FNAMES=""
  FOR J=1 TO MAXV
    IF AREC<5,J>[1,2] # "BK" THEN FNAMES :=AREC<5,J>:",":AREC<6,J>:"  "
  NEXT J
  *
  READV CKEY FROM IL.CHANGE.LOG.INDEX,AREC<24>,1 ELSE CKEY=""
  READ CHNG_REC FROM IL.TB.CHNG.LOG,CKEY ELSE CHNG_REC=""
  READ HELP.TEXT FROM HELP.TEXT.USA,ATB ELSE HELP.TEXT= " NOT FOUND"
  CONVERT "~" TO "" IN HELP.TEXT
  DEP=AREC<16>
  CONVERT @VM TO "," IN DEP
  PRINT ATB
  PRINT
  PRINT "IL.BPI" MSK               :AREC<1>
  PRINT "FILE(S)" MSK              :FNAMES
  PRINT "FIELD" MSK                :AREC<2>
  PRINT "CHANGE LOG INDEX" MSK     :AREC<24>
  PRINT "CHANGE LOG KEY" MSK       :CKEY
  PRINT "TYPE" MSK                 :AREC<3>
  PRINT "MASK" MSK                 :AREC<10>
  PRINT "S/MV" MSK                 :AREC<14>
  PRINT "CONTROLLING/DEPENDENT" MSK:AREC<15>
  PRINT "SUB/MASTER FIELDS" MSK    :DEP
  PRINT "CHG DESCRIPTION" MSK      :CHNG_REC<1>
  IF AREC<32> # "" THEN
    PRINT "COMMENTS" MSK           :AREC<32>
    PRINT
  END
  PRINT
  MAXV=DCOUNT(HELP.TEXT<2>,@VM)
  FOR J=1 TO MAXV
    PRINT HELP.TEXT<2,J>
  NEXT J
RETURN
*
GET.TERM.WIDTH:
  T='/tmp/':@LOGNAME:'.term'
  EXEC.LINE=\!tput cols > \:T ;* Always returns 80 if you capture, so use tmp file
  CAP.ACTIVE=FALSE
  GOSUB EXEC.SUB
  EXEC.LINE=\!cat \:T
  CAP.ACTIVE=TRUE
  GOSUB EXEC.SUB
  TERM.WIDTH=EXEC.CAP<1>
  EXEC.LINE=\!rm \:T
  GOSUB EXEC.SUB
  EXEC.LINE=\TERM \:TERM.WIDTH ; GOSUB EXEC.SUB
RETURN
*
PICKLE:
  PICKLE.LIST=''
  *
  IF FIELD(ANS,' ',2)='DICT' THEN
    FILE='DICT ':FIELD(ANS,' ',3)
    ITEM=FIELD(ANS,' ',4)
  END ELSE
    FILE=FIELD(ANS,' ',2)
    ITEM=FIELD(ANS,' ',3)
  END
  OPEN FILE TO FVAR ELSE
    PRINT 'Cannot open ':FILE
    RETURN
  END
  READ REC FROM FVAR, ITEM ELSE
    PRINT 'Cannot read ':FILE:' ':ITEM
    RETURN
  END
  BLOB='R=""'
  IF FILE[1,5]='DICT ' THEN DEL REC<9> ; DEL REC<8> ;* Avoid CD probs
  INS ITEM BEFORE REC<1>
  INS FILE BEFORE REC<1>
  SWAP @AM WITH '#AM#' IN REC   ; SWAP @VM WITH '#VM#' IN REC
  SWAP @SVM WITH '#SVM#' IN REC ; SWAP '\' WITH '#134#' IN REC
  BLOB<-1>=\S=''\
  LOOP
    T=REC[1,70]
    BLOB<-1>='S:=\':T:'\'
    REC=REC[71,LEN(REC)]
  UNTIL LEN(REC)=0 DO
  REPEAT
  BLOB<-1>='R<-1>=S'
  BLOB<-1>='*'
  *
  * Write out basic code that when run will recreate the record
  BLOB<-1>='FOR F=1 TO DCOUNT(R,@AM)'
  BLOB<-1>='  REC=R<F>'
  BLOB<-1>='  SWAP "#AM#" WITH @AM IN REC   ; SWAP "#VM#" WITH @VM IN REC'
  BLOB<-1>='  SWAP "#SVM#" WITH @SVM IN REC ; SWAP "#134#" WITH "\" IN REC'
  BLOB<-1>='  FILE=REC<1> ; DEL REC<1>'
  BLOB<-1>='  ITEM=REC<1> ; DEL REC<1>'
  BLOB<-1>='  PRINT FILE:" ":ITEM:'
  BLOB<-1>='  OPEN FILE TO FVAR ELSE STOP 201, FILE'
  BLOB<-1>='  WRITE REC ON FVAR,ITEM ; PRINT "*"'
  BLOB<-1>='  CLOSE FVAR'
  BLOB<-1>='NEXT F'
  FOR I=1 TO DCOUNT(BLOB,@AM)
    PRINT BLOB<I>
  NEXT I
RETURN
*
SETTINGS:
  PRINT CS:
  PRINT 'COMMAND.SEP  = ':SETTINGS<1>
  PRINT 'STACK.CHAR   = ':SETTINGS<2>
  PRINT 'PROG.CHAR    = ':SETTINGS<3>
  PRINT 'MAX.STACK    = ':SETTINGS<4>
  PRINT 'WP.VERB      = ':SETTINGS<5>
  PRINT 'ED.VERB      = ':SETTINGS<6>
  PRINT 'STAMP.STRING = ':SETTINGS<7>
  PRINT 'GET.LINE.FLAG= ':SETTINGS<8>
  PRINT 'WORK.FILE    = ':SETTINGS<9>
  PRINT 'MCU.ON       = ':SETTINGS<10>
  PRINT 'STARTUP      = ':SETTINGS<11>
  PRINT 'PROMT        = ':SETTINGS<12>
  PRINT 'X.DISP       = ':SETTINGS<13>
  PRINT 'DEF.SHELL    = ':SETTINGS<14>
  PRINT ; PRINT 'Hit ENTER to accept the current default, / to Cancel'
  X=18
  LEN=30
  DISP.LEN=30
  *
  PRINT
  PRINT 'The command seperator is used to run multiple commands from one entry'
  PRINT 'E.g. COUNT VOC ; COUNT VOC WITH F1 = "C" will run both count commands'
  PRINT 'Current value:':SETTINGS<1>
  PRINT 'COMMAND SEPERATOR:':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<1>
  SETTINGS<1>=ENTRY
  *
  PRINT
  PRINT 'The stack character is what to prefix command stack operations with'
  PRINT 'E.g. .L or .R87 or .D uses a stack character of "."'
  PRINT 'Current value:':SETTINGS<2>
  PRINT 'STACK CHAR       :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<2>
  SETTINGS<2>=ENTRY
  *
  PRINT
  PRINT 'The program character is what to prefix program stack operations with'
  PRINT 'E.g. /W2 or /B3 or /L uses a program character of "/"'
  PRINT 'Current value:':SETTINGS<3>
  PRINT 'PROG CHAR        :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<3>
  SETTINGS<3>=ENTRY
  *
  PRINT
  PRINT 'Max lines is the maximum number of lines to hold in the command stack'
  PRINT 'E.g. 9999'
  PRINT 'Current value:':SETTINGS<4>
  PRINT 'MAX # LINES      :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<4>
  SETTINGS<4>=ENTRY
  *
  PRINT
  PRINT 'Screen editor is what command to run to edit a program visually'
  PRINT 'E.g. VI or !emacs or !/home/dsiroot/joe'
  PRINT 'Current value:':SETTINGS<5>
  PRINT 'SCREEN EDITOR    :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<5>
  SETTINGS<5>=ENTRY
  *
  PRINT
  PRINT 'Line editor is what command to run to edit a program'
  PRINT 'E.g. AE or ED'
  PRINT 'Current value:':SETTINGS<6>
  PRINT 'LINE EDITOR      :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<6>
  SETTINGS<6>=ENTRY
  *
  PRINT
  PRINT 'Header string is not currently used'
  PRINT 'HEADER STRING    :':SETTINGS<7>
  *
  PRINT
  PRINT 'Use enhanced input commands, allowing editing with arrow keys'
  PRINT 'Or just use plain INPUT command'
  PRINT 'Current value:':SETTINGS<8>
  PRINT 'USE GET.LINE SUBR:':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<8>
  IF ENTRY='Y' OR ENTRY='1' THEN ENTRY='1' ELSE ENTRY='0'
  SETTINGS<8>=ENTRY
  *
  PRINT
  PRINT 'Default file for basic programs if none specifed'
  PRINT 'E.g. BP'
  PRINT 'Current value:':SETTINGS<9>
  PRINT 'WORK FILE        :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<9>
  SETTINGS<9>=ENTRY
  *
  PRINT
  PRINT 'Convert commands to upper case before running'
  PRINT 'E.g. 1 or 0, Y or N'
  PRINT 'Current value:':SETTINGS<10>
  PRINT 'CONVERT TO UCASE :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<9>
  IF ENTRY='Y' OR ENTRY='1' THEN ENTRY='1' ELSE ENTRY='0'
  SETTINGS<9>=ENTRY
  *
  PRINT
  PRINT 'Command to run when stack first starts'
  PRINT 'E.g. LISTUSER ; WHO'
  PRINT 'Current value:':SETTINGS<11>
  PRINT 'STARTUP COMMAND  :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<11>
  SETTINGS<11>=ENTRY
  *
  PRINT
  PRINT 'Default Prompt to display, use .P to change this'
  PRINT 'PROMPT           :':SETTINGS<12>
  PRINT
  PRINT 'Adjustment for input position (if you use #R, then CR+LF is inserted,'
  PRINT 'and an adjustment of -2 is needed.  Use .P to change this'
  PRINT 'X DISP FOR PROMPT:':SETTINGS<13>
  *
  PRINT
  PRINT 'Default shell to use with !command'
  PRINT 'E.g. ksh, bash, /usr/bin/ksh, /opt/freeware/bin/bash'
  PRINT 'Current value:':SETTINGS<14>
  PRINT 'SHELL            :':
  INPUT ENTRY
  IF ENTRY = '/' THEN RETURN
  IF ENTRY = ''  THEN ENTRY=SETTINGS<14>
  SETTINGS<14>=ENTRY
  *
  WRITE SETTINGS ON HOME.F, SETTING.ITEM
RETURN
*
LISTA:
  OPEN 'ACC' TO ACC.F ELSE STOP 201,'ACC'
  OPEN 'INFO.STATUS' TO INFO.STATUS ELSE STOP 201,'INFO.STATUS'
  SELECT ACC.F
  USER.LIST=''
  LOOP
    READNEXT PORT ELSE EXIT
    READ REC FROM ACC.F, PORT THEN
      READ MENU FROM INFO.STATUS, PORT'R%3' ELSE MENU='TCL'
      MENU=MENU<DCOUNT(MENU,@AM)> ;* Show the last item
      USER=REC<5>
      DATE=REC<2>
      TIME=REC<3>
      LOCATE PORT IN USER.LIST<4> BY 'AR' SETTING POS ELSE NULL
      INS USER BEFORE USER.LIST<1,POS>
      INS DATE BEFORE USER.LIST<2,POS>
      INS TIME BEFORE USER.LIST<3,POS>
      INS PORT BEFORE USER.LIST<4,POS>
      INS MENU BEFORE USER.LIST<5,POS>
    END
  REPEAT
  *GET.LOCKS
  LOCK.LIST=''
  FLIST=''
  FLIST<-1>='AS.FEATURE'
  FLIST<-1>='AS.MASTER'
  FLIST<-1>='AUVB.PARAMETER'
  FLIST<-1>='BQ.PARAMETER'
  FLIST<-1>='CS.MASTER'
  FLIST<-1>='DATA.MASKING.PARAMETER'
  FLIST<-1>='DB.RECORD.LOCKS'
  FLIST<-1>='DE.MASTER'
  FLIST<-1>='FIELD.SECURITY'
  FLIST<-1>='INFO-SYSTEM'
  FLIST<-1>='IT.INSURANCE'
  FLIST<-1>='IT.INSURANCE.AGENT'
  FLIST<-1>='LS.BANK.DEPOSIT'
  FLIST<-1>='LS.DISCOUNT.PACKAGE'
  FLIST<-1>='LS.DISCOUNT.WORKSHEET'
  FLIST<-1>='LS.GL.HISTORY'
  FLIST<-1>='LS.MASTER'
  FLIST<-1>='LS.POST.DATED.CHECK'
  FLIST<-1>='LS.SUPER.QUOTE'
  FLIST<-1>='LS.WK.CASH'
  FLIST<-1>='MISC'
  FLIST<-1>='MM.GROUP'
  FLIST<-1>='PARAMETER'
  FLIST<-1>='PROCESSOR.PARAMETER'
  FLIST<-1>='TRED.FUTURE.PROC.DATES'
  FLIST<-1>='USERS.MENUS'
  FLIST<-1>='WL.FOLLOW.UP'
  FLIST<-1>='WL.PARAMETER'
  *
  FOR G=1 TO DCOUNT(FLIST,@AM)
    FILE='DB.RECORD.LOCKS,':FLIST<G>
    OPEN FILE TO FVAR THEN
      SELECT FVAR
      LOOP
        READNEXT LOCK.ID ELSE EXIT
        READ REC FROM FVAR, LOCK.ID THEN
          PORT=REC<1>
          DATE=REC<2>
          TIME=REC<3>
          USER=REC<4>
          LOCK.LIST<1,-1>=FILE
          LOCK.LIST<2,-1>=LOCK.ID
          LOCK.LIST<3,-1>=PORT
          LOCK.LIST<4,-1>=DATE
          LOCK.LIST<5,-1>=TIME
          LOCK.LIST<6,-1>=USER
          LOCATE PORT IN USER.LIST<4> SETTING POS THEN
            USER.LIST<6,POS>=LOCK.ID:',':USER.LIST<6,POS>
          END
        END
      REPEAT
      CLOSE FVAR
    END
  NEXT G
  *
  PRINT @(-1):'USERS'
  PRINT
  PRINT 'Port':' ':'User''L#12':' ':'Date''L#10':' ':'Time''L#8':' ':
  PRINT 'Time On''L#8':' ':'Menu''L#30':' ':'L'
  PRINT '----':' ':STR('-',12):' ':STR('-',10):' ':STR('-',8):' ':
  PRINT STR('-',8):' ':STR('-',30):' ':'-'
  FOR F=1 TO DCOUNT(USER.LIST<1>,@VM)
    DUR=TIME()-USER.LIST<3,F>
    IF DUR<0 THEN DUR+=86400 ;* Roll over midnight, add back number of seconds in a day
    PRINT USER.LIST<4,F>'R#4':' ':
    PRINT USER.LIST<1,F>'L#12':' ':
    PRINT USER.LIST<2,F>'D4/':' ':
    PRINT USER.LIST<3,F>'MTS':' ':
    PRINT DUR'MTS':' ':
    PRINT USER.LIST<5,F>'L#30':' ':
    IF USER.LIST<6,F>#'' THEN PRINT '*' ELSE PRINT ' '
  NEXT F
  *
  PRINT
  PRINT 'LOCKS'
  PRINT
  PRINT 'Table''L#20':' ':'ID''L#25':' ':'Port''L#4':' ':
  PRINT 'Date''L#5':' ':'Time''L#5':' ':'User''L#15'
  PRINT STR('-',20):' ':STR('-',25):' ':STR('-',4):' ':
  PRINT STR('-',5):' ':STR('-',5):' ':STR('-',15)
  FOR L=1 TO DCOUNT(LOCK.LIST<1>,@VM)
    FILE=FIELD(LOCK.LIST<1,L>,',',2)
    PRINT FILE'L#20':' ':LOCK.LIST<2,L>'L#25':' ':LOCK.LIST<3,L>'R#4':' ':
    PRINT (LOCK.LIST<4,L>'D4/')[1,5]:' ':LOCK.LIST<5,L>'MT':' ':LOCK.LIST<6,L>'L#15'
  NEXT L
  *
  CLOSE ACC.F
  CLOSE INFO.STATUS
  *
RETURN
*
SEARCH.BY.EXAMPLE:
  * Calculate all possible ATB's for an example contract
  @ID=ID
  IF FILE='' OR @ID='' THEN
    PRINT 'Usage: SE <FNAME> <ID>'
    RETURN
  END
  OPEN FILE TO F ELSE PRINT 'Cannot open ':FILE ; RETURN
  OPEN "DICT ":FILE TO @DICT ELSE PRINT 'Cannot open DICT ':FILE ; RETURN
  READ @RECORD FROM F, @ID ELSE PRINT 'Cannot read ':@ID:' in ':FILE ; RETURN
  CLOSE F
  OUTPUT=''
  EXECUTE \SSELECT DICT \:FILE:\ WITH F1 = "I" USING DICT VOC\
  LOOP
    READNEXT FLD ELSE EXIT
    PRINT FLD:'=':
    VAL=CALCULATE(FLD)
    PRINT VAL
    IF @CONV # '' THEN VAL=OCONV(VAL,@CONV)
    *OUTPUT<-1>=FLD:'=':VAL
  REPEAT
  WRITE OUTPUT ON VOC, 'OUTPUT.TMP'
  EXECUTE \AE VOC OUTPUT.TMP\
RETURN
*
IL10.XREF:
  FILE.NAME = FIELD(ANS,' ',2)
  FIELD.NAME = FIELD(ANS,' ',3)
  SELECT.HDR=\BPI,FILE_NAME,FIELD_NAME,STRING_POS,TABLE_NAME,COLUMN_NAME,VALUE_TYPE,FIELD_TYPE\
  SELECT.COMMAND = \SELECT\
  SELECT.COMMAND := \ BPI, FILE_NAME, FIELD_NAME, STRING_POS, TABLE_NAME, COLUMN_NAME, VALUE_TYPE, FIELD_TYPE\
  IF INDEX(FILE.NAME,'%',1) THEN
    SELECT.COMMAND := \ FROM METADATA_FIELDS WHERE (FILE_NAME LIKE '\:FILE.NAME:\' OR TABLE_NAME LIKE '\:FILE.NAME:\')\
  END ELSE
    SELECT.COMMAND := \ FROM METADATA_FIELDS WHERE (FILE_NAME = '\:FILE.NAME:\' OR TABLE_NAME = '\:FILE.NAME:\')\
  END
  IF FIELD.NAME # '' THEN SELECT.COMMAND :=\ AND FIELD_NAME LIKE '%\:FIELD.NAME:\%'\
  SELECT.COMMAND := \ ORDER BY FILE_NAME, STRING_POS\
  *
  GOSUB IL10.SEL
RETURN
*
IL10.AF:
  FLD = FIELD(ANS,' ',2)
  SELECT.HDR=\BPI,FILE_NAME,FIELD_NAME,MV_POS,TABLE_NAME,COLUMN_NAME,MV/S,TYPE,LEN,SCALE\
  SELECT.COMMAND = \SELECT BPI,FILE_NAME,FIELD_NAME,STRING_POS,TABLE_NAME,COLUMN_NAME,VALUE_TYPE,FIELD_TYPE,FIELD_LENGTH,SCALE\
  SELECT.COMMAND  :=\ FROM METADATA_FIELDS\
  SELECT.COMMAND  :=\ WHERE FIELD_NAME LIKE '%\:FLD:\%' OR COLUMN_NAME LIKE '%\:FLD:\%'\
  GOSUB IL10.SEL
RETURN
*
IL10.DESC:
  TABLE = FIELD(ANS,' ',2)
  SELECT.HDR=\COL,COLUMN_NAME,DATA_TYPE\
  SELECT.COMMAND = \SELECT ORDINAL_POSITION, COLUMN_NAME, DATA_TYPE FROM INFORMATION_SCHEMA.COLUMNS\
  SELECT.COMMAND:= \ WHERE TABLE_NAME = '\:TABLE:\'\
  GOSUB IL10.SEL
RETURN
*
IL10.NSEL:
  PRMT=1
  EXECLINE='SELECT ':FIELD(ANS,' ',2,999)
  CALL EXECUTE.SELECT.SUB(EXECLINE,ERR.MSG,1,'',0,SELECTED.LIST,1,'',0,'',0,0)
  CTR=0
  LOOP
    READNEXT ID FROM SELECTED.LIST ELSE EXIT
    CTR+=1
    CRT CTR'R#6':') ':ID
    IF CTR/20=INT(CTR/20) AND PRMT THEN
      CRT ':':
      INPUT AAA
      IF AAA = '/' OR AAA='Q' THEN STOP
      IF AAA = 'N' THEN PRMT=0
    END
  REPEAT
RETURN
*
SQL.SEL:
  SELECT.HDR=''
  SELECT.COMMAND=FIELD(ANS,' ',2,200)
  GOSUB IL10.SEL
RETURN
*
SQL.FILE:
  SELECT.HDR=''
  FILE=FIELD(ANS,' ',2) ;* Spaces in file name are not supported
  OSREAD SELECT.COMMAND FROM FILE THEN
  CONVERT @AM TO ' ' IN SELECT.COMMAND
  SWAP CHAR(13):CHAR(10) WITH ' ' IN SELECT.COMMAND
  GOSUB IL10.SEL
END ELSE
  CRT FILE:' not found'
END
RETURN
*
SQL.SEL.LIST:
  LIST=FIELD(ANS,' ',2)
  SELECT.COMMAND=FIELD(ANS,' ',3,200)
  PRINT SELECT.COMMAND
  PARAM=''
  CALL IDS.EXECUTE.ANSI.SQL(SELECT.COMMAND,PARAM,'','',KEY.LIST)
  CALL CONVERT.LIST(KEY.LIST)
  EXECUTE \SAVE.LIST \:LIST PASSLIST KEY.LIST
RETURN
*
IL10.SEL:
  PARAM=''
  CONVERT ',' TO @VM IN SELECT.HDR
  PRINT SELECT.COMMAND
  CALL IDS.EXECUTE.ANSI.SQL(SELECT.COMMAND,PARAM,'','',KEY.LIST)
  *SUBROUTINE IDS.EXECUTE.ANSI.SQL.ERROR(SQL.STRING, PARAMS, COLUMNS, TYPES, RESULTS.ARRAY, ERROR, OFFSET, LIMIT, SORT.COLUMN, ENHANCE, ALTER.SESSION,TRANSFER.CONTRACT)
  CALL IDS.EXECUTE.ANSI.SQL.ERROR(SELECT.COMMAND, PARAM, '', '', KEY.LIST, ERR, '', '', '', '0', '','')
  DISP.MAX=DCOUNT(KEY.LIST,@AM)
  PRINT DISP.MAX:' items selected, ERR=':ERR
  IF DISP.MAX=0 THEN RETURN
  *
  * Get widths
  W=''
  IF SELECT.HDR # '' THEN
    INS SELECT.HDR BEFORE KEY.LIST<1>
    DISP.MAX+=1
  END
  FOR R=1 TO DISP.MAX
    FOR C=1 TO DCOUNT(KEY.LIST<R>,@VM)
      L=LEN(KEY.LIST<R,C>)
      IF L > W<C> THEN W<C>=L
    NEXT C
  NEXT R
  *
  * Print the header
  DISP.START=1
  IF SELECT.HDR # '' THEN
    DISP.START=2
    FOR C=1 TO DCOUNT(KEY.LIST<1>,@VM)
      PRINT FMT(KEY.LIST<1,C>,'L#':W<C>):' ':
    NEXT C
    PRINT
    *
    FOR C=1 TO DCOUNT(KEY.LIST<1>,@VM)
      PRINT STR('-',W<C>):' ':
    NEXT C
    PRINT
  END
  * Now the data
  FOR R=DISP.START TO DISP.MAX
    IF SELECT.HDR = '' THEN CRT R,:
    FOR C=1 TO DCOUNT(KEY.LIST<R>,@VM)
      PRINT FMT(KEY.LIST<R,C>,'L#':W<C>):' ':
    NEXT C
    PRINT
  NEXT R
RETURN
*
LIST.PARAM:
  P=''
  P<1,-1>=STR('-', 18)         ; P<2,-1>=STR('-',33)                         ; P<3,-1>=STR('-',30)
  P<1,-1>='Key Prefix'         ; P<2,-1>='InfoLease Table'                   ; P<3,-1>='RDBMS Table'
  P<1,-1>=STR('-', 18)         ; P<2,-1>=STR('-',33)                         ; P<3,-1>=STR('-',30)
  P<1,-1>='*00'                ; P<2,-1>='Lessor Parameters'                 ; P<3,-1>='LESSOR_NF'
  P<1,-1>='*00A'               ; P<2,-1>='Temporary Lessor'                  ; P<3,-1>='TEMP_LESSOR_NF'
  P<1,-1>='*00B'               ; P<2,-1>='Additional Lessor'                 ; P<3,-1>='ADDL_LESSOR_NF'
  P<1,-1>='*00GL'              ; P<2,-1>='Multiple Bookset'                  ; P<3,-1>='MULTIPLE_BOOKSET_NF'
  P<1,-1>='*00UD'              ; P<2,-1>='Lessor User-Defined'               ; P<3,-1>='LESSOR_USER_NF'
  P<1,-1>='*ACH'               ; P<2,-1>='Lessor ACH Flags'                  ; P<3,-1>='LESSOR_ACH_FLAGS_NF'
  P<1,-1>='*ADVICE*'           ; P<2,-1>='Advice Follow-up'                  ; P<3,-1>='ADVICE_FOLLOW_UP_NF'
  P<1,-1>='*COMMISSION'        ; P<2,-1>='Commission'                        ; P<3,-1>='COMMISSION_NF'
  P<1,-1>='*WARNING.MESSAGES'  ; P<2,-1>='Lessor Warning Messages'           ; P<3,-1>='LESSOR_WARNING_MESSAGES_NF'
  P<1,-1>='[Lessor Id]'        ; P<2,-1>='Lessor Address'                    ; P<3,-1>='LS_ADDRESS_NF'
  P<1,-1>='00*00'              ; P<2,-1>='Lease System Parameters'           ; P<3,-1>='PARAMETER_NF'
  P<1,-1>='00*00A'             ; P<2,-1>='Temporary Lease System Params'     ; P<3,-1>='TEMP_PARAMETER_NF'
  P<1,-1>='00*00B'             ; P<2,-1>='Additional Lease System Params'    ; P<3,-1>='ADDL_PARAMETER_NF'
  P<1,-1>='00*00IRR'           ; P<2,-1>='IRR Parameter'                     ; P<3,-1>='IRR_PARAMETER_NF'
  P<1,-1>='00*00RPT'           ; P<2,-1>='Report Parameter'                  ; P<3,-1>='RPT_PARAMETER_NF'
  P<1,-1>='10*'                ; P<2,-1>='Personnel'                         ; P<3,-1>='PERSONNEL_INFO_NF'
  P<1,-1>='12*'                ; P<2,-1>='Office'                            ; P<3,-1>='OFFICE_DATA_NF'
  P<1,-1>='13*'                ; P<2,-1>='Vendor/Dealer'                     ; P<3,-1>='PARAM_ADDRESS_NF'
  P<1,-1>='13APA*'             ; P<2,-1>='Additional Vendor/Dealer Address'  ; P<3,-1>='ADDL_PARAM_ADDRESS_NF'
  P<1,-1>='14*'                ; P<2,-1>='Reason Code'                       ; P<3,-1>='REASON_CODE_NF'
  P<1,-1>='15*'                ; P<2,-1>='Collateral Code'                   ; P<3,-1>='TB_COLLATERAL_NF'
  P<1,-1>='16*'                ; P<2,-1>='Equipment Category'                ; P<3,-1>='EQUIP_CODE_DEFAULTS_NF'
  P<1,-1>='17*'                ; P<2,-1>='Tax Description'                   ; P<3,-1>='TAX_DESC_TBL_NF'
  P<1,-1>='18*'                ; P<2,-1>='Property Tax Status'               ; P<3,-1>='PROP_TAX_STATUS_TBL_NF'
  P<1,-1>='19*'                ; P<2,-1>='Region'                            ; P<3,-1>='REGION_TABLE_NF'
  P<1,-1>='20*'                ; P<2,-1>='Remit To'                          ; P<3,-1>='REMIT_ADDRESS_NF'
  P<1,-1>='21*'                ; P<2,-1>='Base Rate Indicator'               ; P<3,-1>='FLOAT_BANK_NF'
  P<1,-1>='22*'                ; P<2,-1>='Broker Address'                    ; P<3,-1>='BROKER_TABLE_NF'
  P<1,-1>='23*'                ; P<2,-1>='General Ledger Account'            ; P<3,-1>='GL_ACCT_TABLE_NF'
  P<1,-1>='24*'                ; P<2,-1>='Branch'                            ; P<3,-1>='BRANCH_DATA_NF'
  P<1,-1>='26*'                ; P<2,-1>='Department'                        ; P<3,-1>='DEPARTMENT_NF'
  P<1,-1>='27*'                ; P<2,-1>='Business'                          ; P<3,-1>='TB_BUSINESS_NF'
  P<1,-1>='28*'                ; P<2,-1>='Program Type'                      ; P<3,-1>='PROG_TYPE_DEFAULTS_NF'
  P<1,-1>='29*'                ; P<2,-1>='Payment Plan'                      ; P<3,-1>='TB_PAYMENT_PLAN_NF'
  P<1,-1>='30*'                ; P<2,-1>='Promotion'                         ; P<3,-1>='PROMOTION_TBL_NF'
  P<1,-1>='31*'                ; P<2,-1>='Account Type'                      ; P<3,-1>='TB_ACCT_TYPE_NF'
  P<1,-1>='32*'                ; P<2,-1>='Business Type'                     ; P<3,-1>='TB_BUSINESS_TYPE_NF'
  P<1,-1>='33*'                ; P<2,-1>='Application Status'                ; P<3,-1>='TB_STATUS_NF'
  P<1,-1>='34*'                ; P<2,-1>='Disposition Payment Type'          ; P<3,-1>='TB_DISP_PAYMENT_TYPE_NF'
  P<1,-1>='35*'                ; P<2,-1>='Disposition/Inventory'             ; P<3,-1>='DISP_INVENT_TABLE_NF'
  P<1,-1>='36*'                ; P<2,-1>='Bank Additional User-Defined'      ; P<3,-1>='AUS_BANKS_NF'
  P<1,-1>='39*'                ; P<2,-1>='Product Line'                      ; P<3,-1>='PROD_LINE_DEFAULTS_NF'
  P<1,-1>='40*'                ; P<2,-1>='Insurance Type'                    ; P<3,-1>='TB_INSURANCE_TYPE_NF'
  P<1,-1>='41*'                ; P<2,-1>='Insurance Status'                  ; P<3,-1>='TB_INSURANCE_STATUS_NF'
  P<1,-1>='42*'                ; P<2,-1>='Contract Status'                   ; P<3,-1>='CONTRACT_STATUS_INFO_NF'
  P<1,-1>='43*'                ; P<2,-1>='Guaranteed Residual'               ; P<3,-1>='TB_GUARANTEED_RESIDUAL_NF'
  P<1,-1>='45*'                ; P<2,-1>='Country Code'                      ; P<3,-1>='COUNTRY_CODES_NF'
  P<1,-1>='ACTIVITY.DE*'       ; P<2,-1>='Activity (Inv. Interface)'         ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='ADDL.BUYOUT*'       ; P<2,-1>='Additional Buyout Info'            ; P<3,-1>='ADDL_BUYOUT_DEFAULT_NF'
  P<1,-1>='ADJ*'               ; P<2,-1>='Adjustment Code'                   ; P<3,-1>='ADJUSTMENT_CODE_TBL_NF'
  P<1,-1>='ADMIN*'             ; P<2,-1>='Administrative Code'               ; P<3,-1>='TB_ADMINISTRATIVE_CODE_NF'
  P<1,-1>='AP.INTERFACE*1'     ; P<2,-1>='API Parameters'                    ; P<3,-1>='API_PARAMETERS_NF'
  P<1,-1>='ASSET.DE*'          ; P<2,-1>='Asset (Inv. Interface)'            ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='ASSET.STATUS*'      ; P<2,-1>='Asset Status'                      ; P<3,-1>='TB_ASSET_STATUS_NF'
  P<1,-1>='ASSOCIATION*'       ; P<2,-1>='Association'                       ; P<3,-1>='ASSOC_REL_PARTY_NF'
  P<1,-1>='BANK*'              ; P<2,-1>='Bank Address'                      ; P<3,-1>='BANK_ADDRESS_NF'
  P<1,-1>='BANK.ADDL*'         ; P<2,-1>='Additional Bank Address'           ; P<3,-1>='ADDL_BANK_ADDRESS_NF'
  P<1,-1>='BI.TYPE*'           ; P<2,-1>='Blended Income Type'               ; P<3,-1>='TB_BLENDED_INCOME_TYPE_NF'
  P<1,-1>='BID*'               ; P<2,-1>='Blended Income Defaults'           ; P<3,-1>='BLENDED_INCOME_DEF_NF'
  P<1,-1>='BLENDED.INCOME*'    ; P<2,-1>='Blended Income Parameter'          ; P<3,-1>='BLENDED_INCOME_TBL_NF'
  P<1,-1>='BUS.PLAN*'          ; P<2,-1>='Business Plan'                     ; P<3,-1>='BUS_PLAN_DEFAULTS_NF'
  P<1,-1>='BUS.SEG*'           ; P<2,-1>='Business Segment'                  ; P<3,-1>='BUS_SEGMENT_NF'
  P<1,-1>='BUYOUT*'            ; P<2,-1>='Buyout Parameters'                 ; P<3,-1>='BUYOUT_DEFAULT_NF'
  P<1,-1>='CADDR.DE*'          ; P<2,-1>='Customer Address (Inv. Interface)' ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='CCA*'               ; P<2,-1>='CCA Class'                         ; P<3,-1>='CCA_CLASS_DEPR_NF'
  P<1,-1>='CHECK.TYPE*'        ; P<2,-1>='Check Type'                        ; P<3,-1>='CHECK_TYPE_NF'
  P<1,-1>='CHRG.DE*'           ; P<2,-1>='Charge Info (Inv. Interface)'      ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='CHRG.TYPE*'         ; P<2,-1>='Open Item Charge Types'            ; P<3,-1>='CHARGE_TYPE_TABLE_NF'
  P<1,-1>='CHRG.TYPE.INDEX*'   ; P<2,-1>='Open Item Charge Type Indexes'     ; P<3,-1>='CHARGE_TYPE_INDEX_NF'
  P<1,-1>='CNTC.DE*'           ; P<2,-1>='Contact (Inv. Interface)'          ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='CURRENCY*'          ; P<2,-1>='Currency Code'                     ; P<3,-1>='CURRENCY_CODES_NF'
  P<1,-1>='DEALER.DISTRICT*'   ; P<2,-1>='Dealer District'                   ; P<3,-1>='TB_DEALER_DISTRICT_NF'
  P<1,-1>='DEALER.PARAM*'      ; P<2,-1>='Dealer Parameter'                  ; P<3,-1>='DEALER_PARAM_NF'
  P<1,-1>='DEALER.REGION*'     ; P<2,-1>='Dealer Region'                     ; P<3,-1>='TB_DEALER_REGION_NF'
  P<1,-1>='DEALER.SALESMAN*'   ; P<2,-1>='Dealer Salesman'                   ; P<3,-1>='DLR_SALESMAN_NF'
  P<1,-1>='DEALER.SERIES*'     ; P<2,-1>='Dealer Series'                     ; P<3,-1>='TB_DEALER_SERIES_NF'
  P<1,-1>='DEALER.STATUS*'     ; P<2,-1>='Dealer Status'                     ; P<3,-1>='DEALER_STATUS_NF'
  P<1,-1>='DLR.RECOURSE*'      ; P<2,-1>='Dealer Recourse'                   ; P<3,-1>='TB_DEALER_RECOURSE_NF'
  P<1,-1>='EARLY.TERM.OPTION*' ; P<2,-1>='Early Term Option'                 ; P<3,-1>='TB_EARLY_TERM_OPTION_NF'
  P<1,-1>='ER*'                ; P<2,-1>='Exchange Rate'                     ; P<3,-1>='EXCHANGE_RATE_NF'
  P<1,-1>='FAC*'               ; P<2,-1>='Void Factura Reason'               ; P<3,-1>='TB_VOID_FACTURA_REASON_NF'
  P<1,-1>='FIN.CLASS*'         ; P<2,-1>='Finance Class'                     ; P<3,-1>='TB_FINANCE_CLASS_NF'
  P<1,-1>='FIN.PLAN*'          ; P<2,-1>='Finance Plan'                      ; P<3,-1>='TB_FINANCE_PLAN_NF'
  P<1,-1>='FOLLOW.UP*'         ; P<2,-1>='Follow Up'                         ; P<3,-1>='FOLLOW_UP_CODES_NF'
  P<1,-1>='GL.LINK.INDEX*'     ; P<2,-1>='General Ledger Link Index'         ; P<3,-1>='TB_GL_LINK_INDEX_NF'
  P<1,-1>='GROUP.MISC.CODES*'  ; P<2,-1>='Group Misc GL Codes'               ; P<3,-1>='GROUP_MISC_CODES_NF'
  P<1,-1>='HOLIDAY.TBL*'       ; P<2,-1>='Holiday/Weekend'                   ; P<3,-1>='HOLIDAY_WEEKEND_NF'
  P<1,-1>='IDC.DESC*'          ; P<2,-1>='IDC Description'                   ; P<3,-1>='TB_IDC_DESC_NF'
  P<1,-1>='INVOICE.FORMAT*'    ; P<2,-1>='Invoice Format'                    ; P<3,-1>='INVOICE_FORMAT_TABLE_NF'
  P<1,-1>='IP*'                ; P<2,-1>='Insurance Parameter'               ; P<3,-1>='INSURANCE_PARAMETER_NF'
  P<1,-1>='IRS.CAT*'           ; P<2,-1>='IRS Category/Tax'                  ; P<3,-1>='IRS_CAT_DEFAULTS_NF'
  P<1,-1>='ITP'                ; P<2,-1>='Insurance Tape Parameter'          ; P<3,-1>='INS_TAPE_PARAMETER_NF'
  P<1,-1>='L.NATIONALITY*'     ; P<2,-1>='Nationality'                       ; P<3,-1>='TB_NATIONALITY_NF'
  P<1,-1>='LANG*'              ; P<2,-1>='Language'                          ; P<3,-1>='TB_LANGUAGE_NF'
  P<1,-1>='LEGAL.S*'           ; P<2,-1>='Legal Status'                      ; P<3,-1>='TB_LEGAL_STATUS_NF'
  P<1,-1>='LESSEE.CONTACT*'    ; P<2,-1>='Lessee Contact Permitted'          ; P<3,-1>='TB_LESSEE_CONTACT_PERMIT_NF'
  P<1,-1>='LESSOR.SUB*'        ; P<2,-1>='Lessor Subsidiary'                 ; P<3,-1>='SUBSIDIARY_ADDRESS_NF'
  P<1,-1>='LKE.POOL*'          ; P<2,-1>='Like Kind Exchange Pool'           ; P<3,-1>='TB_LIKE_KIND_EXCHANGE_PO_NF'
  P<1,-1>='LOCAL.SIC.CODE*'    ; P<2,-1>='Local SIC Code'                    ; P<3,-1>='LOCAL_SIC_CODE_TBL_NF'
  P<1,-1>='LOCKBOX.PARAMS'     ; P<2,-1>='Lockbox Parameters'                ; P<3,-1>='LOCKBOX_PARAMETERS_NF'
  P<1,-1>='MILE.CAT*'          ; P<2,-1>='Mileage Category'                  ; P<3,-1>='TB_MILEAGE_CATEGORY_NF'
  P<1,-1>='MISC.PARAM*'        ; P<2,-1>='Miscellaneous Parameters'          ; P<3,-1>='MISC_PARAM_DEFAULTS_NF'
  P<1,-1>='MMR.ASSET.DE*'      ; P<2,-1>='MMR Asset (Inv. Interface)'        ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='MMR.ASSET.RATE.DE*' ; P<2,-1>='MMR Asset Rate (Inv. Interface)'   ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='MMR.CHRG.DE*'       ; P<2,-1>='MMR Charge (Inv. Interface)'       ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='NJS.FLAG'           ; P<2,-1>='NJS Flag'                          ; P<3,-1>='NJS_FLAG_NF'
  P<1,-1>='PAYMENT.STATUS*'    ; P<2,-1>='Payment Status'                    ; P<3,-1>='TB_PAYMENT_STATUS_NF'
  P<1,-1>='PAYMENT.TYPE*'      ; P<2,-1>='Payment Type'                      ; P<3,-1>='PYMT_TYPE_NF'
  P<1,-1>='PENDING.CODE*'      ; P<2,-1>='Pending Code'                      ; P<3,-1>='PENDING_CODE_TBL_NF'
  P<1,-1>='POLICY.STATUS*'     ; P<2,-1>='Policy Status'                     ; P<3,-1>='TB_POLICY_STATUS_NF'
  P<1,-1>='PROGRAM.CONTROL*'   ; P<2,-1>='Program Control'                   ; P<3,-1>='TB_PROGRAM_CONTROL_NF'
  P<1,-1>='PUR.OPT*'           ; P<2,-1>='Purchase Option'                   ; P<3,-1>='PURCHASE_OPTION_TABLE_NF'
  P<1,-1>='PURPOSE.LOAN*'      ; P<2,-1>='Purpose Of Loan'                   ; P<3,-1>='TB_PURPOSE_OF_LOAN_NF'
  P<1,-1>='PUT.TO*'            ; P<2,-1>='Put To'                            ; P<3,-1>='TB_PUT_TO_NF'
  P<1,-1>='QUOTE.BUYOUT*'      ; P<2,-1>='Quote Buyout'                      ; P<3,-1>='QUOTE_BUYOUT_TBL_NF'
  P<1,-1>='RCPT*'              ; P<2,-1>='Void Receipt Reason'               ; P<3,-1>='TB_VOID_RECEIPT_REASON_NF'
  P<1,-1>='RECOURSE*'          ; P<2,-1>='Recourse'                          ; P<3,-1>='TB_RECOURSE_CODE_NF'
  P<1,-1>='RECOVERY.STATUS*'   ; P<2,-1>='Recovery Status'                   ; P<3,-1>='TB_RECOVERY_STATUS_NF'
  P<1,-1>='RELATIONSHIP*'      ; P<2,-1>='Relationship'                      ; P<3,-1>='RELATIONSHIP_DATA_NF'
  P<1,-1>='REM.PUR.OPTION*'    ; P<2,-1>='Remarketing Purchase Option'       ; P<3,-1>='TB_REMARKETING_PURCHASE_NF'
  P<1,-1>='RENEWAL.OPTION*'    ; P<2,-1>='Renewal Option'                    ; P<3,-1>='RENEWAL_OPTION_NF'
  P<1,-1>='REPO.STATUS*'       ; P<2,-1>='Repossession Status'               ; P<3,-1>='REPOSSESSION_CODE_NF'
  P<1,-1>='RESERVE*'           ; P<2,-1>='Reserve Code'                      ; P<3,-1>='TB_RESERVE_CODE_NF'
  P<1,-1>='RESIDUAL.GUAR*'     ; P<2,-1>='Residual Guarantee'                ; P<3,-1>='TB_RESIDUAL_GUARANTEE_NF'
  P<1,-1>='RESIDUAL.OWNER*'    ; P<2,-1>='Residual Owner'                    ; P<3,-1>='TB_RESIDUAL_OWNER_NF'
  P<1,-1>='RESIDUAL.SHARING*'  ; P<2,-1>='Residual Sharing'                  ; P<3,-1>='TB_RESIDUAL_SHARING_NF'
  P<1,-1>='RESTOCKING.FEE*'    ; P<2,-1>='Restocking Fee Obligation'         ; P<3,-1>='TB_RESTOCK_FEE_OBLIGATIO_NF'
  P<1,-1>='RETURN.COSTS.PD*'   ; P<2,-1>='Return Costs Paid'                 ; P<3,-1>='TB_RETURN_COSTS_PAID_NF'
  P<1,-1>='REVS.PT*'           ; P<2,-1>='REVS Plate Type'                   ; P<3,-1>='TB_REVS_PLATE_TYPE_NF'
  P<1,-1>='REVS.ST*'           ; P<2,-1>='REVS State'                        ; P<3,-1>='TB_REVS_STATE_NF'
  P<1,-1>='SCAN.LINE.DE*'      ; P<2,-1>='Scan Line (Inv. Interface)'        ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='SCORE.DECISION*'    ; P<2,-1>='Credit Score Decision'             ; P<3,-1>='TB_CREDIT_SCORE_DECISION_NF'
  P<1,-1>='SCORE.STATUS*'      ; P<2,-1>='Credit Score Status'               ; P<3,-1>='CREDIT_SCORE_STATUS_NF'
  P<1,-1>='SCORING.CODE*'      ; P<2,-1>='Scoring Code'                      ; P<3,-1>='SCORING_CODE_NF'
  P<1,-1>='SEC.PARTY*'         ; P<2,-1>='Secure Party'                      ; P<3,-1>='LESSOR_SEC_PARTY_NF'
  P<1,-1>='SOURCE*'            ; P<2,-1>='Source'                            ; P<3,-1>='TB_SOURCE_NF'
  P<1,-1>='SPECIAL.INST*'      ; P<2,-1>='Special Instructions'              ; P<3,-1>='TB_SPECIAL_INSTRUCTIONS_NF'
  P<1,-1>='SPLIT.DE*'          ; P<2,-1>='Invoice Interface Data Elements'   ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='SSP'                ; P<2,-1>='System Security'                   ; P<3,-1>='SC_SECURE_PARAM_NF'
  P<1,-1>='UCC.STATE*'         ; P<2,-1>='Filing State'                      ; P<3,-1>='FILING_STATE_NF'
  P<1,-1>='UCC.STATUS*'        ; P<2,-1>='Filing Status'                     ; P<3,-1>='FILING_STATUS_TABLE_NF'
  P<1,-1>='UCC.TITLE.CODE*'    ; P<2,-1>='Filing Code'                       ; P<3,-1>='FILING_CODE_NF'
  P<1,-1>='UK.POOL*'           ; P<2,-1>='UK Pool'                           ; P<3,-1>='UK_POOL_NUM_NF'
  P<1,-1>='USG.ASSET.DE*'      ; P<2,-1>='Usage Asset (Inv. Interface)'      ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='USG.CHRG.DE*'       ; P<2,-1>='Usage Charge (Inv. Interface)'     ; P<3,-1>='INV_INT_DATA_ELEMENTS_NF'
  P<1,-1>='VLMAKE*'            ; P<2,-1>='Vehicle Make'                      ; P<3,-1>='TB_VEHICLE_MAKE_NF'
  P<1,-1>='VLMODEL*'           ; P<2,-1>='Vehicle Model'                     ; P<3,-1>='TB_VEHICLE_MODEL_NF'
  P<1,-1>='VLOPT*'             ; P<2,-1>='Vehicle Option'                    ; P<3,-1>='TB_VEHICLE_OPTION_NF'
  P<1,-1>='WAREHOUSE*'         ; P<2,-1>='Warehouse Location'                ; P<3,-1>='TB_WAREHOUSE_LOCATION_NF'
  P<1,-1>='WHOLESALE.PLAN*'    ; P<2,-1>='Wholesale Plan'                    ; P<3,-1>='TB_WHOLESALE_PLAN_NF'
  P<1,-1>='WL.FOLLOW-UP.CODE*' ; P<2,-1>='Worklist Follow-Up Codes'          ; P<3,-1>='WORKLIST_FOLLOW_UP_CODES_NF'
  P<1,-1>='WP.PARAM'           ; P<2,-1>='Word Processing'                   ; P<3,-1>='WP_PARAM_NF'
  P<1,-1>=STR('-', 18)         ; P<2,-1>=STR('-',33)                         ; P<3,-1>=STR('-',30)
  FOR F=1 TO DCOUNT(P<1>,@VM)
    PRINT '|':P<1,F>'L#18':'|':P<2,F>'L#33':'|':P<3,F>'L#30':'|'
  NEXT F
RETURN
*
BUILD.AC:
  * Check for a DICT request
  IF FIELD(ANS,' ',2)='DICT' THEN
    DICT=FIELD(ANS,' ',3)
    OPEN 'DICT',DICT TO DVAR ELSE CRT 'Cannot open DICT':DICT ; RETURN
    SELECT DVAR
    ID.LIST=''
    LOOP
      READNEXT ID ELSE EXIT
      READ R FROM DVAR, ID ELSE CONTINUE
      IF R<1>='D' OR R<1>='I' OR R<1>='V' THEN
        ID.LIST<-1>='DICT-':DICT:'_':ID
      END
    REPEAT
    GOSUB ADD.TO.AC
    RETURN
  END
  *
  * Build auto-complete list of VOC commands
  CLEARFILE AC
  L1='' ; L2=''
  *
  EXECUTE \SELECT VOC WITH F1 = "C" "V"\ RTNLIST L1
  ID.LIST=''
  LOOP
    READNEXT ID FROM L1 ELSE EXIT
    READ R FROM VOC, ID ELSE CONTINUE
    ID.LIST<-1>='CMD_':ID
  REPEAT
  GOSUB ADD.TO.AC
  *
  * Build auto-complete list for filenames
  *
  EXECUTE \SELECT VOC WITH F1 = "F" "LF" "DIR" "LD" AND WITH @ID # "TMP]"\ RTNLIST L1
  ID.LIST=''
  LOOP
    READNEXT ID FROM L1 ELSE EXIT
    READ R FROM VOC, ID ELSE CONTINUE
    ID.LIST<-1>='FILE_':ID
    IF R<1>='LF' OR R<1>='LD' THEN
      * Multi-level file or dir, dive deeper
      E=\SELECT DICT \:ID:\ WITH @ID = "@]" AND WITH F1 = "LF" "LD" USING DICT VOC\
      *CRT E
      EXECUTE E RTNLIST L2 CAPTURING DUMMY
      LOOP
        READNEXT ID2 FROM L2 ELSE EXIT
        ID2=ID:',':ID2[2,99]
        ID.LIST<-1>='FILE_':ID2
      REPEAT
    END
  REPEAT
  GOSUB ADD.TO.AC
RETURN
*
ADD.TO.AC:
  NUM.ITEMS=DCOUNT(ID.LIST,@AM)
  CRT NUM.ITEMS:' ITEMS'
  FOR I=1 TO NUM.ITEMS
    ID=ID.LIST<I>
    L=LEN(ID)
    FOR C=1 TO LEN(ID)
      PRE=ID[1,C]
      READ NODE FROM AC, PRE ELSE NODE=''
      * Now insert pointers to one level down
      PTR=ID[1,C+1]
      LOCATE PTR IN NODE<1> BY 'AL' SETTING POS THEN
        LOCATE ID IN NODE<2,POS> BY 'AL' SETTING POS2 ELSE NULL
        INS ID BEFORE NODE<2,POS, POS2>
      END ELSE
        INS PTR BEFORE NODE<1,POS>
        INS ID  BEFORE NODE<2,POS>
      END
      WRITE NODE ON AC, PRE
    NEXT C
  NEXT I
RETURN
*

TclStack: Difference between revisions

Latest revision as of 22:54, 13 September 2019

Navigation menu

Page actions

Page actions

Personal tools

Navigation

Search

Tools