--- loncom/xml/lonxml.pm 2003/06/20 14:45:48 1.265 +++ loncom/xml/lonxml.pm 2003/08/11 20:05:53 1.270 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.265 2003/06/20 14:45:48 bowersj2 Exp $ +# $Id: lonxml.pm,v 1.270 2003/08/11 20:05:53 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -70,6 +70,7 @@ use Math::Cephes(); use Math::Random(); use Opcode(); + sub register { my ($space,@taglist) = @_; foreach my $temptag (@taglist) { @@ -95,6 +96,8 @@ use Apache::run(); use Apache::londefdef(); use Apache::scripttag(); use Apache::edit(); +use Apache::inputtags(); +use Apache::outputtags(); use Apache::lonnet(); use Apache::File(); use Apache::loncommon(); @@ -489,6 +492,7 @@ sub latex_special_symbols { $current_token=~s/(>|<)/\$$1\$/g; #more or less if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space + if ($current_token eq '%.') {$current_token = '\%.';} #persent at the end of statement } return $current_token; } @@ -948,83 +952,105 @@ sub store_counter { } sub get_all_text { - my($tag,$pars)= @_; - &Apache::lonxml::debug("Got a ".ref($pars)); - my $gotfullstack=1; - if (ref($pars) ne 'ARRAY') { - $gotfullstack=0; - $pars=[$pars]; - } - 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')) { - $result.=$token->[1]; - } elsif ($token->[0] eq 'PI') { - $result.=$token->[2]; - } elsif ($token->[0] eq 'S') { - if ($token->[1] =~ /^$tag$/i) { $depth++; } - $result.=$token->[4]; - } elsif ($token->[0] eq 'E') { - if ( $token->[1] =~ /^$tag$/i) { $depth--; } - #skip sending back the last end tag - 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); - } - } - if ($top_empty && $depth >= 0) { - #never found the end tag ran out of text, throw error send back blank - &error('Never found end tag for <'.$tag.'>'); - if ($gotfullstack) { - my $newstring=''.$result; - &Apache::lonxml::newparser($pars,\$newstring); - } - $result=''; - } - } else { - while ($#$pars > -1) { - while ($token = $$pars[-1]->get_token) { - #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); - if (($token->[0] eq 'T')||($token->[0] eq 'C')|| - ($token->[0] eq 'D')) { - $result.=$token->[1]; - } elsif ($token->[0] eq 'PI') { - $result.=$token->[2]; - } elsif ($token->[0] eq 'S') { - if ( $token->[1] =~ /^$tag$/i) { - $$pars[-1]->unget_token($token); last; - } else { - $result.=$token->[4]; - } - } elsif ($token->[0] eq 'E') { - $result.=$token->[2]; - } - } - if (($#$pars > 0) ) { - pop(@$pars); - pop(@Apache::lonxml::pwd); - } else { last; } - } - } - if ($result =~ m||) { - $Apache::lonxml::usestyle=1; - } - #&Apache::lonxml::debug("Exit:$result:"); - return $result + my($tag,$pars,$style)= @_; + &Apache::lonxml::debug("Got a ".ref($pars)); + my $gotfullstack=1; + if (ref($pars) ne 'ARRAY') { + $gotfullstack=0; + $pars=[$pars]; + } + &Apache::lonxml::debug("Got a ".ref($style)); + if (ref($style) ne 'HASH') { + $style={}; + } else { + &Apache::lonhomework::showhash(%$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')) { + $result.=$token->[1]; + } elsif ($token->[0] eq 'PI') { + $result.=$token->[2]; + } elsif ($token->[0] eq 'S') { + if ($token->[1] =~ /^$tag$/i) { $depth++; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + if ( $token->[1] =~ /^$tag$/i) { $depth--; } + #skip sending back the last end tag + if ($depth == 0 && exists($$style{'/'.$token->[1]})) { + my $string= + ''. + $$style{'/'.$token->[1]}. + $token->[2]. + ''; + &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); + } + } + if ($top_empty && $depth >= 0) { + #never found the end tag ran out of text, throw error send back blank + &error('Never found end tag for <'.$tag. + '> current string
'.
+		   &HTML::Entities::encode($result).
+		   '
'); + if ($gotfullstack) { + my $newstring=''.$result; + &Apache::lonxml::newparser($pars,\$newstring); + } + $result=''; + } + } else { + while ($#$pars > -1) { + while ($token = $$pars[-1]->get_token) { + #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); + if (($token->[0] eq 'T')||($token->[0] eq 'C')|| + ($token->[0] eq 'D')) { + $result.=$token->[1]; + } elsif ($token->[0] eq 'PI') { + $result.=$token->[2]; + } elsif ($token->[0] eq 'S') { + if ( $token->[1] =~ /^$tag$/i) { + $$pars[-1]->unget_token($token); last; + } else { + $result.=$token->[4]; + } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; + } + } + if (($#$pars > 0) ) { + pop(@$pars); + pop(@Apache::lonxml::pwd); + } else { last; } + } + } + #&Apache::lonxml::debug("Exit:$result:"); + return $result } sub newparser { @@ -1046,7 +1072,7 @@ sub parstring { my $val=$token->[2]->{$_}; $val =~ s/([\%\@\\\"\'])/\\$1/g; #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } - $temp .= "my \$$_=\"$val\";" + $temp .= "my \$$_=\"$val\";"; } } return $temp; @@ -1389,7 +1415,7 @@ sub register_insert { my $line = $data[$i]; if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; } if ( $line =~ /TABLE/ ) { last; } - my ($tag,$descrip,$color,$function,$show) = split(/,/, $line); + my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line); if ($tag) { $insertlist{"$tagnum.tag"} = $tag; $insertlist{"$tagnum.description"} = $descrip; @@ -1397,6 +1423,8 @@ sub register_insert { $insertlist{"$tagnum.function"} = $function; if (!defined($show)) { $show='yes'; } $insertlist{"$tagnum.show"}= $show; + $insertlist{"$tagnum.helpfile"} = $helpfile; + $insertlist{"$tagnum.helpdesc"} = $helpdesc; $insertlist{"$tag.num"}=$tagnum; $tagnum++; } @@ -1431,6 +1459,20 @@ sub description { return $insertlist{$tagnum.'.description'}; } +# Returns a list containing the help file, and the description +sub helpinfo { + my ($token)=@_; + my $tagnum; + my $tag=$token->[1]; + foreach my $namespace (reverse @Apache::lonxml::namespace) { + my $testtag=$namespace.'::'.$tag; + $tagnum=$insertlist{"$testtag.num"}; + if (defined($tagnum)) { last; } + } + if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } + return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'}); +} + # ----------------------------------------------------------------- whichuser # returns a list of $symb, $courseid, $domain, $name that is correct for # calls to lonnet functions for this setup. @@ -1440,7 +1482,7 @@ sub whichuser { my ($symb,$courseid,$domain,$name,$publicuser); if (defined($ENV{'form.grade_symb'})) { my $tmp_courseid=$ENV{'form.grade_courseid'}; - my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid); + my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid); if ($allowed) { $symb=$ENV{'form.grade_symb'}; $courseid=$ENV{'form.grade_courseid'};