TclStack
From Pickwiki
Jump to navigationJump to searchHomePage >> BasicSource >> Github:
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
*
