Diff for /loncom/xml/lonxml.pm between versions 1.440 and 1.452

version 1.440, 2007/02/23 00:39:35 version 1.452, 2007/08/18 00:08:36
Line 42  package Apache::lonxml; Line 42  package Apache::lonxml;
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
 use strict;  use strict;
   use LONCAPA;
 use HTML::LCParser();  use HTML::LCParser();
 use HTML::TreeBuilder();  use HTML::TreeBuilder();
 use HTML::Entities();  use HTML::Entities();
Line 124  $evaluate = 1; Line 125  $evaluate = 1;
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
   # stores all Scrit Vars displays for later showing
   my @script_var_displays=();
   
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
   
Line 315  sub xmlparse { Line 319  sub xmlparse {
      }       }
  }   }
      }       }
  } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) {   } elsif ($env{'construct.style'}
     && ($env{'request.state'} eq 'construct')) {
      my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});       my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
      my $styletext=&Apache::lonnet::getfile($location);       my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {       if ($styletext ne '-1') {
           %style_for_target = (%style_for_target,   %style_for_target = (%style_for_target,
                           &Apache::style::styleparser($target,$styletext));        &Apache::style::styleparser($target,$styletext));
       }       }
  }   }
 #&printalltags();  #&printalltags();
  my @pars = ();   my @pars = ();
Line 356  sub xmlparse { Line 361  sub xmlparse {
   
  &clean_safespace($safeeval);   &clean_safespace($safeeval);
   
    if (@script_var_displays) {
        $finaloutput .= join('',@script_var_displays);
        undef(@script_var_displays);
    }
   
  if ($env{'form.return_only_error_and_warning_counts'}) {   if ($env{'form.return_only_error_and_warning_counts'}) {
      return "$errorcount:$warningcount";       return "$errorcount:$warningcount";
  }   }
Line 585  sub callsub { Line 595  sub callsub {
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
     $currentstring = &Apache::edit::tag_end($target,$token);      $currentstring = &Apache::edit::tag_end($target,$token);
   }    }
  } elsif ($target eq 'modified') {   }
         }
         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') {    if ($token->[0] eq 'S') {
     $currentstring = $token->[4];        $currentstring.=&Apache::edit::handle_insert();
     $currentstring.=&Apache::edit::handle_insert();  
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
     $currentstring = $token->[2];        $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
             $currentstring.=&Apache::edit::handle_insertafter($token->[1]);  
   } else {  
     $currentstring = $token->[2];  
   }    }
  }  
       }        }
     }      }
     use strict 'refs';      use strict 'refs';
Line 613  sub setup_globals { Line 629  sub setup_globals {
   &init_counter();    &init_counter();
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @script_var_displays=();
   @Apache::lonxml::ssi_info=();    @Apache::lonxml::ssi_info=();
   $Apache::lonxml::post_evaluate=1;    $Apache::lonxml::post_evaluate=1;
   $Apache::lonxml::warnings_error_header='';    $Apache::lonxml::warnings_error_header='';
Line 951  sub decreasedepth { Line 968  sub decreasedepth {
 sub get_id {  sub get_id {
     my ($parstack,$safeeval)=@_;      my ($parstack,$safeeval)=@_;
     my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);      my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
     if ($env{'request.state'} eq 'construct' && $id =~ /(\.|_)/) {      if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) {
  &error(&mt("IDs are not allowed to contain &quot;<tt>_</tt>&quot; or &quot;<tt>.</tt>&quot;"));   &error(&mt("ID &quot;[_1]&quot; contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",'<tt>'.$id.'</tt>'));
     }      }
     if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }      if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
     return $id;      return $id;
Line 990  sub get_all_text_unbalanced { Line 1007  sub get_all_text_unbalanced {
     return $result      return $result
 }  }
   
   =pod
   
   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.
   
   The value of it is stored in $Apache:lonxml::counter when live and
   stored back to env after done.
   
   =item &increment_counter($increment);
   
   Increments the internal counter environment variable a specified amount
   
   Optional Arguments:
     $increment - amount to increment by (defaults to 1)
   
   =cut
   
 sub increment_counter {  sub increment_counter {
     my ($increment) = @_;      my ($increment) = @_;
     if (defined($increment) && $increment gt 0) {      if (defined($increment) && $increment gt 0) {
Line 1000  sub increment_counter { Line 1035  sub increment_counter {
     $Apache::lonxml::counter_changed=1;      $Apache::lonxml::counter_changed=1;
 }  }
   
   =pod
   
   =item &init_counter($increment);
   
   Initialize the internal counter environment variable
   
   =cut
   
 sub init_counter {  sub init_counter {
     if ($env{'request.state'} eq 'construct') {      if ($env{'request.state'} eq 'construct') {
  $Apache::lonxml::counter=1;   $Apache::lonxml::counter=1;
Line 1202  sub writeallows { Line 1245  sub writeallows {
     my %httpref=();      my %httpref=();
     foreach (@extlinks) {      foreach (@extlinks) {
        $httpref{'httpref.'.         $httpref{'httpref.'.
          &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;           &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
     }      }
     @extlinks=();      @extlinks=();
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
Line 1221  sub do_registered_ssi { Line 1264  sub do_registered_ssi {
  &Apache::lonnet::ssi($url,%form);   &Apache::lonnet::ssi($url,%form);
     }      }
 }  }
   
   sub add_script_result {
       my ($display) = @_;
       push(@script_var_displays, $display);
   }
   
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1301  SIMPLECONTENT Line 1350  SIMPLECONTENT
   
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents,$filetype)=@_;        my ($filecontents,$filetype)=@_;
       $filecontents = &HTML::Entities::encode($filecontents,'<>&"');        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  #      my $editheader='<a href="#editsection">Edit below</a><hr />';
       my $xml_help = '';        my $xml_help = '';
       my $initialize='';        my $initialize='';
         my $textarea_id = 'filecont';
         my ($add_to_onload, $add_to_onresize);
       if ($filetype eq 'html') {        if ($filetype eq 'html') {
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();    my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
   $initialize=&Apache::lonhtmlcommon::spellheader();    $initialize=&Apache::lonhtmlcommon::spellheader();
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&    if (!&Apache::lonhtmlcommon::htmlareablocked() &&
       &Apache::lonhtmlcommon::htmlareabrowser()) {        &Apache::lonhtmlcommon::htmlareabrowser()) {
         $textarea_id .= '_htmlarea';
       $initialize.=(<<FULLPAGE);        $initialize.=(<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  $addbuttons
Line 1321  $addbuttons Line 1373  $addbuttons
  var editor=new HTMLArea("filecont",config);   var editor=new HTMLArea("filecont",config);
  editor.registerPlugin(FullPage);   editor.registerPlugin(FullPage);
  editor.generate();   editor.generate();
    setTimeout(
      function () {
          HTMLArea._addEvents(editor._doc,
      ["keypress","mousedown"], unClean);
          editor._iframe.id = '$textarea_id';
          resize_textarea('$textarea_id','LC_aftertextarea');";
      },300);
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
Line 1329  FULLPAGE Line 1388  FULLPAGE
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  $addbuttons
     function initDocument() {      function initDocument() {
    resize_textarea('$textarea_id','LC_aftertextarea');";
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
   }    }
           $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;    $add_to_onload = 'initDocument();';
     $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
       }        }
   
       my $cleanbut = '';        my $cleanbut = '';
   
       my $titledisplay=&display_title();        my $titledisplay=&display_title();
Line 1352  $cleanbut Line 1414  $cleanbut
 <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />  <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
 BUTTONS  BUTTONS
       $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');        $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
         my $textarea_events = &Apache::edit::element_change_detection();
         my $form_events     = &Apache::edit::form_change_detection();
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 $initialize  $initialize
 <hr />  <hr />
 <a name="editsection" />  <a name="editsection" />
 <form method="post" name="xmledit">  <form $form_events method="post" name="xmledit">
 $xml_help  $xml_help
 <input type="hidden" name="editmode" value="$lt{'ed'}" />  <input type="hidden" name="editmode" value="$lt{'ed'}" />
 $buttons<br />  $buttons<br />
 <textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>  <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
   <div id="LC_aftertextarea">
 <br />$buttons  <br />$buttons
 <br />  <br />
 </form>  
 $titledisplay  $titledisplay
   </div>
   </form>
 </body>  </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;        return ($editfooter,$add_to_onload,$add_to_onresize);;
       $result=~s/(\<\/body\>)/$editfooter/is;  
       return $result;  
 }  }
   
 sub get_target {  sub get_target {
Line 1479  ENDNOTFOUND Line 1543  ENDNOTFOUND
 #  #
     unless ($env{'request.state'} eq 'published') {      unless ($env{'request.state'} eq 'published') {
  if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))   if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
     {   {
       my ($edit_info, $add_to_onload, $add_to_onresize)=
    &inserteditinfo($filecontents,$filetype);
   
     my $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     my %options = ();      my %options = 
    ('add_entries' =>
                      {'onresize' => $add_to_onresize,
       'onload'   => $add_to_onload,   });
   
     if ($env{'environment.remote'} ne 'off') {      if ($env{'environment.remote'} ne 'off') {
  $options{'bgcolor'}   = '#FFFFFF';   $options{'bgcolor'}   = '#FFFFFF';
    $options{'only_body'} = 1;
     }      }
     my $start_page = &Apache::loncommon::start_page(undef,undef,      my $js =
    &Apache::edit::js_change_detection().
    &Apache::loncommon::resize_textarea_js();
       my $start_page = &Apache::loncommon::start_page(undef,$js,
     \%options);      \%options);
     $result=$start_page.      $result=$start_page.
  &Apache::lonxml::message_location().'<h3>'.   &Apache::lonxml::message_location().'<h3>'.
  $displayfile.   $displayfile.
  '</h3>'.&Apache::loncommon::end_page();   '</h3>'.
     $result=&inserteditinfo($result,$filecontents,$filetype);   $edit_info.
    &Apache::loncommon::end_page();
  }   }
     }      }
     if ($filetype eq 'html') { &writeallows($request->uri); }      if ($filetype eq 'html') { &writeallows($request->uri); }
   
           
     &Apache::lonxml::add_messages(\$result);      &Apache::lonxml::add_messages(\$result);
     $request->print($result);      $request->print($result);
Line 1692  sub get_param_var { Line 1767  sub get_param_var {
   }    }
 }  }
   
 sub register_insert_tab {  
   my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');  
   my $i;  
   my $tagnum=0;  
   my @order;  
   for ($i=0;$i < $#data; $i++) {  
     my $line = $data[$i];  
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }  
     if ( $line =~ /TABLE/ ) { last; }  
     my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);  
     if ($tag) {  
       $insertlist{"$tagnum.tag"} = $tag;  
       $insertlist{"$tag.description"} = $descrip;  
       $insertlist{"$tag.color"} = $color;  
       $insertlist{"$tag.function"} = $function;  
       if (!defined($show)) { $show='yes'; }  
       $insertlist{"$tag.show"}= $show;  
       $insertlist{"$tag.helpfile"} = $helpfile;  
       $insertlist{"$tag.helpdesc"} = $helpdesc;  
       $insertlist{"$tag.num"}=$tagnum;  
       $tagnum++;  
     }  
   }  
   $i++; #skipping TABLE line  
   $tagnum = 0;  
   for (;$i < $#data;$i++) {  
     my $line = $data[$i];  
     my ($mnemonic,@which) = split(/ +/,$line);  
     my $tag = $insertlist{"$tagnum.tag"};  
     for (my $j=0;$j <=$#which;$j++) {  
       if ( $which[$j] eq 'Y' ) {  
  if ($insertlist{"$j.show"} ne 'no') {  
   push(@{ $insertlist{"$tag.which"} },$insertlist{"$j.tag"});  
  }  
       }  
     }  
     $tagnum++;  
   }  
 }  
   
 sub register_insert_xml {  sub register_insert_xml {
     my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}      my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
      .'/insertlist.xml');       .'/insertlist.xml');
     my ($tagnum,$in_help)=(0,0);      my ($tagnum,$in_help)=(0,0);
       my @alltags;
     my $tag;      my $tag;
     while (my $token = $parser->get_token()) {      while (my $token = $parser->get_token()) {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
Line 1744  sub register_insert_xml { Line 1780  sub register_insert_xml {
  $tag = $token->[2]{'name'};   $tag = $token->[2]{'name'};
  $insertlist{"$tagnum.tag"} = $tag;   $insertlist{"$tagnum.tag"} = $tag;
  $insertlist{"$tag.num"}   = $tagnum;   $insertlist{"$tag.num"}   = $tagnum;
    push(@alltags,$tag);
     } elsif ($in_help && $token->[1] eq 'file') {      } elsif ($in_help && $token->[1] eq 'file') {
  $key = $tag.'.helpfile';   $key = $tag.'.helpfile';
     } elsif ($in_help && $token->[1] eq 'description') {      } elsif ($in_help && $token->[1] eq 'description') {
Line 1757  sub register_insert_xml { Line 1794  sub register_insert_xml {
     } elsif ($token->[1] eq 'help') {      } elsif ($token->[1] eq 'help') {
  $in_help=1;   $in_help=1;
     } elsif ($token->[1] eq 'allow') {      } elsif ($token->[1] eq 'allow') {
  my $allow = $parser->get_text();   $key = $tag.'.allow';
  foreach my $element (split(',',$allow)) {  
     $element =~ s/(^\s*|\s*$ )//gx;  
     push(@{ $insertlist{$tag.'.which'} },$element);  
  }  
     }      }
     if (defined($key)) {      if (defined($key)) {
  $insertlist{$key} = $parser->get_text();   $insertlist{$key} = $parser->get_text();
Line 1776  sub register_insert_xml { Line 1809  sub register_insert_xml {
     }      }
  }   }
     }      }
       
       # parse the allows and ignore tags set to <show>no</show>
       foreach my $tag (@alltags) {
           next if (!exists($insertlist{"$tag.allow"}));
    my $allow =  $insertlist{"$tag.allow"};
           foreach my $element (split(',',$allow)) {
       $element =~ s/(^\s*|\s*$ )//gx;
       if (!exists($insertlist{"$element.show"})
                   || $insertlist{"$element.show"} ne 'no') {
    push(@{ $insertlist{$tag.'.which'} },$element);
       }
    }
       }
 }  }
   
 sub register_insert {  sub register_insert {
 #    &register_insert_tab(@_);  
 #    &dump_insertlist('1');  
 #    undef(%insertlist);  
     return &register_insert_xml(@_);      return &register_insert_xml(@_);
 #    &dump_insertlist('2');  #    &dump_insertlist('2');
 }  }

Removed from v.1.440  
changed lines
  Added in v.1.452


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