% helpunx.red
%
% interfacing reduce help file to unix GNU texinfo structure
%
% Author: Herbert Melenk, ZIB Berlin
%
% November 1992
%
% PSL dependent
%-------------------- output ------------------------------------
fluid '(outc newl par !*font !*newline nodechain
prevnode upnodes !*terpri);
symbolic procedure initoutput();
<<
upnodes := {"Top"};
if null nodechain then
nodechain:={{"dummy 2",nil,"dummy 1"}};
prevnode :={nil};
channellinelength(outfile!*,200);
myprin2 bldmsg("@setfilename %w.info",package);
myterpri();
>>;
symbolic procedure endoutput();
nil;
symbolic procedure verbatim(u);
<<myterpri();
if not u then toggle_line();
myprin2 if u then "@example" else "@end example";
myterpri();
if u then toggle_line();
if not u then
<<myprin2t "@*"; myprin2t "@noindent"; >>;
!*verbatim:=u;
>>;
symbolic procedure toggle_line();
<<myterpri!*(); for i:=1:60 do myprin2 "_"; myterpri();>>;
symbolic procedure newfont(f);
if currentfont neq f then
<<fontoff(); currentfont:=f; fonton()>>;
symbolic procedure fontoff();
<<%%% if !*font then channelprin2(outfile!*,"}");
outc:=nil;
!*font:=nil>>;
symbolic procedure fonton();
<<if not !*font then
<<%%% channelprintf(outfile!*,"{\%w ",currentfont);
outc := nil>>;
!*font:=t>>;
symbolic procedure myprin2 u;
if not(u eq '!\) then
<<!*newline:=nil; !*terpri :=nil; channelprin2(outfile!*,u)>>;
fluid '(!*verbescape);
symbolic procedure emit_start_verbatim();
<< myprin2 "@example"; myterpri();toggle_line()>>;
symbolic procedure emit_end_verbatim();
<< toggle_line();myterpri();myprin2 "@end example"; myterpri();>>;
symbolic procedure verbprin2 u; (textout u) where !*verbatim=t;
symbolic procedure verbprin2 u;
if u = '!\ then <<myprin2 '!@ ; !*verbescape :=t>>
else
if u=!$eol!$ then <<myprin2 " "; myterpri();!*verbescape := nil>>
else
if (u = '!&) then
<<myprin2 " "; !*verbescape:=par:=newl:=outc:=nil>>
else
if u memq '(!{ !}) then
<<if not !*verbescape then myprin2 "@"; myprin2 u;
!*verbescape := nil>>
else
<<myprin2 u; !*verbescape := nil>>;
symbolic procedure myprin2t u;
<<!*newline:=t; channelprin2(outfile!*,u); channelterpri outfile!*;>>;
symbolic procedure myterpri!*();
!*terpri or myterpri();
symbolic procedure myterpri();
<<channelterpri outfile!*; !*terpri := t>>;
symbolic procedure textout(u);
if par and (u=!$eol!$ or u='! ) then nil else
if u='!{ or u='!} then nil else
<<fonton();
if u=!$eol!$ and (!*verbatim or newl)
then <<myprin2 u; %%% print_newline();
outc:='! ;newl:=nil; par:=t>>
else
if (u = '!&) then
<<myprin2 " "; par:=newl:=outc:=nil>>
else
if (u = '!$) then
newfont(if currentfont = helvetica then courier else helvetica)
else
if (u neq '! ) or (outc neq '! ) or !*verbatim
then
<<myprin2(u); outc := u;
if u=!$eol!$ then newl:=t else
if u neq '! then newl:=nil;
par:=nil;
>>;
>>;
symbolic procedure textoutl(l);
if null l then nil else
if atom l then textout l else
for each x in l do textout x;
symbolic procedure textout2(l);
if atom l then myprin2 l else
for each x in l do myprin2
if x='! then '!_ else x;
% -------- paragraph heading ---------------------------
symbolic procedure par_heading(type);
<<verbprin2 !$eol!$;
verbprin2 "@noindent"; verbprin2 !$eol!$;
for each x in explode type do verbprin2 x;
verbprin2 ":";
verbprin2 !$eol!$; verbprin2 !$eol!$;
>>;
% -------- directory structure -------------------------
fluid '(!*in!-directory actdir);
symbolic procedure base_new_dir name;
% initial call for new section
<<% name := mycompress name;
prevnode := nil . prevnode;
upnodes:= name.upnodes;
>>;
symbolic procedure emit_dir_new();
% closing a section.
<< if upnodes then
<<actdir := car upnodes; upnodes:=cdr upnodes>>;
if prevnode then prevnode:=cdr prevnode;
>>;
symbolic procedure emit_dir_key u; nil;
symbolic procedure emit_dir_entry(name,lab);
begin scalar n,alias;
if not !*in!-directory then
<<myterpri(); myprin2 "@menu"; myterpri();!*in!-directory:=t;>>;
myprin2 "* ";
textoutl if atom lab then name else lab;
myprin2 "::";
n:=length (if atom lab then name else lab)+2;
for i:=n:25 do myprin2 " ";
if (alias:=assoc(lab,aliases)) then
<<myprin2 " "; textoutl cdr alias; myprin2 " ";>>;
%%% Klappaltar textoutl name;
if find_type(name) then textoutl find_type(name);
myterpri();
end;
fluid '(typen);
typen := for each x in
'("package" "operator" "type" "variable" "concept"
"switch" "command" "introduction" "declaration")
collect explode2 x;
symbolic procedure find_type(name);
<<while memq('! ,name) do name:=cdr name;
if name member typen then name else nil
>>;
symbolic procedure emit_dir_header(); nil;
symbolic procedure emit_dir_separator();
<<myprin2 "@end menu";
myterpri(); myterpri();
!*in!-directory:=nil;
prevnode:=actdir . cdr prevnode;
>>;
symbolic procedure emit_dir_label u; nil;
symbolic procedure emit_dir_title u;
% emit_node_title (nil,u,'section);
emit_node_title (u,u,'section);
symbolic procedure emit_dir_browse(u,n); nil;
% ---- node structure
symbolic procedure emit_node_separator();
<<
myterpri(); myterpri();
outc:='! ; par:=t;
>>;
symbolic procedure printem(s);
begin
fontoff();
myprin2 "@titlefont{";
mapc(s,'myprin2);
myprin2 "}";
end;
symbolic procedure printem(s);
<<mapc(raisestring s,'myprin2);
myprin2 '! ;
>>;
symbolic procedure printref u;
begin scalar l;
l := get_label u;
if l then
<<myprin2 "[@pxref{";
mapc(l,'myprin2);
myprin2 "}] ";
>>
else
<<mapc(u,'myprin2); myprin2 '! >>;
end;
symbolic procedure printnameref u;
<<printref u>>;
symbolic procedure emit_node_keys u; nil;
symbolic procedure emit_node_key u;
if !*verbatim then textoutl u else
<<myprin2 "@cindex{";
textoutl u;
myprin2t "}";
% textoutl u; das ist hier schon ausgegeben
>>;
symbolic procedure emit_hidden_node_key u;
if !*verbatim then textoutl u else
<<myprin2 "@cindex{";
textoutl u;
myprin2t "}";
>>;
symbolic procedure emit_node_label u; nil;
%symbolic procedure emit_node_title (dummy,u,type);
symbolic procedure emit_node_title (u,dummy,type);
begin scalar slot,prev,next,up,cu,z;
cu := u; % cu:=mycompress u;
prev := if prevnode then car prevnode;
slot := assoc(cu,nodechain);
if null slot then
<<slot := {cu,nil,prev};
nodechain :=slot.nodechain;
>>;
if prevnode and car prevnode
and (z:=assoc(car prevnode,nodechain)) then
<<z:=cdr z; car z :=cu>>;
up := if upnodes then car upnodes;
fonton();
myterpri();
myprin2 "@node ";
textoutl u; myprin2 ", ";
textoutl cadr slot;myprin2 ", ";
textoutl caddr slot;myprin2 ", ";
textoutl (up or "(dir)");
myterpri();
if null up then <<myprin2 "@top"; myterpri()>>;
if null prevnode then prevnode := {cu}
else car prevnode := cu;
end;
symbolic procedure emit_node_browse(u,n);
nil;
symbolic procedure set_tab(); nil;
symbolic procedure release_tab(); nil;
symbolic procedure print_bold u;
<<fontoff();
myprin2 "@titlefont{";
mapc(u,'myprin2);
myprin2 "}";
>>;
symbolic procedure print_newline();
<<if null !*newline then
<<channelterpri outfile!*>>;
!*newline:=t
>>;
symbolic procedure second_newline();
<<!*newline :=nil; print_newline()>>;
symbolic procedure print_tab (); textout " ";
%--------------------------------------------------------------
symbolic procedure tue();
% job "c:\herbert\whelp\redindex.tex"$
job("redindex.tex","hugo.x");
%------------------- printstruct -------------------------------
symbolic procedure printstruct();
<<terpri(); printstruct1(car record,1)>>;
symbolic procedure printstruct1(r,n);
<<for i:=1:n do prin2 " ";
mapc(name r,'prin2);
terpri();
for each x in reverse seq r do
printstruct1(nil . x,n+1);
>>;
end;