off echo $
load_package tri $

fluid '(puretex!*) $
share puretex!* $
puretex!*:="" $
 

% (new) tex to string
algebraic procedure tex(s);
begin share r;
 lisp tex1(s,nil,'only);
 r:=puretex!*  ;
 lisp (puretex!*:="");
 return r;
end $


% modified tri::texpri
symbolic procedure tex1(u,v,w);
   (if x and get(x,'texprifn) then apply3(get(x,'texprifn),u,v,w)
     else tex2(u,v,w)) where x = getrtype u $


% modifed tri::texvarpri
symbolic procedure tex2(u,v,w); % same parameters as above
begin scalar !*lower;
   if w memq '(first only) then texstack!*:=nil;
   if v then for each x in reverse v do u:=list('setq,x,u);
   texstack!* := nconc(texstack!*,mktag(u,0,nil));
   if (w=t) or (w='only) or (w='last) then
   << if !*texbreak then
      << texstack!* := insertglue(texstack!*);
         texstack!* := trybreak(texstack!*,breaklist(texstack!*))
      >>;
      texstr(texstack!*,!*texbreak); texstack!*:=nil
   >>;
   %if (null w) or (w eq 'first) then
   %  texstack!* := nconc(texstack!*,list '!\!q!u!a!d! );
   nil
end $

% (new) print to string
symbolic procedure prstr(s);
  puretex!*:=concat(puretex!*, bldmsg s) $
  
% modified tri::texout
symbolic procedure texstr(itemlist,flag);
if null itemlist then nil else
begin
   integer cc,len,indent,ccmax,lines;
   scalar item,class,tag,oldtag,lasttag,indentstack,ispd,nlflag;
   ccmax:=64; cc:=indent:=lines:=0;        % initializations
   tag:=ispd:=nlflag:=indentstack:=nil;    % initializations
   prstr('!$!$);                           % begin TeX math group
   if flag then prstr('!\!d!i!s!p!l!a!y!l!i!n!e!s!{!\!q!d!d);
   while itemlist do
   << item:=car itemlist; itemlist:=cdr itemlist;
      len:=texstrlen(explode(item)); oldtag:=nil; lasttag:=tag or class;
      class:=classof(item); tag:=(class='inn)and(kindof(item));
      %ispd:=(class='ORD)and itemlist and(classof(car itemlist)='OPN);
      %%%if (tag='mat)or(tag='frc)or(class='opn) %or ispd
      %%%then newline();                      % start new line
      if (groupbeg(tag))or(class='opn) then
      << tpush(indentstack,indent);        % push it to the stack
         tpush(indentstack,lasttag);       % the reason for pushing
         if (cc+cc < ccmax)                % within left half of page ?
         then if ((class='opn)and(lasttag='ord))or % predicate?
                 (groupbeg(tag)and not((tag='frc)or(tag='mat)))
           then indent:=cc+len             % take current position
           else indent:=indent+len         % compute new indentation
      >>
      else if (groupend(tag))or(class='clo) then
      << oldtag:=tpop(indentstack); indent:=tpop(indentstack)
      >>;
      %%%if (cc+len > ccmax) or      % beyond right margin ?
      %%%   (item='!+)or(item='!-)or(class='clo) % important item?
      %%%then newline();
      if nlflag then << nlflag:=nil; spaces(cc) >>;
      if tag='cr  then lines:=lines+1;
      if not(item='! ) then prstr(item);   % print the item and
      cc:=cc+len;                          % count the characters
      %%%if groupvs(tag) or                   % vertical seperator ?
      %%%   (groupend(tag) and                % end of a large group,
      %%%    ((oldtag='frc) or (oldtag='mat)))% i.e. fraction, matrix ?
      %%%   or (class='clo) or                % closing parenthesis ?
      %%%   (((class='rel)or(class='bin))and  % binary/relational operator?
      %%%    (cc+cc+cc > ccmax+ccmax))        % within last third of page?
      %%%   or item='!,  or null class
      %%%then newline()
   >>;
   %%%newline();                              % start final line
   if flag then
     if lines=0 then prstr('!\!c!r!})
     else prstr('!\!N!l!});                % end multi-line output
   prstr('!$!$); return(puretex!*)     % end math group
end $


$end$