⟦d7ff5731a⟧

TextFileVerbose

job stb 4 3447
doksroff=set 84 disc1
scope user doksroff
message start compile doksroff
doksroff=algol
begin
<* this program is a preprocessor to the roff
text editing program.

its main purpose is to help roffing the doks-register.
 
the doks register is a register keeping track of all
documents in a project.
a doks number follows the syntax:
   <headgroup>.<subgroup>.<document number>/<version>
the version being optional.
for each document you have a date and the initials of
the author.
 
the only additional command is:

>dn <doksnumber> <date> <author>
text

which must be given for each document.

before each new headgroup a >a1 command must be given.

before each subgroup a >a2 command must be given.

These commands are slightly different from the
normal >a commands in that the left section number
are 15 positions to the left (in stead of 8).


doksroff was programmed 06.02.1980 by stb

edited 07.10.1980/stb: >a commands changed.

*>


integer array line(1:200), section(1:4);

integer line_length,lf,sp,ff,sp_fix,
_       c_a1,c_a2,c_a3,c_a4,i,ul,ll,c_dn,c_ug,
_       c_fg,c_ex,fg_no,ex_no,boss_line,c_bl,contents_line;

boolean finished,no_fill_mode,boss_line_mode;

zone contents(128,1,stderror);

\f


procedure init_com(com,first,second);
value first,second;
integer com,first,second;
com:=62 shift 16 + first shift 8 + second;


\f


procedure no_fill(no_fill_yes);
value no_fill_yes;  boolean no_fill_yes;
begin
no_fill_mode:=no_fill_yes;

write(out,if no_fill_mode then <:>nf:> else <:>fi:>,
_     <:<10>:>);
end;

\f


procedure print_contents(level);
value level; integer level;
begin <* prints a line in the table of contents *>
integer chars;

if contentsline>60 then
begin <* change page *>
outchar(contents,ff);
contentsline:=0;
end;

contentsline:=contentsline+1;

if section(2)=0 then 
begin outchar(contents,10);
contentsline:=contentsline+1;
end;
 
write(contents,false add 32,10);

chars:=write(contents,false add 32, ((case level of (0,4,9,16))))
_     +print_section_number_2
_     +write(contents,<:  :>)
_     +print_line_rest_2
_     +write(contents,<: :>)
;

write(contents,false add 46,60-chars,false add 10,1);

end print contents;

\f


procedure print_line;
begin <* prints the line contained in the 'line-arrAy'
and handles possible preroff-commands *>
integer com,i;

com:=if line_length<3 then 0 else
_    line(1) shift 16 + line(2) shift 8 + line(3);

if line_length=0 then write(out,<:>sp1<10>:>)
else
if com=c_dn then
begin <* doks number *>
integer point;

point:=4;

write(out,<:>ne5<10>>ti-15<10>:>);
skip_spaces(point);
print_word(point);
write(out,<:<10>>tl<10>:>);
skipspaces(point);
printword(point);
write(out,false add 32,2);
skipspaces(point);
printword(point);
write(out,<:<10>>sp0<10>:>);
end
else
if com=c_ug then
begin <* new doks usubgroup *>
integer point;

point:=4;
write(out,<:>np<10>>ti-15<10>>ul<10>:>);
skipspaces(point);
printword(point);
outchar(out,lf);
end
else
if com=c_a1 then
begin <* start a new chapter *>
section(1):=section(1)+1;

for i:=2,3,4 do section(i):=0;

if section(1)>1 then
write(out,<:>np<10>:>);
print_section_head;
print_contents(1);
end
else
if com=c_a2 then
begin
section(2):=section(2)+1;

for i:=3,4 do section(i):=0;

print_section_head;
print_contents(2);
end
else
if com=c_a3 then
begin
section(3):=section(3)+1;
section(4):=0;
print_section_head;
print_contents(3);
end
else
if com=c_a4 then
begin
section(4):=section(4)+1;
print_section_head;
print_contents(4);
end
else
if com=c_fg then
begin <* figure *>
nofill(false);
write(out,<:>nf<10>>in-8<10>>ll+50<10>:>,
_     false add spfix,(70-linelength-9)//2,
_     <:fig. :>,fgno,<:. :>);
fg_no:=fg_no+1;
printlinerest(false);
write(out,<:>fi<10>>ll-50<10>>in8<10>:>);
end
else
if com=c_ex then
begin <* example *>
nofill(false);
write(out,<:>ne8<10>>ul<10>Eksempel:>,false add ul,1,<<d>,ex_no,<:::>,
_     false add ul,1);
printlinerest(true);
ex_no:=ex_no+1;
end
else
if com=c_bl then
begin <* set bossline mode *>
boss_line_mode:=true;
end
else
begin <* ordinary line *>

if line_length >= 1 then
begin
if line(1)=sp then
begin integer i;

for i:=1 step 1 until line_length do
if line(i)=sp then line(i):=sp_fix;

if -, no_fill_mode then no_fill(true);
end
else
if line(1)<>sp and no_fill_mode then no_fill(false);
end;

for i:=1 step 1 until line_length do
outchar(out,line(i));
outchar(out,lf);
end;

line_length:=0;
bossline:=bossline+10;
end print line;


\f


procedure print_line_rest(underline);
value underline;  boolean underline;
begin <* prints the rest of a line starting with
a preroff_command. underline indicates whether spaces 
shall be converted into underlines *>
integer i;

i:=4;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<=line_length do
begin
outchar(out,if (line(i)=sp) and underline then ul
_       else line(i));
i:=i+1;
end;

if bosslinemode then write(out,false add spfix,1,<<d>,bossline);
outchar(out,10);
end print line rest;


procedure skip_spaces(point);
integer point;
begin <* point is moved to the first position in line
which isnt a space *>
while (line(point)=32) and (point<=linelength) do
point:=point+1;
end;



procedure print_word(point);
integer point;
begin <* prints the word starting at point *>
while (line(point)<>32) and (point<=linelength) do
begin
outchar(out,line(point));
point:=point+1;
end;
end;

\f


integer procedure print_line_rest_2;
begin <* prints the rest of the input_line as it is *>
integer i,chars;

i:=4;
chars:=0;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<line_length do
begin
outchar(contents,line(i));
i:=i+1;
chars:=chars+1;
end;

if line(line_length)<>46 then
begin <* the line doesn't end with a period *>
outchar(contents,line(linelength));
chars:=chars+1;
end;


print_line_rest2:=chars;
end;


\f


procedure print_section_head;
begin <* provides the roff-commands necessary to
make the proper format of a section_header.

the section_number is taken from the 'section'-array *>

integer i,extra_ll;

procedure print_section_number(spaces);
value spaces; boolean spaces;
begin integer i,j;
i:=write(out,<<d>,section(1));

for j:=2,3,4 do
if section(j)>0 then
i:=i+write(out,<:.:>,<<d>,section(j));

if spaces then write(out,false add ul,15-i);
end print section number;


nofill(false);

write(out,<:>ne8<10>:>);

if section(2)<>0 then write(out,<:>sp2<10>:>);

extra_ll:=line_length+8-ll;

if extra_ll>0 then write(out,<:>ll+:>,<<d>,extra_ll+2,false add 10,1);

write(out,<:>in-15<10>>ul<10>:>);

print_section_number(true);
i:=4;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<=line_length do
begin
outchar(out,if line(i)<>sp then line(i) else ul);
i:=i+1;
end;
  
if bosslinemode then write(out, << d>,bossline);

if extra_ll <= 0 then
begin <* write the section number right justified *>
write(out,<:<10>>rj<10>:>);
print_section_number(false);
end
else
write(out,<:<10>>ll-:>,<<d>,extra_ll+2);
 
write(out,<:<10>>sp1<10>>in15<10>:>);

end print section head;

\f


integer procedure print_section_number2;
begin <* prints the section number as it is in the
contents file *>
integer chars,i;

chars:=write(contents,<<d>,section(1),
_            if section(2)=0 then <:.:> else <::>);

for i:=2,3,4 do
if section(i)>0 then
chars:=chars+write(contents,<:.:>,<<d>,section(i));

print_section_number2:=chars;
end;



\f


procedure read_line;
begin <* reads a line from input and stores
the characters in the 'line'-array *>

integer char;
boolean line_finished;

line_length:=0;
line_finished:=false;

repeat 
readchar(in,char);

if char=25 then line_finished:=finished:=true
else
begin
if (char=lf) or (char=ff) then line_finished:=true
else
begin
line_length:=line_length+1;
line(line_length):=char;
end;
end;

until finished or line_finished;
end read line;

\f


procedure testout(text,int);
value int; integer int; string text;
begin write(out,<:**** :>,text,<:  :>,int,false add lf,1);
setposition(out,0,0);
end test out;




\f


<******* i n i t i a l i s e   ******>

finished:=false;
no_fill_mode:=false;
bosslinemode:=false;
contentsline:=10;
ll:=58;
lf:=10;
ff:=12;
ul:=95;
sp:=32;
sp_fix:=64;

fg_no:=1;
ex_no:=1;
bossline:=10;

init_com(c_a1,97,49);
init_com(c_a2,97,50);
init_com(c_a3,97,51);
init_com(c_a4,97,52);
init_com(c_fg,102,103);
init_com(c_ex,101,120);
init_com(c_bl,98,108);
init_com(c_ug,117,103);
init_com(c_dn,100,110);

for i:=1 step 1 until 4 do section(i):=0;

open(contents,4,<:contents:>,0);

\f


<*******   m a i n   l o o p    ******>

write(contents,false add ff,1,false add lf,10,false add 32,10);
write(contents,<:INDHOLD:>,false add 32,52,<:side:>);
write(contents,false add lf,1,false add 32,10,false add ul,63,false add lf,2);


write(out,<:>pw+16<10>>ll+8<10>:>);
write(out,<:>he <64><126><35><126><64><10>:>,
_       <:>in15<10>>ta15<10>:>);



repeat
read_line;
print_line
until finished;

write(out,<:>np<10>:>);
outchar(out,ff);
outchar(contents,ff);
outchar(contents,lf);
outchar(contents,25);
close(contents,true);

end
if warning.yes
(message warning compilation not ok
finis)
message compilation ok
finis
«eof»
DataMuseum.dk

RC3500

⟦d7ff5731a⟧ TextFileVerbose

Derivation

TextFileVerbose
