(* Custom version of PRINT, called SYSPRNT. It includes the *)
(* system name (HPSYSNAME) in the heading, when the PAGEHEAD *)
(* option is used. *)
(* *)
(* R. Horner 07/21/2000 *)
(* *)
VAR RF: TFILECOMBINED;
VAR INFILE: STRING[256];
VAR OUTFILE: STRING[128];
VAR STARTREC: INTEGER;
VAR STARTRECFIXED: INTEGER;
VAR ENDREC: INTEGER;
VAR BUF: BOOLEAN;
VAR SEARCHSTR: STRING[256];
VAR SEARCHC: SHORTINT;
VAR PREVSTR: STRING[256];
VAR PREVC: SHORTINT;
VAR CAFTERSTR: STRING[256];
VAR CAFTERC: SHORTINT;
VAR CBEFORESTR: STRING[256];
VAR CBEFOREC: SHORTINT;
VAR FORMATSTR: STRING[256];
VAR FORMATCODE: SHORTINT;
VAR TADDR: SHORTINT;
VAR T: POINTER TPRINTINFO;
VAR TYPE: STRING[1];
VAR PAGESIZE: INTEGER;
VAR PPAGEHEAD: BOOLEAN;
VAR NUM: BOOLEAN;
VAR REC: STRING[1024];
VAR PREVREC: STRING[1024];
VAR PREVNUM: STRING[10];
VAR RECLEN: INTEGER;
VAR MATCHEDPREV: BOOLEAN;
VAR CHECKINGCAFTER: BOOLEAN;
VAR SEARCHRESULT: BOOLEAN;
VAR PREVRESULT: BOOLEAN;
VAR LASTNONPRINTEDRECNUM: INTEGER;
VAR LASTPRINTEDRECNUM: INTEGER;
VAR INTERACT: BOOLEAN;
VAR SAVECONTROLY: INTEGER;
VAR SVEOUTFNUM: INTEGER;
VAR NOPAGE: BOOLEAN;
VAR COPYACCESS: BOOLEAN;
VAR NONUMRECOGNIZE: BOOLEAN;
VAR ALLFILENAMES: BOOLEAN;
VAR DOMAIN: SHORTINT;
VAR DOMAINSTR: STRING[8];
VAR VARNONDELIMS: STRING[256];
VAR KEEPAMDATES: BOOLEAN;
VAR F: STRING[VE_SIZE_FILENAME];
VAR CCTL: BOOLEAN;
VAR OUTSIZE: INTEGER;
VAR FILESETCMD: BOOLEAN;
VAR NOBANNERYET: BOOLEAN;
VAR NOEJECTYET: BOOLEAN;
VAR ABORTOPERATION: BOOLEAN;
VAR DONTASK: BOOLEAN;
VAR NUMFILES: INTEGER;
VAR HILIGHT: SHORTINT;
VAR WAIT: SHORTINT;
VAR LONGWAIT: BOOLEAN;
VAR SKIP: SHORTINT;
VAR IV: STRING[4];
VAR LINECOUNT: INTEGER;
VAR LINESFOUND: INTEGER; (* obsolete *)
VAR MAXLINES: INTEGER; (* obsolete *)
VAR MAXFOUND: INTEGER; (* MAX search matches in current file *)
VAR MAXSHOWN: INTEGER; (* MAX lines displayed in current file *)
VAR NUMFOUND: INTEGER; (* search matches in current file *)
VAR SHOWN: INTEGER; (* lines displayed in current file *)
VAR GLOBNUMFOUND: INTEGER; (* MPEXPRINTLINESFOUND counter *)
VAR DONE: BOOLEAN; (* deferred 'file done' flag *)
VAR ISBYTE: BOOLEAN;
VAR INITIALEOF: INTEGER;
VAR DEBUG: BOOLEAN;
VAR SPF: BOOLEAN; (* experimental *)
VAR STARTPAGE: INTEGER; (* undocumented *)
VAR ENDPAGE: INTEGER; (* undocumented *)
VAR MUSTSAVE: BOOLEAN;
SUBROUTINE DOCALL (CODE: VALUE INTEGER);
BEGIN
ISBOOLEAN (CALLVAR (CODE, ISDOUBLE(T)))
END;
SUBROUTINE MYTEXTPOINT (ADDR: SHORTINT; RNUM: VALUE INTEGER);
BEGIN
TRY TEXTPOINT (ADDR, RNUM) RECOVER;
END;
SUBROUTINE PRINTREADDIR (NUM: VALUE INTEGER);
BEGIN
MYTEXTPOINT (TADDR, NUM);
PRINTREAD (T, REC, RECLEN)
END;
(* default value in FTRUE'EOF is near MAXINT, but not so near *)
(* that adding small numbers to it will cause an overflow. *)
SUBROUTINE TRUEEOF;
BEGIN
TRY CALL FTRUE'EOF (TEXTFNUM(TADDR), 32767, 0) RECOVER 0
END;
SUBROUTINE VESOFTPAGESIZE; IVAR ('VESOFTPAGESIZE', 60);
WITH T DO
BEGIN
SUBROUTINE SLOWTRUEEOF;
VAR RETNUM: INTEGER;
SEG (BEGIN
MYTEXTPOINT (TADDR, 2000000000); (* returns actual EOF, the slow way *)
RETNUM:=RECNUM;
MYTEXTPOINT (TADDR, 0);
RETNUM+0
END);
SUBROUTINE SUBFMTLINENUMBER; FMTLINENUMBER;
SUBROUTINE DOSELECT;
VAR CAFTERMATCHED: BOOLEAN;
BEGIN
CAFTERMATCHED:=CHECKINGCAFTER AND (CAFTERC=0 OR DOCALL (CAFTERC));
(* Handle CONTEXT=,1 type searches *)
IF CAFTERMATCHED AND NUMFOUND>=MAXFOUND THEN
DONE:=TRUE;
IF (SEARCHRESULT:=SEARCHC=0 OR DOCALL (SEARCHC)) THEN
BEGIN
++NUMFOUND;
(* handle CONTEXT=1 type searches *)
IF NUMFOUND>=MAXFOUND AND (CAFTERC=0 OR CAFTERMATCHED) THEN
DONE:=TRUE;
IF CAFTERC<>0 THEN
CHECKINGCAFTER:=TRUE;
RECNUMSEARCH:=RECNUM;
END;
IF (PREVRESULT:=PREVC<>0 AND DOCALL(PREVC)) THEN
BEGIN
MATCHEDPREV:=TRUE;
PREVREC:=REC;
PREVNUM:=SUBFMTLINENUMBER;
END;
IF CAFTERMATCHED AND NOT SEARCHRESULT THEN
BEGIN
CHECKINGCAFTER:=FALSE;
TRUE
END
ELSE IF CHECKINGCAFTER OR SEARCHRESULT THEN
TRUE
ELSE
BEGIN
LASTNONPRINTEDRECNUM:=RECNUM;
FALSE
END
END;
SUBROUTINE ASKCONTINUE;
VAR SEL: STRING[10];
VAR NEWREC: INTEGER;
BEGIN
SEG (
BEGIN
LINECOUNT:=0;
SEL:=READSTRING (
(IF NOBANNERYET THEN
''
ELSE IF ISBYTE THEN
STRWRITE ('(', RECNUM, '/'+
(IF STARTREC<0 OR ENDREC<0 THEN
STRWRITE(INITIALEOF) ELSE '?')+
') (', BYTENUM, '/', TRUEEOF,') ')
ELSE
STRWRITE ('(', RECNUM, '/', TRUEEOF, ') '))+
'Continue (Yes/No/Quit/Dontask)?');
IF HPTERMINAL() THEN
WRITEPROMPT (%33C, 'A', %33C, 'K');
END);
SEG (
BEGIN
IF UPS(SEL)[0:2]='NU' THEN (* force NUMBER flag on *)
BEGIN
NUM:=TRUE;
TRUE
END
ELSE IF UPS(SEL)[0:2]='UN' THEN (* force NUMBER flag off *)
BEGIN
NUM:=FALSE;
TRUE
END
ELSE IF UPS(SEL)[0:1]='N' THEN
BEGIN
ABORTMPE (VE_E_FLUSHED);
FALSE
END
ELSE IF UPS(SEL)='Q' OR UPS(SEL)='QUIT' THEN
BEGIN
ABORTOPERATION:=TRUE;
ABORTMPE (VE_E_FLUSHED);
FALSE
END
ELSE IF UPS(SEL)='D' OR UPS(SEL)='DONTASK' THEN
BEGIN
DONTASK:=TRUE;
TRUE
END
ELSE IF SEL<>'' AND VALIDINTEGER (SEL) AND TADDR<>0 THEN
BEGIN
IF SEL[0:1]='-' OR SEL[0:1]='+' THEN
NEWREC:=RECNUM+INTEGERPARSE (SEL)-1
ELSE
NEWREC:=INTEGERPARSE (SEL)-1;
(* exit silently if start>eof *)
NEWREC:=MIN(NEWREC, TRUEEOF);
MYTEXTPOINT (TADDR, MAX(0,NEWREC));
FALSE (* don't print the line we were about to print *)
END
ELSE
TRUE (* OK to print the line we were about to print *)
END)
END;
SUBROUTINE PRINTBANNER (F: VALUE STRING);
SEG (
BEGIN
IF INTERACT AND OUTFILE='$STDLIST' THEN
BEGIN
IF INTERACT AND (LINECOUNT0 AND HPTERMINAL() THEN
WRITEPROMPT (%33C, '&dJ');
WRITELN ('-----Printing ', F);
++LINECOUNT;
END;
END
ELSE
(* don't WRITELN, it would send the line to the ;OUT= file. *)
MPE ('ECHO -----Printing '+F);
NOBANNERYET:=FALSE;
END);
SUBROUTINE PRINTPAGEHEAD (F: VALUE STRING);
SEG (
BEGIN
WRITELN ('SYSTEM: ', HPSYSNAME); (* Here is the change *)
WRITELN ('MPEX %PRINT ', FREMLOCKWORD(F),
STRWRITE (HPDATEF, ', ', HPTIMEF, ' (PAGE ', VEPAGENUMBER, ')')
:(80-13-LEN(FREMLOCKWORD(F))):'RIGHTJUST');
WRITELN;
END);
SUBROUTINE PAGEEJECT;
SEG (
BEGIN
IF NOT NOPAGE AND NOT INTERACT AND NUMFILES>1 THEN
WRITEPAGE ();
NOEJECTYET:=FALSE;
END);
SUBROUTINE MAYWRITECCTL (CCTL: VALUE BOOLEAN; S: VALUE STRING);
BEGIN
IF NOT INTERACT OR LINECOUNT0 AND NOT VE_G_LOGIC_STATE AND LEN(RR)>0 THEN
IF CCTL THEN
RR[0:1]+IV+RR[1:512]
ELSE
IV+RR
ELSE
RR
ELSE
BEGIN
SAVER:=RADDRLEN;
RADDRLEN:=ISDOUBLE(RR);
SCOPY1 (CALLVARSTR (FORMATCODE, ISDOUBLE(T)), RADDRLEN:=SAVER)
END
END;
SUBROUTINE OUTLINE;
BEGIN
IF MATCHEDPREV THEN
OUT1 (IF NUM THEN STRWRITE(PREVNUM:9)+'-'+FORMAT(PREVREC)
ELSE FORMAT(PREVREC));
IF NOT MATCHEDPREV OR PREVNUM<>SUBFMTLINENUMBER THEN
BEGIN
IF NUM THEN
OUT1 (STRWRITE(SUBFMTLINENUMBER:9)+
(IF SEARCHRESULT AND (CAFTERC<>0 OR CBEFOREC<>0) THEN '*' ELSE ' ')+
FORMAT(REC))
ELSE
OUT1 (FORMAT(REC));
IF ++LINESFOUND>=MAXLINES THEN (* obsolete *)
ABORTMPE (VE_E_FLUSHED);
IF ++SHOWN>=MAXSHOWN THEN
(* MAX used without SEARCH;CONTEXT *)
ABORTMPE (VE_E_FLUSHED);
END;
MATCHEDPREV:=FALSE;
END;
SUBROUTINE DORECWITHCBEFORE;
VAR SAVERECNUM: INTEGER;
BEGIN
IF SEARCHRESULT AND CBEFOREC<>0 THEN
SEG (
BEGIN
SEARCHRESULT:=FALSE;
SAVERECNUM:=RECNUM;
WHILE RECNUM>STARTRECFIXED AND
RECNUM>LASTPRINTEDRECNUM+1 AND
PRINTREADDIR (RECNUM-2) AND
NOT DOCALL(CBEFOREC) DO
;
IF RECNUM<=LASTNONPRINTEDRECNUM THEN
BEGIN
LASTNONPRINTEDRECNUM:=RECNUM-1;
WHILE RECNUM'' THEN
+FLAB.FULLNAMELOCK
(* If lockword was specified, work it back in -- if the user
doesn't have AM/SM capability, lockword was stripped from
FLAB *)
ELSE IF LDLOCKWORD(LD)<>'' THEN
FLAB.FILE+'/'+LDLOCKWORD(LD)+'.'+FLAB.GROUP+'.'+FLAB.ACCOUNT
ELSE
VEFDOMAININFO (F,DOMAIN).FULLNAMELINK
END
RECOVER
F
END);
SUBROUTINE DOOPENINIT (ENDRECFIXED: INTEGER; ISWAIT: VALUE BOOLEAN);
SEG (BEGIN
CHECKINGCAFTER:=FALSE;
LASTNONPRINTEDRECNUM:=-1;
LASTPRINTEDRECNUM:=-1;
IF TRUEEOF=0 AND ENDREC=-1 THEN
(* probably an empty message file, read until EOF *)
ENDRECFIXED:=$7FFFFFFF
ELSE IF ENDREC<0 THEN
ENDRECFIXED:=ENDREC+1+INITIALEOF
ELSE
ENDRECFIXED:=ENDREC;
STARTRECFIXED:=IF STARTREC<0 THEN STARTREC+INITIALEOF+1 ELSE STARTREC;
(* exit silently if start>eof *)
IF NOT ISWAIT THEN
STARTRECFIXED:=MIN(STARTRECFIXED, INITIALEOF+1);
IF STARTRECFIXED<>1 THEN
MYTEXTPOINT (TADDR, MAX(0,STARTRECFIXED-1));
MATCHEDPREV:=FALSE;
IF NOT INTERACT THEN
VEPAGESIZE:=MIN(PAGESIZE,32767);
PRINTDELIMFLAG:=0;
PRINTCASELESSFLAG:=FALSE;
END);
SUBROUTINE DOOPENFILE (F: VALUE STRING);
VAR ENDRECFIXED: INTEGER;
VAR I: INTEGER;
BEGIN
DOOPENINIT (ENDRECFIXED, FALSE);
FOR I IN RANGE(1,1)
PAGEHEAD
IF NOT INTERACT AND PPAGEHEAD THEN
PRINTPAGEHEAD (F)
DO
WHILE PRINTREAD (T, REC, RECLEN) AND RECNUM<=ENDRECFIXED DO
IF DOSELECT THEN
DORECWITHCBEFORE;
END;
SUBROUTINE DOOPENFILEWAIT (F: VALUE STRING; FULLNAME: VALUE STRING);
VAR ENDRECFIXED: INTEGER;
VAR I: INTEGER;
VAR WRITEX: BOOLEAN;
VAR LOOP1: BOOLEAN;
VAR LASTRECNUM: INTEGER;
VAR ANYWRITER: BOOLEAN;
VAR DIRTY: BOOLEAN;
BEGIN
ANYWRITER:=FALSE;
DIRTY:=FALSE;
DOOPENINIT (ENDRECFIXED, TRUE);
TRY
(* wait, looping on eof of file while open for writing *)
LOOP1:=TRUE; (* 1st time through loop *)
FOR I IN RANGE(1,1)
PAGEHEAD
IF NOT INTERACT AND PPAGEHEAD THEN
PRINTPAGEHEAD (F)
DO
BEGIN
WHILE (NOT VE_G_CONY_HIT) AND
( (WRITEX:=TRY VEFLDOMAININFO(FULLNAME,DOMAIN).WRITING
RECOVER FALSE) OR
LONGWAIT OR LOOP1 OR
ENDREC>(IF ISBYTE THEN BYTENUM ELSE RECNUM)) DO
BEGIN
ANYWRITER:=ANYWRITER OR WRITEX;
LOOP1:=FALSE;
IF (ENDREC:=TRUEEOF)>(IF ISBYTE THEN BYTENUM ELSE RECNUM) THEN
SEG (BEGIN
(* ensure TEXT routines access updated EOF *)
TEXTEOF:=ENDREC;
MYTEXTPOINT (TADDR, MAX(0,RECNUM));
(* clear previous message, beep if wait +ve *)
IF DIRTY THEN
WRITEPROMPT ('':25, CHR(13),
IF WAIT>0 AND ANYWRITER THEN CHR(7) ELSE '');
LASTRECNUM:=RECNUM;
WHILE PRINTREAD (T,REC, RECLEN) AND RECNUM<=ENDREC DO
IF DOSELECT THEN
DORECWITHCBEFORE;
(* Partially-flushed var files on MPE/V may prevent any data *)
(* being displayed until a block is completely flushed. In *)
(* this case, execution continues with LASTRECNUM=RECNUM. *)
IF (WRITEX:=TRY VEFLDOMAININFO(FULLNAME,DOMAIN).WRITING
RECOVER FALSE) THEN
BEGIN
WRITEPROMPT ( '(Pausing at EOF)':30,CHR(13) );
DIRTY:=TRUE;
END
ELSE IF LONGWAIT THEN
BEGIN
WRITEPROMPT ( '(Pausing at EOF, no writers) '+CHR(13) );
DIRTY:=TRUE;
END;
END);
IF (LONGWAIT OR WRITEX) AND NOT VE_G_CONY_HIT THEN
PAUSE (ABS(WAIT));
ENDREC:=TRUEEOF;
END;
IF NOT VE_G_CONY_HIT AND ANYWRITER THEN
WRITELN ('(Stopped at EOF)':30,IF WAIT>0 THEN CHR(7) ELSE '');
END;
CLEANUP
IF VE_G_CONY_HIT THEN
SEG (BEGIN
WRITELN ('':30,CHR(13));
ABORTMPE (VE_E_CONTROL_Y);
END);
END;
SUBROUTINE DOFILE (F: VALUE STRING);
VAR LEVEL: SHORTINT;
VAR DFNUM: INTEGER;
VAR FLAB: TFILE;
BEGIN
GETSTACKLEVEL (LEVEL);
SEG (
BEGIN
TRY
(FLAB*^(2*VE_SIZE_FLAB)):=VEFINFO0(F,DOMAIN)
RECOVER
FILL (FLAB, VE_SIZE_FLAB, 0);
NUMFOUND:=0; (* searches NUMFOUND in current file *)
SHOWN:=0; (* lines shown from current file *)
DONE:=FALSE; (* deferred exit *)
TADDR:=0;
(* use VEFLxxxINFO to recover info on Link target *)
ISBYTE:=POSIX() AND (TRY FLAB.RECTYPE RECOVER -1)=9;
IF INTERACT AND
VE_CODE_ENCRYPT=(IF FILESETCMD THEN RF.INTCODE
ELSE FLAB.INTCODE) THEN
SEG (BEGIN
IF NOT ALLFILENAMES AND NOBANNERYET THEN
PRINTBANNER (F);
DFNUM:=CALL MPE'COPY
(SPRINTF ('%s,$UNIQUED.PUB.$OWNACCT;MAKETEMP%q(;KEEPAMDATES)'+
';CODE=%d;KEEPOPEN;KEEPATTR;DECRYPT;CRYPTKEY=%s',
F, KEEPAMDATES, VEFUNC CRYPTFCODE (F),
VEFUNC CRYPTKEYREAD ('decryption key'))+CHR(13),
@RF, IF FILESETCMD THEN 3 ELSE 2);
TEXTOPENFNUM (TADDR, DFNUM, ';DEL');
END)
ELSE IF VE_CODE_STRMJOB=(IF FILESETCMD THEN RF.INTCODE
ELSE FLAB.INTCODE) AND
CAPABILITY('SM') AND FORMATSTR="STRWRITE(SPRINTF('%Ls',R))" THEN
SEG (BEGIN
IF NOT ALLFILENAMES AND NOBANNERYET THEN
PRINTBANNER (F);
DFNUM:=CALL MPE'COPY
(SPRINTF ('%s,$UNIQUED.PUB.$OWNACCT;MAKETEMP%q(;KEEPAMDATES)'+
';CODE=0;KEEPOPEN;KEEPATTR', F, KEEPAMDATES)+CHR(13),
@RF, IF FILESETCMD THEN 3 ELSE 2);
TEXTOPENFNUM (TADDR, DFNUM, ';DEL');
END)
ELSE IF FILESETCMD THEN
SEG (TEXTOPEN (TADDR, F+','+DOMAINSTR+';SHR;NOFILEEQ;TEXT'+
(IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')+
(IF COPYACCESS THEN ';COPY' ELSE '')+
(IF BUF OR RF.BLOCKSIZE>4096 OR RF.ISXLSPOOLFILE
OR ((RF.ISMSG OR RF.ISRIO) AND NOT COPYACCESS)
THEN '' ELSE ';NOBUF')))
ELSE IF LFT(F)='(' AND RHT(F)=')' THEN
SEG (TEXTOPEN (TADDR, STRLDROP(STRRDROP(F))+
(IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')))
ELSE IF LFT(F)='*' THEN
SEG (TEXTOPEN (TADDR, MERGEFEQWITHDOMAIN(F,'OLDANY')+
(IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')))
ELSE
SEG (TEXTOPEN (TADDR, TRUEFILENAME(F,DOMAIN,FLAB)+','+DOMAINSTR+
';SHR;NOFILEEQ;TEXT'+
(IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')+
(IF COPYACCESS THEN ';COPY' ELSE '')+
(IF WAIT<>0 THEN ';GMULTI' ELSE '')+
(IF BUF OR
(FLAB.BLOCKSIZE>4096 OR
FLAB.ISXLSPOOLFILE AND
FLAB.OPENED OR
(FLAB.ISMSG OR
FLAB.ISRIO) AND
NOT COPYACCESS)
THEN '' ELSE ';NOBUF')));
END);
SEG (
BEGIN
TRY
BEGIN
@@T:=DBUILD (TADDR, 128);
IF (TRY VEFINFO(TEXTFNUM(TADDR)).INTCODE RECOVER 0)=111 AND
QEDITRECLEN>0 THEN
RECLEN:=QEDITRECLEN
ELSE
RECLEN:=512;
IF NONUMRECOGNIZE THEN
SETNONUMRECOGNIZE;
ISDOUBLEPTR(T[*24]):=DBUILD(@VARNONDELIMS,LEN(VARNONDELIMS));
CCTL:=IFNUMINFO(VEOUTFNUM,2)[7:1]=1 AND
IFNUMINFO(TEXTFNUM(TADDR),2)[7:1]=1 AND NOT NUM;
INITIALEOF:=IF ISBYTE AND (STARTREC<0 OR ENDREC<0) THEN SLOWTRUEEOF
ELSE TRUEEOF;
IF WAIT=0 THEN
DOOPENFILE (FNUMFNAME(TEXTFNUM(TADDR)))
ELSE
DOOPENFILEWAIT (FNUMFNAME(TEXTFNUM(TADDR)),F);
END
CLEANUP
BEGIN
IF TADDR<>0 THEN
TEXTCLOSE (TADDR);
TADDR:=0;
GLOBNUMFOUND:=GLOBNUMFOUND+IF SEARCHC=0 THEN SHOWN ELSE NUMFOUND;
END;
END);
SETSTACKLEVEL (LEVEL);
END;
SUBROUTINE MERGEDOUTFILE (FILEEQ: VALUE STRING);
VAR LOCEQ: STRING[256];
VAR RECSPEC: STRING[80];
VAR PRECSIZE: SHORTINT;
VAR PBLKFACT: SHORTINT;
VAR PFORMAT: SHORTINT;
VAR PASCII: SHORTINT;
VAR PMASK: INTEGER;
SEG (BEGIN
(* extract and decompose REC= specification, merge with ASCII default *)
LOCEQ:=STRCHANGE(UPS(FILEEQ), ' ', '');
MUSTSAVE:=POS(';SAVE',LOCEQ)>0;
IF POS (';REC=',LOCEQ)=0 THEN
LOCEQ:=';REC='
ELSE
LOCEQ:=TOKEN(LOCEQ[POS(';REC=',LOCEQ):256],';');
KEYWORDPARSE (LOCEQ, ';REC=s80:def//', RECSPEC);
PMASK:=KEYWORDPARSE (RECSPEC,
'a=271i,b=272i,c=273aF|V|U|B,d=274aBINARY|ASCII',
PRECSIZE, PBLKFACT, PFORMAT, PASCII);
IF PMASK[-13:1]=0 THEN
PASCII:=1; (* defaults to ;REC=,,,ASCII *)
TOKEN(FILEEQ,';')+';NOFILEEQ;ACC=OUT'+
(IF OUTFILE='$STDLIST' OR PAGESIZE<>-1 THEN ';CCTL' ELSE '')+
(FILEEQ-TOKEN(FILEEQ,';'))+
SPRINTF (';REC=%q(%d),%q(%d),%q(%c),%q(BINARY)%q(ASCII)',
PMASK[-16:1]=1, PRECSIZE, PMASK[-15:1]=1, PBLKFACT,
PMASK[-14:1]=1, 'FVUB'[PFORMAT:1], PASCII=0, PASCII<>0)
END);
SUBROUTINE OPENOUT;
SEG (BEGIN
VEOUTFNUM:=0;
MUSTSAVE:=FALSE;
IF OUTFILE<>'$STDLIST' OR
(* don't reopen output file if we already have a redirected stdlist *)
NOT BVAR('HPINTERACTIVE') AND NOT ISREDIRECTED() THEN
VEOUTFNUM:=FOPEN (IF LFT(OUTFILE)='(' AND RHT(OUTFILE)=')' THEN
MERGEDOUTFILE(STRLDROP(STRRDROP(OUTFILE)))
ELSE
OUTFILE+';REC=,,,ASCII;NOFILEEQ;ACC=OUT'+
(IF OUTFILE='$STDLIST' OR PAGESIZE<>-1
THEN ';CCTL' ELSE ''))
ELSE
VEOUTFNUM:=SVEOUTFNUM;
OUTSIZE:=OUTRECSIZE();
IF OUTSIZE=0 (*$NULL*) THEN
OUTSIZE:=32767;
END);
SUBROUTINE CLOSEOUT;
SEG (BEGIN
IF VEOUTFNUM<>0 AND VEOUTFNUM<>SVEOUTFNUM THEN
FCLOSE (VEOUTFNUM, IF IFNUMINFO(VEOUTFNUM,2)[14:2]=1 THEN 0
ELSE IF MUSTSAVE THEN 1 ELSE 2, 0);
VEOUTFNUM:=SVEOUTFNUM;
END);
SUBROUTINE TRUEPAGESIZE (PAGESIZE: VALUE INTEGER;
INTERACT: VALUE BOOLEAN;
PPAGEHEAD: VALUE BOOLEAN);
BEGIN
IF PAGESIZE=-1 THEN
IF INTERACT THEN 23
ELSE IF PPAGEHEAD AND VESOFTPAGESIZE<>0 THEN VESOFTPAGESIZE
ELSE 2000000000
ELSE IF PAGESIZE=0 THEN 2000000000
ELSE PAGESIZE
END;
SUBROUTINE DOPARSING;
VAR CONTEXT: STRING[256];
VAR KEYDESC: STRING[485];
VAR NOWAIT: BOOLEAN;
BEGIN
SEG (
BEGIN
KEYDESC:=
"FILE=s:def/$STDINX/,OUT=s128:def/$STDLIST/,START=d:def/1/,"+
"END=d:def/-1/,PAGE=d:def/-1/;UNN|NUM;NOPAGEHEAD|PAGEHEAD;BUF;"+
"SEARCH=s:def/TRUE/:incquotes;CONTEXT=s:incquotes;"+
"PREV=s:def/FALSE/:incquotes;FORMAT=s:def/R/:incquotes;"+
"OLDMAX=d:def/$7FFFFFFF/;NOFILEPAGEBREAK;KEEPAMDATES;"+
"COPY+ACCESS;NONUM+RECOGNIZE;ALLFILENAMES;NEW|OLD|OLDTEMP|OLDANY|TEMP;"+
"NOIV|IV|HI+LIGHT|HILITE|HIGHLIGHT;LONGWAIT;DEBUG;SPF;"+
"STARTPAGE=d:def/1/;ENDPAGE=d:def/-1/;"+
"ALL|IFLO+WLIGHT|IFLOL+ITE;MAX=d:def/$7FFFFFFF/"; (* 475 *)
WAIT:=0;
TRY
(* VECIERR:=0; *)
(* first form: WAIT=delay *)
KEYWORDPARSEDV (VEPARMS, "PRINT", KEYDESC+";WAIT=i;NOWAIT",
INFILE, OUTFILE, STARTREC, ENDREC, PAGESIZE, NUM,
PPAGEHEAD, BUF, SEARCHSTR, CONTEXT, PREVSTR, FORMATSTR,
MAXLINES, NOPAGE, KEEPAMDATES, COPYACCESS,
NONUMRECOGNIZE, ALLFILENAMES, DOMAIN, HILIGHT, LONGWAIT,
DEBUG, SPF, STARTPAGE, ENDPAGE, SKIP, MAXFOUND,
WAIT, NOWAIT);
IF NOWAIT THEN (* override WAIT *)
WAIT:=0;
RECOVER
IF VECIERR=612 THEN (* did not find '=' *)
BEGIN
(* second form: WAIT is boolean *)
KEYWORDPARSEDV (VEPARMS, "PRINT", KEYDESC+";NOWAIT|WAIT",
INFILE, OUTFILE, STARTREC, ENDREC, PAGESIZE, NUM,
PPAGEHEAD, BUF, SEARCHSTR, CONTEXT, PREVSTR,
FORMATSTR, MAXLINES, NOPAGE, KEEPAMDATES, COPYACCESS,
NONUMRECOGNIZE, ALLFILENAMES, DOMAIN, HILIGHT,
LONGWAIT, DEBUG, SPF, STARTPAGE, ENDPAGE,
SKIP, MAXFOUND, WAIT);
IF WAIT=1 THEN
WAIT:=-5;
END
ELSE
ABORTMPE(VECIERR);
IF DOMAIN=4 THEN (* TEMP same as OLDTEMP *)
DOMAIN:=2;
IF LONGWAIT AND WAIT=0 THEN
WAIT:=-5; (* LONGWAIT implies WAIT *)
IF INFILE="$STDINX" THEN (* inhibit WAIT logic *)
BEGIN
WAIT:=0;
LONGWAIT:=FALSE;
END;
IF WAIT<>0 AND PAGESIZE=-1 THEN
PAGESIZE:=0; (* default is PAGE=0 when WAITing *)
IF WAIT<>0 AND ENDREC<>-1 THEN
ABORT ("Can't specify ;WAIT and ;END together");
(* assume :SPOOL suffix if spoolfile selection criteria used *)
(*
IF POS('SPOOL.',UPS(REMTOKEN(INFILE,'(')))>0 AND
UPS(INFILE[LEN(INFILE)-6:6])<>":SPOOL" THEN
INFILE:=INFILE+":SPOOL";
*)
IF UPS(INFILE[LEN(INFILE)-6:6])=':SPOOL' AND ISPOSIXFILE(INFILE) THEN
ABORT ("Can't use :SPOOL with POSIX-syntax filenames");
IF LFT(OUTFILE)<>'(' AND LFT(OUTFILE)<>'*' AND ISFILESET(OUTFILE) THEN
ABORTMPE (944); (* Wildcards not allowed in file name *)
IF MAXFOUND<>$7FFFFFFF AND CONTEXT='' THEN
(* MAX without CONTEXT= instead means 'lines shown' *)
MAXSHOWN:=MAXFOUND
ELSE
(* Impose no limit on lines displayed: limit search matches NUMFOUND *)
MAXSHOWN:=$7FFFFFFF;
END);
SEG (
BEGIN
KEYWORDPARSE (CONTEXT,
"a=s:def/TRUE/:incquotes,b=s:def/TRUE/:incquotes",
CBEFORESTR, CAFTERSTR);
IF VALIDINTEGER(CBEFORESTR) THEN
CBEFORESTR:="RECNUMSEARCH-RECNUM="+
STRWRITE(ABS(INTEGERPARSE(CBEFORESTR)));
IF VALIDINTEGER(CAFTERSTR) THEN
CAFTERSTR:="RECNUM-RECNUMSEARCH="+
STRWRITE(INTEGERPARSE(CAFTERSTR));
IF IVAR("MPEXPRINTKEEPAMDATES",0)<>0 THEN
KEEPAMDATES:=TRUE;
IF SKIP>0 THEN
IV:=%33C+"&d"+UPS(SVAR("VESOFTENHANCEFALSE","H")[0:1]);
END);
END;
SEG (
BEGIN
ABORTOPERATION:=FALSE;
DONTASK:=FALSE;
LINESFOUND:=0; (* obsolete *)
GLOBNUMFOUND:=0; (* global MAX tracking *)
VE_G_LOGIC_STATE:=TRUE; (* initial IFTRUE | IFFALSE state *)
IV:="";
SAVECONTROLY:=CONTROLYSET();
VARNONDELIMS:=SVAR ("MPEXPRINTNONDELIMS", "");
SVEOUTFNUM:=VEOUTFNUM;
DOPARSING;
FILESETCMD:=XEQCALL AND LFT(INFILE)<>'(' AND ISFILESET(INFILE);
IF DOMAIN=0 THEN
DOMAIN:=IF FILESETCMD THEN 1 ELSE 3;
DOMAINSTR:=STRRTRIM('NEW OLD OLDTEMP OLDANY '[8*DOMAIN:8]);
(* ensure banner handled correctly when ;ALLFILENAMES specified *)
FILESETCMD:=FILESETCMD OR ALLFILENAMES;
IF FILESETCMD THEN
MPEXINITJCWS ();
IF NOT ISPOSIXFILE(OUTFILE) THEN
OUTFILE:=UPS(OUTFILE);
END);
IF SEARCHSTR='TRUE' THEN
SEARCHC:=0
ELSE
SEG (COMPILEBOOL (SEARCHC,
"[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
SEARCHSTR+")"+CHR(13)));
IF CAFTERSTR='TRUE' THEN
CAFTERC:=0
ELSE
SEG (COMPILEBOOL (CAFTERC,
"[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
CAFTERSTR+")"+CHR(13)));
IF CBEFORESTR='TRUE' THEN
CBEFOREC:=0
ELSE
SEG (COMPILEBOOL (CBEFOREC,
"[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
CBEFORESTR+")"+CHR(13)));
IF FORMATSTR='R' THEN
FORMATCODE:=0
ELSE
SEG (COMPILE (FORMATCODE, TYPE,
"[[[VARPARM P:TPRINTINFO; WITH P DO SCOPY(FORMATS]]]("+
FORMATSTR+")[[[)]]]"+CHR(13)));
IF PREVSTR='FALSE' THEN
PREVC:=0
ELSE
SEG (COMPILEBOOL (PREVC,
"[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
PREVSTR+")"+CHR(13)));
BIND (VE_G_FS_CIERR, 9080);
TRY
BEGIN
SEG (BEGIN
OPENOUT;
LINECOUNT:=0;
NUMFILES:=0;
INTERACT:=ISBOOLEAN (CALL IO'INTERACTIVE(VE_G_IN_FNUM,VEOUTFNUM))
AND INFILE<>"$STDINX";
PAGESIZE:=TRUEPAGESIZE (PAGESIZE, INTERACT, PPAGEHEAD);
END);
IF NOT FILESETCMD THEN
SEG (
BEGIN
NOBANNERYET:=FALSE; (* because none will be printed anyway *)
NOEJECTYET:=FALSE; (* ditto *)
TRY
DOFILE (INFILE)
RECOVER
IF VECIERR<>VE_E_FLUSHED THEN
ABORTNOPARM();
END)
ELSE
FOR RF IN DIRFILESMPEX (INFILE+IF DOMAIN=2 THEN ' :TEMP' ELSE '',
9080,52,9080,51,9080,50)
(* Don't use TOTAL since it doesn't work from SEGs *)
FIRST NUMFILES:=0
DOBEFORE ++NUMFILES
WHILE NOT ABORTOPERATION DO
BEGIN
SEG (
BEGIN
NOBANNERYET:=TRUE;
NOEJECTYET:=TRUE;
IF RF.SPOOL.SPOOLFILENUM<>0 THEN
F:=RF.SPOOL.YESNOSPOOL
ELSE
F:=RF.FULLNAME;
END);
TRY
SEG (
BEGIN
IF ALLFILENAMES THEN
PRINTBANNER (F);
DOFILE (IF RF.SPOOL.SPOOLFILENUM<>0 THEN
TOKEN(F-'#',' ')+
(IF F[1:1]='O' THEN '.OUT.HPSPOOL'
ELSE '.IN.HPSPOOL')
ELSE
RF.FULLNAMELOCK);
MPEXSUCCEEDED (MPCOMMON);
END)
RECOVER
SEG (IF VECIERR<>VE_E_FLUSHED THEN
MPEXFAILED (MPCOMMON, F) );
END;
END
CLEANUP
SEG (
TRY
CLOSEOUT
CLEANUP
BEGIN
IVARSET ("MPEXPRINTLINESFOUND",
IF MAXLINES=$7FFFFFFF THEN GLOBNUMFOUND ELSE LINESFOUND);
CONTROLYRESET (SAVECONTROLY);
END);
UNBIND (VE_G_FS_CIERR);
END;