Diff for /loncom/xml/lonxml.pm between versions 1.214 and 1.221.2.2

version 1.214, 2002/11/12 20:11:10 version 1.221.2.2, 2003/01/13 22:20:35
Line 101  use Apache::File(); Line 101  use Apache::File();
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonfeedback();  use Apache::lonfeedback();
 use Apache::lonmsg();  use Apache::lonmsg();
   use Apache::loncacc();
   
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
 #debugging control, to turn on debugging modify the correct handler  #debugging control, to turn on debugging modify the correct handler
Line 144  $Apache::lonxml::registered=0; Line 145  $Apache::lonxml::registered=0;
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
   
 # a problem number counter, and check on hether it is used  # a problem number counter, and check on ether it is used
 $Apache::lonxml::counter=0;  $Apache::lonxml::counter=1;
 $Apache::lonxml::counter_changed=0;  $Apache::lonxml::counter_changed=0;
   
 #internal check on whether to look at style defs  #internal check on whether to look at style defs
Line 351  sub printtokenheader { Line 352  sub printtokenheader {
     if ($target eq 'web') {      if ($target eq 'web') {
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));          my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
  return    return 
  '<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.   '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.
                'Checked out for '.$plainname.                 'Checked out for '.$plainname.
                '<br />User: '.$tuname.' at '.$tudom.                 '<br />User: '.$tuname.' at '.$tudom.
        '<br />ID: '.$idhash{$tuname}.         '<br />ID: '.$idhash{$tuname}.
Line 373  sub fontsettings() { Line 374  sub fontsettings() {
     return $headerstring;      return $headerstring;
 }  }
   
   
   ##
   ## switchmenu - modeled on lonmenu::switchmenu, but better. 
   ## Helper function for registerurl
   ##
   sub switchmenu {
       my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
       return(<<ENDSMENU);
       menu.switchbutton($row,$col,'$imgsrc','$texttop','$textbot','$action','$description');
   ENDSMENU
   }
   
 sub registerurl {  sub registerurl {
     my $forcereg=shift;      my $forcereg=shift;
     my $target = shift;      my $target = shift;
Line 421  ENDGRDS Line 434  ENDGRDS
 ENDPARM  ENDPARM
             }              }
  }   }
           ###
           ### Determine whether or not to display the 'cstr' button for this
           ### resource
           ###
           my $editbutton = '';
           if ($ENV{'user.author'}) {
               if ($ENV{'request.role'}=~/^(ca|au)/) {
                   # Set defaults for authors
                   my ($top,$bottom) = ('con-','struct');
                   my $action = "go('/priv/".$ENV{'user.name'}."');";
                   my $cadom  = $ENV{'request.role.domain'};
                   my $caname = $ENV{'user.name'};
                   my $desc = "Enter my resource construction space";
                   # Set defaults for co-authors
                   if ($ENV{'request.role'} =~ /^ca/) { 
                       ($cadom,$caname)=($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
                       ($top,$bottom) = ('co con-','struct');
                       $action = 'go("/priv/'.$caname.'");';
                       $desc = "Enter construction space as co-author";
                   }
                   # Check that we are on the correct machine
                   my $home = &Apache::lonnet::homeserver($caname,$cadom);
                   if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) {
                       $editbutton=&switchmenu
                           (6,1,$top,,$bottom,$action,$desc);
                   }
               }
               ##
               ## Determine if user can edit url.
               ##
               my $cfile='';
               my $cfuname='';
               my $cfudom='';
               if ($ENV{'request.filename'}) {
                   my $file=&Apache::lonnet::declutter($ENV{'request.filename'});
                   $file=~s/^(\w+)\/(\w+)/\/priv\/$2/;
                   # Chech that the user has permission to edit this resource
                   ($cfuname,$cfudom)=&Apache::loncacc::constructaccess($file,$1);
                   if (defined($cfudom)) {
                       if (&Apache::lonnet::homeserver($cfuname,$cfudom) 
                           eq $Apache::lonnet::perlvar{'lonHostID'}) {
                           $cfile=$file;
                       }
                   }
               }        
               # Finally, turn the button on or off
               if ($cfile) {
                   $editbutton=&switchmenu
                       (6,1,'cstr.gif','edit','resource',
                        'go("'.$cfile.'");',"Edit this resource");
               } elsif ($editbutton eq '') {
                   $editbutton = '    menu.clearbut(6,1);';
               }
           }
           ###
           ###
  $result = (<<ENDREGTHIS);   $result = (<<ENDREGTHIS);
             
 <script language="JavaScript">  <script language="JavaScript">
Line 456  ENDPARM Line 525  ENDPARM
           menu.switchbutton            menu.switchbutton
                                (9,3,'anot.gif','anno-','tations','annotate()','Make notes and annotations about this resource');                                 (9,3,'anot.gif','anno-','tations','annotate()','Make notes and annotations about this resource');
           $hwkadd            $hwkadd
             $editbutton
     }      }
   
     function LONCAPAstale() {      function LONCAPAstale() {
Line 470  ENDPARM Line 540  ENDPARM
           menu.clearbut(7,3);            menu.clearbut(7,3);
           menu.menucltim=menu.setTimeout(            menu.menucltim=menu.setTimeout(
  'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+   'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
  'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)',   'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3);clearbut(6,1)',
   2000);    2000);
   
       }        }
Line 598  sub htmlclean { Line 668  sub htmlclean {
   
 sub latex_special_symbols {  sub latex_special_symbols {
     my ($current_token,$stack,$parstack)=@_;      my ($current_token,$stack,$parstack)=@_;
     $current_token=~s/\\/\\char92 /g;      $current_token=~s/\\ /\\char92 /g;
     $current_token=~s/\^/\\char94 /g;      $current_token=~s/\^/\\char94 /g;
     $current_token=~s/\~/\\char126 /g;      $current_token=~s/\~/\\char126 /g;
     $current_token=~s/(&[^a-z\#])/\\$1/g;      $current_token=~s/(&[^a-z\#])/\\$1/g;
Line 623  sub inner_xmlparse { Line 693  sub inner_xmlparse {
  if ($metamode<1) {   if ($metamode<1) {
     my $text=$token->[1];      my $text=$token->[1];
     if ($token->[0] eq 'C' && $target eq 'tex') {      if ($token->[0] eq 'C' && $target eq 'tex') {
  $text = '%'.$text;   $text = '%'.$text."\n";
  $text =~ s/[\n\r]//g;  
     }      }
     $result.=$text;      $result.=$text;
  }   }
Line 702  sub inner_xmlparse { Line 771  sub inner_xmlparse {
       if ($token->[0] eq 'E') {         if ($token->[0] eq 'E') { 
  &end_tag($stack,$parstack,$token);   &end_tag($stack,$parstack,$token);
       }        }
     }      }
     if ($#$pars > -1) {      if ($#$pars > -1) {
  pop @$pars;   pop @$pars;
  pop @Apache::lonxml::pwd;   pop @Apache::lonxml::pwd;
Line 716  sub inner_xmlparse { Line 785  sub inner_xmlparse {
   
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }    }    
   return $finaloutput;    return $finaloutput;
 }  }
   
Line 744  sub callsub { Line 813  sub callsub {
     }      }
     if (!$deleted) {      if (!$deleted) {
       if ($space) {        if ($space) {
  &Apache::lonxml::debug("Calling sub $sub in $space $metamode");   #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
  $sub1="$space\:\:$sub";   $sub1="$space\:\:$sub";
  ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,   ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
      $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
      $style);       $style);
       } else {        } else {
  &Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");   #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
  if ($metamode <1) {   if ($metamode <1) {
   if (defined($token->[4]) && ($metamode < 1)) {    if (defined($token->[4]) && ($metamode < 1)) {
     $currentstring = $token->[4];      $currentstring = $token->[4];
Line 762  sub callsub { Line 831  sub callsub {
       #    &Apache::lonxml::debug("nodefalt:$nodefault:");        #    &Apache::lonxml::debug("nodefalt:$nodefault:");
       if ($currentstring eq '' && $nodefault eq '') {        if ($currentstring eq '' && $nodefault eq '') {
  if ($target eq 'edit') {   if ($target eq 'edit') {
   &Apache::lonxml::debug("doing default edit for $token->[1]");    #&Apache::lonxml::debug("doing default edit for $token->[1]");
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring = &Apache::edit::tag_start($target,$token);      $currentstring = &Apache::edit::tag_start($target,$token);
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
Line 863  sub init_safespace { Line 932  sub init_safespace {
   $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');    $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
   $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');    $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
   $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');    $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::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_beta,$safeeval,'&math_random_beta');
   $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');    $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_exponential,$safeeval,'&math_random_exponential');
Line 1013  sub store_counter { Line 1113  sub store_counter {
 sub get_all_text {  sub get_all_text {
  my($tag,$pars)= @_;   my($tag,$pars)= @_;
  &Apache::lonxml::debug("Got a ".ref($pars));   &Apache::lonxml::debug("Got a ".ref($pars));
    my $gotfullstack=1;
  if (ref($pars) ne 'ARRAY') {   if (ref($pars) ne 'ARRAY') {
        $gotfullstack=0;
      $pars=[$pars];       $pars=[$pars];
  }   }
  my $depth=0;   my $depth=0;
Line 1022  sub get_all_text { Line 1124  sub get_all_text {
  if ( $tag =~ m:^/: ) {    if ( $tag =~ m:^/: ) { 
    my $tag=substr($tag,1);      my $tag=substr($tag,1); 
    #&Apache::lonxml::debug("have:$tag:");     #&Apache::lonxml::debug("have:$tag:");
    while (($depth >=0) && ($#$pars > -1)) {     my $top_empty=0;
      while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {       while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
        #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);         #&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->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
Line 1044  sub get_all_text { Line 1147  sub get_all_text {
        pop(@$pars);         pop(@$pars);
        pop(@Apache::lonxml::pwd);         pop(@Apache::lonxml::pwd);
      }       }
        if (($depth >=0) && ($#$pars == 0) ) {        &debug("here4");$top_empty=1; }
      }
      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 &lt;'.$tag.'&gt;');
          if ($gotfullstack) {
      my $newstring='</'.$tag.'>'.$result;
      &Apache::lonxml::newparser($pars,\$newstring);
          }
          $result='';
    }     }
  } else {   } else {
      while ($#$pars > -1) {       while ($#$pars > -1) {

Removed from v.1.214  
changed lines
  Added in v.1.221.2.2


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