#line 2092 "ext.nw"
require "pwd.pl";
&initpwd;



#line 452 "ext.nw"
$mode = $ARGV[0] && shift;

if (!($ARGV[0])) { &print_usage($mode);}
    
$filearg = $ARGV[0] && shift;

if ($mode eq "Mkman") { $numbered = "yes"; }
else { $numbered  = "no";}      # Usually manual pages are not numbered
$ack = "yes";            # ext asks for acknowledgments when it is confused
$constref = "no";   # const-& pairs are usually suppressed
$partypes = "no";   # operators suppress argument types that are identical to Mname
$usesubscripts = "no";    # usually we do not write indexed variables as subscripts
$size = 12;             # default size is 12pt
$xdvi = "yes";
$warnings = "yes";     # default is to give warnings
$filter = "all";        # usually we show everything
$print_title = 1;  # usually we print the title
$pid = "";            # we do not know the process id yet
$latexruns=1;
$map = "";           # the substitution map
$delman = "yes";     # Ldoc usually removes manual comments
$outfile = "";       # the default is that we determine the outfile
$dvioutfile = "";     # only relevant for Mkdvi
$section = "section"; # each manual page is a LaTeX section 
$nextwarning = "yes"; # default is to show the next warning
$justset = "no";      # $nextwarning was not just set to no.




#line 492 "ext.nw"
if ($mode eq "Fman")
{ if ($ARGV[0]) 
    { $filter = $ARGV[0];    
      foreach  $candidate ("all","signatures","definition","creation",  
              "operations","implementation","example")
        { if ($filter eq $candidate) { goto filterfound; }
        }
      print "\n\n searching for operation $filter of type $filearg";
      filterfound:
      } 
  print "\n\n\n"; 
}
else
{ foreach $path ("HOME","PWD")
  { if ($path eq "HOME") {$CFG = $ENV{$path} . "\/" . $mode . "\.cfg";}
    else {$CFG = $mode . "\.cfg";}
    if (-e $CFG)
     { open (CFG); 
       print "reading ", $CFG,"\n\n";
       while (<CFG>) 
         { if (/(\w+)=(.*)/) {eval "\$$1 = \$2";} 
         }
       close (CFG);
     }
  }
  eval "\$$1 = \$2" while $ARGV[0] =~ /(\w+)=(.*)/ && shift; 
}

if ($pid eq "") {$pid = $$;}

$showsem = 1;          # usually we show the semantics of functions
 if ($filter eq "signatures")
  { $filter = "operations";
    $showsem = 0;
  }


#line 544 "ext.nw"
$LEDAROOT = $ENV{"LEDAROOT"};
$INCL = $ENV{"LEDAROOT"} . "/incl/LEDA";
if ($filearg =~ /(.*)\.[whln]/)
  {$basename = $1;}
else
  {$basename = $filearg;}

@doc_tools = ('Lman','Ldoc','Fman','lweave','lw2dvi');
foreach $arg (@doc_tools)
  { if ($basename eq $arg)
      {  $owd = $ENV{"PWD"};
         chdir ("/tmp");
         if ($mode eq "Fman") 
          { system("cat \$LEDAROOT/Manual/MANUAL/doctools.tex");
          }
         else
          { $outfile = "/tmp/" . $pid . "-ext.tex";
            open(OUTPUT,">".$outfile);
            print OUTPUT "\\documentclass\[11pt,a4paper\]\{article\}\n\n"; 
            print OUTPUT "\\input " . $ENV{"LEDAROOT"} . "/Manual/tex/MANUAL.pagesize\n\n";
            print OUTPUT "\\input " . $ENV{"LEDAROOT"} . "/Manual/tex/MANUAL.mac\n\n"; 
            print OUTPUT "\\begin\{document\}\n\n";
            close(OUTPUT);
            system("cat \$LEDAROOT/Manual/MANUAL/doctools.tex  >> $outfile");
            open(OUTPUT,">>".$outfile);
            print OUTPUT "\\end\{document\}\n\n";
            close(OUTPUT);
            system ("latex /tmp/$pid-ext.tex");

            system ("xdvi /tmp/$pid-ext.dvi");
          }
        chdir ("$owd");
        exit;
      }
  }
if (-e ($basename . "\.w")) 
  { $INPUT = $basename . "\.w" ; $kind = "Cweb"; $ext = "w";goto DONE;}
if (-e ($basename . "\.web")) 
  { $INPUT = $basename . "\.web" ; $kind = "Cweb"; $ext = "web";goto DONE;}
if (-e ($basename . "\.lw")) 
  { $INPUT = $basename . "\.lw" ; $kind = "Lweb";$ext = "lw"; goto DONE;}
if (-e ($basename . "\.nw")) 
 { $INPUT = $basename . "\.nw" ; $kind = "noweb"; $ext = "nw";goto DONE;}
if (-e ($basename . "\.h")) 
 { $INPUT = $basename . "\.h" ; $kind = "h";goto DONE;}
$longname = $INCL . "/" . $basename;
if (-e ($longname . "\.h"))
 { $INPUT = $longname . "\.h" ; $kind = "LEDAtype";}
DONE:
open (INPUT)  || die "ext: Cannot find input file $basename: $!\n";

if ($mode eq "Lman" && $xdvi eq "yes" && 
      (-e "$LEDAROOT/Manual/MANUAL/DVI/$basename.dvi"))
  { print "\n\ndvi-file exists already and so Lman takes a shortcut\n\n";
    system("xdvi $LEDAROOT/Manual/MANUAL/DVI/$basename.dvi");
    exit;
  }    

if ($mode ne "Fman") 
  { if ($outfile eq ""  || $mode eq "Ldoc") 
           {$outfile = "/tmp/" . $pid . "-ext.tex";}
    open(OUTPUT,">".$outfile);
    print "reading input file to extract manual ...\n\n";
  }


#line 626 "ext.nw"
if ($mode eq "Lman")
{  
                            
  print OUTPUT "\\documentclass\[" . $size . "pt,a4paper\]\{article\}\n\n"; 

  print OUTPUT "\\input " . $ENV{"LEDAROOT"} . "/Manual/tex/MANUAL.pagesize\n\n";

  print OUTPUT "\\input " . $ENV{"LEDAROOT"} . "/Manual/tex/MANUAL.mac\n\n"; 

  print OUTPUT "\\begin\{document\}\n\n";

  print OUTPUT "\\begin\{manual\}\n\n";                        
}
if ($mode eq "Ldoc" || $mode eq "Mkman") {print OUTPUT "\\begin{manual}\n";}


#line 664 "ext.nw"
$Mvar    = "";
$Mtype   = ""; 
$Mname   = "";
main_loop:
{ # $_ is either undefined or the last line of an Mcomment
  
#line 694 "ext.nw"
# I advance $_ to a non-empty line (WEB-directives are output but count as 
# empty lines otherwise) or beyond the end of the file

$_ = <INPUT>;

build_code_unit:
    while ($_ && (($_ =~ /^\s*$/) || ($_ =~ /^\@[sf]/))){  $_ = <INPUT>; }
    if (! $_) {last main_loop;}   # input exhausted
    $code_unit = "";
    # $_ exists, is non_empty, and contains no @, and $code_unit is empty
    # The code_unit is either terminated by an Mcomment or an empty line
    # (empty line: only white space characters) or the end of the file
    while ($_ && !(/\/\*\{\\M/ || /^\s*$/)) 
     { if ($_ =~ /\/\* *\{M/)
         {&print_warning("I encountered /*{M. Did you really mean it?");}     
       $code_unit .= $_;   # append current line to code unit
       $_ = <INPUT>;
     }

# The current line either does not exist or is either empty or the 
# begin of an Mcomment.
# Skip empty lines.

while ( $_ && /^ *$/ ){ $_ = <INPUT>; }

# the current line is non-empty (if it exists).

if (! $_) {last main_loop;}   # input exhausted

# the current line is non-empty.

if (! (/\/\*\{\\M/)) { goto build_code_unit;}   # start new code unit.

@invisible_words = ('__exportC' , '__exportF' , '__exportD');
foreach $invis_word (@invisible_words)
  { $code_unit =~ s/$invis_word//g;
  }

$original_code_unit = $code_unit;

#line 670 "ext.nw"
  # $_ is an Mline and variables $original_code_unit and $code_unit 
  # contain the current code unit. 
  
#line 747 "ext.nw"
s/^(.*)\/\*\{\\//; # remove begin comment and everything before it

if ($1 =~ /\S/) # issue warning if something non-white before comment
 { &print_warning("ignored non-white stuff in front of begin comment\n"); }

$Mcomment = "";

while ($_ && (! ( /\}\*\// ) ) )
{
if (/\} *\*\//) {&print_warning("encountered } */ in manual comment. Did you mean }*/ ?");}
$Mcomment .= $_;
$_ = <INPUT>;
}
if (! $_){die "ERROR: missing end comment\n";}


s/\}\*\/(.*)$/ /;  # replace end comment and everything after it by a blank
if ($1 =~ /\S/)
  { &print_warning("ignored non-white after Mcomment."); }

$Mcomment .= $_;   
$original_comment = $Mcomment;

# Mcomment contains the entire manual comment. We extract the command (the
# maximal alphanumeric prefix).

$Mcomment =~ /^(\w*)\W.*/;
$command = $1;
$Mcomment =~ s/$command *//;  # remove command and succeeding blanks
$command =~ s/^M//;           # remove the M

#line 673 "ext.nw"
  # $Mcomment contains the manual command (without the brackets /*{\M and }*/
  # $Mcommand contains the command (without the leading M)
  
#line 797 "ext.nw"
if ($nextwarning eq "no" && $justset eq "no") { $nextwarning = "yes";} 
$justset = "no";
switch: 
{ if ($command eq 'options') {
#line 825 "ext.nw"
$Mcomment =~ s/\s//g;
$Mcomment =~ /^(\w+)=(.*)$/ ;
eval "\$$1 = \$2";
if ($nextwarning eq "no") {$justset = "yes";}

#line 800 "ext.nw"
                                          last switch;}
  if ($command eq 'subst')   {
#line 836 "ext.nw"
while ($Mcomment =~ s/ *(\w+) +(\w+) *//) {$map{$1} = $2;}
 
#line 801 "ext.nw"
                                        last switch;}

  if ($command eq 'anpage') {
#line 846 "ext.nw"
if (! ($Mcomment =~ /\{([^\{\}]*)\}\s*\{([^\{\}]*)\}\s*\{([^\{\}]*)\}\s*\{([^\{\}]*)\}/ || 
       $Mcomment =~ /\{([^\{\}]*)\}\s*\{([^\{\}]*)\}\s*\{([^\{\}]*)\}/ ) )                         
  { &print_warning("Manpage expects either three or four arguments"); }
$Mtype = $1;
$par_list = $2;
$title = $3;
if ($4) {$Mvar = $4;}
if ($par_list =~ /^ *$/) {$Mname = $Mtype;}
else 
  { # remove excessive blanks in parlist
    $par_list =~ s/ //g;
    $Mname = $Mtype."<".$par_list.">";
   } 
if ($mode eq "Lman" || $mode eq "Mkman")
  { 
    # we print \section*{title (type')}\label{type}\n where type' is obtained
    # from type by quoting underscores.
    # if numbered is true we supress the star
    $Mtype1 = $Mtype;
    $Mtype1 =~ s/_/\\_/g;
    if ($numbered eq "yes") {$star = "";} else {$star = "*";}
    print  OUTPUT "\\$section" , $star, "{",$title," (",$Mtype1,
              ")}\\label{",$title,"}\n\\label{$Mtype}\n";
   }

 
#line 803 "ext.nw"
                                                 last switch;}
  if ($command eq 'definition' || $command eq 'example'  
            || $command eq 'implementation' || $command eq 'creation' ||
               $command eq 'operations')
     {
#line 891 "ext.nw"
if ($command eq "creation")
{ # Mcomment may contain a varname and/or a length.
  @params = split(' ',$Mcomment);  # split at blanks
  foreach $i (0 .. $#params)
   { if ($params[$i] =~ /^[a-zA-Z]/) 
       { $Mvar = $params[$i];}    # variable names start with a letter
     else
       {  $a = $params[$i];
          if ($a =~ /^ *$/) {print "something wrong in create";}
          if ($a =~ /^[0-9\.]*$/) {$a = $a . 'cm';}
          print OUTPUT "\\setlength\{\\declwidth}\{" , $a, "\}\n" ;
          print OUTPUT "\\computewidths\n";
       }
    }
  $Mcomment = "";
}

if ($command eq "operations")
{ # Mcomment is either empty or a b where a and b are lengths
  # If the lengths are without dimension then we add cm

  @params = split(' ',$Mcomment);  # split at blanks
  foreach $i (0 .. $#params)
    {  $a = $params[$i];
       if ($a =~ /^[0-9\.]*$/) {$a = $a . 'cm';}
       if ($i == 0)
         { print OUTPUT "\\setlength\{\\typewidth\}\{" , $a, "\}\n" ;}
       else { print OUTPUT "\\setlength\{\\callwidth\}\{" , $a, "\}\n" ;} 
    }
  print OUTPUT "\\computewidths\n";
  $Mcomment = "";
}

$currentsection = $command;

if ($filter eq "all" || $filter eq $currentsection)
{ if ($mode eq "Fman")
    { print $command , "\n______________\n\n" , &substitute_for_placeholders($Mcomment) 
             ,"\n\n"; }
   else 
     { $output = "\\" . $command ;
       if ($Mcomment) { $output .= "\n" . &convert_text($Mcomment);}
       &print_unit($output);
     }
}
      
#line 807 "ext.nw"
                          last switch;}
  if ($command eq 'text'  || $command eq "preamble")
     {
#line 942 "ext.nw"
      
if ($filter eq "all" || $filter eq $currentsection )
 { if ($mode eq "Fman")
       { print &substitute_for_placeholders($Mcomment) , "\n\n"; }
   else 
       { if ($command eq "text" || $mode ne "Ldoc")   
           { &print_unit(&convert_text($Mcomment)); }
       }
 }

#line 809 "ext.nw"
                           last switch;}

  
#line 1070 "ext.nw"
$prefix = "";
$funcname = "";
$postfix = "";
$signature  = ""; 
$type = "";
$fname = "";
$static = 0;
$constructor = 0;
$operator = 0;
$conversion = 0;
$destructor = 0;

if (! $code_unit)
  { &print_warning("current code unit is empty."); 
    last switch;
  }
#line 1154 "ext.nw"
  
#line 1144 "ext.nw"
$code_unit =~ s/\@\+/ /g; # remove @+
$code_unit =~ s/\@\// /g; # remove @/
$code_unit =~ s/\@\|/ /g; # remove @|
$code_unit =~ s/\@\#/ /g; # remove @#
$code_unit =~ s/\@\;/ /g; # remove @;
$code_unit =~ s/\@\,/ /g; # remove @,




#line 1157 "ext.nw"
if ($code_unit =~ /\/\*/)       # commented code units
  { &print_warning("code unit contains a comment. I remove the lines containing /* and */");
    $code_unit =~ s/ *\/\*.*//;  # remove first line
    $code_unit =~ s/ *\*\/ *//;    # remove last line
    $original_code_unit = $code_unit;
  }
$code_unit =~ s/\t/ /g;        # replace tab by blank
$code_unit =~ s/ *\#.*\n/ /g;  # remove all lines with compiler directives 
$code_unit =~ s/\n/ /g;       # replace newline characters by blanks
while ($code_unit =~ s/\{[^\{\}]*\}/\;/) {}  
             # replaces code by a single semicolon.
while ($code_unit =~ s/\;\s*\;/\;/) {}        
             # replaces white space-separated ; by a single ;
$code_unit =~ s/\; *$//;                   
             # remove last semicolon if only followed by whitespace
if ($code_unit =~ /\;([^\;]*)$/)
     { &print_warning("code unit contains several function definitions. I extracted\n $1");
       $code_unit = $1;
     }

# At this point we have a single function definition in code_unit
   
$code_unit =~ s/const *$//;  # remove const qualifier
$code_unit =~ s/::/doppeldoppel/g;  # replace :: by doppeldoppel
$code_unit =~ s/ *:.*$//;    # remove initialization constructor call
$code_unit =~ s/doppeldoppel/::/g;   # reintroduce ::
# $code_unit =~ s/; *$///;    # remove ;blanks at end of line

#line 1192 "ext.nw"
$code_unit  =~ s/template *< *class *\w* *>// ; # remove template definition
$code_unit  =~ s/virtual//;  # remove blanks virtual blanks      
$code_unit  =~ s/friend//;       # remove friend
$code_unit  =~ s/inline//;       # remove inline
$code_unit  =~ s/extern//;       # remove extern
$static = ($code_unit  =~ s/static//);  #remove static and record

#line 1218 "ext.nw"
$conversion = ! ($code_unit =~ /\(/); 
if ($code_unit =~ /\( *\) *\(.*\)/) { $code_unit =~ s/\( *\) *\((.*)\)//; }
else { $code_unit =~ s/\((.*)\)//;}

$par_list = $1;

$operator = (($code_unit =~ /operator/) && !$conversion);  # symbol operator

$destructor = ($code_unit =~ /^ *\~/);
 
&remove_enclosing_blanks($code_unit); # I do anchored matches below

extraction:
{ if ($destructor) {last extraction;}
 
  if ($conversion)     # a conversion function: operator type
    { if (!($code_unit =~ s/ *operator *//))
        {&print_warning("expected a conversion function")};
      $fname = $code_unit;
      last extraction;
    }

  if ($operator)  # an operator: type operator opsymbol  
   { $code_unit =~ /^(.*) *operator *(.*)$/;
     $type = $1;
     $fname = $2;
     last extraction;
   }
 
#line 1265 "ext.nw"
if ($code_unit eq $Mtype) {$constructor = 1;}
else
  { # a function
    if ($code_unit =~ /^([:\w]+)$/ )
      { $type = "int";
        $fname = $code_unit;
      }
    else 
      { $code_unit =~ /^(.*[^\:\w])([\:\w]+)$/ ;
        $type = $1; 
        $fname = $2;
        $type =~ s/ //g;  # remove blanks
        if (($type =~ /^\s*const/) 
              && ($constref eq "no"))  # remove const & bracket
          { $type =~ s/^\s*const//; $type =~ s/\& *//;
          }
        $type =~ s/ *\& */\& /g;
       }
   }

        
#line 1247 "ext.nw"
}    
#line 1314 "ext.nw"
&remove_enclosing_blanks($type);
&remove_enclosing_blanks($fname);
&remove_enclosing_blanks($Mvar);
&remove_enclosing_blanks($Mtype);
&remove_enclosing_blanks($command);

#line 1327 "ext.nw"
@params = split(/,/,$par_list);  # split at commas
$par_list = "";
$i = 0;
while ($i <= $#params)
{ $j = $i + 1;
  while ($params[$i] =~ /</  && (($params[$i]=~tr/</</) > ($params[$i]=~tr/>/>/)))
    { $params[$i] .= "," . $params[$j]; $j++;
    }
  if (($params[$i] =~ /^ *const/) && ($constref eq "no"))
     { $params[$i] =~ s/^ *const//;
       $params[$i] =~ s/\& */ /; # replace &blanks by a single blank
     }
  &remove_enclosing_blanks($params[$i]);
  $params[$i] =~ s/ *\& */\& /g;
   
  if ($i > 0) {$par_list .= "\, ";}
  $par_list .= $params[$i];
  $i = $j;
}

$varname = $Mvar;
$signature = $fname . "(" . $par_list . ")";

if ($command =~ /^opl?$/){
#line 1378 "ext.nw"
if ($operator || $constructor || $conversion || $static)
     {&print_warning("Mop applies only to member functions and not to operators, ...");}

$prefix = $Mvar . "\.";
$funcname = $fname;
$postfix = $par_list;
if ($filter eq "all" || $filter eq $currentsection || $filter eq $funcname)
  { &print_function();}

#line 1350 "ext.nw"
                                  last switch;} 
   
if ($command =~ /^funcl?$/) {
#line 1390 "ext.nw"
if ($operator || $constructor || $conversion || $static)
     {&print_warning("Mop applies only to functions and not to operators, ... ");}

$prefix = "";
$funcname = $fname;
$postfix = $par_list;
if ($filter eq "all" || $filter eq $currentsection || $filter eq $funcname )
  { &print_function(); }
     
#line 1352 "ext.nw"
                                       last switch;}
  
if ($command =~ /^binopl?$/) {
#line 1405 "ext.nw"
if (! $operator) {&print_warning("Mbinop applies only to operators");}

$Mreplace = $Mname . " ";

if ($partypes eq "no")
   { while ($par_list =~ /$Mreplace/) {$par_list = $` . $';} }    

$signature = $Mvar. " " . $fname . " " . $par_list;

if ($filter eq "all" || $filter eq $currentsection ||
        $ filter eq ("operator" . $fname) ){&print_function();}

#line 1354 "ext.nw"
                                         last switch;}
  
if ($command =~ /^binopfuncl?$/) {
#line 1424 "ext.nw"
if (! $operator) {&print_warning("Mbinopfunc applies only to operators");}
 
$Mreplace = $Mname . " ";

if ($partypes eq "no")
     { while ($par_list =~ /$Mreplace/) {$par_list = $` . $';} }        

$par_list =~ s/\, / $fname /;

$signature = $par_list;
    
if ($filter eq "all" || $filter eq $currentsection || 
        $ filter eq ("operator" . $fname) ){&print_function();}

#line 1356 "ext.nw"
                                                 last switch;}
 
if ($command =~ /^arropl?$/) {
#line 1443 "ext.nw"
if (! $operator) {&print_warning("Marrop applies only to operators");}

$signature = $varname . "\[" . $par_list . "\]";

if ($filter eq "all" || $filter eq $currentsection
         || $filter eq "arrop" ){&print_function();}

#line 1358 "ext.nw"
                                         last switch;}
  
if ($command =~ /^funopl?$/) {
#line 1453 "ext.nw"
if (! $operator) {&print_warning("Mfunop applies only to operators");}

$signature = $varname . "\(" . $par_list . "\)";

if ($filter eq "all" || $filter eq $currentsection || 
         $filter eq "funop" ){&print_function();}

#line 1360 "ext.nw"
                                         last switch;}
  
if ($command =~ /^unopl?$/) {
#line 1468 "ext.nw"
    
if (! $operator) {&print_warning("Munop applies only to operators");}
     
unopcases:
  {if ($fname eq "->")
        {$signature = $varname . $fname;   # -> is postfix
         last unopcases;
        }
   if ($fname eq "new" || $fname eq "delete" )
        { $signature = $fname . ' ' . $varname;  # new and delete are prefix
          last unopcases;
        }
   if ($par_list)
         {$signature = $varname . $fname; # postfix ++ and --
          last unopcases;
         }       
   $signature = $fname . $varname; # all others are prefix operators 
  }

if ($filter eq "all" || $filter eq $currentsection ||
         $filter eq ("operator" . $fname )){&print_function();}

#line 1362 "ext.nw"
                                       last switch;}
       
if ($command =~ /^unopfuncl?$/){
#line 1500 "ext.nw"
if (! $operator) {&print_warning("Munop applies only to operators");}
     
unopfunccases:
 {if ($fname eq "->")
        {$signature = $varname . $fname;   # -> is postfix
         last unopfunccases;
        }
  if ($fname eq "new" || $fname eq "delete" )
        { $signature = $fname . ' ' . $varname;  # new and delete are prefix
          last unopfunccases;
        }
  if ($par_list =~ /,/)
         {$signature = $varname . $fname; # postfix ++ and --
          last unopfunccases;
         }       
  $signature = $fname . $varname; # all others are prefix operators 
}

if ($filter eq "all" || $filter eq $currentsection ||
         $filter eq ("operator" . $fname ) ){&print_function();}

#line 1364 "ext.nw"
                                              last switch;}
        
if ($command =~ /^staticl?$/){
#line 1525 "ext.nw"
if (!$static) {&print_warning("Mstatic applies only to static member functions");}
     
$prefix = $Mtype . "\:\:";
$funcname = $fname;
$postfix = $par_list;
     
if ($filter eq "all" || $filter eq $currentsection || $filter eq $fname )    
    {&print_function();}

#line 1366 "ext.nw"
                                          last switch;}
     
if ($command =~ /^conversion/){
#line 1540 "ext.nw"
if (!$conversion) {&print_warning("Mconversion applies only to conversion operators");}

$funcname = $fname;
$postfix = $Mvar;
     if ($filter eq "all" || $filter eq $currentsection ){&print_function();}

#line 1368 "ext.nw"
                                               last switch;}
     
if ($command =~ /^create/){
#line 1551 "ext.nw"
if (!$constructor) {&print_warning("Mcreate applies only to constructors");}

if ($filter eq "all" || $filter eq $currentsection ){&print_constructor();}

#line 1370 "ext.nw"
                                       last switch;}
 
if ($command =~ /^destruct/) {
#line 1561 "ext.nw"
if (!$destructor) {&print_warning("Mdestruct applies only to destructors");}

if ($filter eq "all" || $filter eq $currentsection ){ &print_destructor();}


#line 1372 "ext.nw"
                                            last switch;}

 

#line 812 "ext.nw"
&print_warning( "did not recognize command name M" . $command);
}

#line 676 "ext.nw"
redo main_loop;
}


#line 1990 "ext.nw"
if ($mode eq "Fman") {exit;}

if ($mode eq "Lman")
{ print OUTPUT "\\end\{manual\}\n";         
  print OUTPUT "\\end{document}\n";          
  close OUTPUT;
  $owd = $ENV{"PWD"};
  if ($latexruns == 0) {exit;}
  chdir ("/tmp");
   
  print "preparing  manual page with LaTeX  ...\n\n";

  if ($outfile ne "/tmp/$pid-ext.tex")
     { if ($outfile =~ /\//) # absolute path name 
          { system("cp $outfile /tmp/$pid-ext.tex");}
       else 
          { system("cp $owd/$outfile /tmp/$pid-ext.tex");}
      }

  system ("latex /tmp/" . $pid . "-ext.tex");
  if ($latexruns == 2) {system ("latex /tmp/" . $pid . "-ext.tex");}

  if ($xdvi eq "yes")
   { print "starting xdvi previewer ... \n\n";
     system ("xdvi -s 3 /tmp/" . $pid . "-ext.dvi");
   }
  else
   { if ($dvioutfile ne "")
      { print "\n\ncopying dvi file into file $dvioutfile in working directory\n\n";
        system("cp /tmp/$pid-ext.dvi $owd/$dvioutfile");
      }
     else 
      { print "\n\ncopying dvi file into file $basename.dvi in working directory\n\n";
     system("cp /tmp/$pid-ext.dvi $owd/$basename.dvi");
      }
   }

  # system("rm -f /tmp/" . $pid . "-ext.*");
  chdir ("$owd");
}

if ($mode eq "Mkman") {  print OUTPUT "\\end{manual}\n";}

if ($mode eq "Ldoc")
{  print OUTPUT "\\end{manual}\n";
   close(OUTPUT); 

  print "\n   created $basename.man\n\n\n";

  print "removing the manual comments (except for Mpreamble) from the input file ...\n\n";

  $tempfile = "/tmp/" . $pid . "-$basename";
  if ($delman eq "yes" || $kind eq "Cweb")
  { if ($delman eq "no")
      { print "option delman=no not implemented for Cweb\n";}
    system("ldel $INPUT $tempfile.$ext");
    print "\n    created $tempfile.$ext through ldel\n\n";

  }
  else { system("cp  $INPUT $tempfile.$ext"); 
         print "\n    created $tempfile.$ext by copying\n\n";
       }

   
  system("mv /tmp/$pid-ext.tex $basename.man");  # move manpage
  print "calling $kind weave ...\n\n";
  # cweave produces its output in the working directory
  # lweave produces its output in the directory of the input
  # noweave produces its output on standard output
  if ($kind eq "Cweb") 
     { system( "cweave $tempfile.$ext");
       system( "mv $pid-$basename.scn $basename.scn");
       system( "mv $pid-$basename.idx $basename.idx");
       system( "mv $pid-$basename.tex $basename.tex");

     }
  if ($kind eq "Lweb") 
     { system( "lweave $tempfile");
       system( "mv $tempfile.tex $basename.tex");
       system( "mv $tempfile.nw $basename.nw");

     }
  if ($kind eq "noweb") {system("noweave -delay $tempfile.nw > $basename.tex");}

  # system( "mv $tempfile $basename-del.$ext");
  print "\n   created $basename.tex\n\n\n";
  if ($latexruns == 0) {exit;}
  print "calling latex ...\n\n";
  system("latex  $basename.tex");
  if ($latexruns == 2) {system("latex  $basename.tex");}

  if ($xdvi eq "yes")
  { print "starting xdvi previewer ... \n\n";
    system("xdvi -s 3 $basename.dvi");
  }

}


#line 955 "ext.nw"
sub print_unit{
   local($text) = @_; # read argument into local variable
   print OUTPUT $text,"\n\n";
}

#line 970 "ext.nw"
sub convert_text{
  local($text) = @_; # read argument into local variable
  $text = &substitute_for_placeholders($text);
  $text = &web_to_latex($text);
  if ($kind eq "Cweb")
    { 
#line 980 "ext.nw"
  
local($i, $remline, $outline, $lines , $word); 
@lines = split(/^/,$text);  # split at new lines
$text = "";
foreach $i (0 .. $#lines)
  {if (length($lines[$i]) > 80)
     { $outline = "";
       $remline = $lines[$i];
       while ($remline )            
         { if ($remline =~ /[\w\,] /) 
             {  $word = $` . $&; $remline = $';}
           else {$word = $remline; $remline = ""; }
           # a word charachter or komma followed by a blank or the entire line
           if (length($outline) + length($word) < 80)
             {$outline  .= $word;}
           else 
             {if ($outline) { $text .= $outline . "\n"; }
              else { &print_warning("unable to break line, might cause trouble with cweave\n$word\n\n");}
              $outline = $word;
             }
          }
       $text .= $outline;   # no newline here
      }
   else { $text .= $lines[$i]; }   # no newline here
 }  

#line 975 "ext.nw"
                                             }
  $text;
}


#line 1015 "ext.nw"
sub substitute_for_placeholders{
  local($string) = @_;
  $string =~ s/\\Mvar/$Mvar/g;
  $string =~ s/\\Mtype/$Mtype/g;
  $string =~ s/\\Mname/$Mname/g;
  foreach $key (keys(%map))  # for each key  in the substitution map
     { $string =~ s/$key/$map{$key}/g; }
  
  if ($string =~ /\\var\W/ || $string =~ /Mvar/) {&print_warning("found an occurrence of \\var or an unslashed occurrence of Mvar. Did you mean \\Mvar?");}
  if ($string =~ /\\type\W/ || $string =~ /Mtype/) {&print_warning("found an occurrence of \\type or an unslashed occurrence of Mtype. Did you mean \\Mtype?");}
  if  ($string =~ /\\nameW/ || $string =~ /Mname/) {&print_warning("found an occurrence of \\name or an unslashed occurrence of Mname. Did you mean \\Mname?");}

  $string;
}

#line 1037 "ext.nw"
sub web_to_latex{
  local($text) = @_; # read argument into local variable
  local($output) = "";
  while ($text)
    { $text =~ /^([^\n]*\n)/;
      $text = $';
      $output .= &convert_line($1);
    } 
    return $output;
}


#line 2590 "ext.nw"
sub convert_line{
  local($text) = @_; # read argument into local variable
  local($output) = "";
  chop($text);
iteration:
   while ($text)
    { if ($text =~ /^([^\\\[\|]+)/)  # does not start with [ or | or \
        { $text = $';
          $output .= $1;
          if ($text eq "") { last iteration;}
        } 
      # text is nonempty and starts with [ or | or \       
      if ($text =~ /^\\Mcode(.)/)
       { $text = $';
         $delimiter=$1;
         if (!($text =~ /\\$1/))  # \ to protext meta characters
            {&print_warning("Mcode extends beyond end of line");}
         $text = $';
         $output .= &convert_M($`);
         next iteration;
       }
      if ($text =~ /^\\Tcode(.)/)
       { $text = $';
         $delimiter=$1;
         if (!($text =~ /\\$1/))  # as above
           {&print_warning("Tcode extends beyond end of line");}
         $text = $';
         $output .= &convert_T($`);
         next iteration;
       }
      # next we deal with | in its exceptional meanings
      if ($text =~ /^\\begin\{tabular\}/)
       {  $output .= $text;
          last iteration;
       }     
      if ($text =~ /^\\left\|/)
       { $text = $';
         $output .= "\\left\|";
       }
      if ($text =~ /^\\right\|/)
       { $text = $';
         $output .= "\\right\|";
       }
      if ($text =~ /^\|/)
       { $text = $';
         if (!($text =~ /\|/)) { &print_warning("odd number of |:\n|$text\n\n");}
         $text = $';
         $output .= &convert_M($`);
         next iteration;
       }
      if ($text =~ /^\[\[/)
       { $text = $';
         if (!($text =~ /\]\]/))
           { &print_warning("encountered [[ without matching ]]:[[$text\n\n");}
         $code = $`;  
         $text = $';
         while ($code =~ /\]\]/)
           { $code = $`;
             $text = $' . "]]" . $text;
           }
         $output .= &convert_T($code);;
         next iteration;
       }
     
      # text does not start with a special symbol. Move first symbol to output.
      $text =~ /^(.)/;
      $output .= $1;
      $text = $';
    }
  return $output . "\n";
}
         

#line 2716 "ext.nw"
# the following procedure is copied from ext.nw. Please make changes only here.
# I still need  way to maintain consistency with ext.

sub convert_M{
 local($Ctext) = @_; # read argument into local variable
   # we first work on identifiers 
   local($prefix) = "";
   local($suffix) = $Ctext;
   local($ident) = "";
identloop:
   while ($suffix =~ /^(\W*)(\w.*)$/)
     { $prefix .= $1;
       $suffix = $2;
       if ( $suffix =~ /^(\w+)(\W.*)$/)
         { $ident = $1;
           $suffix = $2;
         }
       else 
          { $ident = $suffix;
            $suffix = "";
          }
       if ($prefix =~ /\\$/) # For things like \n
          { if ($ident ne "n") {&print_warning("huch:\\ in  quoted code");}
            $prefix .= "L" . $ident; next identloop;
          }
       if ($ident =~ /^[0-9]*$/ )   # just a number
          { $prefix .= $ident; next identloop;}
       if (($usesubscripts eq "yes") && ($ident =~ /^([a-zA-Z])([0-9]+)$/)) 
             { $ident = $1 ."\\underscore\{$2\}"; }
           else { $ident = "\\mathit\{$ident\}"; }
       $prefix .= $ident;
        
      }
   $Ctext = $prefix . $suffix;
   $Ctext =~ s/&/\\&/g;
   $Ctext =~ s/_/\\nspaceunderscore\\_/g; # small negative space before _
   $Ctext =~ s/\./\\nspacedot\./g;  # small negative space before .
   $Ctext =~ s/::/\\DP /g;
   $Ctext =~ s/<</\\ll/g;
   $Ctext =~ s/>>/\\gg/g;
   $Ctext =~ s/ *<= */\\Lle/g;
   $Ctext =~ s/ *>= */\\Lge/g;
   $Ctext =~ s/ *== */\\Leq/g;
   $Ctext =~ s/ *-> */\\Larrow/g;
   $Ctext =~ s/ *\+ */+/g;   # LaTeX takes care of the spacing
   $Ctext =~ s/ *- */-/g;
   $Ctext =~ s/ *\* +/\*/g;
   $Ctext =~ s/ *< */</g;
   $Ctext =~ s/ *> */>/g;
   $Ctext =~ s/ *\+= */\\Lass\{\+\}/g;
   $Ctext =~ s/ *\-= */\\Lass\{\-\}/g;
   $Ctext =~ s/ *\*= */\\Lass\{\*\}/g;
   $Ctext =~ s/ *\/= */\\Lass\{\/\}/g;
   $Ctext =~ s/ *\\&= */\\Lass\{\\&\}/g;
   $Ctext =~ s/ *!= */\\Lass\{\!\}/g;
   $Ctext =~ s/ *\|= */\\Lass\{\|\}/g;



   # All blanks that are still in Ctext are to be preserved and are hence quoted
   $Ctext =~ s/ /\\ /g;
   $Ctext =~ s/\+\+/\\Dplus /g;
   $Ctest =~ s/--/\\Dminus /g;
   # $Ctext =~ s/!=/\\Noteq /g;
   $Ctext =~ s/\\Lle/\\Lle /g;
   $Ctext =~ s/\\Lge/\\Lge /g;
   $Ctext =~ s/\\Leq/\\Leq /g;
   $Ctext =~ s/\\Larrow/\\Larrow /g;
   if ($Ctext =~ /</) 
   { while ($Ctext =~ /^(.*)<([^>]*)>(.*)$/) # template brackets
     { $Ctext =~ s/</\\Lless /g; 
       $Ctext =~ s/>/\\Lgreater /g;
     }
   }
   $Ctext =~ s/%/\\%/g; 
   $Ctext =~ s/\^/\\circumflexop /g;
   $Ctext =~ s/~/\\tildeop /g;
   $Ctext =~ s/'/\\Lrquote /g;
   $Ctext =~ s/`/\\Llquote /g; 
   $Ctext =~ s/\(\)/\(\\;\)/g;      # a little space for empty argument list
   $Ctext =~ s/\,\\ /\,\$\}\n\\mbox\{\$/g;  
       # replace ,blank by ,$}newline\mbox{$ to allow line breaks
   $Ctext = "\\mbox\{\$" . $Ctext . "\$\}";

 $Ctext;
}
  

#line 2842 "ext.nw"
# the following procedure is copied from ext.nw. Please make changes only here.
# I still need  way to maintain consistency with ext.

sub convert_T{
 local($Ctext) = @_; # read argument into local variable
 $Ctext =~ s/&/\\&/g;
 $Ctext =~ s/_/\\_/g;
 $Ctext =~ s/{/\\{/g;
 $Ctext =~ s/}/\\}/g;
 $Ctext =~ s/%/\\%/g; 
 $Ctext =~ s/\^/\\circumflexop /g;
 $Ctext =~ s/~/\\Tildeop /g; 
 return "\{\\tt " . $Ctext . "\}";
}





#line 1600 "ext.nw"
sub print_function{
@args = ("funcname","prefix","postfix","signature","type");
foreach $arg (@args)
{ foreach $key (keys(%map)) 
     {$$arg =~ s/$key/$map{$key}/g; }
} 
if ($mode eq "Fman")
 { if ($funcname) {$signature = $prefix . $funcname . "(". $postfix. ")";}
   print $type , " ", $signature , "\n" ;
   if ($showsem == 1) 
   { print &substitute_for_placeholders($Mcomment) , "\n\n"; }
   return;
 }

$arg1 = "";  # conversion functions have no return type
$arg4 = "";  # description may be empty

if ($type) { $arg1 = &convert_M($type);}

$arg2 = "";
if ($funcname)
  { if ($prefix) { $arg2 .= &convert_M($prefix);}
    $funcname =~ s/_/\\nspaceunderscore\\_/g;  # quote and back up slightly
    $arg2 .= $funcname;
    if ($postfix =~ /^ *$/) {$arg3 = "";}
    else {$arg3 = &convert_M($postfix);}
   }
else
  { $arg2 =   &convert_M($signature);
    $arg3 = "";
  }

if ($Mcomment && $showsem == 1) {$arg4 = &convert_text($Mcomment);}
 
local($text) = "";
if ($command =~ /^opl?/ || $command =~ /^funcl?/ || $command =~ /^staticl?/)
 {  if ($arg3 eq "") {$arg3 = "\$\\,\$"; } # small space
    $text = "\\function" .' {'. $arg1 . "\}\n\{". $arg2 ."\} \n\{". $arg3 . "\} \n\{" . $arg4 .'}';
 }
else 
 { $text = "\\operator" .' {'. $arg1 . "\}\n\{". $arg2 ."\}  \n\{" . $arg4 .'}'; }

print OUTPUT $text,"\n\n";

}

#line 1652 "ext.nw"
sub print_constructor{
@args = ("par_list");
foreach $arg (@args)
   { foreach $key (keys(%map)) 
     {$$arg =~ s/$key/$map{$key}/g; }
   } 
if (!$Mvar || !$Mname )
     {&print_warning("ERROR: You forgot to define either Mvar or Mname");}
if ($mode eq "Fman")
    { $signature = $Mname . " " . $Mvar;
      if ($par_list) { $signature .= "(" . $par_list. ")"; }
      print $signature , ";\n" , &substitute_for_placeholders($Mcomment) , "\n\n";
      return;
    }
$arg1 = &convert_M($Mname);
$arg2 = &convert_M($Mvar);
if ($par_list)
    { $arg3 = &convert_M($par_list);}
else
    { $arg3 = "";}  # empty arg list
  
$arg4 = &convert_text($Mcomment);

local($text) = "\\create" .' {'. $arg1 ."\}\n\{". $arg2 ."\} \n\{".$arg3 . "} \n\{".$arg4 .'}';

print OUTPUT $text,"\n\n";

}

#line 1687 "ext.nw"
sub print_destructor{

 if ($mode eq "Fman")
 { print "~", $Mname ,"()\n" , &substitute_for_placeholders($Mcomment) ,"\n\n";
 }

  $arg1 = &convert_M($Mname);
     
  $arg2 = &convert_text($Mcomment);

  local($text) = "\\destruct" .' {'. $arg1 ."\}\n\{". $arg2 ."\}\n";

  print OUTPUT $text,"\n\n";
}

#line 2101 "ext.nw"
sub error_handler{
local($text) =  @_;  # read argument into local variable
print STDOUT "A problem occured near line " , $. ,"\n";
print STDOUT $text,"\n\n";
print STDOUT "The current code unit is:\n";
print STDOUT $original_code_unit, "\n";
print STDOUT "The current manual comment is:\n";
print STDOUT $original_comment, "\n\n";
if ($ack eq "yes") { print STDOUT "*  ";
            read(STDIN,$meaningless,1); }
}

sub print_warning{
if ($warnings eq "no" || $nextwarning eq "no") {return;}
local($text) =  @_;  # read argument into local variable
print STDOUT "A problem occured near line " , $. ,"\n";
print STDOUT "WARNING: ",$text,"\n\n";
print STDOUT "The current code unit is:\n\n";
print STDOUT $original_code_unit, "\n";
print STDOUT "The current manual comment is:\n\n";
print STDOUT $original_comment, "\n\n";
if ($ack eq "yes") { print STDOUT "*  ";
            read(STDIN,$meaningless,1); }
}


#line 2137 "ext.nw"
sub remove_enclosing_blanks{
if ($_[0] =~ /^ *$/)  {$_[0] = "";}
else
  { 
    $_[0] =~ / *(.*[^ ]) *$/; 
    $_[0] = $1;   
  }
}



#line 2153 "ext.nw"
sub print_usage{
if ($mode eq "Lman" || $mode eq "Ldoc")
{ print "\n\n\n
usage is
         Lman|Ldoc file [options]
Options are given in assignment syntax variable=value. There must be no
blank on either side of the equality sign. We list all variables and 
their possible values below. For each variable the default value of 
each option is given first.

size={12,11,10}
constref={no,yes}
partypes={no,yes}
numbered={no,yes}
xdvi={yes,no}
warnings={yes,no}
ack={yes,no}
usesubscripts={no,yes}
latexruns={1,2,0}
delman={yes,no}
filter={all,signatures,definition,creation,operations,
implementation,example,opname}

Lman and Ldoc can be customized by putting options in a 
file Lman.cfg or Ldoc.cfg 
in either 
the home directory or the working directory.

Call Lman Lman or Lman Ldoc for more information.  

call\n\n\n";
}
if ($mode eq "Fman")
{ print "\n\n\n
usage is
         Fman file filter

where the file name is of the form T[.h/.w] and T is either 
the name of a LEDA type, e.g., list, sortseq, or point, or 
the name of a user defined data type. The value of filter is one of {all,signatures,definition,creation,operations,
implementation,example,opname}" ;
}
exit;
}