/* BEGIN DOCUMENTATION Name: TCMTEST.PLI: Created: 10/10/83 DTS Last Update: 05/22/84 Title: Test program for TCM system. Index: TCM, Text Collection Management System Abstract: Tests all calls to TCM via FMS screen that prompts for all parameters. Usage: Parameters: Inputs Command Function: I)nit, E)dit, R)etreive, F)ile, D)elete, K)ill text, S)how, Q)uit, X)it. Environment: MMR PL/I - FMS interface See Also: TCMPLI.C, TCM.DOC, TCM.C Description: Example(s): Uses: Internal: Update History: 01/17/84 DTS - Change TCOLL call for options structure END DOCUMENTATION */ TCMTST: PROC OPTIONS (MAIN); %INCLUDE 'LB:[1,2]FMS.PLI'; %INCLUDE 'SY:TCME.PLI'; %INCLUDE 'SY:TCMERR.PLI'; DCL SYSPRINT FILE; DCL WRTPAS ENTRY (FILE,CHAR(*)) ; DCL TRIM ENTRY(CHAR(*)) RETURNS (CHAR(255) VARYING); DCL ASCII ENTRY (FIXED BIN(7)) RETURNS (CHAR(1)); DCL IMPURE_AREA CHAR(2500) STATIC; DCL IMPURE_SIZE FIXED BIN(15) STATIC INIT(2500); DCL FLB_LUN FIXED BIN(15); DCL FNDLUN ENTRY(FIXED BIN(15)); DCL (STAT1,STAT2) FIXED BIN(15) STATIC; DCL R_FLAG FIXED BIN(15) STATIC INIT(6); DCL TERM FIXED BIN(15); DCL LINENO FIXED BIN(15); DCL LINESTRNG CHAR(9) VAR; DCL ZERO FIXED BIN(15) INIT(0); DCL NAME CHAR(8); /* WINDOW NAME */ DCL TEXT CHAR(255) VARYING; /* Line buffer or File spec */ DCL 1 W_DEF STATIC, 2 ROW FIXED BIN(15), /* Window position */ 2 COL FIXED BIN(15), 2 HEIGHT FIXED BIN(15), /* Window size */ 2 WIDTH FIXED BIN(15), 2 FILL_CHAR CHAR(1), /* Background character */ 2 BORDERS FIXED BIN(1), 2 VIRT_LINES FIXED BIN(15), /* Maximum lines in buffer */ 2 MAX_CHARS FIXED BIN(15); /* Maximum buffer size */ DCL 1 OPTIONS STATIC, 2 ERR_LEVEL FIXED BIN(15), /* Severity level for editing */ 2 MAX_TIME FIXED BIN(15), /* Timeout on no activity in sec */ 2 C_POS, /* Cursor postion for edit */ 3 LINE FIXED BIN(15), /* Relative line of text (IN & OUT) */ 3 COLUMN FIXED BIN(15), 2 STATUS_LINE FIXED BIN(1), /* Display status line if true */ 2 READ_ONLY FIXED BIN(1), /* Display only mode if true */ 2 INSERT FIXED BIN(1); /* Default to insert mode */ DCL 1 DELSTART, 2 LINE FIXED BIN(15), /* Start of delete text */ 2 COLUMN FIXED BIN(15); DCL 1 DELEND, 2 LINE FIXED BIN(15), /* End of delete text */ 2 COLUMN FIXED BIN(15); DCL E_FLAG FIXED BIN(15); /* Event flag for async calls */ DCL (RC,EXIT_STAT) FIXED BIN(15); /* Return codes */ DCL CMD CHAR(1) STATIC INIT(' '); /********************************************************************/ CALL FMSINIT; CALL FCLRSH('TCMTST',ZERO); CALL STATUS; DO WHILE (CMD ^= 'X'); RC = 0; EXIT_STAT = TS_SUC; TERM = 0; ROW = 0; COL = 0; WIDTH = 0; HEIGHT = 0; VIRT_LINES = 0; MAX_CHARS = 0; MAX_TIME = 0; E_FLAG = 0; CALL FGET(CMD,TERM,'CMD',ZERO); CALL STATUS; IF CMD = 'i' ! CMD = 'I' THEN DO; CALL TINIT(R_FLAG,RC); /* FIXED EVENT FLAG */ END; ELSE IF CMD = 'c' ! CMD = 'C' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'ROW',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN ROW = TEXT; CALL FGET(TEXT,TERM,'COL',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN COL = TEXT; CALL FGET(TEXT,TERM,'HEIGHT',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN HEIGHT = TEXT; CALL FGET(TEXT,TERM,'WIDTH',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN WIDTH = TEXT; CALL FGET(TEXT,TERM,'VIRTL',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN VIRT_LINES = TEXT; CALL FGET(TEXT,TERM,'MAXC',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN MAX_CHARS = TEXT; call fget(TEXT,term,'BORDER',ZERO); call status; if text = 'Y' then borders = 1; else borders = 0; CALL FGET(FILL_CHAR,TERM,'FILL',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'INITD',ZERO); CALL STATUS; TEXT = TRIM(TEXT); CALL TWINCR(NAME,TEXT,ADDR(W_DEF),RC); END; ELSE IF CMD = 'e' ! CMD = 'E' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'CPOS',ZERO); CALL STATUS; IF TEXT = 'B' ! TEXT = 'b' THEN DO; OPTIONS.COLUMN = 1; OPTIONS.LINE = 1; END; ELSE IF TEXT = 'E' ! TEXT = 'e' THEN DO; OPTIONS.COLUMN = 0; OPTIONS.LINE = 0; END; CALL FGET(TEXT,TERM,'ERRLV',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN OPTIONS.ERR_LEVEL = TEXT; CALL FGET(TEXT,TERM,'MAXTIM',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN OPTIONS.MAX_TIME = TEXT; CALL FGET(TEXT,TERM,'STALIN',ZERO); CALL STATUS; IF TEXT = 'T' ! TEXT = 'Y' THEN OPTIONS.STATUS_LINE = 1; ELSE OPTIONS.STATUS_LINE = 0; CALL FGET(TEXT,TERM,'RDONLY',ZERO); CALL STATUS; IF TEXT = 'T' ! TEXT = 'Y' THEN OPTIONS.READ_ONLY = 1; ELSE OPTIONS.READ_ONLY = 0; CALL FGET(TEXT,TERM,'INSERT',ZERO); CALL STATUS; IF TEXT = 'T' ! TEXT = 'Y' THEN OPTIONS.INSERT = 1; ELSE OPTIONS.INSERT = 0; CALL FGET(TEXT,TERM,'EFLAG',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN E_FLAG = TEXT; IF OPTIONS.ERR_LEVEL = 1 THEN DO; CALL FGET(TEXT,TERM,'INITD',ZERO); CALL STATUS; TEXT = TRIM(TEXT); END; EXIT_STAT = TS_UKY; DO WHILE(EXIT_STAT = TS_UKY); CALL TCOLL(NAME,ADDR(OPTIONS),E_FLAG,TERM,RC,EXIT_STAT); IF EXIT_STAT = TS_UKY & TERM > 128 THEN CALL TXTINS(NAME,TEXT,ADDR(OPTIONS.C_POS),RC); IF RC ^= 0 THEN CALL WRTPAS(SYSPRINT,ASCII(27)!!'[23;1HCMD = T RC ='!!RC!!' Exit Status ='!!EXIT_STAT!!' Term ='!!TERM); END; LINENO = OPTIONS.C_POS.LINE; LINESTRNG = LINENO; CALL FPUT(TRIM(LINESTRNG),'LINENO'); CALL STATUS; LINESTRNG = OPTIONS.C_POS.COLUMN; CALL FPUT(TRIM(LINESTRNG),'COLNO'); CALL STATUS; END; ELSE IF CMD = 'k' ! CMD = 'K' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'LINENO',ZERO); CALL STATUS; DELSTART.LINE = TRIM(TEXT); CALL FGET(TEXT,TERM,'COLNO',ZERO); CALL STATUS; DELSTART.COLUMN = TRIM(TEXT); CALL FGET(TEXT,TERM,'LINENO',ZERO); CALL STATUS; DELEND.LINE = TRIM(TEXT); CALL FGET(TEXT,TERM,'COLNO',ZERO); CALL STATUS; DELEND.COLUMN = TRIM(TEXT); CALL TXTDEL(NAME,ADDR(DELSTART),ADDR(DELEND),RC); END; ELSE IF CMD = 'r' ! CMD = 'R' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'LINENO',ZERO); CALL STATUS; TEXT = TRIM(TEXT); IF LENGTH(TEXT) > 0 THEN LINENO = TEXT; CALL TRETRV(NAME,TEXT,LINENO,RC); CALL WRTPAS(SYSPRINT,ASCII(27)!!'[21;1HLine '!!LINENO); CALL WRTPAS(SYSPRINT,ASCII(27)!!'[22;1H"'!!TEXT!!'"'!!ASCII(27)!!'[K'); LINESTRNG = LINENO; CALL FPUT(TRIM(LINESTRNG),'LINENO'); CALL STATUS; END; ELSE IF CMD = 'f' ! CMD = 'F' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL FGET(TEXT,TERM,'EFLAG',ZERO); CALL STATUS; IF LENGTH(TEXT) > 0 THEN E_FLAG = TEXT; CALL FGET(TEXT,TERM,'FILE',ZERO); CALL STATUS; IF E_FLAG > 0 THEN CALL TWINSA(NAME,TEXT,E_FLAG,RC,EXIT_STAT); ELSE CALL TWINSA(NAME,TEXT,RC,EXIT_STAT); END; ELSE IF CMD = 'd' ! CMD = 'D' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL TWINDE(NAME,RC); END; ELSE IF CMD = 's' ! CMD = 'S' THEN DO; CALL FGET(NAME,TERM,'NAME',ZERO); CALL STATUS; CALL TWINRF(NAME,RC); END; ELSE IF CMD = 'q' ! CMD = 'Q' THEN CALL TSTOP(RC); ELSE IF CMD ^= 'x' & CMD ^= 'X' THEN CALL FPUTL('Invalid Command, Use I,C,E,R,F,D,S,Q, or X only.'); IF (RC ^= TS_SUC) & (TCMDSW < 0) THEN CALL FPUTL('TCM Error, RC = '!!RC!!' TCMDSW = '!!TCMDSW); IF RC ^= 0 THEN CALL WRTPAS(SYSPRINT,ASCII(27)!!'[23;1HCMD = '!!CMD!!' RC ='!!RC!!' Exit Status ='!!EXIT_STAT!!' Term ='!!TERM); END; CALL FLCLOS; /********************************************************************/ FMSINIT: PROC; CALL ATTACH; CALL FINIT(IMPURE_AREA,IMPURE_SIZE,STAT1); CALL STATUS; CALL FNDLUN(FLB_LUN); CALL STATUS; CALL FLCHAN(FLB_LUN); CALL STATUS; CALL FLOPEN('TCMTST.FLB'); CALL STATUS; CALL WRTPAS(SYSPRINT,ASCII(27)!!'='); END FMSINIT; /*******************************************************************/ ATTACH: PROC; CALL WTQIO(768,5,5); /* ATTACH TERMINAL */ END ATTACH; DETACH: PROC; CALL WTQIO(1024,5,5); /* ATTACH TERMINAL */ END DETACH; STATUS: PROC; CALL FSTAT(STAT1,STAT2); IF STAT1 < 0 THEN DO; CALL FPUTL('Error Status 1 = '!!STAT1!!' Status 2 = '!!STAT2); CALL FGET; END; END STATUS; /*******************************************************************/ END TCMTST;