Artifact 2586e4cf717c2c3d87078360ecb51f4a0401c88fe91aa1c868304d91096f6fb1:
- Executable file
r36/mkhelp/helpwin.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 14208) [annotate] [blame] [check-ins using] [more...]
% helpwin.red % % interfacing reduce help file to Microsoft help compiler rtf structure % % Author: Herbert Melenk, ZIB Berlin % % November 1992 % fluid '(outc newl par !*font !*newline !*windows); !*windows:=t; helvetica:= "f2"; courier:= "f4"; % The original version of this file had initoutput() as an empty % procedure, but after the run it used shell commands to concatenate % the following text at the start and end of the generated file. To % reduce the amount of shell programming needed and keep as much as % possible in REDUCE code the (fixed) header and trailer text is % generated explicitly (albeit clumsily) here now. symbolic procedure initoutput (); begin scalar o; o := wrs outfile!*; prin2t "{\rtf1\ansi \deff0{\fonttbl{\f0\froman Tms Rmn;}"; prin2t "{\f1\fdecor Symbol;}"; prin2t "{\f2\fswiss Helv;}"; prin2t "{\f3\fmodern pica;}"; prin2t "{\f4\fmodern Courier;}"; prin2t "{\f5\fmodern elite;}"; prin2t "{\f6\fmodern prestige;}"; prin2t "{\f7\fmodern lettergothic;}"; prin2t "{\f8\fmodern gothicPS;}"; prin2t "{\f9\fmodern cubicPS;}"; prin2t "{\f10\fmodern lineprinter;}"; prin2t "{\f11\fswiss Helvetica;}"; prin2t "{\f12\fmodern avantegarde;}"; prin2t "{\f13\fmodern spartan;}"; prin2t "{\f14\fmodern metro;}"; prin2t "{\f15\fmodern presentation;}"; prin2t "{\f16\fmodern APL;}"; prin2t "{\f17\fmodern OCRA;}"; prin2t "{\f18\fmodern OCRB;}"; prin2t "{\f19\froman boldPS;}"; prin2t "{\f20\froman emperorPS;}"; prin2t "{\f21\froman madaleine;}"; prin2t "{\f22\froman zapf humanist;}"; prin2t "{\f23\froman classic;}"; prin2t "{\f24\froman roman f;}"; prin2t "{\f25\froman roman g;}"; prin2t "{\f26\froman roman h;}"; prin2t "{\f27\froman timesroman;}"; prin2t "{\f28\froman century;}"; prin2t "{\f29\froman palantino;}"; prin2t "{\f30\froman souvenir;}"; prin2t "{\f31\froman garamond;}"; prin2t "{\f32\froman caledonia;}"; prin2t "{\f33\froman bodini;}"; prin2t "{\f34\froman university;}"; prin2t "{\f35\fscript Script;}"; prin2t "{\f36\fscript scriptPS;}"; prin2t "{\f37\fscript script c;}"; prin2t "{\f38\fscript script d;}"; prin2t "{\f39\fscript commercial script;}"; prin2t "{\f40\fscript park avenue;}"; prin2t "{\f41\fscript coronet;}"; prin2t "{\f42\fscript script h;}"; prin2t "{\f43\fscript greek;}"; prin2t "{\f44\froman kana;}"; prin2t "{\f45\froman hebrew;}"; prin2t "{\f46\froman roman s;}"; prin2t "{\f47\froman russian;}"; prin2t "{\f48\froman roman u;}"; prin2t "{\f49\froman roman v;}"; prin2t "{\f50\froman roman w;}"; prin2t "{\f51\fdecor narrator;}"; prin2t "{\f52\fdecor emphasis;}"; prin2t "{\f53\fdecor zapf chancery;}"; prin2t "{\f54\fdecor decor d;}"; prin2t "{\f55\fdecor old english;}"; prin2t "{\f56\fdecor decor f;}"; prin2t "{\f57\fdecor decor g;}"; prin2t "{\f58\fdecor cooper black;}"; prin2t "{\f59\fnil linedraw;}"; prin2t "{\f60\fnil math7;}"; prin2t "{\f61\fnil math8;}"; prin2t "{\f62\fnil bar3of9;}"; prin2t "{\f63\fnil EAN;}"; prin2t "{\f64\fnil pcline;}"; prin2t "{\f65\fnil tech h;}"; prin2t "{\f66\fswiss Helvetica-Narrow;}"; prin2t "{\f67\fmodern Modern;}"; prin2t "{\f68\froman Roman;}}"; terpri(); princ "{\colortbl;\red0\green0\blue0;\red0\green0\blue255;"; prin2t "\red0\green255\blue255;\red0\green255\blue0;"; princ "\red255\green0\blue255;\red255\green0\blue0;"; prin2t "\red255\green255\blue0;\red255\green255\blue255;}"; princ "{\stylesheet{\s244 \fs16\up6 \sbasedon0\snext0"; prin2t " footnote reference;}"; prin2t "{\s245 \fs20 \sbasedon0\snext245 footnote text;}"; prin2t "{\s246\li720 \i\fs20 "; prin2t "\sbasedon0\snext255 heading 9;}"; prin2t "{\s247\li720 \i\fs20 \sbasedon0\snext255 heading 8;}"; prin2t "{\s248\li720 \i\fs20 \sbasedon0\snext255 heading 7;}"; prin2t "{\s249\li720 \fs20\ul \sbasedon0\snext255 heading 6;}"; prin2t "{\s250\li720 \b\fs20 \sbasedon0\snext255 heading 5;}"; prin2t "{\s251\li360 "; prin2t "\ul \sbasedon0\snext255 heading 4;}"; prin2t "{\s252\li360 \b \sbasedon0\snext255 heading 3;}"; prin2t "{\s253\sb120 \b\f2 \sbasedon0\snext0 heading 2;}"; prin2t "{\s254\sb240 \b\f2\ul \sbasedon0\snext0 heading 1;}"; prin2t "{\s255\li720 \fs20 \sbasedon0\snext255 Normal Indent;}"; prin2t "{\fs20 "; prin2t "\snext0 Normal;}"; prin2t "{\s2\fi-240\li480\sb80\tx480 \f11 \sbasedon0\snext2 nscba;}"; prin2t "{\s3\fi-240\li240\sa20 \f11 \sbasedon0\snext3 j;}"; prin2t "{\s4\li480\sa20 \f11 \sbasedon0\snext4 ij;}"; prin2t "{\s5\sb80\sa20 \f11 \sbasedon0\snext5 btb;}"; prin2t "{\s6\fi-240\li2400\sb20\sa20 \f11\fs20 "; prin2t "\sbasedon0\snext6 ctcb;}"; prin2t "{\s7\fi-240\li480\sa40\tx480 \f11 \sbasedon0\snext7 ns;}"; prin2t "{\s8\sa120 \f11\fs28 \sbasedon0\snext8 TT;}"; prin2t "{\s9\fi-240\li2400\sa20 \f11 \sbasedon0\snext9 crtj;}"; prin2t "{\s10\fi-240\li480\tx480 \f11 \sbasedon0\snext10 nsca;}"; prin2t "{\s11\sa20 \f11 "; prin2t "\sbasedon0\snext11 bt;}"; prin2t "{\s12\li240\sb120\sa40 \f11 \sbasedon0\snext12 Hf;}"; prin2t "{\s13\li240\sb120\sa40 \f11 \sbasedon0\snext13 Hs;}"; prin2t "{\s14\li480\sb120\sa40 \f11 \sbasedon0\snext14 RT;}"; princ "{\s15\fi-2160\li2160\sb240\sa80\tx2160 \f11"; prin2t " \sbasedon0\snext15 c;}"; prin2t "{"; prin2t "\s16\li2160\sa20 \f11 \sbasedon0\snext16 ct;}"; prin2t "{\s17\li240\sa20 \f11 \sbasedon0\snext17 it;}"; prin2t "{\s18\li480 \f11\fs20 \sbasedon0\snext18 nsct;}"; prin2t "{\s19\fi-160\li400\sb80\sa40 \f11 \sbasedon0\snext19 nscb;}"; prin2t "{\s20\fi-2640\li2880\sb120\sa40\brdrb\brdrs \brdrbtw\brdrs "; prin2t "\tx2880 \f11 \sbasedon0\snext20 HC2;}"; princ "{\s21\fi-2640\li2880\sb120\sa20\tx2880 \f11"; prin2t " \sbasedon0\snext21 C2;}"; prin2t "{\s22\fi-240\li2400\sa20 \f11\fs20 \sbasedon0\snext22 ctc;}"; prin2t "{\s23\li2160\sb160 \f11 \sbasedon0\snext23 crt;}"; prin2t "{\s24\li480\sb20\sa40 \f11 "; prin2t "\sbasedon0\snext24 or;}}"; terpri(); princ "{\info{\author Dan Davids}{\operator Dan Davids}"; prin2t "{\creatim\yr2137\mo8\dy7}"; princ "{\revtim\yr1990\mo5\dy9\hr16\min54}{\version3}"; prin2t "{\edmins3134}{\nofpages0}"; prin2t "{\nofwords65536}{\nofchars69885}{\vern8310}}"; terpri(); prin2t "\ftnbj \sectd \linex576\endnhere "; prin2t "\pard\plain \sl240 \fs20 "; terpri(); terpri(); terpri(); wrs o; end; symbolic procedure endoutput (); begin scalar o; o := wrs outfile!*; prin2t "}"; wrs o end; symbolic procedure verbatim u; !*verbatim := u; 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; <<!*newline:=nil; channelprin2(outfile!*,u)>>; symbolic procedure myprin2_protected u; <<if u memq '(!{ !}) then myprin2 "\"; myprin2 u; >>; fluid '(!*verbescape); symbolic procedure emit_start_verbatim(); nil; symbolic procedure emit_end_verbatim(); nil; symbolic procedure verbprin2 u; if u = '!\ then <<myprin2 u ; !*verbescape :=t>> else if u=!$eol!$ then <<myprin2 " \par"; myterpri();!*verbescape := nil>> else if (u = '!&) then <<myprin2 "\tab "; !*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 myterpri(); channelterpri outfile!*; symbolic procedure number4out n; % print number with 4 digits. << if n<10 then textout "0"; if n<100 then textout "0"; if n<1000 then textout "0"; textout n>>; % par = t: paragraph has been terminated - no new data so far % newl = t: last character has been an EOL symbolic procedure textout(u); if par and (u=!$eol!$ or u='! ) then nil else <<fonton(); if u=!$eol!$ and (!*verbatim or newl) then <<print_newline(); outc:='! ; if not !*verbatim then second_newline(); newl:=nil; par:=t>> else if (u = '!&) then <<myprin2 "\tab "; par:=newl:=outc:=nil>> else if (u = '!$) then newfont(if currentfont = helvetica then courier else helvetica) else if (u memq '(!{ !})) then <<myprin2 '!\; myprin2 u>> else if (u neq '! ) or (outc neq '! ) or !*verbatim then <<if u=!$eol!$ and outc neq '! then myprin2 '! ; myprin2(u); outc := u; if u=!$eol!$ then newl:=t else if u neq '! then newl:=nil; par:=nil; >>; >>; % -------- paragraph heading --------------------------- symbolic procedure par_heading(type); <<verbprin2 !$eol!$; for each x in explode type do verbprin2 x; verbprin2 ":"; verbprin2 !$eol!$; >>; % -------- directory structure ------------------------- symbolic procedure base_new_dir(name); nil; symbolic procedure emit_dir_new(); nil; symbolic procedure emit_dir_key u; emit_node_key u; symbolic procedure emit_dir_separator(); emit_node_separator(); symbolic procedure emit_dir_label u; emit_node_label u; symbolic procedure emit_dir_title u; emit_node_title(u,nil,'section); symbolic procedure emit_dir_browse(u,n); emit_node_browse(u,n); % ---- node structure symbolic procedure emit_node_separator(); <<fonton(); myterpri(); myterpri(); channelprin2(outfile!*,"\page"); myterpri(); myterpri(); outc:='! ; par:=t; >>; symbolic procedure set_tab(); myprin2 "\pard \tx3420 "; symbolic procedure release_tab(); myprin2 "\pard \sl240 "; symbolic procedure textoutl(l); % l is a list of characters to be printed. % special action for names: \ in front of _ suppressed because % of Microsoft HC logic (don't know why). if atom l then textout l else while l do <<if not(car l = '!\) or null cdr l or not(cadr l = '!_) then textout car l; l := cdr l>>; symbolic procedure textout2(l); if atom l then myprin2 l else for each x in l do myprin2 if x='! then '!_ else x; symbolic procedure printem(s); % print italic begin myprin2 "{\i "; mapc(s,'myprin2); myprin2 "} "; end; symbolic procedure printem(s); begin fontoff(); myprin2 "{\f3 "; mapc(s,'myprin2_protected); myprin2 "} "; end; symbolic procedure printref u; begin scalar r; r:= get_label u; if null r then return printem u; fontoff(); myterpri(); myprin2 "{\f2\uldb "; mapc(u,'myprin2); myprin2 "}{\v\f2 "; mapc(r,'myprin2); myprin2 "}"; myprin2 " "; myterpri(); end; symbolic procedure printnameref u; printref u; fluid '(key_database); symbolic procedure emit_node_keys u; begin scalar keys; keys := assoc(u,key_database); if null keys then return; keys := cdr keys; fonton(); myterpri(); myprin2 " K{\footnote \pard\plain \sl240 \fs20 K "; while keys do <<textoutl car keys; keys:= cdr keys; if keys then myprin2";">>; myprin2 "}"; myterpri(); end; symbolic procedure emit_node_key u; emit_hidden_node_key u; symbolic procedure emit_hidden_node_key u; if current_node!* then begin scalar q; q:= assoc(current_node!*,key_database); if null q then key_database := (current_node!* . {u}).key_database else if not member(u,cdr q) then cdr q:=u.cdr q; end; symbolic procedure emit_node_label u; <<fonton(); myterpri(); myprin2 "#{\footnote \pard\plain \sl240 \fs20 # "; textout2 u; myprin2 "}"; myterpri(); >>; symbolic procedure emit_node_title(u,dummy,type); <<fonton(); myterpri(); myprin2 "${\footnote \pard\plain \sl240 \fs20 $ "; textoutl u; myprin2 "}"; myterpri(); >>; symbolic procedure emit_node_browse(u,n); <<fonton(); myterpri(); myprin2 "+{\footnote \pard\plain \sl240 \fs20 + "; textout u; textout ":"; number4out n; myprin2 "}"; myterpri(); >>; symbolic procedure print_bold u; <<fontoff(); myprin2 "{\b\f2 "; mapc(u,'myprin2); myprin2 "}"; >>; symbolic procedure emit_dir_header(); <<fontoff(); myprin2 "{\f2 \par }\pard \sl240 {\f2 \par }"; myterpri(); >>; symbolic procedure emit_dir_entry(name,lab); begin scalar alias; fontoff(); myprin2 "{\f2 \tab}{\f2\uldb "; mapc(name,'myprin2); myprin2 "}"; myterpri(); myprin2 "{\v\f2 "; textout2 lab; myprin2 "}"; if (alias:=assoc(lab,aliases)) then <<myprin2 " "; myprin2 cdr alias>>; print_newline(); end; symbolic procedure print_newline(); <<if null !*newline then <<fonton(); channelprin2(outfile!*,"\par "); channelterpri outfile!*>>; !*newline:=t >>; symbolic procedure second_newline(); <<!*newline :=nil; print_newline()>>; symbolic procedure print_tab (); <<fonton(); myprin2 "\tab ">>; %------------------- 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;