|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10880 (0x2a80)
Types: TextFile
Names: »LIST.PAS«
└─⟦59f3de555⟧ Bits:30004546 Turbo Pascal 5.5 for C-DOS Piccoline
└─⟦this⟧ »LIST.PAS«
PROGRAM list;
uses crt, printer;
æ LIST is a very useful all-purpose list program. It can output å
æ listings of all sorts of text files, with headers, line num- å
æ bers, and full control of page length, line length, left mar- å
æ gin and bottom margin. LIST obtains all its parameters from å
æ the command line. The command line format is: å
æ å
æ LIST <filename><options>,...,<filename><options> å
æ å
æ where <filename> is a file name acceptable to the operating å
æ system, and <options> are one or more options, selected from å
æ the following list: å
æ å
æ Inn Indent each line printed by nn blanks. å
æ Snn Skip nn lines at the bottom of each page. å
æ H Print file name and page number on top of å
æ each page. å
æ Hsssss Print header string and page number on top å
æ of each page. å
æ N Print line number before each line. å
æ F Form-feed. Skip to top of next page. å
æ Tn Tegntype: 1 = Pica, 2 = Elite, 3 = Compressed å
æ An Afstand: 1 = 6 lpi, 2 = 8 lpi å
æ D Dansk tegnsaet å
æ U USA tegnsaet å
æ E Enkeltark å
æ å
æ Each option must be preceded by a forward slash. An example å
æ of a LIST command line: å
æ å
æ LIST WORK.PAS/I8/N/HWorkfile Listing,CALC.PAS,/F å
æ å
æ This line will cause WORK.PAS to be listed with an indenta- å
æ tion (left margin) of 8, line numbers and a user specified å
æ heading. Following this, CALC.PAS is listed using the default å
æ page format parameters, and finally a form-feed is output. å
CONST
dpagelen = 72; æDefault page lengthå
dlinelen = 80; æDefault line lengthå
dindent = 0; æDefault indentationå
dskip = 12; æDefault bottom skipå
lf = #10; æLinefeedå
rev_lf = #27'j'#180; æreverse linefeedå
crlf = #13#10; æcarriagereturn - linefeedå
ht = #9; æHorizontal tabå
ff = #12; æFormfeedå
esc = #27; æEscapeå
P_ulnon = #27'-'#1;
P_ulnoff = #27'-'#0;
P_inton = #27'E'#27'G';
P_intoff = #27'F'#27'H';
P_itaon = #27'4';
P_itaoff = #27'5';
P_super = #27'S'#0;
P_sub = #27'S'#1;
P_suoff = #27'T';
Pica = #27#18#27'P';
Elite = #27#18#27'M';
Comp_on = #27'P'#27#15;
LPI6 = #27'2';
LPI8 = #27'0';
SW_reset = #27'@';
US = #27'R'#13;
DK = #27'R'#10;
set_tof = #27'C'#0#12;
eject = #27'J'#180;
VAR
i,pos,pagelen,linelen,indent,skip,arg,
pageno,lineno,lin,col,width: integer;
ch,opt: char;
first, printhdr,linenumbers, sheet, dk_set: boolean;
ns: STRINGÆ4Å;
filename,header: STRINGÆ80Å;
line, cmdline: STRINGÆ127Å;
infile, outfile: text;
FUNCTION cap(ch: char): char;
BEGIN
IF (ch>='a') AND (ch<='z') THEN
cap:=chr(ord(ch)-32) ELSE cap:=ch;
END;
procedure stop_print;
begin
ClrScr;
write(#7'Skift ark, n▶86◀r printeren er f▶91◀rdig, og tryk p▶86◀ retur');
readln;
ClrScr;
write(outfile,set_tof);
end;
BEGIN
pagelen:=dpagelen; linelen:=dlinelen; indent:=dindent;
skip:=dskip; header:=''; printhdr:=false; linenumbers:=false;
filename:=''; line:=''; pos:=1; first:= TRUE; sheet:= FALSE;
for i:=1 to ParamCount do line:= line+' '+ParamStr(i);
line:= line+#0; i:=1;
while lineÆiÅ<>#0 do begin
if lineÆiÅ='@' then lineÆiÅ:= ' ';
i:=i+1;
end;
cmdline:=LPI6+DK+Pica; dk_set:= TRUE;
assign(outfile,'LST'); rewrite(outfile);
REPEAT
WHILE lineÆposÅ IN Æ' ',','Å DO pos:=succ(pos);
WHILE NOT(lineÆposÅ IN Æ' ',',','/',#0Å) DO
BEGIN
filename:=filename+lineÆposÅ; pos:=succ(pos);
END;
WHILE lineÆposÅ=' ' DO pos:=succ(pos);
WHILE lineÆposÅ='/' DO
BEGIN
pos:=succ(pos); opt:=cap(lineÆposÅ); pos:=succ(pos);
CASE opt OF
'I','S','T','A':
BEGIN
arg:=0;
WHILE lineÆposÅ IN Æ'0'..'9'Å DO
BEGIN
arg:=arg*10+ord(lineÆposÅ)-ord('0');
pos:=succ(pos);
END;
CASE opt OF
'I': indent:=arg;
'S': skip:=arg;
'T': CASE arg OF
1: begin
cmdline:= cmdline+Pica;
linelen:= 80;
indent:= 0;
end;
2: begin
cmdline:= cmdline+Elite;
linelen:= 94;
indent:= 10;
end;
3: begin
cmdline:= cmdline+Comp_on;
linelen:= 135;
indent:= 15;
end;
ELSE
writeln('Illegal fontnumber: ',arg);
if not first then write(outfile,SW_reset); halt;
END;
'A': CASE arg OF
1: begin
cmdline:= cmdline+LPI6;
pagelen:= 72;
if sheet then skip:= 15 else skip:= 12;
end;
2: begin
cmdline:= cmdline+LPI8;
pagelen:= 96;
if sheet then skip:= 20 else skip:= 16;
end;
ELSE
writeln('Illegal line spacing: ',arg);
if not first then write(outfile,SW_reset); halt;
END;
END;
END;
'H':
BEGIN
WHILE NOT(lineÆposÅ IN Æ',','/',#0Å) DO
BEGIN
header:=header+lineÆposÅ; pos:=succ(pos);
END;
printhdr:=true;
END;
'N': linenumbers:=true;
'E': begin
sheet:= TRUE;
cmdline:= cmdline+Elite;
linelen:= 94;
indent:= 10;
if pagelen=72 then skip:=15 else skip:=20;
end;
'F': write(outfile,ff);
'D': begin cmdline:= cmdline+DK; dk_set:= TRUE; end;
'U': begin cmdline:= cmdline+US; dk_set:= FALSE; end;
ELSE
writeln('Unknown option identifier: "',opt,'"');
if not first then write(outfile,SW_reset); halt;
END;
WHILE lineÆposÅ=' ' DO pos:=succ(pos);
END;
IF filename<>'' THEN
BEGIN
assign(infile,filename);
æ$I-å reset(infile) æ$I+å;
IF ioresult<>0 THEN
BEGIN
writeln('File not found: "',filename,'"');
write(outfile,SW_reset); halt;
END;
IF header='' THEN header:='File '+filename;
pageno:=1; lineno:=1; lin:=0; width:=linelen-indent;
IF linenumbers THEN width:=width-6;
IF first then
if sheet then
write(outfile,set_tof)
else
write(outfile,rev_lf,set_tof)
else
write(outfile, ff);
write(outfile,cmdline);
cmdline:=''; first:= FALSE;
WHILE NOT eof(infile) DO
BEGIN
IF keypressed THEN
BEGIN
ch:= ReadKey;
if ch=#0 then ch:=ReadKey;
IF ch=esc THEN
BEGIN
writeln('Interrupted');
IF lin<>0 THEN
write(outfile,ff);
write(outfile,SW_reset); halt;
END;
END;
IF printhdr AND (lin=0) THEN
BEGIN
write(outfile,'':indent,P_inton,header);
writeln(outfile,'':linelen-indent-length(header)-8,'Page ',pageno);
write(outfile,P_intoff,crlf,crlf); lin:=3;
END;
write(outfile,'':indent);
IF linenumbers THEN
BEGIN
str(lineno,ns); write(outfile,copy('000',1,4-length(ns)),ns,' ');
END;
col:=0; ch:= ' ';
WHILE (NOT eoln(infile)) AND (ch<>ff) DO
BEGIN
read(infile,ch);
if ((ch=#155) or (ch=#157)) and dk_set then
if ch=#155 then ch:=#124 else ch:=#92;
CASE ch OF
#32..#126, #128..#255:
BEGIN
IF col<width THEN
write(outfile,ch);
col:=succ(col);
END;
ht:
REPEAT
IF col<width THEN write(outfile,' ');
col:=succ(col);
UNTIL col MOD 8=0;
ff:
BEGIN
write(outfile,ff);
if sheet then stop_print;
pageno:=succ(pageno); lin:= 0;
END;
^A: write(outfile,Pica);
^B: write(outfile,Elite);
^C: write(outfile,Comp_on);
^D: begin write(outfile,DK); dk_set:= TRUE; end;
^E: write(outfile,LPI6);
^F: write(outfile,LPI8);
^G: write(outfile,P_inton);
^H: write(outfile,P_intoff);
^N: write(outfile,P_super);
^O: write(outfile,P_sub);
^P: write(outfile,P_suoff);
^R: write(outfile,P_ulnon);
^S: write(outfile,P_ulnoff);
^U: begin write(outfile,US); dk_set:= FALSE; end;
^V: write(outfile,P_itaon);
^W: write(outfile,P_itaoff);
END;
END;
IF eoln(infile) THEN readln(infile);
IF ch<>ff THEN BEGIN
writeln(outfile);
lineno:=succ(lineno); lin:=succ(lin);
IF lin=pagelen-skip THEN
BEGIN
write(outfile,ff);
if sheet then stop_print;
pageno:=succ(pageno); lin:=0;
END;
END;
END;
IF lin<>0 THEN
write(outfile,ff);
filename:=''; header:='';
printhdr:=false; linenumbers:=false;
close(infile);
END;
UNTIL lineÆposÅ=#0;
if not sheet then write(outfile,eject);
write(outfile,SW_reset);
close(outfile);
END.
«eof»