Diff for /loncom/xml/lonxml.pm between versions 1.1 and 1.527

version 1.1, 2000/06/19 15:52:29 version 1.527, 2011/12/09 21:21:43
Line 1 Line 1
 package Apache::lonxml;  # The LearningOnline Network with CAPA
   # XML Parser Module 
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   # Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 
   # TtHfunc and TtMfunc (the "Code") may be compiled and linked into 
   # binary executable programs or libraries distributed by the 
   # Michigan State University (the "Licensee"), but any binaries so 
   # distributed are hereby licensed only for use in the context
   # of a program or computational system for which the Licensee is the 
   # primary author or distributor, and which performs substantial 
   # additional tasks beyond the translation of (La)TeX into HTML.
   # The C source of the Code may not be distributed by the Licensee
   # to any other parties under any circumstances.
   #
   
   =pod
   
   =head1 NAME
   
   Apache::lonxml
   
   =head1 SYNOPSIS
   
   XML Parsing Module
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   
   =head1 SUBROUTINES
   
   =cut
   
   
   
   package Apache::lonxml; 
   use vars 
   qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
 use strict;  use strict;
 use HTML::TokeParser;  use LONCAPA;
 use Safe;  use HTML::LCParser();
   use HTML::TreeBuilder();
   use HTML::Entities();
   use Safe();
   use Safe::Hole();
   use Math::Cephes();
   use Math::Random();
   use Opcode();
   use POSIX qw(strftime);
   use Time::HiRes qw( gettimeofday tv_interval );
   use Symbol();
   
   sub register {
     my ($space,@taglist) = @_;
     foreach my $temptag (@taglist) {
       push(@{ $Apache::lonxml::alltags{$temptag} },$space);
     }
   }
   
   sub deregister {
     my ($space,@taglist) = @_;
     foreach my $temptag (@taglist) {
       my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
       if ($tempspace eq $space) {
         pop(@{ $Apache::lonxml::alltags{$temptag} });
       }
     }
     #&printalltags();
   }
   
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lontexconvert;  use Apache::lontexconvert();
   use Apache::style();
   use Apache::run();
   use Apache::londefdef();
   use Apache::scripttag();
   use Apache::languagetags();
   use Apache::edit();
   use Apache::inputtags();
   use Apache::outputtags();
   use Apache::lonnet;
   use Apache::File();
   use Apache::loncommon();
   use Apache::lonfeedback();
   use Apache::lonmsg();
   use Apache::loncacc();
   use Apache::lonmaxima();
   use Apache::lonr();
   use Apache::lonlocal;
   use Apache::lonhtmlcommon();
   use Apache::functionplotresponse();
   
   #====================================   Main subroutine: xmlparse  
   
   #debugging control, to turn on debugging modify the correct handler
   
   $Apache::lonxml::debug=0;
   
   # keeps count of the number of warnings and errors generated in a parse
   $warningcount=0;
   $errorcount=0;
   
   #path to the directory containing the file currently being processed
   @pwd=();
   
   #these two are used for capturing a subset of the output for later processing,
   #don't touch them directly use &startredirection and &endredirection
   @outputstack = ();
   $redirection = 0;
   
   #controls wheter the <import> tag actually does
   $import = 1;
   @extlinks=();
   
   # meta mode is a bit weird only some output is to be turned off
   #<output> tag turns metamode off (defined in londefdef.pm)
   $metamode = 0;
   
   # turns on and of run::evaluate actually derefencing var refs
   $evaluate = 1;
   
   # data structure for eidt mode, determines what tags can go into what other tags
   %insertlist=();
   
   # stores the list of active tag namespaces
   @namespace=();
   
   # stores all Scrit Vars displays for later showing
   my @script_var_displays=();
   
   # a pointer the the Apache request object
   $Apache::lonxml::request='';
   
   # a problem number counter, and check on ether it is used
   $Apache::lonxml::counter=1;
   $Apache::lonxml::counter_changed=0;
   
   # Part counter hash.   In analysis mode, the
   # problems can use this to record which parts increment the counter
   # by how much.  The counter subs will maintain this hash via
   # their optional part parameters.  Note that the assumption is that
   # analysis is done in one request and therefore it is not necessary to
   # save this information request-to-request.
   
   
   %Apache::lonxml::counters_per_part = ();
   
   #internal check on whether to look at style defs
   $Apache::lonxml::usestyle=1;
   
   #locations used to store the parameter string for style substitutions
   $Apache::lonxml::style_values='';
   $Apache::lonxml::style_end_values='';
   
   #array of ssi calls that need to occur after we are done parsing
   @Apache::lonxml::ssi_info=();
   
   #should we do the postag variable interpolation
   $Apache::lonxml::post_evaluate=1;
   
   #a header message to emit in the case of any generated warning or errors
   $Apache::lonxml::warnings_error_header='';
   
   #  Control whether or not LaTeX symbols should be substituted for their
   #  \ style equivalents...this may be turned off e.g. in an verbatim
   #  environment.
   
   $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
   
   sub enable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 1;
   }
   sub disable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 0;
   }
   
   sub xmlend {
       my ($target,$parser)=@_;
       my $mode='xml';
       my $status='OPEN';
       if ($Apache::lonhomework::parsing_a_problem ||
    $Apache::lonhomework::parsing_a_task ) {
    $mode='problem';
    $status=$Apache::inputtags::status[-1]; 
       }
       my $discussion;
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
      ['LONCAPA_INTERNAL_no_discussion']);
       if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) ||
           $env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {
           $discussion=&Apache::lonfeedback::list_discussion($mode,$status);
       }
       if ($target eq 'tex') {
    $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
    &Apache::lonxml::newparser($parser,\$discussion,'');
    return '';
       }
   
       return $discussion;
   }
   
 #=======================================================   Main subroutine: xmlparse    sub printalltags {
     my $temp;
     foreach $temp (sort keys %Apache::lonxml::alltags) {
       &Apache::lonxml::debug("$temp -- ".
     join(',',@{ $Apache::lonxml::alltags{$temp} }));
     }
   }
   
 sub xmlparse {  sub xmlparse {
    my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
   
    &setup_globals($request,$target);
    &Apache::inputtags::initialize_inputtags();
    &Apache::bridgetask::initialize_bridgetask();
    &Apache::outputtags::initialize_outputtags();
    &Apache::edit::initialize_edit();
    &Apache::londefdef::initialize_londefdef();
   
   #
   # do we have a course style file?
   #
   
    if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') {
        my $bodytext=
    $env{'course.'.$env{'request.course.id'}.'.default_xml_style'};
        if ($bodytext) {
    foreach my $file (split(',',$bodytext)) {
        my $location=&Apache::lonnet::filelocation('',$file);
        my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {
    %style_for_target = (%style_for_target,
         &Apache::style::styleparser($target,$styletext));
        }
    }
        }
    } elsif ($env{'construct.style'}
     && ($env{'request.state'} eq 'construct')) {
        my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
        my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {
    %style_for_target = (%style_for_target,
         &Apache::style::styleparser($target,$styletext));
        }
    }
   #&printalltags();
    my @pars = ();
    my $pwd=$env{'request.filename'};
    $pwd =~ s:/[^/]*$::;
    &newparser(\@pars,\$content_file_string,$pwd);
   
    my $safeeval = new Safe;
    my $safehole = new Safe::Hole;
    &init_safespace($target,$safeeval,$safehole,$safeinit);
   #-------------------- Redefinition of the target in the case of compound target
   
    ($target, my @tenta) = split('&&',$target);
   
    my @stack = ();
    my @parstack = ();
    &initdepth();
    &init_alarm();
    my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
      $safeeval,\%style_for_target,1);
   
    if (@stack) {
        &warning(&mt('At end of file some tags were still left unclosed:').
         ' <tt>&lt;'.join('&gt;</tt>, <tt>&lt;',reverse(@stack)).
         '&gt;</tt>');
    }
    if ($env{'request.uri'}) {
       &writeallows($env{'request.uri'});
    }
    &do_registered_ssi();
    if ($Apache::lonxml::counter_changed) { &store_counter() }
   
    &clean_safespace($safeeval);
   
    if (@script_var_displays) {
        my $scriptoutput = join('',@script_var_displays);
        $finaloutput=~s{(</body>\s*</html>)\s*$}{$scriptoutput$1}s;
        undef(@script_var_displays);
    }
    &init_state();
    if ($env{'form.return_only_error_and_warning_counts'}) {
        if ($env{'request.filename'}=~/\.(html|htm|xml)$/i) { 
           my $error=&verify_html($content_file_string);
           if ($error) { $errorcount++; }
        }
        return "$errorcount:$warningcount";
    }
    return $finaloutput;
   }
   
   sub latex_special_symbols {
       my ($string,$where)=@_;
       #
       #  If e.g. in verbatim mode, then don't substitute.
       #  but return original string.
       #
       if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
    return $string;
       }
       if ($where eq 'header') {
    $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
    $string =~ s/(\$|%|\{|\})/\\$1/g;
    $string=&Apache::lonprintout::character_chart($string);
    # any & or # leftover should be safe to just escape
           $string=~s/([^\\])\&/$1\\\&/g;
           $string=~s/([^\\])\#/$1\\\#/g;
    $string =~ s/_/\\_/g;              # _ -> \_
    $string =~ s/\^/\\\^{}/g;          # ^ -> \^{} 
       } else {
    $string=~s/\\/\\ensuremath{\\backslash}/g;
    $string=~s/\\\%|\%/\\\%/g;
    $string=~s/\\{|{/\\{/g;
    $string=~s/\\}|}/\\}/g;
    $string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
    $string=~s/\\\$|\$/\\\$/g;
    $string=~s/\\\_|\_/\\\_/g;
           $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;
    $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less
    $string=&Apache::lonprintout::character_chart($string);
    # any & or # leftover should be safe to just escape
    $string=~s/\\\&|\&/\\\&/g;
    $string=~s/\\\#|\#/\\\#/g;
           $string=~s/\|/\$\\mid\$/g;
   #single { or } How to escape?
       }
       return $string;
   }
   
     my ($target,$content_file_string,%style_for_target) = @_;  sub inner_xmlparse {
     my $pars = HTML::TokeParser->new(\$content_file_string);    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
     my $currentstring = '';    my $finaloutput = '';
     my $finaloutput = '';     my $result;
     my $newarg = '';    my $token;
     my $tempostring = '';    my $dontpop=0;
     my $tempocont = '';    my $startredirection = $Apache::lonxml::redirection;
     my $safeeval = new Safe;    while ( $#$pars > -1 ) {
       while ($token = $$pars['-1']->get_token) {
 #------------------------- Redefinition of the target in the case of compound target        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
     ($target, my @tenta) = split('&&',$target);   if ($metamode<1) {
 #------------------------------ Stack definition (in stack we have all current tags)      my $text=$token->[1];
       if ($token->[0] eq 'C' && $target eq 'tex') {
    $text = '';
   # $text = '%'.$text."\n";
       }
       $result.=$text;
    }
         } elsif (($token->[0] eq 'D')) {
    if ($metamode<1 && $target eq 'web') {
       my $text=$token->[1];
       $result.=$text;
    }
         } elsif ($token->[0] eq 'PI') {
    if ($metamode<1 && $target eq 'web') {
     $result=$token->[2];
    }
         } elsif ($token->[0] eq 'S') {
    # add tag to stack
    push (@$stack,$token->[1]);
    # add parameters list to another stack
    push (@$parstack,&parstring($token));
    &increasedepth($token);
    if ($Apache::lonxml::usestyle &&
       exists($$style_for_target{$token->[1]})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
       &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$$parstack[-1];
       $Apache::lonxml::style_end_values=$$parstack[-1];
    } else {
     $result = &callsub("start_$token->[1]", $target, $token, $stack,
        $parstack, $pars, $safeeval, $style_for_target);
    }
         } elsif ($token->[0] eq 'E') {
    if ($Apache::lonxml::usestyle &&
       exists($$style_for_target{'/'."$token->[1]"})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{'/'.$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
       &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
       $Apache::lonxml::style_end_values='';
       $dontpop=1;
    } else {
       #clear out any tags that didn't end
       while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
    my $lasttag=$$stack[-1];
    if ($token->[1] =~ /^\Q$lasttag\E$/i) {
       &Apache::lonxml::warning(&mt('Using tag [_1] on line [_2] as end tag to [_3]','&lt;/'.$token->[1].'&gt;','.$token->[3].','&lt;'.$$stack[-1].'&gt;'));
       last;
    } else {
                       &Apache::lonxml::warning(&mt('Found tag [_1] on line [_2] when looking for [_3] in file.','&lt;/'.$token->[1].'&gt;',$token->[3],'&lt;/'.$$stack[-1].'&gt;'));
       &end_tag($stack,$parstack,$token);
    }
       }
       $result = &callsub("end_$token->[1]", $target, $token, $stack,
          $parstack, $pars,$safeeval, $style_for_target);
    }
         } else {
    &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
         }
         #evaluate variable refs in result
         if ($Apache::lonxml::post_evaluate &&$result ne "") {
     my $extras;
     if (!$Apache::lonxml::usestyle) {
         $extras=$Apache::lonxml::style_values;
     }
     if ( $#$parstack > -1 ) {
         $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
     } else {
         $result= &Apache::run::evaluate($result,$safeeval,$extras);
             }
         }
         $Apache::lonxml::post_evaluate=1;
   
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
     #Style file definitions should be correct
     if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
         $result=&latex_special_symbols($result);
     }
         }
   
         if ($Apache::lonxml::redirection) {
    $Apache::lonxml::outputstack['-1'] .= $result;
         } else {
    $finaloutput.=$result;
         }
         $result = '';
   
         if ($token->[0] eq 'E' && !$dontpop) {
    &end_tag($stack,$parstack,$token);
         }
         $dontpop=0;
       }
       if ($#$pars > -1) {
    pop @$pars;
    pop @Apache::lonxml::pwd;
       }
     }
   
     # if ($target eq 'meta') {
     #   $finaloutput.=&endredirection;
     # }
   
     if ( $start && $target eq 'grade') { &endredirection(); }
     if ( $Apache::lonxml::redirection > $startredirection) {
         while ($Apache::lonxml::redirection > $startredirection) {
     $finaloutput .= &endredirection();
         }
     }
     if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
       $finaloutput=&afterburn($finaloutput);
     }
     if ($target eq 'modified') {
   # if modfied, handle startpart and endpart
        $finaloutput=~s/\<startpartmarker[^\>]*\>(.*)\<endpartmarker[^\>]*\>/<part>$1<\/part>/gs;
     }    
     return $finaloutput;
   }
   
     my @stack = ();   ## 
     my @parstack = ();  ## Looks to see if there is a subroutine defined for this tag.  If so, call it,
   ## otherwise do not call it as we do not know what it is.
   ##
   sub callsub {
     my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $currentstring='';
     my $nodefault;
     {
       my $sub1;
       no strict 'refs';
       my $tag=$token->[1];
   # get utterly rid of extended html tags
       if ($tag=~/^x\-/i) { return ''; }
       my $space=$Apache::lonxml::alltags{$tag}[-1];
       if (!$space) {
         $tag=~tr/A-Z/a-z/;
    $sub=~tr/A-Z/a-z/;
    $space=$Apache::lonxml::alltags{$tag}[-1]
       }
   
 #------------------------------------------ Parse input string (content_file_string)      my $deleted=0;
       if (($token->[0] eq 'S') && ($target eq 'modified')) {
         $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
        $parstack,$parser,$safeeval,
        $style);
       }
       if (!$deleted) {
         if ($space) {
    #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
    $sub1="$space\:\:$sub";
    ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
        $parstack,$parser,$safeeval,
        $style);
         } else {
             if ($target eq 'tex') {
                 # throw away tag name
                 return '';
             }
    #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
    if ($metamode <1) {
     if (defined($token->[4]) && ($metamode < 1)) {
       $currentstring = $token->[4];
     } else {
       $currentstring = $token->[2];
     }
    }
         }
         #    &Apache::lonxml::debug("nodefalt:$nodefault:");
         if ($currentstring eq '' && $nodefault eq '') {
    if ($target eq 'edit') {
     #&Apache::lonxml::debug("doing default edit for $token->[1]");
     if ($token->[0] eq 'S') {
       $currentstring = &Apache::edit::tag_start($target,$token);
     } elsif ($token->[0] eq 'E') {
       $currentstring = &Apache::edit::tag_end($target,$token);
     }
    }
         }
         if ($target eq 'modified' && $nodefault eq '') {
     if ($currentstring eq '') {
         if ($token->[0] eq 'S') {
     $currentstring = $token->[4];
         } elsif ($token->[0] eq 'E') {
     $currentstring = $token->[2];
         } else {
     $currentstring = $token->[2];
         }
     }
     if ($token->[0] eq 'S') {
         $currentstring.=&Apache::edit::handle_insert();
     } elsif ($token->[0] eq 'E') {
         $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
     }
         }
       }
       use strict 'refs';
     }
     return $currentstring;
   }
   
   {
       my %state;
   
       sub init_state {
    undef(%state);
       }
       
       sub set_state {
    my ($key,$value) = @_;
    $state{$key} = $value;
    return $value;
       }
       sub get_state {
    my ($key) = @_;
    return $state{$key};
       }
   }
   
   sub setup_globals {
     my ($request,$target)=@_;
     $Apache::lonxml::request=$request;
     $errorcount=0;
     $warningcount=0;
     $Apache::lonxml::internal_error=0;
     $Apache::lonxml::default_homework_loaded=0;
     $Apache::lonxml::usestyle=1;
     &init_counter();
     &clear_bubble_lines_for_part();
     &init_state();
     &set_state('target',$target);
     @Apache::lonxml::pwd=();
     @Apache::lonxml::extlinks=();
     @script_var_displays=();
     @Apache::lonxml::ssi_info=();
     $Apache::lonxml::post_evaluate=1;
     $Apache::lonxml::warnings_error_header='';
     $Apache::lonxml::substitute_LaTeX_symbols = 1;
     if ($target eq 'meta') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'answer') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'grade') {
       &startredirection(); #ended in inner_xmlparse on exit
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'modified') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 0;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'edit') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 0;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'analyze') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } else {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     }
   }
   
   sub init_safespace {
     my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->reval('use Math::Complex;');
     $safeeval->reval('use LaTeX::Table;');
     $safeeval->deny_only(':dangerous');
     $safeeval->permit_only(":default");
     $safeeval->permit("entereval");
     $safeeval->permit(":base_math");
     $safeeval->permit("sort");
     $safeeval->permit("time");
     $safeeval->permit("caller");
     $safeeval->deny("rand");
     $safeeval->deny("srand");
     $safeeval->deny(":base_io");
     $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
     $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
     $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
     '&chem_standard_order');
     $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');
     $safehole->wrap(\&Apache::response::implicit_multiplication,$safeeval,'&implicit_multiplication');
   
     $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval');
     $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check');
     $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval,
     '&maxima_cas_formula_fix');
   
     $safehole->wrap(\&Apache::lonr::r_eval,$safeeval,'&r_eval');
     $safehole->wrap(\&Apache::lonr::Rentry,$safeeval,'&Rentry');
     $safehole->wrap(\&Apache::lonr::Rarray,$safeeval,'&Rarray');
     $safehole->wrap(\&Apache::lonr::r_check,$safeeval,'&r_check');
     $safehole->wrap(\&Apache::lonr::r_cas_formula_fix,$safeeval,
                     '&r_cas_formula_fix');
     
     my $token;    $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval,
     '&capa_formula_fix');
   
     $safehole->wrap(\&Apache::lonlocal::locallocaltime,$safeeval,
                     '&locallocaltime');
   
     $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
     $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
     $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
     $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh');
     $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh');
     $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh');
     $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh');
     $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh');
     $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh');
     $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf');
     $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc');
     $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0');
     $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1');
     $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn');
     $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv');
     $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0');
     $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
     $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
     $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
     
     $safehole->wrap(\&Math::Cephes::bdtr  ,$safeeval,'&bdtr'  );
     $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' );
     $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' );
     $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' );
     $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' );
     $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc');
     $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri');
     $safehole->wrap(\&Math::Cephes::fdtr  ,$safeeval,'&fdtr'  );
     $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' );
     $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' );
     $safehole->wrap(\&Math::Cephes::gdtr  ,$safeeval,'&gdtr'  );
     $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' );
     $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' );
     $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc');
     $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri');
     $safehole->wrap(\&Math::Cephes::ndtr  ,$safeeval,'&ndtr'  );
     $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' );
     $safehole->wrap(\&Math::Cephes::pdtr  ,$safeeval,'&pdtr'  );
     $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' );
     $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' );
     $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
     $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');
   
     $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat');
     $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval,
     '&Math::Cephes::Matrix::new');
     $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval,
     '&Math::Cephes::Matrix::coef');
     $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval,
     '&Math::Cephes::Matrix::clr');
     $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval,
     '&Math::Cephes::Matrix::add');
     $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval,
     '&Math::Cephes::Matrix::sub');
     $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval,
     '&Math::Cephes::Matrix::mul');
     $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval,
     '&Math::Cephes::Matrix::div');
     $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval,
     '&Math::Cephes::Matrix::inv');
     $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval,
     '&Math::Cephes::Matrix::transp');
     $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval,
     '&Math::Cephes::Matrix::simq');
     $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval,
     '&Math::Cephes::Matrix::mat_to_vec');
     $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval,
     '&Math::Cephes::Matrix::vec_to_mat');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
   
   #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
   #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
   #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
   #  $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul');
   #  $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv');
   #  $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid');
   
     $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
     $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');
     $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');
     $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f');
     $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma');
     $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal');
     $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial');
     $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square');
     $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');
     $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');
     $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');
     $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');
     $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');
     $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');
     $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');
     $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial');
     $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial');
     $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase');
     $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
     $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
     $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
     $safehole->wrap(\&Apache::loncommon::languages,$safeeval,'&languages');
     $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
     $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
     $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
     $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');
     $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_val,$safeeval,'&fpr_val');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_f,$safeeval,'&fpr_f');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_dfdx,$safeeval,'&fpr_dfdx');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_d2fdx2,$safeeval,'&fpr_d2fdx2');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorcoords,$safeeval,'&fpr_vectorcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_objectcoords,$safeeval,'&fpr_objectcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorlength,$safeeval,'&fpr_vectorlength');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorangle,$safeeval,'&fpr_vectorangle');
   
   #  use Data::Dumper;
   #  $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');
   #need to inspect this class of ops
   # $safeeval->deny(":base_orig");
     $safeeval->permit("require");
     $safeinit .= ';$external::target="'.$target.'";';
     &Apache::run::run($safeinit,$safeeval);
     &initialize_rndseed($safeeval);
   }
   
   sub clean_safespace {
       my ($safeeval) = @_;
       delete_package_recurse($safeeval->{Root});
   }
   
   sub delete_package_recurse {
        my ($package) = @_;
        my @subp;
        {
    no strict 'refs';
    while (my ($key,$val) = each(%{*{"$package\::"}})) {
        if (!defined($val)) { next; }
        local (*ENTRY) = $val;
        if (defined *ENTRY{HASH} && $key =~ /::$/ &&
    $key ne "main::" && $key ne "<none>::")
        {
    my ($p) = $package ne "main" ? "$package\::" : "";
    ($p .= $key) =~ s/::$//;
    push(@subp,$p);
        }
    }
        }
        foreach my $p (@subp) {
    delete_package_recurse($p);
        }
        Symbol::delete_package($package);
   }
   
   sub initialize_rndseed {
       my ($safeeval)=@_;
       my $rndseed;
       my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
       $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
       my $safeinit = '$external::randomseed="'.$rndseed.'";';
       &Apache::lonxml::debug("Setting rndseed to $rndseed");
       &Apache::run::run($safeinit,$safeeval);
   }
   
   sub default_homework_load {
       my ($safeeval)=@_;
       &Apache::lonxml::debug('Loading default_homework');
       my $default=&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonIncludes'}.
                                            '/default_homework.lcpm');
       if ($default eq -1) {
    &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
       } else {
    &Apache::run::run($default,$safeeval);
    $Apache::lonxml::default_homework_loaded=1;
       }
   }
   
   {
       my $alarm_depth;
       sub init_alarm {
    alarm(0);
    $alarm_depth=0;
       }
   
       sub start_alarm {
    if ($alarm_depth<1) {
       my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
       if ($old) {
    &Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur.");
       }
    }
    $alarm_depth++;
       }
   
       sub end_alarm {
    $alarm_depth--;
    if ($alarm_depth<1) { alarm(0); }
       }
   }
   my $metamode_was;
   sub startredirection {
       if (!$Apache::lonxml::redirection) {
    $metamode_was=$Apache::lonxml::metamode;
       }
       $Apache::lonxml::metamode=0;
       $Apache::lonxml::redirection++;
       push (@Apache::lonxml::outputstack, '');
   }
   
   sub endredirection {
       if (!$Apache::lonxml::redirection) {
    &Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller);
    return '';
       }
       $Apache::lonxml::redirection--;
       if (!$Apache::lonxml::redirection) {
    $Apache::lonxml::metamode=$metamode_was;
       }
       pop @Apache::lonxml::outputstack;
   }
   sub in_redirection {
       return ($Apache::lonxml::redirection > 0)
   }
   
   sub end_tag {
     my ($tagstack,$parstack,$token)=@_;
     pop(@$tagstack);
     pop(@$parstack);
     &decreasedepth($token);
   }
   
   sub initdepth {
     @Apache::lonxml::depthcounter=();
     undef($Apache::lonxml::last_depth_count);
   }
   
   
     while ($token = $pars->get_token) {  my @timers;
   if ($token->[0] eq 'T') {  my $lasttime;
     $finaloutput .= $token->[1];  # @Apache::lonxml::depthcounter -> count of tags that exist so
             $tempocont .= $token->[1];  #                                  far at each level
   # $Apache::lonxml::last_depth_count -> when ascending, need to
   # remember the count for the level below the current level (for
   # example going from 1_2 -> 1 -> 1_3 need to remember the 2 )
   
   sub increasedepth {
     my ($token) = @_;
     push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1);
     undef($Apache::lonxml::last_depth_count);
     my $time;
     if ($Apache::lonxml::debug eq "1") {
         push(@timers,[&gettimeofday()]);
         $time=&tv_interval($lasttime);
         $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x($#Apache::lonxml::depthcounter);
     $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
   #  &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time");
   #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
   }
   
   sub decreasedepth {
     my ($token) = @_;
     if (  $#Apache::lonxml::depthcounter == -1) {
         &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     }
     $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);
   
     my ($timer,$time);
     if ($Apache::lonxml::debug eq "1") {
         $timer=pop(@timers);
         $time=&tv_interval($lasttime);
         $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x($#Apache::lonxml::depthcounter);
     $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
   #  &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
   #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
   }
   
   sub get_id {
       my ($parstack,$safeeval)=@_;
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) {
    &error(&mt('ID [_1] contains invalid characters. IDs are only allowed to contain letters, numbers, spaces and -','"<tt>'.$id.'</tt>"'));
       }
       if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
       return $id;
   }
   
   sub get_all_text_unbalanced {
   #there is a copy of this in lonpublisher.pm
       my($tag,$pars)= @_;
       my $token;
       my $result='';
       $tag='<'.$tag.'>';
       while ($token = $$pars[-1]->get_token) {
    if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
       if ($token->[0] eq 'T' && $token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $result.=$token->[1];
       }
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
  } elsif ($token->[0] eq 'S') {   } elsif ($token->[0] eq 'S') {
 #------------------------------------------------------------------ add tag to stack          $result.=$token->[4];
                push (@stack,$token->[1]);   } elsif ($token->[0] eq 'E')  {
 #---------------------------------------------- add parameters list to another stack      $result.=$token->[2];
        map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};   }
                push (@parstack,$tempostring);   if ($result =~ /\Q$tag\E/is) {
                $tempostring = '';      ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
                $tempocont = '';       #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
       #&Apache::lonxml::debug('Result is :'.$1);
                if (exists $style_for_target{$token->[1]}) {       $redo=$tag.$redo;
       &Apache::lonxml::newparser($pars,\$redo);
 #--------------------------------------------------------- use style file definition      last;
    }
                    $newarg = $style_for_target{$token->[1]};      }
       return $result
                    if (index($newarg,'script') != -1 ) {  
                     my $pat = HTML::TokeParser->new(\$newarg);  
                     my $tokenpat;  
                     my $partstring = '';  
                     my $oustring = '';  
                     my $outputstring;  
   
                     while  ($tokenpat = $pat->get_token) {  
  if ($tokenpat->[0] eq 'T') {  
     $oustring .= $tokenpat->[1];  
  } elsif ($tokenpat->[0] eq 'S') {  
                             if ($tokenpat->[1] eq 'script') {  
                                while  ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {  
                                     if ($tokenpat->[0] eq 'S')  {  
  $partstring .=  $tokenpat->[4];  
     } elsif ($tokenpat->[0] eq 'T') {  
                                         $partstring .=  $tokenpat->[1];  
     } elsif ($tokenpat->[0] eq 'E') {  
                                         $partstring .=  $tokenpat->[2];  
                                     }  
        }  
         
                                 map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};  
                                  
                                 &run($partstring,$safeeval);  
                                 $partstring = '';  
     } elsif ($tokenpat->[1] eq 'evaluate') {         
  $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval);  
                                    $oustring .=  $outputstring;  
     } else {  
                                    $oustring .= $tokenpat->[4];   
     }  
  } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {  
                              $oustring .= $tokenpat->[1];      
  }  
     }  
     $newarg =  $oustring;  
                    } else {  
                        map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};  
            }  
    $finaloutput .= $newarg;  
        } else {  
 #----------------------------------------------------- use default definition of tag  
                    my $sub="start_$token->[1]";  
            
                    {  
        no strict 'refs';  
                        if (defined (&$sub)) {  
                          $currentstring = &$sub($target,$token,\@parstack);  
                          $finaloutput .= $currentstring;  
                          $currentstring = '';  
        } else {  
    $finaloutput .= $token->[4];  
        }  
                        use strict 'refs';      
    }  
        }                
   } elsif ($token->[0] eq 'E')  {  
                pop @stack;   
                unless (exists $style_for_target{$token->[1]}) {  
                      my $sub="end_$token->[1]";  
                        {  
          no strict 'refs';  
                            if (defined (&$sub)) {  
      $currentstring = &$sub($target,$token,\@parstack);  
                              $finaloutput .= $currentstring;  
                              $currentstring = '';  
            } else {  
                              $finaloutput .= $token->[4];  
            }  
  use strict 'refs';  
                }  
        }  
 #------------------------------------------------------- end tag from the style file  
                if (exists $style_for_target{'/'."$token->[1]"}) {  
                    $newarg = $style_for_target{'/'."$token->[1]"};  
                    my @very_temp = split(',',@parstack[$#parstack]);  
                    map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;  
    $finaloutput .= $newarg;   
        }  
                pop @parstack;  
  }  
     }  
     return $finaloutput;  
 }  }
   
   #########################################################################
   #                                                                       #
   #           bubble line counter management                              #
   #                                                                       #
   #########################################################################
   
 #================================================================== style subroutine   =pod
   
 sub styleparser {  For bubble grading mode and exam bubble printing mode, the tracking of
   the current 'bubble line number' is stored in the %env element
   'form.counter', and is modifed and handled by the following routines.
   
     my ($target,$content_style_string) = @_;  The value of it is stored in $Apache:lonxml::counter when live and
   stored back to env after done.
   
 #------------------------------------------------ target redefinition (if necessary)   =item &increment_counter($increment, $part_response);
       
     my @target_string = '';  
     my $element;  
      
     ($element,@target_string) = split ('&&',$target);  
   
      map {$content_style_string =~ s/\<(.*)$_\>/\<$1$element\>/g; } @target_string;  
      
     $target = $element;  
      
 #------------------------------------------------- create a table for defined target  
 #---------------------------------------------- from the information from Style File  
   
     my @value_style = ();  
     my $current_key = '';  
     my $current_value = '';  
   
     my $pstyle = HTML::TokeParser->new(\$content_style_string);  
   
     my $stoken;  
   
       while ($stoken = $pstyle->get_token) {  
 #---------------------------------------------------------- start for tag definition  
   if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') {  
 #------------------------------------------------------------------- new key in hash  
      $current_key = $stoken->[2]{name};  
              if ($target eq 'meta') {  
 #-------------------------------------------------- reserved for the metadate output  
   
   
      } else {  
 #-------------------------------------------------------------------- outtext output  
  while ($stoken = $pstyle->get_token and $stoken->[1] ne 'outtext') {  
  }  
  while ($stoken = $pstyle->get_token and $stoken->[0] ne 'S') {  
      $current_value .= $stoken->[1];  
  }  
                  while ($stoken->[1] ne 'definetag') {  
                       if ($stoken->[0] eq 'S' and $stoken->[1] eq $target) {  
   while ($stoken = $pstyle->get_token) {  
                if ($stoken->[1] ne $target) {  
          if ($stoken->[0] eq 'S') {  
            $current_value .= $stoken->[4];  
                  }   
                                  if ($stoken->[0] eq 'E') {  
                                    $current_value .= $stoken->[2];  
                  }   
                                  if ($stoken->[0] eq 'T') {  
                                    $current_value .= $stoken->[1];   
                  }                   
                }  else {        
               last;  
                }  
   }  
       } elsif ($stoken->[0] eq 'S' and $stoken->[1] ne $target) {  
              while ($stoken = $pstyle->get_token and $stoken->[0] ne 'E') {  
              }  
       }  
   
                       while ($stoken = $pstyle->get_token) {  
                          if ($stoken->[0] eq 'T') {  
                              $current_value .= $stoken->[1];  
  }   
                          if ($stoken->[0] eq 'E') {  
    last;  
  }   
                          if ($stoken->[0] eq 'S') {  
    last;  
  }  
       }       
       
  }  
      }  
       
   }      
                     push (@value_style,lc $current_key,$current_value);  
                     $current_key = '';  
                     $current_value = '';           
   
       }  Increments the internal counter environment variable a specified amount
     
     my %style_for_target = @value_style;  
      
 #-------------------------------------------------------------------- check printing  
 #   while (($current_key,$current_value) = each %style_for_target) {  
 #       print "$current_key => $current_value\n";  
 #   }  
   
     return %style_for_target;  Optional Arguments:
       $increment - amount to increment by (defaults to 1)
                  Also 1 if the value is negative or zero.
     $part_response - A concatenation of the part and response id
                      identifying exactly what is being 'answered'.
   
   
   =cut
   
   sub increment_counter {
       my ($increment, $part_response) = @_;
       if ($env{'form.grade_noincrement'}) { return; }
       if (!defined($increment) || $increment le 0) {
    $increment = 1;
       }
       $Apache::lonxml::counter += $increment;
   
       # If the caller supplied the response_id parameter, 
       # Maintain its counter.. creating if necessary.
   
       if (defined($part_response)) {
    if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
       $Apache::lonxml::counters_per_part{$part_response} = 0;
    }
    $Apache::lonxml::counters_per_part{$part_response} += $increment;
    my $new_value = $Apache::lonxml::counters_per_part{$part_response};
       }
   
       $Apache::lonxml::counter_changed=1;
 }  }
   
   =pod
   
   =item &init_counter($increment);
   
 #=============================================================== Subroutine definition  Initialize the internal counter environment variable
 #--------------------------------------------------------------------------------- Run   
         sub evaluate {  
     my ($expression,$safeeval) = @_;  
             return $safeeval->reval($expression);  
         }  
   
         sub run {  =cut
     my ($code,$safeeval) = @_;  
             $safeeval->reval($code);  
         }  
   
 #===================================================================== TAG SUBROUTINES  sub init_counter {
 #----------------------------------------------------------------------------- <m> tag      if ($env{'request.state'} eq 'construct') {
         sub start_m {   $Apache::lonxml::counter=1;
     my ($target,$token) = @_;   $Apache::lonxml::counter_changed=1;
             my $currentstring = '';      } elsif (defined($env{'form.counter'})) {
             if ($target eq 'web') {   $Apache::lonxml::counter=$env{'form.counter'};
               $currentstring = "\$out = lontexconvert::converted(\$in = '\$'.\"";        $Apache::lonxml::counter_changed=0;
     } elsif ($target eq 'tex') {      } else {
               $currentstring = "\$";   $Apache::lonxml::counter=1;
             }   $Apache::lonxml::counter_changed=1;
    return $currentstring;      }
   }
   
   sub store_counter {
       &Apache::lonnet::appenv({'form.counter' => $Apache::lonxml::counter});
       $Apache::lonxml::counter_changed=0;
       return '';
   }
   
   {
       my $state;
       sub clear_problem_counter {
    undef($state);
    &Apache::lonnet::delenv('form.counter');
    &Apache::lonxml::init_counter();
    &Apache::lonxml::store_counter();
       }
   
       sub remember_problem_counter {
    &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
    $state = $env{'form.counter'};
       }
   
       sub restore_problem_counter {
    if (defined($state)) {
       &Apache::lonnet::appenv({'form.counter' => $state});
  }   }
         sub end_m {      }
     my ($target,$token) = @_;      sub get_problem_counter {
             my $currentstring = '';   if ($Apache::lonxml::counter_changed) { &store_counter() }
             if ($target eq 'web') {   &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
               $currentstring = "\".'\$') ";       return $env{'form.counter'};
             } elsif ($target eq 'tex') {      }
               $currentstring = "\$";  }
             }  
    return $currentstring;  =pod
   
   =item  bubble_lines_for_part(part_response)
   
   Returns the number of lines required to get a response for
   $part_response (this is just $Apache::lonxml::counters_per_part{$part_response}
   
   =cut
   
   sub bubble_lines_for_part {
       my ($part_response) = @_;
   
       if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
    return 0;
       } else {
    return $Apache::lonxml::counters_per_part{$part_response};
       }
   }
   
   =pod
   
   =item clear_bubble_lines_for_part
   
   Clears the hash of bubble lines per part.  If a caller
   needs to analyze several resources this should be called between
   resources to reset the hash for each problem being analyzed.
   
   =cut
   
   sub clear_bubble_lines_for_part {
       undef(%Apache::lonxml::counters_per_part);
   }
   
   =pod
   
   =item set_bubble_lines(part_response, value)
   
   If there is a problem part, that for whatever reason
   requires bubble lines that are not
   the same as the counter increment, it can call this sub during
   analysis to set its hash value explicitly.
   
   =cut
   
   sub set_bubble_lines {
       my ($part_response, $value) = @_;
   
       $Apache::lonxml::counters_per_part{$part_response} = $value;
   }
   
   =pod
   
   =item get_bubble_line_hash
   
   Returns the current bubble line hash.  This is assumed to 
   be small so we return a copy
   
   
   =cut
   
   sub get_bubble_line_hash {
       return %Apache::lonxml::counters_per_part;
   }
   
   
   #--------------------------------------------------
   
   sub get_all_text {
       my($tag,$pars,$style)= @_;
       my $gotfullstack=1;
       if (ref($pars) ne 'ARRAY') {
    $gotfullstack=0;
    $pars=[$pars];
       }
       if (ref($style) ne 'HASH') {
    $style={};
       }
       my $depth=0;
       my $token;
       my $result='';
       if ( $tag =~ m:^/: ) { 
    my $tag=substr($tag,1); 
    #&Apache::lonxml::debug("have:$tag:");
    my $top_empty=0;
    while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
       while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
    #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
    if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
       if ($token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $result.=$token->[1];
       }
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {
       if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
       $result.=$token->[4];
    } elsif ($token->[0] eq 'E')  {
       if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; }
       #skip sending back the last end tag
       if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
    my $string=
       '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
    $$style{'/'.$token->[1]}.
       $token->[2].
    '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
    &Apache::lonxml::newparser($pars,\$string);
    #&Apache::lonxml::debug("reParsing $string");
    next;
       }
       if ($depth > -1) {
    $result.=$token->[2];
       } else {
    $$pars[-1]->unget_token($token);
       }
    }
       }
       if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
       if (($depth >=0) && ($#$pars > 0) ) {
    pop(@$pars);
    pop(@Apache::lonxml::pwd);
       }
  }   }
 #-------------------------------------------------------------------------- <html> tag       if ($top_empty && $depth >= 0) {
       sub start_html {      #never found the end tag ran out of text, throw error send back blank
     my ($target,$token) = @_;      &error('Never found end tag for &lt;'.$tag.
             my $currentstring = '';     '&gt; current string <pre>'.
             if ($target eq 'web') {     &HTML::Entities::encode($result,'<>&"').
               $currentstring = $token->[4];          '</pre>');
     }       if ($gotfullstack) {
    return $currentstring;   my $newstring='</'.$tag.'>'.$result;
  }   &Apache::lonxml::newparser($pars,\$newstring);
         sub end_html {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #-------------------------------------------------------------------------- <head> tag  
       sub start_head {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_head {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #--------------------------------------------------------------------------- <map> tag  
       sub start_map {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_map {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------ <applet> tag  
       sub start_applet {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_applet {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------ <select> tag  
       sub start_select {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_select {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------ <option> tag  
       sub start_option {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_option {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------- <input> tag  
       sub start_input {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_input {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #---------------------------------------------------------------------- <textarea> tag  
       sub start_textarea {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_textarea {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #-------------------------------------------------------------------------- <form> tag  
       sub start_form {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_form {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------- <title> tag  
       sub start_title {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }      }
    return $currentstring;      $result='';
  }   }
         sub end_title {      } else {
     my ($target,$token) = @_;   while ($#$pars > -1) {
             my $currentstring = '';      while ($token = $$pars[-1]->get_token) {
             if ($target eq 'web') {   #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
               $currentstring = $token->[2];       if (($token->[0] eq 'T')||($token->[0] eq 'C')||
             }       ($token->[0] eq 'D')) {
    return $currentstring;      if ($token->[2]) {
  }   $result.='<![CDATA['.$token->[1].']]>';
 #-------------------------------------------------------------------------- <meta> tag      } else {
       sub start_meta {   $result.=$token->[1];
     my ($target,$token) = @_;      }
             my $currentstring = '';   } elsif ($token->[0] eq 'PI') {
             if ($target eq 'web') {      $result.=$token->[2];
               $currentstring = $token->[4];        } elsif ($token->[0] eq 'S') {
       if ( $token->[1] =~ /^\Q$tag\E$/i) {
    $$pars[-1]->unget_token($token); last;
       } else {
    $result.=$token->[4];
       }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
    } elsif ($token->[0] eq 'E')  {
       $result.=$token->[2];
    }
     }      }
    return $currentstring;      if (($#$pars > 0) ) {
    pop(@$pars);
    pop(@Apache::lonxml::pwd);
       } else { last; }
  }   }
         sub end_meta {      }
     my ($target,$token) = @_;      #&Apache::lonxml::debug("Exit:$result:");
             my $currentstring = '';      return $result
             if ($target eq 'web') {  }
               $currentstring = $token->[2];      
             }   sub newparser {
    return $currentstring;    my ($parser,$contentref,$dir) = @_;
  }    push (@$parser,HTML::LCParser->new($contentref));
 #-------------------------------------------------------------------------- <body> tag    $$parser[-1]->xml_mode(1);
         sub start_body {    $$parser[-1]->marked_sections(1);
     my ($target,$token) = @_;    if ( $dir eq '' ) {
             my $currentstring = '';      push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
             if ($target eq 'web') {    } else {
               $currentstring = $token->[4];           push (@Apache::lonxml::pwd, $dir);
     } elsif ($target eq 'tex') {    } 
               $currentstring = " \\begin{document} ";    }
     }   
    return $currentstring;  sub parstring {
  }      my ($token) = @_;
         sub end_body {      my (@vars,@values);
     my ($target,$token) = @_;      foreach my $attr (@{$token->[3]}) {
             my $currentstring = '';   if ($attr!~/\W/) {
             if ($target eq 'web') {      my $val=$token->[2]->{$attr};
               $currentstring = $token->[2];           $val =~ s/([\%\@\\\"\'])/\\$1/g;
     } elsif ($target eq 'tex') {      $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
               $currentstring = " \\end{document}";        $val =~ s/(\$)$/\\$1/;
     }       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
    return $currentstring;      push(@vars,"\$$attr");
  }      push(@values,"\"$val\"");
 #------------------------------------------------------------------------ <center> tag   }
         sub start_center {      }
     my ($target,$token) = @_;      my $var_init = 
             my $currentstring = '';   (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');'
             if ($target eq 'web') {          : '';
               $currentstring = $token->[4];           return $var_init;
     } elsif ($target eq 'tex') {  }
               $currentstring = " \\begin{center} ";    
     }   sub extlink {
    return $currentstring;      my ($res,$exact)=@_;
  }      if (!$exact) {
         sub end_center {   $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);
     my ($target,$token) = @_;      }
             my $currentstring = '';      push(@Apache::lonxml::extlinks,$res)  
             if ($target eq 'web') {  }
               $currentstring = $token->[2];       
     } elsif ($target eq 'tex') {  sub writeallows {
               $currentstring = " \\end{center}";        unless ($#extlinks>=0) { return; }
     }       my $thisurl = &Apache::lonnet::clutter(shift);
    return $currentstring;      if ($env{'httpref.'.$thisurl}) {
  }   $thisurl=$env{'httpref.'.$thisurl};
 #----------------------------------------------------------------------------- <b> tag      }
         sub start_b {      my $thisdir=$thisurl;
     my ($target,$token) = @_;      $thisdir=~s/\/[^\/]+$//;
             my $currentstring = '';      my %httpref=();
             if ($target eq 'web') {      foreach (@extlinks) {
               $currentstring = $token->[4];              $httpref{'httpref.'.
     } elsif ($target eq 'tex') {           &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
               $currentstring = " {\\bf ";        }
     }       @extlinks=();
    return $currentstring;      &Apache::lonnet::appenv(\%httpref);
  }  }
         sub end_b {  
     my ($target,$token) = @_;  sub register_ssi {
             my $currentstring = '';      my ($url,%form)=@_;
             if ($target eq 'web') {      push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form});
               $currentstring = $token->[2];           return '';
     } elsif ($target eq 'tex') {  }
               $currentstring = "}";    
     }   sub do_registered_ssi {
    return $currentstring;      foreach my $info (@Apache::lonxml::ssi_info) {
  }   my %form=%{ $info->{'form'}};
 #------------------------------------------------------------------------ <strong> tag   my $url=$info->{'url'};
         sub start_strong {   &Apache::lonnet::ssi($url,%form);
     my ($target,$token) = @_;      }
             my $currentstring = '';  }
             if ($target eq 'web') {  
               $currentstring = $token->[4];       sub add_script_result {
     } elsif ($target eq 'tex') {      my ($display) = @_;
               $currentstring = " {\\bf ";        push(@script_var_displays, $display);
     }   }
    return $currentstring;  
  }  #
         sub end_strong {  # Afterburner handles anchors, highlights and links
     my ($target,$token) = @_;  #
             my $currentstring = '';  sub afterburn {
             if ($target eq 'web') {      my $result=shift;
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
               $currentstring = $token->[2];           ['highlight','anchor','link']);
     } elsif ($target eq 'tex') {      if ($env{'form.highlight'}) {
               $currentstring = "}";           foreach (split(/\,/,$env{'form.highlight'})) {
     }              my $anchorname=$_;
    return $currentstring;     my $matchthis=$anchorname;
  }             $matchthis=~s/\_+/\\s\+/g;
 #---------------------------------------------------------------------------- <h1> tag             $result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs;
         sub start_h1 {         }
     my ($target,$token) = @_;      }
             my $currentstring = '';      if ($env{'form.link'}) {
             if ($target eq 'web') {         foreach (split(/\,/,$env{'form.link'})) {
        $currentstring .= $token->[4];             my ($anchorname,$linkurl)=split(/\>/,$_);
     } elsif ($target eq 'tex') {     my $matchthis=$anchorname;
  $currentstring .= "\\chapter{ ";             $matchthis=~s/\_+/\\s\+/g;
     }              $result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
            return $currentstring;         }
  }      }
         sub end_h1 {      if ($env{'form.anchor'}) {
     my ($target,$token) = @_;          my $anchorname=$env{'form.anchor'};
             my $currentstring = '';   my $matchthis=$anchorname;
             if ($target eq 'web') {          $matchthis=~s/\_+/\\s\+/g;
        $currentstring .= $token->[2];          $result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
     } elsif ($target eq 'tex') {          $result.=(<<"ENDSCRIPT");
  $currentstring .= "}";  <script type="text/javascript">
     }       document.location.hash='$anchorname';
            return $currentstring;  </script>
  }  ENDSCRIPT
 #---------------------------------------------------------------------------- <h2> tag      }
         sub start_h2 {      return $result;
     my ($target,$token) = @_;  }
             my $currentstring = '';  
             if ($target eq 'web') {  sub storefile {
        $currentstring .= $token->[4];      my ($file,$contents)=@_;
     } elsif ($target eq 'tex') {      &Apache::lonnet::correct_line_ends(\$contents);
  $currentstring .= "\\section{ ";      if (my $fh=Apache::File->new('>'.$file)) {
     }    print $fh $contents;
            return $currentstring;          $fh->close();
  }          return 1;
         sub end_h2 {      } else {
     my ($target,$token) = @_;   &warning(&mt('Unable to save file [_1]','<tt>'.$file.'</tt>'));
             my $currentstring = '';   return 0;
             if ($target eq 'web') {      }
        $currentstring .= $token->[2];  }
     } elsif ($target eq 'tex') {  
  $currentstring .= "}";  sub createnewhtml {
     }       my $title=&mt('Title of document goes here');
            return $currentstring;      my $body=&mt('Body of document goes here');
  }      my $filecontents=(<<SIMPLECONTENT);
 #---------------------------------------------------------------------------- <h3> tag  <html>
         sub start_h3 {  <head>
     my ($target,$token) = @_;  <title>$title</title>
             my $currentstring = '';  </head>
             if ($target eq 'web') {  <body bgcolor="#FFFFFF">
        $currentstring .= $token->[4];  $body
     } elsif ($target eq 'tex') {  </body>
  $currentstring .= "\\subsection{ ";  </html>
     }   SIMPLECONTENT
            return $currentstring;      return $filecontents;
  }  }
         sub end_h3 {  
     my ($target,$token) = @_;  sub createnewsty {
             my $currentstring = '';    my $filecontents=(<<SIMPLECONTENT);
             if ($target eq 'web') {  <definetag name="">
        $currentstring .= $token->[2];      <render>
     } elsif ($target eq 'tex') {         <web></web>
  $currentstring .= "}";         <tex></tex>
     }       </render>
            return $currentstring;  </definetag>
  }  SIMPLECONTENT
 #---------------------------------------------------------------------------- <h4> tag    return $filecontents;
         sub start_h4 {  }
     my ($target,$token) = @_;  
             my $currentstring = '';  sub createnewjs {
             if ($target eq 'web') {      my $filecontents=(<<SIMPLECONTENT);
        $currentstring .= $token->[4];  <script type="text/javascript" language="Javascript">
     } elsif ($target eq 'tex') {  
  $currentstring .= "\\subsubsection{ ";  </script>
     }   SIMPLECONTENT
            return $currentstring;      return $filecontents;
  }  }
         sub end_h4 {  
     my ($target,$token) = @_;  sub verify_html {
             my $currentstring = '';      my ($filecontents)=@_;
             if ($target eq 'web') {      my ($is_html,$is_xml);
        $currentstring .= $token->[2];      if ($filecontents =~/(?:\<|\&lt\;)\?xml[^\<]*\?(?:\>|\&gt\;)/is) {
     } elsif ($target eq 'tex') {          $is_xml = 1;
  $currentstring .= "}";      } elsif ($filecontents =~/(?:\<|\&lt\;)html(?:\s+[^\<]+|\s*)(?:\>|\&gt\;)/is) {
     }           $is_html = 1;
            return $currentstring;      }
  }      unless ($is_xml || $is_html) {
 #---------------------------------------------------------------------------- <h5> tag          return &mt('File does not have [_1] or [_2] starting tag','&lt;html&gt;','&lt;?xml ?&gt;');
         sub start_h5 {      }
     my ($target,$token) = @_;      if ($is_html) {
             my $currentstring = '';          if ($filecontents!~/(?:\<|\&lt\;)\/html(?:\>|\&gt\;)/is) {
             if ($target eq 'web') {              return &mt('File does not have [_1] ending tag','&lt;html&gt;');
        $currentstring .= $token->[4];          }
     } elsif ($target eq 'tex') {          if ($filecontents!~/(?:\<|\&lt\;)(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
  $currentstring .= "\\paragraph{ ";              return &mt('File does not have [_1] or [_2] starting tag','&lt;body&gt;','&lt;frameset&gt;');
     }           }
            return $currentstring;          if ($filecontents!~/(?:\<|\&lt\;)\/(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
  }              return &mt('File does not have [_1] or [_2] ending tag','&lt;body&gt;','&lt;frameset&gt;');
         sub end_h5 {          }
     my ($target,$token) = @_;      }
             my $currentstring = '';      return '';
             if ($target eq 'web') {  }
        $currentstring .= $token->[2];  
     } elsif ($target eq 'tex') {  sub renderingoptions {
  $currentstring .= "}";      my %langchoices=('' => '');
     }       foreach (&Apache::loncommon::languageids()) {
            return $currentstring;          if (&Apache::loncommon::supportedlanguagecode($_)) {
  }              $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
 #---------------------------------------------------------------------------- <h6> tag                         = &Apache::loncommon::plainlanguagedescription($_);
         sub start_h6 {          }
     my ($target,$token) = @_;      }
             my $currentstring = '';      my $output;
             if ($target eq 'web') {      unless ($env{'form.forceedit'}) {
        $currentstring .= $token->[4];         $output .=
     } elsif ($target eq 'tex') {             '<span class="LC_nobreak">'.
  $currentstring .= "\\subparagraph{ ";             &mt('Language:').' '.
     }              &Apache::loncommon::select_form(
            return $currentstring;                 $env{'form.languages'},
  }                 'languages',
         sub end_h6 {                 {&Apache::lonlocal::texthash(%langchoices)}).
     my ($target,$token) = @_;             '</span>';
             my $currentstring = '';      }
             if ($target eq 'web') {      $output .=
        $currentstring .= $token->[2];       ' <span class="LC_nobreak">'.
     } elsif ($target eq 'tex') {         &mt('Math Rendering:').' '.
  $currentstring .= "}";         &Apache::loncommon::select_form(
     }              $env{'form.texengine'},
            return $currentstring;             'texengine',
  }             {&Apache::lonlocal::texthash
 #-------------------------------------------------------------------------- <cite> tag                 (''        => '',
         sub start_cite {                  'tth'     => 'tth (TeX to HTML)',
     my ($target,$token) = @_;                  'MathJax' => 'MathJax',
             my $currentstring = '';    'jsMath'  => 'jsMath',
             if ($target eq 'web') {                  'mimetex' => 'mimetex (Convert to Images)')}).
        $currentstring .= $token->[4];       '</span>';
     } elsif ($target eq 'tex') {      return $output;
  $currentstring .= "{ \\it ";  }
     }   
            return $currentstring;  sub inserteditinfo {
  }        my ($filecontents, $filetype, $filename)=@_;
         sub end_cite {        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
     my ($target,$token) = @_;        my $xml_help = '';
             my $currentstring = '';        my $initialize='';
             if ($target eq 'web') {        my $textarea_id = 'filecont';
        $currentstring .= $token->[2];        my $dragmath_button;
     } elsif ($target eq 'tex') {        my ($add_to_onload, $add_to_onresize);
  $currentstring .= "}";        $initialize=&Apache::lonhtmlcommon::spellheader();
     }         if (($filetype eq 'html') && (&Apache::lonhtmlcommon::htmlareabrowser())) {
            return $currentstring;    my $lang = &Apache::lonhtmlcommon::htmlarea_lang();
  }            my %textarea_args = (
 #----------------------------------------------------------------------------- <i> tag                                  fullpage => 'true',
         sub start_i {                                  dragmath => 'math',
     my ($target,$token) = @_;                                );
             my $currentstring = '';            $initialize .= &Apache::lonhtmlcommon::htmlareaselectactive(\%textarea_args); 
             if ($target eq 'web') {        }
        $currentstring .= $token->[4];        $initialize .= (<<FULLPAGE);
     } elsif ($target eq 'tex') {  <script type="text/javascript">
  $currentstring .= "{ \\it ";  // <![CDATA[
     }       function initDocument() {
            return $currentstring;   resize_textarea('$textarea_id','LC_aftertextarea');
  }      }
         sub end_i {  // ]]>
     my ($target,$token) = @_;  </script>
             my $currentstring = '';  FULLPAGE
             if ($target eq 'web') {        if ($filetype eq 'html') {
        $currentstring .= $token->[2];            $dragmath_button = '<span id="math_filecont">'.&Apache::lonhtmlcommon::dragmath_button('filecont',1).'</span>';
     } elsif ($target eq 'tex') {            $initialize .= "\n".&Apache::lonhtmlcommon::dragmath_js('EditMathPopup');
  $currentstring .= "}";        }
     }         $add_to_onload = 'initDocument();';
            return $currentstring;        $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
  }  
 #----------------------------------------------------------------------- <address> tag        if ($filetype eq 'html') {
         sub start_address {    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
     my ($target,$token) = @_;        }
             my $currentstring = '';  
             if ($target eq 'web') {        my $titledisplay=&display_title();
        $currentstring .= $token->[4];        my $textareaclass;
     } elsif ($target eq 'tex') {        my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit',
  $currentstring .= "{ \\it ";   'vi' => 'Save and View',
     }    'dv' => 'Discard Edits and View',
            return $currentstring;   'un' => 'undo',
  }   'ed' => 'Edit');
         sub end_address {        my $spelllink = &Apache::lonhtmlcommon::spelllink('xmledit','filecont');
     my ($target,$token) = @_;        my $textarea_events = &Apache::edit::element_change_detection();
             my $currentstring = '';        my $form_events     = &Apache::edit::form_change_detection();
             if ($target eq 'web') {        my $htmlerror;
        $currentstring .= $token->[2];        if ($filetype eq 'html') {
     } elsif ($target eq 'tex') {            $htmlerror=&verify_html($filecontents);
  $currentstring .= "}";            if ($htmlerror) {
     }                 $htmlerror='<span class="LC_error">'.$htmlerror.'</span>';
            return $currentstring;            }
  }            if (&Apache::lonhtmlcommon::htmlareabrowser()) {
 #--------------------------------------------------------------------------- <dfn> tag                $textareaclass = 'class="LC_richDefaultOff"';
         sub start_dfn {            }
     my ($target,$token) = @_;        }
             my $currentstring = '';        my $editfooter=(<<ENDFOOTER);
             if ($target eq 'web') {  $initialize
        $currentstring .= $token->[4];  <a name="editsection" />
     } elsif ($target eq 'tex') {  <form $form_events method="post" name="xmledit">
  $currentstring .= "{ \\it ";    <div class="LC_edit_problem_editxml_header">
     }       <table class="LC_edit_problem_header_title"><tr><td>
            return $currentstring;          $filename
  }        </td><td align="right">
         sub end_dfn {          $xml_help
     my ($target,$token) = @_;        </td></tr>
             my $currentstring = '';      </table>
             if ($target eq 'web') {      <div class="LC_edit_problem_discards">
        $currentstring .= $token->[2];        <input type="submit" name="discardview" accesskey="d" value="$lt{'dv'}" />
     } elsif ($target eq 'tex') {        <input type="submit" name="Undo" accesskey="u" value="$lt{'un'}" />
  $currentstring .= "}";        $htmlerror $dragmath_button
     }       </div>
            return $currentstring;      <div class="LC_edit_problem_saves">
  }        <input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
 #---------------------------------------------------------------------------- <tt> tag        <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
         sub start_tt {      </div>
     my ($target,$token) = @_;    </div>
             my $currentstring = '';    <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont" $textareaclass>$filecontents</textarea><br />$spelllink
             if ($target eq 'web') {    <div id="LC_aftertextarea">
        $currentstring .= $token->[4];      <br />
     } elsif ($target eq 'tex') {      $titledisplay
  $currentstring .= "{ \\tt ";    </div>
     }   </form>
            return $currentstring;  </body>
  }  ENDFOOTER
         sub end_tt {        return ($editfooter,$add_to_onload,$add_to_onresize);;
     my ($target,$token) = @_;  }
             my $currentstring = '';  
             if ($target eq 'web') {  sub get_target {
        $currentstring .= $token->[2];    my $viewgrades=&Apache::lonnet::allowed('vgr',$env{'request.course.id'});
     } elsif ($target eq 'tex') {    if ( $env{'request.state'} eq 'published') {
  $currentstring .= "}";      if ( defined($env{'form.grade_target'})
     }    && ($viewgrades == 'F' )) {
            return $currentstring;        return ($env{'form.grade_target'});
  }      } elsif (defined($env{'form.grade_target'})) {
 #---------------------------------------------------------------------------- <kbd> tag        if (($env{'form.grade_target'} eq 'web') ||
         sub start_kbd {    ($env{'form.grade_target'} eq 'tex') ) {
     my ($target,$token) = @_;   return $env{'form.grade_target'}
             my $currentstring = '';        } else {
             if ($target eq 'web') {   return 'web';
        $currentstring .= $token->[4];        }
     } elsif ($target eq 'tex') {      } else {
  $currentstring .= "{ \\tt ";        return 'web';
     }       }
            return $currentstring;    } elsif ($env{'request.state'} eq 'construct') {
  }      if ( defined($env{'form.grade_target'})) {
         sub end_kbd {        return ($env{'form.grade_target'});
     my ($target,$token) = @_;      } else {
             my $currentstring = '';        return 'web';
             if ($target eq 'web') {      }
        $currentstring .= $token->[2];    } else {
     } elsif ($target eq 'tex') {      return 'web';
  $currentstring .= "}";    }
     }   }
            return $currentstring;  
  }  sub handler {
 #-------------------------------------------------------------------------- <code> tag      my $request=shift;
         sub start_code {  
     my ($target,$token) = @_;      my $target=&get_target();
             my $currentstring = '';      $Apache::lonxml::debug=$env{'user.debug'};
             if ($target eq 'web') {      
        $currentstring .= $token->[4];      &Apache::loncommon::content_type($request,'text/html');
     } elsif ($target eq 'tex') {      &Apache::loncommon::no_cache($request);
  $currentstring .= "{ \\tt ";      if ($env{'request.state'} eq 'published') {
     }    $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
            return $currentstring;        'lastrevisiondate'));
  }      }
         sub end_code {      # Embedded Flash movies from Camtasia served from https will not display in IE
     my ($target,$token) = @_;      #   if XML config file has expired from cache.    
             my $currentstring = '';      if ($ENV{'SERVER_PORT'} == 443) {
             if ($target eq 'web') {          if ($request->uri =~ /\.xml$/) {
        $currentstring .= $token->[2];              my ($httpbrowser,$clientbrowser) =
     } elsif ($target eq 'tex') {                  &Apache::loncommon::decode_user_agent($request);
  $currentstring .= "}";              if ($clientbrowser =~ /^explorer$/i) {
     }                   delete $request->headers_out->{'Cache-control'};
            return $currentstring;                  delete $request->headers_out->{'Pragma'};
  }                  my $expiration = time + 60;
 #---------------------------------------------------------------------------- <em> tag                  my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime($expiration));
         sub start_em {                  $request->headers_out->set("Expires" => $date);
     my ($target,$token) = @_;              }
             my $currentstring = '';          }
             if ($target eq 'web') {      }
        $currentstring .= $token->[4];      $request->send_http_header;
     } elsif ($target eq 'tex') {      
  $currentstring .= "{ \\emph ";      return OK if $request->header_only;
     }   
            return $currentstring;  
  }      my $file=&Apache::lonnet::filelocation("",$request->uri);
         sub end_em {      my ($filetype,$breadcrumbtext);
     my ($target,$token) = @_;      if ($file =~ /\.(sty|css|js|txt|tex)$/) {
             my $currentstring = '';   $filetype=$1;
             if ($target eq 'web') {      } else {
        $currentstring .= $token->[2];   $filetype='html';
     } elsif ($target eq 'tex') {      }
  $currentstring .= "}";      if ($filetype eq 'sty') {
     }           $breadcrumbtext = 'Style File Editor';
            return $currentstring;      } elsif ($filetype eq 'js') {
  }          $breadcrumbtext = 'Javascript Editor';
 #----------------------------------------------------------------------------- <q> tag      } elsif ($filetype eq 'css') {
         sub start_q {          $breadcrumbtext = 'CSS Editor';
     my ($target,$token) = @_;      } elsif ($filetype eq 'txt') {
             my $currentstring = '';          $breadcrumbtext = 'Text Editor';
             if ($target eq 'web') {      } elsif ($filetype eq 'tex') {
        $currentstring .= $token->[4];          $breadcrumbtext = 'TeX Editor';
     } elsif ($target eq 'tex') {      } else {
  $currentstring .= "{ \\emph ";          $breadcrumbtext = 'HTML Editor';
     }       }
            return $currentstring;  
  }  #
         sub end_q {  # Edit action? Save file.
     my ($target,$token) = @_;  #
             my $currentstring = '';      if (!($env{'request.state'} eq 'published')) {
             if ($target eq 'web') {   if ($env{'form.savethisfile'} || $env{'form.viewmode'} || $env{'form.Undo'}) {
        $currentstring .= $token->[2];      my $html_file=&Apache::lonnet::getfile($file);
     } elsif ($target eq 'tex') {      my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'});
  $currentstring .= "}";              if ($env{'form.savethisfile'}) {
     }                   $env{'form.editmode'}='Edit'; #force edit mode
            return $currentstring;  
  }  
 #----------------------------------------------------------------------------- <p> tag  
         sub start_p {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[4];  
     } elsif ($target eq 'tex') {  
  $currentstring .= "{\\par ";  
     }   
            return $currentstring;  
  }  
         sub end_p {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[2];  
     } elsif ($target eq 'tex') {  
         $currentstring .= " }";  
             }              }
            return $currentstring;  
  }   }
 #---------------------------------------------------------------------------- <br> tag      }
         sub start_br {      my %mystyle;
     my ($target,$token) = @_;      my $result = '';
             my $currentstring = '';      my $filecontents=&Apache::lonnet::getfile($file);
             if ($target eq 'web') {      if ($filecontents eq -1) {
        $currentstring .= $token->[4];   my $start_page=&Apache::loncommon::start_page('File Error');
     } elsif ($target eq 'tex') {   my $end_page=&Apache::loncommon::end_page();
  $currentstring .= "\\\\";          my $errormsg='<p class="LC_error">'
     }                       .&mt('File not found: [_1]'
            return $currentstring;                          ,'<span class="LC_filename">'.$file.'</span>')
  }                      .'</p>';
         sub end_br {   $result=(<<ENDNOTFOUND);
     my ($target,$token) = @_;  $start_page
             my $currentstring = '';  $errormsg
             if ($target eq 'web') {  $end_page
        $currentstring .= $token->[2];  ENDNOTFOUND
           $filecontents='';
    if ($env{'request.state'} ne 'published') {
       if ($filetype eq 'sty') {
    $filecontents=&createnewsty();
               } elsif ($filetype eq 'js') {
                   $filecontents=&createnewjs();
               } elsif ($filetype ne 'css' && $filetype ne 'txt' && $filetype ne 'tex') {
    $filecontents=&createnewhtml();
     }      }
            return $currentstring;      $env{'form.editmode'}='Edit'; #force edit mode
  }   }
 #--------------------------------------------------------------------------- <big> tag      } else {
         sub start_big {   unless ($env{'request.state'} eq 'published') {
     my ($target,$token) = @_;      if ($filecontents=~/BEGIN LON-CAPA Internal/) {
             my $currentstring = '';   &Apache::lonxml::error(&mt('This file appears to be a rendering of a LON-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.'));
             if ($target eq 'web') {      }
        $currentstring .= $token->[4];  #
     } elsif ($target eq 'tex') {  # we are in construction space, see if edit mode forced
  $currentstring .= "{\\large ";              &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     }       ['editmode']);
            return $currentstring;   }
  }   if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {
         sub end_big {              if ($filetype eq 'html' || $filetype eq 'sty') {
     my ($target,$token) = @_;          &Apache::structuretags::reset_problem_globals();
             my $currentstring = '';          $result = &Apache::lonxml::xmlparse($request,$target,
             if ($target eq 'web') {                                                      $filecontents,'',%mystyle);
        $currentstring .= $token->[2];      # .html files may contain <problem> or <Task> need to clean
     } elsif ($target eq 'tex') {      # up if it did
         $currentstring .= " }";          &Apache::structuretags::reset_problem_globals();
           &Apache::lonhomework::finished_parsing();
               } elsif ($filetype eq 'tex') {
                   $result = &Apache::lontexconvert::converted(\$filecontents,
                                 $env{'form.texengine'});
                   if ($env{'form.return_only_error_and_warning_counts'}) {
                       $result = "$errorcount:$warningcount";
                   }
               } else {
                   $result = $filecontents;
             }              }
            return $currentstring;      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  }      ['rawmode']);
 #------------------------------------------------------------------------- <small> tag      if ($env{'form.rawmode'}) { $result = $filecontents; }
         sub start_small {              if (($filetype ne 'html') && 
     my ($target,$token) = @_;                  (!$env{'form.return_only_error_and_warning_counts'})) {
             my $currentstring = '';                  my $nochgview = 1;
             if ($target eq 'web') {                  my $controls = '';
        $currentstring .= $token->[4];                      if ($env{'request.state'} eq 'construct') {
     } elsif ($target eq 'tex') {                          $controls = &Apache::loncommon::head_subbox(
  $currentstring .= "{\\footnotesize ";                                          &Apache::loncommon::CSTR_pageheader()
     }                                          .&Apache::londefdef::edit_controls($nochgview));
            return $currentstring;                      }
  }                  if ($filetype ne 'sty' && $filetype ne 'tex') {
         sub end_small {                      $result =~ s/</&lt;/g;
     my ($target,$token) = @_;                      $result =~ s/>/&gt;/g;
             my $currentstring = '';                      $result = '<table class="LC_sty_begin">'.
             if ($target eq 'web') {                                '<tr><td><b><pre>'.$result.
        $currentstring .= $token->[2];                                '</pre></b></td></tr></table>';
     } elsif ($target eq 'tex') {                  }
         $currentstring .= " }";                  my $brcrum;
                   if ($env{'request.state'} eq 'construct') {
                       $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri),
                                   'text' => 'Construction Space'},
                                  {'href' => '',
                                   'text' => $breadcrumbtext}];
                   } else {
                       $brcrum = ''; # FIXME: Where are we?
                   }
                   my %options = ('bread_crumbs' => $brcrum,
                                  'bgcolor'      => '#FFFFFF');
                   $result =
                       &Apache::loncommon::start_page(undef,undef,\%options)
                      .$controls
                      .$result
                      .&Apache::loncommon::end_page();
             }              }
            return $currentstring;          }
  }      }
 #---------------------------------------------------------------------- <basefont> tag  
       sub start_basefont {  #
     my ($target,$token) = @_;  # Edit action? Insert editing commands
             my $currentstring = '';  #
             if ($target eq 'web') {      unless ($env{'request.state'} eq 'published') {
               $currentstring = $token->[4];        if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
     }    {
    return $currentstring;      my $displayfile=$request->uri;
  }      $displayfile=~s/^\/[^\/]*//;
 #-------------------------------------------------------------------------- <font> tag  
          sub start_font {      my ($edit_info, $add_to_onload, $add_to_onresize)=
     my ($target,$token) = @_;   &inserteditinfo($filecontents,$filetype,$displayfile);
             my $currentstring = '';  
             if ($target eq 'web') {      my %options = 
               $currentstring = $token->[4];        ('add_entries' =>
     }                      {'onresize'     => $add_to_onresize,
    return $currentstring;                      'onload'       => $add_to_onload,   });
  }              my $header;
         sub end_font {              if ($env{'request.state'} eq 'construct') {
     my ($target,$token) = @_;                  $options{'bread_crumbs'} = [{
             my $currentstring = '';                              'href' => &Apache::loncommon::authorspace($request->uri),
             if ($target eq 'web') {                              'text' => 'Construction Space'},
               $currentstring = $token->[2];                                 {'href' => '',
             }                               'text' => $breadcrumbtext}];
    return $currentstring;                  $header = &Apache::loncommon::head_subbox(
  }                                 &Apache::loncommon::CSTR_pageheader());
 #------------------------------------------------------------------------ <strike> tag  
         sub start_strike {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[4];  
     } elsif ($target eq 'tex') {  
  $currentstring .= "{\\underline ";  
     }   
            return $currentstring;  
  }  
         sub end_strike {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[2];  
     } elsif ($target eq 'tex') {  
         $currentstring .= " }";  
             }              }
            return $currentstring;      my $js =
    &Apache::edit::js_change_detection().
    &Apache::loncommon::resize_textarea_js();
       my $start_page = &Apache::loncommon::start_page(undef,$js,
       \%options);
               $result = $start_page
                        .$header
                        .&Apache::lonxml::message_location()
                        .$edit_info
                        .&Apache::loncommon::end_page();
           }
       }
       if ($filetype eq 'html') { &writeallows($request->uri); }
   
       &Apache::lonxml::add_messages(\$result);
       $request->print($result);
       
       return OK;
   }
   
   sub display_title {
       my $result;
       if ($env{'request.state'} eq 'construct') {
    my $title=&Apache::lonnet::gettitle();
    if (!defined($title) || $title eq '') {
       $title = $env{'request.filename'};
       $title = substr($title, rindex($title, '/') + 1);
  }   }
 #----------------------------------------------------------------------------- <s> tag          $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA "
         sub start_s {                    .&mt('Construction Space')."';</script>";
     my ($target,$token) = @_;      }
             my $currentstring = '';      return $result;
             if ($target eq 'web') {  }
        $currentstring .= $token->[4];  
     } elsif ($target eq 'tex') {  sub debug {
  $currentstring .= "{\\underline ";      if ($Apache::lonxml::debug eq "1") {
     }    $|=1;
            return $currentstring;   my $request=$Apache::lonxml::request;
  }   if (!$request) {
         sub end_s {      eval { $request=Apache->request; };
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[2];  
     } elsif ($target eq 'tex') {  
         $currentstring .= " }";  
             }  
            return $currentstring;  
  }   }
 #--------------------------------------------------------------------------- <sub> tag   if (!$request) {
         sub start_sub {      eval { $request=Apache2::RequestUtil->request; };
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[4];  
     } elsif ($target eq 'tex') {  
  $currentstring .= "\$_{ ";  
     }   
            return $currentstring;  
  }  
         sub end_sub {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
        $currentstring .= $token->[2];  
     } elsif ($target eq 'tex') {  
         $currentstring .= " }\$";  
             }  
            return $currentstring;  
  }   }
 #--------------------------------------------------------------------------- <sup> tag   $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
         sub start_sup {   #&Apache::lonnet::logthis($_[0]);
     my ($target,$token) = @_;      }
             my $currentstring = '';  }
             if ($target eq 'web') {  
        $currentstring .= $token->[4];  sub show_error_warn_msg {
     } elsif ($target eq 'tex') {      if (($env{'request.filename'} eq 
  $currentstring .= "\$^{ ";           $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/lib/templates/simpleproblem.problem') &&
     }           (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) {
            return $currentstring;   return 1;
  }      }
         sub end_sup {      return (($Apache::lonxml::debug eq 1) ||
     my ($target,$token) = @_;      ($env{'request.state'} eq 'construct') ||
             my $currentstring = '';      ($Apache::lonhomework::browse eq 'F'
             if ($target eq 'web') {       &&
        $currentstring .= $token->[2];       $env{'form.show_errors'} eq 'on'));
     } elsif ($target eq 'tex') {  }
         $currentstring .= " }\$";  
             }  sub error {
            return $currentstring;      my @errors = @_;
   
       $errorcount++;
   
       $Apache::lonxml::internal_error=1;
   
       if (defined($Apache::inputtags::part)) {
    if ( @Apache::inputtags::response ) {
       push(@errors,
    &mt("This error occurred while processing response [_1] in part [_2]",
        $Apache::inputtags::response[-1],
        $Apache::inputtags::part));
    } else {
       push(@errors,
    &mt("This error occurred while processing part [_1]",
        $Apache::inputtags::part));
  }   }
 #---------------------------------------------------------------------------- <hr> tag      }
         sub start_hr {  
     my ($target,$token) = @_;      if ( &show_error_warn_msg() ) {
             my $currentstring = '';   # If printing in construction space, put the error inside <pre></pre>
             if ($target eq 'web') {   push(@Apache::lonxml::error_messages,
        $currentstring .= $token->[4];       $Apache::lonxml::warnings_error_header
     } elsif ($target eq 'tex') {               .'<div class="LC_error">'
  $currentstring .= "\\hline ";               .'<b>'.&mt('ERROR:').' </b>'.join("<br />\n",@errors)
     }                ."</div>\n");
            return $currentstring;   $Apache::lonxml::warnings_error_header='';
  }      } else {
 #----------------------------------------------------------------------------- <a> tag   my $errormsg;
         sub start_a {   my ($symb)=&Apache::lonnet::symbread();
     my ($target,$token) = @_;   if ( !$symb ) {
             my $currentstring = '';      #public or browsers
             if ($target eq 'web') {      $errormsg=&mt("An error occurred while processing this resource. The author has been notified.");
        $currentstring .= $token->[4];   }
     } elsif ($target eq 'tex') {   my $host=$Apache::lonnet::perlvar{'lonHostID'};
    push(@errors,
           &mt("The error occurred on host [_1]",
                "<tt>$host</tt>"));
   
    my $msg = join('<br />', @errors);
   
    #notify author
    &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
    #notify course
    if ( $symb && $env{'request.course.id'} ) {
       my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
       my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
       my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1);
       my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
               my $baseurl = &Apache::lonnet::clutter($declutter);
       my @userlist;
       foreach (keys %users) {
    my ($user,$domain) = split(/:/, $_);
    push(@userlist,"$user\@$domain");
    my $key=$declutter.'_'.$user.'_'.$domain;
    my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
         [$key],
         $cdom,$cnum);
    my $now=time;
    if ($now-$lastnotified{$key}>86400) {
                       my $title = &Apache::lonnet::gettitle($symb);
                       my $sentmessage;
       &Apache::lonmsg::user_normal_msg($user,$domain,
           "Error [$title]",$msg,'',$baseurl,'','',
                           \$sentmessage,$symb,$title,1);
       &Apache::lonnet::put('nohist_xmlerrornotifications',
    {$key => $now},
    $cdom,$cnum);
    }
       }
       if ($env{'request.role.adv'}) {
    $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
       } else {
    $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified.");
     }      }
            return $currentstring;  
  }   }
         sub end_a {   push(@Apache::lonxml::error_messages,"<b>$errormsg</b> <br />");
     my ($target,$token,$stackref) = @_;      }
             my $currentstring = '';  }
             if ($target eq 'web') {  
        $currentstring .= $token->[2];  sub warning {
     } elsif ($target eq 'tex') {      $warningcount++;
                 my  $tempor_var = $stackref->[$#$stackref];    
  if (index($tempor_var,'name') != -1 ) {      if ($env{'form.grade_target'} ne 'tex') {
     $tempor_var =~ s/name=([^,]*),/$1/g;   if ( &show_error_warn_msg() ) {
         $currentstring .= " \\label{$tempor_var}";      push(@Apache::lonxml::warning_messages,
         } elsif (index($tempor_var,'href') != -1 ) {   $Apache::lonxml::warnings_error_header
     $tempor_var =~ s/href=([^,]*),/$1/g;                  .'<div class="LC_warning">'
         $currentstring .= " \\ref{$tempor_var}";                  .&mt('[_1]W[_2]ARNING','<b>','</b>')."<b>:</b> ".join('<br />',@_)
         }                  ."</div>\n"
             }                  );
            return $currentstring;      $Apache::lonxml::warnings_error_header='';
  }   }
 #---------------------------------------------------------------------------- <li> tag      }
         sub start_li {  }
     my ($target,$token,$stackref) = @_;  
             my $currentstring = '';  sub info {
             if ($target eq 'web') {      if ($env{'form.grade_target'} ne 'tex' 
               $currentstring = $token->[4];        && $env{'request.state'} eq 'construct') {
     } elsif ($target eq 'tex') {   push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n");
                 my  $tempor_var = $stackref->[$#$stackref-1];      }
                 if (index($tempor_var,'circle') != -1 ) {  }
           $currentstring .= " \\item[o] ";  
         } elsif (index($tempor_var,'square') != -1 ) {  sub message_location {
                $currentstring .= " \\item[$\Box$] ";      return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
         } else {  }
     $currentstring .= " \\item ";  
         }    sub add_messages {
     }       my ($msg)=@_;
    return $currentstring;      my $result=join(' ',
  }      @Apache::lonxml::info_messages,
         sub end_li {      @Apache::lonxml::error_messages,
     my ($target,$token) = @_;      @Apache::lonxml::warning_messages);
             my $currentstring = '';      undef(@Apache::lonxml::info_messages);
             if ($target eq 'web') {      undef(@Apache::lonxml::error_messages);
               $currentstring = $token->[2];           undef(@Apache::lonxml::warning_messages);
     }       $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
    return $currentstring;      $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
  }  }
 #----------------------------------------------------------------------------- <u> tag  
         sub start_u {  sub get_param {
     my ($target,$token) = @_;      my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
             my $currentstring = '';      if ( ! $context ) { $context = -1; }
             if ($target eq 'web') {      my $args ='';
        $currentstring .= $token->[4];      if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
     } elsif ($target eq 'tex') {      if ( ! $Apache::lonxml::usestyle ) {
  $currentstring .= "{\\underline ";   $args=$Apache::lonxml::style_values.$args;
     }       }
            return $currentstring;      if ( ! $args ) { return undef; }
  }      if ( $case_insensitive ) {
         sub end_u {   if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
     my ($target,$token) = @_;      return &Apache::run::run("{$args;".'return $'.$param.'}',
             my $currentstring = '';                                       $safeeval); #'
             if ($target eq 'web') {   } else {
        $currentstring .= $token->[2];      return undef;
     } elsif ($target eq 'tex') {   }
         $currentstring .= " }";      } else {
             }   if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
            return $currentstring;      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                        $safeeval); #'
    } else {
       return undef;
  }   }
 #---------------------------------------------------------------------------- <ul> tag      }
         sub start_ul {  }
     my ($target,$token) = @_;  
             my $currentstring = '';  sub get_param_var {
             if ($target eq 'web') {    my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
               $currentstring = $token->[4];         if ( ! $context ) { $context = -1; }
     } elsif ($target eq 'tex') {    my $args ='';
               $currentstring = " \\begin{itemize} ";      if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
     }     if ( ! $Apache::lonxml::usestyle ) {
    return $currentstring;        $args=$Apache::lonxml::style_values.$args;
  }    }
         sub end_ul {    &Apache::lonxml::debug("Args are $args param is $param");
     my ($target,$token) = @_;    if ($case_insensitive) {
             my $currentstring = '';        if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
             if ($target eq 'web') {    return undef;
               $currentstring = $token->[2];             }
     } elsif ($target eq 'tex') {    } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
               $currentstring = " \\end{itemize}";      my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
     }     &Apache::lonxml::debug("first run is $value");
    return $currentstring;    if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
  }        &Apache::lonxml::debug("doing second");
 #-------------------------------------------------------------------------- <menu> tag        my @result=&Apache::run::run("return $value",$safeeval,1);
         sub start_menu {        if (!defined($result[0])) {
     my ($target,$token) = @_;    return $value
             my $currentstring = '';        } else {
             if ($target eq 'web') {    if (wantarray) { return @result; } else { return $result[0]; }
               $currentstring = $token->[4];             }
     } elsif ($target eq 'tex') {    } else {
               $currentstring = " \\begin{itemize} ";        return $value;
     }     }
    return $currentstring;  }
  }  
         sub end_menu {  sub register_insert_xml {
     my ($target,$token) = @_;      my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
             my $currentstring = '';       .'/insertlist.xml');
             if ($target eq 'web') {      my ($tagnum,$in_help)=(0,0);
               $currentstring = $token->[2];           my @alltags;
     } elsif ($target eq 'tex') {      my $tag;
               $currentstring = " \\end{itemize}";        while (my $token = $parser->get_token()) {
     }    if ($token->[0] eq 'S') {
    return $currentstring;      my $key;
  }      if ($token->[1] eq 'tag') {
 #--------------------------------------------------------------------------- <dir> tag   $tag = $token->[2]{'name'};
         sub start_dir {                  if (defined($tag)) {
     my ($target,$token) = @_;      $insertlist{$tagnum.'.tag'} = $tag;
             my $currentstring = '';      $insertlist{$tag.'.num'}   = $tagnum;
             if ($target eq 'web') {      push(@alltags,$tag);
               $currentstring = $token->[4];                       }
     } elsif ($target eq 'tex') {      } elsif ($in_help && $token->[1] eq 'file') {
               $currentstring = " \\begin{itemize} ";     $key = $tag.'.helpfile';
     }       } elsif ($in_help && $token->[1] eq 'description') {
    return $currentstring;   $key = $tag.'.helpdesc';
  }      } elsif ($token->[1] eq 'description' ||
         sub end_dir {       $token->[1] eq 'color'       ||
     my ($target,$token) = @_;       $token->[1] eq 'show'          ) {
             my $currentstring = '';   $key = $tag.'.'.$token->[1];
             if ($target eq 'web') {      } elsif ($token->[1] eq 'insert_sub') {
               $currentstring = $token->[2];        $key = $tag.'.function';
     } elsif ($target eq 'tex') {      } elsif ($token->[1] eq 'help') {
               $currentstring = " \\end{itemize}";     $in_help=1;
     }       } elsif ($token->[1] eq 'allow') {
    return $currentstring;   $key = $tag.'.allow';
  }      }
 #---------------------------------------------------------------------------- <ol> tag      if (defined($key)) {
         sub start_ol {   $insertlist{$key} = $parser->get_text();
     my ($target,$token) = @_;   $insertlist{$key} =~ s/(^\s*|\s*$ )//gx;
             my $currentstring = '';      }
             if ($target eq 'web') {   } elsif ($token->[0] eq 'E') {
               $currentstring = $token->[4];           if      ($token->[1] eq 'tag') {
     } elsif ($target eq 'tex') {   undef($tag);
               $currentstring = " \\begin{enumerate} ";     $tagnum++;
     }       } elsif ($token->[1] eq 'help') {
    return $currentstring;   undef($in_help);
  }      }
         sub end_ol {   }
     my ($target,$token) = @_;      }
             my $currentstring = '';      
             if ($target eq 'web') {      # parse the allows and ignore tags set to <show>no</show>
               $currentstring = $token->[2];           foreach my $tag (@alltags) {
     } elsif ($target eq 'tex') {          next if (!exists($insertlist{$tag.'.allow'}));
               $currentstring = " \\end{enumerate}";     my $allow =  $insertlist{$tag.'.allow'};
     }           foreach my $element (split(',',$allow)) {
    return $currentstring;      $element =~ s/(^\s*|\s*$ )//gx;
  }      if (!exists($insertlist{$element.'.show'})
 #---------------------------------------------------------------------------- <dl> tag                  || $insertlist{$element.'.show'} ne 'no') {
         sub start_dl {   push(@{ $insertlist{$tag.'.which'} },$element);
     my ($target,$token) = @_;      }
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     } elsif ($target eq 'tex') {  
               $currentstring = " \\begin{description} ";    
     }   
    return $currentstring;  
  }  
         sub end_dl {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];       
     } elsif ($target eq 'tex') {  
               $currentstring = " \\end{description}";    
     }   
    return $currentstring;  
  }  
 #---------------------------------------------------------------------------- <dt> tag  
         sub start_dt {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     } elsif ($target eq 'tex') {  
               $currentstring = "\\item[ ";    
     }   
    return $currentstring;  
  }  
         sub end_dt {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             } elsif ($target eq 'tex') {  
               $currentstring = "]";    
     }   
    return $currentstring;  
  }  
 #---------------------------------------------------------------------------- <dd> tag  
         sub start_dd {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     }   
    return $currentstring;  
  }  
         sub end_dd {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];      
             }   
    return $currentstring;  
  }  
 #------------------------------------------------------------------------- <table> tag  
         sub start_table {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[4];       
     } elsif ($target eq 'tex') {  
               $currentstring = " \\begin{tabular} ";    
     }   
    return $currentstring;  
  }  
         sub end_table {  
     my ($target,$token) = @_;  
             my $currentstring = '';  
             if ($target eq 'web') {  
               $currentstring = $token->[2];       
     } elsif ($target eq 'tex') {  
               $currentstring = " \\end{tabular}";    
     }   
    return $currentstring;  
  }   }
       }
   }
   
   sub register_insert {
       return &register_insert_xml(@_);
   #    &dump_insertlist('2');
   }
   
   sub dump_insertlist {
       my ($ext) = @_;
       open(XML,">/tmp/insertlist.xml.$ext");
       print XML ("<insertlist>");
       my $i=0;
   
       while (exists($insertlist{"$i.tag"})) {
    my $tag = $insertlist{"$i.tag"};
    print XML ("
   \t<tag name=\"$tag\">");
    if (defined($insertlist{"$tag.description"})) {
       print XML ("
   \t\t<description>".$insertlist{"$tag.description"}."</description>");
    }
    if (defined($insertlist{"$tag.color"})) {
       print XML ("
   \t\t<color>".$insertlist{"$tag.color"}."</color>");
    }
    if (defined($insertlist{"$tag.function"})) {
       print XML ("
   \t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>");
    }
    if (defined($insertlist{"$tag.show"})
       && $insertlist{"$tag.show"} ne 'yes') {
       print XML ("
   \t\t<show>".$insertlist{"$tag.show"}."</show>");
    }
    if (defined($insertlist{"$tag.helpfile"})) {
       print XML ("
   \t\t<help>
   \t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>");
       if ($insertlist{"$tag.helpdesc"} ne '') {
    print XML ("
   \t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>");
       }
       print XML ("
   \t\t</help>");
    }
    if (defined($insertlist{"$tag.which"})) {
       print XML ("
   \t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>");
    }
    print XML ("
   \t</tag>");
    $i++;
       }
       print XML ("\n</insertlist>\n");
       close(XML);
   }
   
   sub description {
       my ($token)=@_;
       my $tag = &get_tag($token);
       return $insertlist{$tag.'.description'};
   }
   
   # Returns a list containing the help file, and the description
   sub helpinfo {
       my ($token)=@_;
       my $tag = &get_tag($token);
       return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
   }
   
   sub get_tag {
       my ($token)=@_;
       my $tagnum;
       my $tag=$token->[1];
       foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
    my $testtag = $namespace.'::'.$tag;
    $tagnum = $insertlist{"$testtag.num"};
    last if (defined($tagnum));
       }
       if (!defined($tagnum)) {
    $tagnum = $Apache::lonxml::insertlist{"$tag.num"};
       }
       return $insertlist{"$tagnum.tag"};
   }
   
   ############################################################
   #                                           PDF-FORM-METHODS
   
   =pod
   
   =item &print_pdf_radiobutton(fieldname, value)
   
   Returns a latexline to generate a PDF-Form-Radiobutton.
   Note: Radiobuttons with equal names are automaticly grouped 
         in a selection-group.
   
   $fieldname: PDF internalname of the radiobutton(group)
   $value:     Value of radiobutton
   
   =cut
   sub print_pdf_radiobutton {
       my ($fieldname, $value) = @_;
       return '\radioButton[\symbolchoice{circle}]{'
              .$fieldname.'}{10bp}{10bp}{'.$value.'}';
   }
   
   
   =pod
   
   =item &print_pdf_start_combobox(fieldname)
   
   Starts a latexline to generate a PDF-Form-Combobox with text.
   
   $fieldname: PDF internal name of the Combobox
   
   =cut
   sub print_pdf_start_combobox {
       my $result;
       my ($fieldName) = @_;
       $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n";
       $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; # 
   
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_add_combobox_option(options)
   
   Generates a latexline to add Options to a PDF-Form-ComboBox.
   
   $option: PDF internal name of the Combobox-Option
   
   =cut
   sub print_pdf_add_combobox_option {
   
       my $result;
       my ($option) = @_;  
   
       $result .= '('.$option.')';
       
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_end_combobox(text) {
   
   Returns latexcode to end a PDF-Form-Combobox with text.
   
   =cut
   sub print_pdf_end_combobox {
       my $result;
       my ($text) = @_;
   
       $result .= '}&'.$text."\\\\\n";
       $result .= '\end{tabularx}' . "\n";
       $result .= '\hspace{2mm}' . "\n";
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_hiddenField(fieldname, user, domain)
   
   Returns a latexline to generate a PDF-Form-hiddenField with userdata.
   
   $fieldname label for hiddentextfield
   $user:    name of user
   $domain:  domain of user
   
   =cut
   sub print_pdf_hiddenfield {
       my $result;
       my ($fieldname, $user, $domain) = @_;
   
       $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n";
   
       return $result;
   }
   
 1;  1;
 __END__  __END__
   

Removed from v.1.1  
changed lines
  Added in v.1.527


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>